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

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

import Drasil.GOOL (CodeType(..))
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(..))

-- | 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 (f :: * -> *) a. Applicative f => a -> f a
pure CodeType
t
        selectType Lang
l Space
s [] = String -> GenState CodeType
forall a. HasCallStack => String -> a
error (String -> GenState CodeType) -> String -> GenState CodeType
forall a b. (a -> b) -> a -> b
$ String
"Chosen CodeType matches for Space " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
          Space -> String
forall a. Show a => a -> String
show Space
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" are not compatible with target language " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Lang -> String
forall a. Show a => a -> String
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 = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"Language " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Lang -> String
forall a. Show a => a -> String
show Lang
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" does not support "
  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"code type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CodeType -> String
forall a. Show a => a -> String
show CodeType
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", chosen as the match for the " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Space -> String
forall a. Show a => a -> String
show Space
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
  String
" space. Trying next choice."

-- | Defines a successful log message.
successLog :: Space -> CodeType -> Doc
successLog :: Space -> CodeType -> Doc
successLog Space
s CodeType
t = String -> Doc
text (String
"Successfully matched "String -> String -> String
forall a. Semigroup a => a -> a -> a
<>Space -> String
forall a. Show a => a -> String
show Space
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" with "String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CodeType -> String
forall a. Show a => a -> String
show CodeType
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
".")