{-# OPTIONS_GHC -Wno-orphans #-}

-- | Defines chunk types for use in code generation.
module Language.Drasil.Chunk.Code (
  CodeIdea(..), CodeChunk(..), CodeVarChunk(..), CodeFuncChunk(..),
  VarOrFunc(..), obv, quantvar, quantfunc, ccObjVar, codevars, codevars',
  funcResolve, varResolve, listToArray, programName, funcPrefix,
  DefiningCodeExpr(..)
) where

import Control.Lens ((^.), view)

import Language.Drasil
import Language.Drasil.Chunk.CodeBase
import Language.Drasil.Printers (symbolDoc)

import Text.PrettyPrint.HughesPJ (render)

-- | Finds the code name of a 'CodeChunk'.
instance CodeIdea    CodeChunk where
  codeName :: CodeChunk -> String
codeName = Doc -> String
render (Doc -> String) -> (CodeChunk -> Doc) -> CodeChunk -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Doc
symbolDoc (Symbol -> Doc) -> (CodeChunk -> Symbol) -> CodeChunk -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantityDict -> Symbol
forall q. HasSymbol q => q -> Symbol
codeSymb (QuantityDict -> Symbol)
-> (CodeChunk -> QuantityDict) -> CodeChunk -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting QuantityDict CodeChunk QuantityDict
-> CodeChunk -> QuantityDict
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting QuantityDict CodeChunk QuantityDict
Lens' CodeChunk QuantityDict
qc
  codeChunk :: CodeChunk -> CodeChunk
codeChunk = CodeChunk -> CodeChunk
forall a. a -> a
id

-- | Finds the code name and 'CodeChunk' within a 'CodeVarChunk'.
instance CodeIdea    CodeVarChunk where
  codeName :: CodeVarChunk -> String
codeName = CodeChunk -> String
forall c. CodeIdea c => c -> String
codeName (CodeChunk -> String)
-> (CodeVarChunk -> CodeChunk) -> CodeVarChunk -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting CodeChunk CodeVarChunk CodeChunk
-> CodeVarChunk -> CodeChunk
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CodeChunk CodeVarChunk CodeChunk
Lens' CodeVarChunk CodeChunk
ccv
  codeChunk :: CodeVarChunk -> CodeChunk
codeChunk CodeVarChunk
c = QuantityDict -> VarOrFunc -> CodeChunk
CodeC (Getting QuantityDict CodeChunk QuantityDict
-> CodeChunk -> QuantityDict
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting QuantityDict CodeChunk QuantityDict
Lens' CodeChunk QuantityDict
qc (CodeChunk -> QuantityDict) -> CodeChunk -> QuantityDict
forall a b. (a -> b) -> a -> b
$ Getting CodeChunk CodeVarChunk CodeChunk
-> CodeVarChunk -> CodeChunk
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CodeChunk CodeVarChunk CodeChunk
Lens' CodeVarChunk CodeChunk
ccv CodeVarChunk
c) VarOrFunc
Var

-- | Finds the code name and 'CodeChunk' within a 'CodeFuncChunk'.
instance CodeIdea    CodeFuncChunk where
  codeName :: CodeFuncChunk -> String
codeName = CodeChunk -> String
forall c. CodeIdea c => c -> String
codeName (CodeChunk -> String)
-> (CodeFuncChunk -> CodeChunk) -> CodeFuncChunk -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting CodeChunk CodeFuncChunk CodeChunk
-> CodeFuncChunk -> CodeChunk
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CodeChunk CodeFuncChunk CodeChunk
Iso' CodeFuncChunk CodeChunk
ccf
  codeChunk :: CodeFuncChunk -> CodeChunk
codeChunk CodeFuncChunk
c = QuantityDict -> VarOrFunc -> CodeChunk
CodeC (Getting QuantityDict CodeChunk QuantityDict
-> CodeChunk -> QuantityDict
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting QuantityDict CodeChunk QuantityDict
Lens' CodeChunk QuantityDict
qc (CodeChunk -> QuantityDict) -> CodeChunk -> QuantityDict
forall a b. (a -> b) -> a -> b
$ Getting CodeChunk CodeFuncChunk CodeChunk
-> CodeFuncChunk -> CodeChunk
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CodeChunk CodeFuncChunk CodeChunk
Iso' CodeFuncChunk CodeChunk
ccf CodeFuncChunk
c) VarOrFunc
Func

-- | Combine an Object-type 'CodeChunk' with another 'CodeChunk' to create a new
-- 'CodeChunk' which represents a field of the first. ex. @ccObjVar obj f = obj.f@.
ccObjVar :: CodeVarChunk -> CodeVarChunk -> CodeVarChunk
ccObjVar :: CodeVarChunk -> CodeVarChunk -> CodeVarChunk
ccObjVar CodeVarChunk
c1 CodeVarChunk
c2 = Space -> CodeVarChunk
checkObj (CodeVarChunk
c1 CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Getter c Space
Getter CodeVarChunk Space
typ)
  where checkObj :: Space -> CodeVarChunk
checkObj (Actor String
_) = CodeChunk -> Maybe CodeChunk -> CodeVarChunk
CodeVC (CodeVarChunk -> CodeChunk
forall c. CodeIdea c => c -> CodeChunk
codeChunk CodeVarChunk
c2) (CodeChunk -> Maybe CodeChunk
forall a. a -> Maybe a
Just (CodeChunk -> Maybe CodeChunk) -> CodeChunk -> Maybe CodeChunk
forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> CodeChunk
forall c. CodeIdea c => c -> CodeChunk
codeChunk CodeVarChunk
c1)
        checkObj Space
_ = String -> CodeVarChunk
forall a. HasCallStack => String -> a
error String
"First CodeChunk passed to ccObjVar must have Actor space"