module Language.Drasil.Code.Imperative.SpaceMatch (
  chooseSpace
) where

import Language.Drasil
import Language.Drasil.Choices (Choices(..), Maps(..))
import Language.Drasil.Code.Imperative.DrasilState (GenState, MatchedSpaces, 
  addToDesignLog, addLoggedSpace)
import Language.Drasil.Code.Lang (Lang(..))

import GOOL.Drasil (CodeType(..))

import Control.Monad.State (modify)
import Text.PrettyPrint.HughesPJ (Doc, text)

-- | Concretizes the 'spaceMatch' in 'Choices' to a 'MatchedSpace' based on target language.
chooseSpace :: Lang -> Choices -> MatchedSpaces
chooseSpace :: Lang -> Choices -> MatchedSpaces
chooseSpace lng :: Lang
lng chs :: Choices
chs = \s :: Space
s -> Lang -> Space -> [CodeType] -> GenState CodeType
selectType Lang
lng Space
s (Maps -> SpaceMatch
spaceMatch (Choices -> Maps
maps Choices
chs) Space
s)
        -- Floats unavailable in Python
  where selectType :: Lang -> Space -> [CodeType] -> GenState CodeType
        selectType :: Lang -> Space -> [CodeType] -> GenState CodeType
selectType Python s :: Space
s (Float:ts :: [CodeType]
ts) = do
          (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Space -> CodeType -> DrasilState -> DrasilState
addLoggedSpace Space
s CodeType
Float (DrasilState -> DrasilState)
-> (DrasilState -> DrasilState) -> DrasilState -> DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
            Space -> CodeType -> Doc -> DrasilState -> DrasilState
addToDesignLog Space
s CodeType
Float (Lang -> Space -> CodeType -> Doc
incompatibleType Lang
Python Space
s CodeType
Float))
          Lang -> Space -> [CodeType] -> GenState CodeType
selectType Lang
Python Space
s [CodeType]
ts
        -- In all other cases, just select first choice
        selectType _ s :: Space
s (t :: CodeType
t:_) = do 
          (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Space -> CodeType -> DrasilState -> DrasilState
addLoggedSpace Space
s CodeType
t (DrasilState -> DrasilState)
-> (DrasilState -> DrasilState) -> DrasilState -> DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Space -> CodeType -> Doc -> DrasilState -> DrasilState
addToDesignLog Space
s CodeType
t (Space -> CodeType -> Doc
successLog Space
s CodeType
t))
          CodeType -> GenState CodeType
forall (m :: * -> *) a. Monad m => a -> m a
return CodeType
t
        selectType l :: Lang
l s :: Space
s [] = [Char] -> GenState CodeType
forall a. HasCallStack => [Char] -> a
error ([Char] -> GenState CodeType) -> [Char] -> GenState CodeType
forall a b. (a -> b) -> a -> b
$ "Chosen CodeType matches for Space " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ 
          Space -> [Char]
forall a. Show a => a -> [Char]
show Space
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ " are not compatible with target language " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Lang -> [Char]
forall a. Show a => a -> [Char]
show Lang
l

-- | Defines a design log message based on an incompatibility between the given 
-- 'Lang' and attempted 'Space'-'CodeType' match.
incompatibleType :: Lang -> Space -> CodeType -> Doc
incompatibleType :: Lang -> Space -> CodeType -> Doc
incompatibleType l :: Lang
l s :: Space
s t :: CodeType
t = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ "Language " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Lang -> [Char]
forall a. Show a => a -> [Char]
show Lang
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ " does not support "
  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "code type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CodeType -> [Char]
forall a. Show a => a -> [Char]
show CodeType
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ", chosen as the match for the " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Space -> [Char]
forall a. Show a => a -> [Char]
show Space
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ 
  " space. Trying next choice." 

-- | Defines a successful log message.
successLog :: Space -> CodeType -> Doc
successLog :: Space -> CodeType -> Doc
successLog s :: Space
s t :: CodeType
t = [Char] -> Doc
text ("Successfully matched "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Space -> [Char]
forall a. Show a => a -> [Char]
show Space
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ " with "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CodeType -> [Char]
forall a. Show a => a -> [Char]
show CodeType
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++".")