module Language.Drasil.ICOSolutionSearch (
    Def, Known, Need, solveExecOrder
) where

import Control.Lens ((^.))
import Data.List ((\\), intercalate, partition)

import Drasil.Database (ChunkDB, showUID, HasUID)
import Language.Drasil.Chunk.CodeDefinition (CodeDefinition, auxExprs)
import Utils.Drasil (subsetOf)

import Drasil.Code.CodeVar (DefiningCodeExpr(..), CodeVarChunk)
import Language.Drasil.Chunk.CodeBase (codevars', quantvar)

-- | Mathematical definition.
type Def = CodeDefinition
-- | Known values.
type Known = CodeVarChunk
-- | Calculated values.
type Need  = CodeVarChunk

-- | Find a calculation path from a list of 'Known' values to values that 'Need'
-- to be calculated, i.e., topologically sort a list of 'Def's.
solveExecOrder :: [Def] -> [Known] -> [Need] -> ChunkDB -> [Def]
solveExecOrder :: [Def] -> [CodeVarChunk] -> [CodeVarChunk] -> ChunkDB -> [Def]
solveExecOrder [Def]
allDefs [CodeVarChunk]
knowns [CodeVarChunk]
needs =
  [Def]
-> [Def] -> [CodeVarChunk] -> [CodeVarChunk] -> ChunkDB -> [Def]
topologicalSort [] [Def]
allDefs [CodeVarChunk]
knowns ([CodeVarChunk]
needs [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeVarChunk]
knowns)

-- | Topologically sort a list of 'Def's. First parameter is the found path.
topologicalSort :: [Def] -> [Def] -> [Known] -> [Need] -> ChunkDB -> [Def]
topologicalSort :: [Def]
-> [Def] -> [CodeVarChunk] -> [CodeVarChunk] -> ChunkDB -> [Def]
topologicalSort [Def]
foundOrder [Def]
allDefs [CodeVarChunk]
knowns [CodeVarChunk]
needs ChunkDB
db
  -- Successfully found a path
  | [CodeVarChunk] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CodeVarChunk]
needs = [Def]
foundOrder
  -- Path impossible (missing pieces)
  | [Def] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Def]
nextCalcs = [Def] -> [CodeVarChunk] -> [CodeVarChunk] -> [Def]
forall a. [Def] -> [CodeVarChunk] -> [CodeVarChunk] -> a
prettyError [Def]
allDefs [CodeVarChunk]
knowns [CodeVarChunk]
needs
  -- Continuously looks for the next possible set of 'Needs' that can be
  -- computed until all are consumed.
  | Bool
otherwise = [Def]
-> [Def] -> [CodeVarChunk] -> [CodeVarChunk] -> ChunkDB -> [Def]
topologicalSort
                  ([Def]
foundOrder [Def] -> [Def] -> [Def]
forall a. [a] -> [a] -> [a]
++ [Def]
nextCalcs)
                  [Def]
notReady
                  ([CodeVarChunk]
knowns [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. [a] -> [a] -> [a]
++ [CodeVarChunk]
newlyCalculated)
                  ([CodeVarChunk]
needs [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeVarChunk]
newlyCalculated)
                  ChunkDB
db
  where
    ([Def]
nextCalcs, [Def]
notReady) = (Def -> Bool) -> [Def] -> ([Def], [Def])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ChunkDB -> [CodeVarChunk] -> Def -> Bool
computable ChunkDB
db [CodeVarChunk]
knowns) [Def]
allDefs
    newlyCalculated :: [CodeVarChunk]
newlyCalculated = (Def -> CodeVarChunk) -> [Def] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map Def -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar [Def]
nextCalcs

-- | Check if a 'Def' is computable given a list of 'Known's.
computable :: ChunkDB -> [Known] -> Def -> Bool
computable :: ChunkDB -> [CodeVarChunk] -> Def -> Bool
computable ChunkDB
db [CodeVarChunk]
knowns Def
def = [CodeVarChunk]
requiredInputs [CodeVarChunk] -> [CodeVarChunk] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`subsetOf` [CodeVarChunk]
knowns
  where
    inputs :: [CodeVarChunk]
inputs = (CodeExpr -> [CodeVarChunk]) -> [CodeExpr] -> [CodeVarChunk]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CodeExpr -> ChunkDB -> [CodeVarChunk]
`codevars'` ChunkDB
db) (Def
def Def -> Getting CodeExpr Def CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr Def CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' Def CodeExpr
codeExpr CodeExpr -> [CodeExpr] -> [CodeExpr]
forall a. a -> [a] -> [a]
: Def
def Def -> Getting [CodeExpr] Def [CodeExpr] -> [CodeExpr]
forall s a. s -> Getting a s a -> a
^. Getting [CodeExpr] Def [CodeExpr]
Lens' Def [CodeExpr]
auxExprs)
    -- FIXME: This allows variables to be defined in terms of themselves, but is
    -- this the right spot for this sanity check?
    requiredInputs :: [CodeVarChunk]
requiredInputs = [CodeVarChunk]
inputs [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Def -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar Def
def]

prettyError :: [Def] -> [Known] -> [Need] -> a
prettyError :: forall a. [Def] -> [CodeVarChunk] -> [CodeVarChunk] -> a
prettyError [Def]
defs [CodeVarChunk]
knowns [CodeVarChunk]
needs = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$
  [Char]
"The following outputs cannot be computed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [CodeVarChunk] -> [Char]
forall c. HasUID c => [c] -> [Char]
lm [CodeVarChunk]
needs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"Unused definitions are: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Def] -> [Char]
forall c. HasUID c => [c] -> [Char]
lm [Def]
defs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"Known values are: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [CodeVarChunk] -> [Char]
forall c. HasUID c => [c] -> [Char]
lm [CodeVarChunk]
knowns
  where
    lm :: HasUID c => [c] -> String
    lm :: forall c. HasUID c => [c] -> [Char]
lm = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ([[Char]] -> [Char]) -> ([c] -> [[Char]]) -> [c] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> [Char]) -> [c] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map c -> [Char]
forall a. HasUID a => a -> [Char]
showUID