module Language.Drasil.Code.Imperative.GenODE (
  chooseODELib
) where

import Language.Drasil (Sentence(..), (+:+.))
import Language.Drasil.Code.ExtLibImport (ExtLibState(..),
  genExternalLibraryCall)
import Language.Drasil.Code.Lang (Lang(..))
import Language.Drasil.Chunk.Code (codeName)
import Language.Drasil.Chunk.CodeDefinition (odeDef)
import Language.Drasil.Mod (Name, Version)
import Language.Drasil.Data.ODELibPckg (ODELibPckg(..))

import Control.Monad.State (State, modify)
import Language.Drasil.Choices (ODE(..))

-- | Holds the generation information for an ordinary differential equation.
type ODEGenInfo = (Maybe FilePath, [(Name, ExtLibState)], (Name,Version))

-- | Chooses the first 'ODELibPckg' from the list specified by the user that is
-- compatible with the current target 'Lang'.
-- Interprets the ExternalLibrary and ExternalLibraryCall for the selected
-- 'ODELibPckg' by concretizing the ExternalLibraryCall with each of the 'ODEInfo's
-- The internal helper chooseODELib' keeps a read only preference list and a currently considered
-- preference list (which can change), this facilitates the 'firstChoiceODELib' check.
chooseODELib :: Lang -> Maybe ODE -> State [Sentence] ODEGenInfo
chooseODELib :: Lang -> Maybe ODE -> State [Sentence] ODEGenInfo
chooseODELib Lang
_ Maybe ODE
Nothing = ODEGenInfo -> State [Sentence] ODEGenInfo
forall a. a -> StateT [Sentence] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name
forall a. Maybe a
Nothing, [], (Name
"",Name
""))
chooseODELib Lang
l (Just ODE
ode) = [ODELibPckg] -> [ODELibPckg] -> State [Sentence] ODEGenInfo
chooseODELib' (ODE -> [ODELibPckg]
odeLib ODE
ode) (ODE -> [ODELibPckg]
odeLib ODE
ode)
  where chooseODELib' :: [ODELibPckg] -> [ODELibPckg] -> State [Sentence] ODEGenInfo
        chooseODELib' :: [ODELibPckg] -> [ODELibPckg] -> State [Sentence] ODEGenInfo
chooseODELib' [ODELibPckg]
_ [] = Name -> State [Sentence] ODEGenInfo
forall a. HasCallStack => Name -> a
error (Name -> State [Sentence] ODEGenInfo)
-> Name -> State [Sentence] ODEGenInfo
forall a b. (a -> b) -> a -> b
$ Name
"None of the chosen ODE libraries are " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++
          Name
"compatible with " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Lang -> Name
forall a. Show a => a -> Name
show Lang
l
        chooseODELib' [ODELibPckg]
prefLibList (ODELibPckg
o:[ODELibPckg]
os) = if Lang
l Lang -> [Lang] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ODELibPckg -> [Lang]
compatibleLangs ODELibPckg
o
          then do
            ([Sentence] -> [Sentence]) -> StateT [Sentence] Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([Sentence] -> [Sentence] -> [Sentence]
forall a. [a] -> [a] -> [a]
++ [[ODELibPckg] -> ODELibPckg -> Sentence
firstChoiceODELib [ODELibPckg]
prefLibList ODELibPckg
o])
            ODEGenInfo -> State [Sentence] ODEGenInfo
forall a. a -> StateT [Sentence] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ODELibPckg -> Maybe Name
libPath ODELibPckg
o, (ODEInfo -> (Name, ExtLibState))
-> [ODEInfo] -> [(Name, ExtLibState)]
forall a b. (a -> b) -> [a] -> [b]
map (\ODEInfo
ode' -> (CodeDefinition -> Name
forall c. CodeIdea c => c -> Name
codeName (CodeDefinition -> Name) -> CodeDefinition -> Name
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeDefinition
odeDef ODEInfo
ode',
              ExternalLibrary -> ExternalLibraryCall -> ExtLibState
genExternalLibraryCall (ODELibPckg -> ExternalLibrary
libSpec ODELibPckg
o) (ExternalLibraryCall -> ExtLibState)
-> ExternalLibraryCall -> ExtLibState
forall a b. (a -> b) -> a -> b
$ ODELibPckg -> ODEInfo -> ExternalLibraryCall
libCall ODELibPckg
o ODEInfo
ode')) ([ODEInfo] -> [(Name, ExtLibState)])
-> [ODEInfo] -> [(Name, ExtLibState)]
forall a b. (a -> b) -> a -> b
$ ODE -> [ODEInfo]
odeInfo ODE
ode,
                (ODELibPckg -> Name
libName ODELibPckg
o, ODELibPckg -> Name
libVers ODELibPckg
o))
          else ([Sentence] -> [Sentence]) -> StateT [Sentence] Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([Sentence] -> [Sentence] -> [Sentence]
forall a. [a] -> [a] -> [a]
++ [Lang -> ODELibPckg -> Sentence
incompatibleLib Lang
l ODELibPckg
o]) StateT [Sentence] Identity ()
-> State [Sentence] ODEGenInfo -> State [Sentence] ODEGenInfo
forall a b.
StateT [Sentence] Identity a
-> StateT [Sentence] Identity b -> StateT [Sentence] Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ODELibPckg] -> [ODELibPckg] -> State [Sentence] ODEGenInfo
chooseODELib' [ODELibPckg]
prefLibList [ODELibPckg]
os

-- | Defines a design log message based on an incompatibility between the given
-- 'Lang' and chosen 'ODELibPckg'.
incompatibleLib :: Lang -> ODELibPckg -> Sentence
incompatibleLib :: Lang -> ODELibPckg -> Sentence
incompatibleLib Lang
lng ODELibPckg
lib = Name -> Sentence
S (Name -> Sentence) -> Name -> Sentence
forall a b. (a -> b) -> a -> b
$ Name
"Language " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Lang -> Name
forall a. Show a => a -> Name
show Lang
lng Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" is not " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++
  Name
"compatible with chosen library " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ ODELibPckg -> Name
libName ODELibPckg
lib Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
", trying next choice."

-- | Defines a design log message if the first choice ODE Library, which is the head of
-- the preference list that the user selected, is compatible with the given 'Lang'.
firstChoiceODELib :: [ODELibPckg] -> ODELibPckg -> Sentence
firstChoiceODELib :: [ODELibPckg] -> ODELibPckg -> Sentence
firstChoiceODELib [ODELibPckg]
prefer ODELibPckg
olp =  if ODELibPckg -> Name
libName ([ODELibPckg] -> ODELibPckg
forall a. HasCallStack => [a] -> a
head [ODELibPckg]
prefer) Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ODELibPckg -> Name
libName ODELibPckg
olp  then
  Name -> Sentence
S Name
"Successfully selected first choice ODE Library package" Sentence -> Sentence -> Sentence
+:+. Name -> Sentence
S (ODELibPckg -> Name
libName ODELibPckg
olp)
  else Name -> Sentence
S Name
"ODE Library package selected as" Sentence -> Sentence -> Sentence
+:+. Name -> Sentence
S (ODELibPckg -> Name
libName ODELibPckg
olp)