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 Drasil.GOOL (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 Lang
lng Choices
chs = \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 Lang
Python Space
s (CodeType
Float:[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 Lang
_ Space
s (CodeType
t:[CodeType]
_) = 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 a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return CodeType
t
        selectType Lang
l Space
s [] = [Char] -> GenState CodeType
forall a. HasCallStack => [Char] -> a
error ([Char] -> GenState CodeType) -> [Char] -> GenState CodeType
forall a b. (a -> b) -> a -> b
$ [Char]
"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]
++ [Char]
" 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 Lang
l Space
s CodeType
t = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char]
"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]
++ [Char]
" does not support "
  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"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]
++ [Char]
", 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]
++
  [Char]
" space. Trying next choice."

-- | Defines a successful log message.
successLog :: Space -> CodeType -> Doc
successLog :: Space -> CodeType -> Doc
successLog Space
s CodeType
t = [Char] -> Doc
text ([Char]
"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]
++ [Char]
" 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]
++[Char]
".")