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 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
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Space -> CodeType -> DrasilState -> DrasilState
addLoggedSpace Space
s CodeType
Float 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
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Space -> CodeType -> DrasilState -> DrasilState
addLoggedSpace Space
s CodeType
t 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))
          forall (m :: * -> *) a. Monad m => a -> m a
return CodeType
t
        selectType Lang
l Space
s [] = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Chosen CodeType matches for Space " forall a. [a] -> [a] -> [a]
++
          forall a. Show a => a -> [Char]
show Space
s forall a. [a] -> [a] -> [a]
++ [Char]
" are not compatible with target language " forall a. [a] -> [a] -> [a]
++ 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 forall a b. (a -> b) -> a -> b
$ [Char]
"Language " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Lang
l forall a. [a] -> [a] -> [a]
++ [Char]
" does not support "
  forall a. [a] -> [a] -> [a]
++ [Char]
"code type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CodeType
t forall a. [a] -> [a] -> [a]
++ [Char]
", chosen as the match for the " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Space
s 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 "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Space
s forall a. [a] -> [a] -> [a]
++ [Char]
" with "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CodeType
t forall a. [a] -> [a] -> [a]
++[Char]
".")