-- | Contains functions related to the choice of concept matches.
module Language.Drasil.Code.Imperative.ConceptMatch (
  chooseConcept, conceptToGOOL
) where

import Language.Drasil (UID, Sentence(S), (+:+), (+:+.))

import Language.Drasil.Choices (Choices(..), CodeConcept(..),
    MatchedConceptMap, showChs, Maps(..))

import Drasil.GOOL (SValue, SharedProg, MathConstant(..))

import Prelude hiding (pi)
import qualified Data.Map as Map (mapWithKey)
import Control.Monad.State (State, modify)

-- | Concretizes the ConceptMatchMap in Choices to a 'MatchedConceptMap'.
-- Currently we don't have any Choices that would prevent a 'CodeConcept' from
-- being mapped, so we just take the head of the list of 'CodeConcept's
-- The ConceptMatchMap from choices is passed to chooseConcept' internally, this way
-- any 'CodeConcept' list can be matched to its appropiate 'UID'.
chooseConcept :: Choices -> State [Sentence] MatchedConceptMap
chooseConcept :: Choices -> State [Sentence] MatchedConceptMap
chooseConcept Choices
chs = Map UID (StateT [Sentence] Identity CodeConcept)
-> State [Sentence] MatchedConceptMap
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Map UID (m a) -> m (Map UID a)
sequence (Map UID (StateT [Sentence] Identity CodeConcept)
 -> State [Sentence] MatchedConceptMap)
-> Map UID (StateT [Sentence] Identity CodeConcept)
-> State [Sentence] MatchedConceptMap
forall a b. (a -> b) -> a -> b
$ (UID -> [CodeConcept] -> StateT [Sentence] Identity CodeConcept)
-> Map UID [CodeConcept]
-> Map UID (StateT [Sentence] Identity CodeConcept)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey UID -> [CodeConcept] -> StateT [Sentence] Identity CodeConcept
chooseConcept' (Maps -> Map UID [CodeConcept]
conceptMatch (Maps -> Map UID [CodeConcept]) -> Maps -> Map UID [CodeConcept]
forall a b. (a -> b) -> a -> b
$ Choices -> Maps
maps Choices
chs)
  where chooseConcept' :: UID -> [CodeConcept] -> State [Sentence] CodeConcept
        chooseConcept' :: UID -> [CodeConcept] -> StateT [Sentence] Identity CodeConcept
chooseConcept' UID
_ [] = [Char] -> StateT [Sentence] Identity CodeConcept
forall a. HasCallStack => [Char] -> a
error ([Char] -> StateT [Sentence] Identity CodeConcept)
-> [Char] -> StateT [Sentence] Identity CodeConcept
forall a b. (a -> b) -> a -> b
$ [Char]
"Empty list of CodeConcepts in the " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          [Char]
"ConceptMatchMap"
        chooseConcept' UID
uid (CodeConcept
c:[CodeConcept]
_) = do
            ([Sentence] -> [Sentence]) -> StateT [Sentence] Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([Sentence] -> [Sentence] -> [Sentence]
forall a. [a] -> [a] -> [a]
++ [[Char] -> Sentence
S [Char]
"Code Concept" Sentence -> Sentence -> Sentence
+:+ [Char] -> Sentence
S (UID -> [Char]
forall a. Show a => a -> [Char]
show UID
uid) Sentence -> Sentence -> Sentence
+:+ [Char] -> Sentence
S [Char]
"selected as" Sentence -> Sentence -> Sentence
+:+. CodeConcept -> Sentence
forall a. RenderChoices a => a -> Sentence
showChs CodeConcept
c])
            CodeConcept -> StateT [Sentence] Identity CodeConcept
forall a. a -> StateT [Sentence] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return CodeConcept
c

-- | Translates a 'CodeConcept' into GOOL.
conceptToGOOL :: (SharedProg r) => CodeConcept -> SValue r
conceptToGOOL :: forall (r :: * -> *). SharedProg r => CodeConcept -> SValue r
conceptToGOOL CodeConcept
Pi = SValue r
forall (r :: * -> *). MathConstant r => SValue r
pi