{-# LANGUAGE TemplateHaskell #-}
module Language.Drasil.Chunk.CodeVar where
import Data.Char (isSpace)
import Control.Lens ((^.), view, makeLenses, Lens')
import Language.Drasil.Classes (CommonIdea(abrv), Quantity, Idea(getA), NamedIdea(..), Callable)
import Language.Drasil.Chunk.Quantity (QuantityDict, implVar')
import Language.Drasil.Space (HasSpace(..), Space(..))
import Language.Drasil.Symbol (HasSymbol(symbol))
import Language.Drasil.UID (HasUID(uid), (+++))
import Language.Drasil.Chunk.UnitDefn (MayHaveUnit(getUnit))
import Language.Drasil.Stages (Stage(..))
import Language.Drasil.CodeExpr.Lang (CodeExpr)
import Utils.Drasil (toPlainName)
class CodeIdea c where
codeName :: c -> String
codeChunk :: c -> CodeChunk
class CodeIdea c => DefiningCodeExpr c where
codeExpr :: Lens' c CodeExpr
programName :: CommonIdea c => c -> String
programName :: forall c. CommonIdea c => c -> String
programName = String -> String
toPlainName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CommonIdea c => c -> String
abrv
funcPrefix :: String
funcPrefix :: String
funcPrefix = String
"func_"
data VarOrFunc = Var | Func
data CodeChunk = CodeC { CodeChunk -> QuantityDict
_qc :: QuantityDict
, CodeChunk -> VarOrFunc
kind :: VarOrFunc
}
makeLenses ''CodeChunk
instance HasUID CodeChunk where uid :: Lens' CodeChunk UID
uid = Lens' CodeChunk QuantityDict
qc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasUID c => Lens' c UID
uid
instance NamedIdea CodeChunk where term :: Lens' CodeChunk NP
term = Lens' CodeChunk QuantityDict
qc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. NamedIdea c => Lens' c NP
term
instance Idea CodeChunk where getA :: CodeChunk -> Maybe String
getA = forall c. Idea c => c -> Maybe String
getA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' CodeChunk QuantityDict
qc
instance HasSpace CodeChunk where typ :: Getter CodeChunk Space
typ = Lens' CodeChunk QuantityDict
qc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasSpace c => Getter c Space
typ
instance HasSymbol CodeChunk where symbol :: CodeChunk -> Stage -> Symbol
symbol = forall c. HasSymbol c => c -> Stage -> Symbol
symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' CodeChunk QuantityDict
qc
instance Quantity CodeChunk
instance Eq CodeChunk where CodeChunk
c1 == :: CodeChunk -> CodeChunk -> Bool
== CodeChunk
c2 = (CodeChunk
c1 forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) forall a. Eq a => a -> a -> Bool
== (CodeChunk
c2 forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
instance MayHaveUnit CodeChunk where getUnit :: CodeChunk -> Maybe UnitDefn
getUnit = forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' CodeChunk QuantityDict
qc
data CodeVarChunk = CodeVC {CodeVarChunk -> CodeChunk
_ccv :: CodeChunk,
CodeVarChunk -> Maybe CodeChunk
_obv :: Maybe CodeChunk}
makeLenses ''CodeVarChunk
instance HasUID CodeVarChunk where uid :: Lens' CodeVarChunk UID
uid = Lens' CodeVarChunk CodeChunk
ccv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasUID c => Lens' c UID
uid
instance NamedIdea CodeVarChunk where term :: Lens' CodeVarChunk NP
term = Lens' CodeVarChunk CodeChunk
ccv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. NamedIdea c => Lens' c NP
term
instance Idea CodeVarChunk where getA :: CodeVarChunk -> Maybe String
getA = forall c. Idea c => c -> Maybe String
getA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' CodeVarChunk CodeChunk
ccv
instance HasSpace CodeVarChunk where typ :: Getter CodeVarChunk Space
typ = Lens' CodeVarChunk CodeChunk
ccv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasSpace c => Getter c Space
typ
instance HasSymbol CodeVarChunk where symbol :: CodeVarChunk -> Stage -> Symbol
symbol = forall c. HasSymbol c => c -> Stage -> Symbol
symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' CodeVarChunk CodeChunk
ccv
instance Quantity CodeVarChunk
instance Eq CodeVarChunk where CodeVarChunk
c1 == :: CodeVarChunk -> CodeVarChunk -> Bool
== CodeVarChunk
c2 = (CodeVarChunk
c1 forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) forall a. Eq a => a -> a -> Bool
== (CodeVarChunk
c2 forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
instance MayHaveUnit CodeVarChunk where getUnit :: CodeVarChunk -> Maybe UnitDefn
getUnit = forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' CodeVarChunk CodeChunk
ccv
newtype CodeFuncChunk = CodeFC {CodeFuncChunk -> CodeChunk
_ccf :: CodeChunk}
makeLenses ''CodeFuncChunk
instance HasUID CodeFuncChunk where uid :: Lens' CodeFuncChunk UID
uid = Iso' CodeFuncChunk CodeChunk
ccf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasUID c => Lens' c UID
uid
instance NamedIdea CodeFuncChunk where term :: Lens' CodeFuncChunk NP
term = Iso' CodeFuncChunk CodeChunk
ccf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. NamedIdea c => Lens' c NP
term
instance Idea CodeFuncChunk where getA :: CodeFuncChunk -> Maybe String
getA = forall c. Idea c => c -> Maybe String
getA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' CodeFuncChunk CodeChunk
ccf
instance HasSpace CodeFuncChunk where typ :: Getter CodeFuncChunk Space
typ = Iso' CodeFuncChunk CodeChunk
ccf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasSpace c => Getter c Space
typ
instance HasSymbol CodeFuncChunk where symbol :: CodeFuncChunk -> Stage -> Symbol
symbol = forall c. HasSymbol c => c -> Stage -> Symbol
symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' CodeFuncChunk CodeChunk
ccf
instance Quantity CodeFuncChunk
instance Callable CodeFuncChunk
instance Eq CodeFuncChunk where CodeFuncChunk
c1 == :: CodeFuncChunk -> CodeFuncChunk -> Bool
== CodeFuncChunk
c2 = (CodeFuncChunk
c1 forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) forall a. Eq a => a -> a -> Bool
== (CodeFuncChunk
c2 forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
instance MayHaveUnit CodeFuncChunk where getUnit :: CodeFuncChunk -> Maybe UnitDefn
getUnit = forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' CodeFuncChunk CodeChunk
ccf
listToArray :: CodeVarChunk -> CodeVarChunk
listToArray :: CodeVarChunk -> CodeVarChunk
listToArray CodeVarChunk
c = Space -> CodeVarChunk
newSpc (CodeVarChunk
c forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ)
where newSpc :: Space -> CodeVarChunk
newSpc (Vect Space
t) = CodeChunk -> Maybe CodeChunk -> CodeVarChunk
CodeVC (QuantityDict -> VarOrFunc -> CodeChunk
CodeC (String
-> NP
-> Maybe String
-> Space
-> Symbol
-> Maybe UnitDefn
-> QuantityDict
implVar' (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ CodeVarChunk
c forall a. HasUID a => a -> String -> UID
+++ String
"_array")
(CodeVarChunk
c forall s a. s -> Getting a s a -> a
^. forall c. NamedIdea c => Lens' c NP
term) (forall c. Idea c => c -> Maybe String
getA CodeVarChunk
c) (Space -> Space
Array Space
t) (forall c. HasSymbol c => c -> Stage -> Symbol
symbol CodeVarChunk
c Stage
Implementation) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit CodeVarChunk
c))
VarOrFunc
Var) (CodeVarChunk
c forall s a. s -> Getting a s a -> a
^. Lens' CodeVarChunk (Maybe CodeChunk)
obv)
newSpc Space
_ = CodeVarChunk
c