module Language.Drasil.Code.Imperative.GenerateGOOL (ClassType(..),
genModuleWithImports, genModule, genDoxConfig, genReadMe,
primaryClass, auxClass, fApp, ctorCall, fAppInOut
) where
import Language.Drasil hiding (List)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..))
import Language.Drasil.Code.Imperative.GOOL.ClassInterface (ReadMeInfo(..),
AuxiliarySym(..))
import Language.Drasil.Choices (Comments(..), AuxFile(..))
import Language.Drasil.CodeSpec (CodeSpec(..))
import Language.Drasil.Mod (Name, Description, Import)
import GOOL.Drasil (SFile, VSType, SVariable, SValue, MSStatement, SMethod,
CSStateVar, SClass, NamedArgs, OOProg, FileSym(..), TypeElim(..),
ValueSym(..), Argument(..), ValueExpression(..), FuncAppStatement(..),
ClassSym(..), ModuleSym(..), CodeType(..), GOOLState)
import Data.Bifunctor (second)
import qualified Data.Map as Map (lookup)
import Data.Maybe (catMaybes)
import Control.Monad.State (get, modify)
genModuleWithImports :: (OOProg r) => Name -> Description -> [Import] ->
[GenState (Maybe (SMethod r))] ->
[GenState (Maybe (SClass r))] -> GenState (SFile r)
genModuleWithImports :: Name
-> Name
-> [Name]
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModuleWithImports n :: Name
n desc :: Name
desc is :: [Name]
is maybeMs :: [GenState (Maybe (SMethod r))]
maybeMs maybeCs :: [GenState (Maybe (SClass r))]
maybeCs = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: DrasilState
s -> DrasilState
s { currentModule :: Name
currentModule = Name
n })
let as :: [Name]
as = case DrasilState -> CodeSpec
codeSpec DrasilState
g of CodeSpec {authors :: ()
authors = [a]
a} -> (a -> Name) -> [a] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map a -> Name
forall n. HasName n => n -> Name
name [a]
a
[Maybe (SClass r)]
cs <- [GenState (Maybe (SClass r))]
-> StateT DrasilState Identity [Maybe (SClass r)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [GenState (Maybe (SClass r))]
maybeCs
[Maybe (SMethod r)]
ms <- [GenState (Maybe (SMethod r))]
-> StateT DrasilState Identity [Maybe (SMethod r)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [GenState (Maybe (SMethod r))]
maybeMs
let commMod :: SFile r -> SFile r
commMod | Comments
CommentMod Comments -> [Comments] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g = Name -> [Name] -> Name -> SFile r -> SFile r
forall (r :: * -> *).
FileSym r =>
Name -> [Name] -> Name -> SFile r -> SFile r
docMod Name
desc
[Name]
as (DrasilState -> Name
date DrasilState
g)
| Comments
CommentFunc Comments -> [Comments] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g Bool -> Bool -> Bool
&& Bool -> Bool
not ([Maybe (SMethod r)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe (SMethod r)]
ms) = Name -> [Name] -> Name -> SFile r -> SFile r
forall (r :: * -> *).
FileSym r =>
Name -> [Name] -> Name -> SFile r -> SFile r
docMod "" []
""
| Bool
otherwise = SFile r -> SFile r
forall a. a -> a
id
SFile r -> GenState (SFile r)
forall (m :: * -> *) a. Monad m => a -> m a
return (SFile r -> GenState (SFile r)) -> SFile r -> GenState (SFile r)
forall a b. (a -> b) -> a -> b
$ SFile r -> SFile r
commMod (SFile r -> SFile r) -> SFile r -> SFile r
forall a b. (a -> b) -> a -> b
$ FSModule r -> SFile r
forall (r :: * -> *). FileSym r => FSModule r -> SFile r
fileDoc (FSModule r -> SFile r) -> FSModule r -> SFile r
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> [SMethod r] -> [SClass r] -> FSModule r
forall (r :: * -> *).
ModuleSym r =>
Name -> [Name] -> [SMethod r] -> [SClass r] -> FSModule r
buildModule Name
n [Name]
is ([Maybe (SMethod r)] -> [SMethod r]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (SMethod r)]
ms) ([Maybe (SClass r)] -> [SClass r]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (SClass r)]
cs)
genModule :: (OOProg r) => Name -> Description ->
[GenState (Maybe (SMethod r))] ->
[GenState (Maybe (SClass r))] -> GenState (SFile r)
genModule :: Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule n :: Name
n desc :: Name
desc = Name
-> Name
-> [Name]
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModuleWithImports Name
n Name
desc []
genDoxConfig :: (AuxiliarySym r) => GOOLState -> GenState (Maybe (r (Auxiliary r)))
genDoxConfig :: GOOLState -> GenState (Maybe (r (Auxiliary r)))
genDoxConfig s :: GOOLState
s = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let n :: Name
n = CodeSpec -> Name
pName (CodeSpec -> Name) -> CodeSpec -> Name
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
cms :: [Comments]
cms = DrasilState -> [Comments]
commented DrasilState
g
v :: Verbosity
v = DrasilState -> Verbosity
doxOutput DrasilState
g
Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r))))
-> Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r)))
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not ([Comments] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Comments]
cms) then r (Auxiliary r) -> Maybe (r (Auxiliary r))
forall a. a -> Maybe a
Just (Name -> GOOLState -> Verbosity -> r (Auxiliary r)
forall (r :: * -> *).
AuxiliarySym r =>
Name -> GOOLState -> Verbosity -> r (Auxiliary r)
doxConfig Name
n GOOLState
s Verbosity
v) else Maybe (r (Auxiliary r))
forall a. Maybe a
Nothing
genReadMe :: (AuxiliarySym r) => ReadMeInfo -> GenState (Maybe (r (Auxiliary r)))
genReadMe :: ReadMeInfo -> GenState (Maybe (r (Auxiliary r)))
genReadMe rmi :: ReadMeInfo
rmi = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let n :: Name
n = CodeSpec -> Name
pName (CodeSpec -> Name) -> CodeSpec -> Name
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r))))
-> Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r)))
forall a b. (a -> b) -> a -> b
$ [AuxFile] -> ReadMeInfo -> Maybe (r (Auxiliary r))
forall (r :: * -> *).
AuxiliarySym r =>
[AuxFile] -> ReadMeInfo -> Maybe (r (Auxiliary r))
getReadMe (DrasilState -> [AuxFile]
auxiliaries DrasilState
g) ReadMeInfo
rmi {caseName :: Name
caseName = Name
n}
getReadMe :: (AuxiliarySym r) => [AuxFile] -> ReadMeInfo -> Maybe (r (Auxiliary r))
getReadMe :: [AuxFile] -> ReadMeInfo -> Maybe (r (Auxiliary r))
getReadMe auxl :: [AuxFile]
auxl rmi :: ReadMeInfo
rmi = if AuxFile
ReadME AuxFile -> [AuxFile] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AuxFile]
auxl then r (Auxiliary r) -> Maybe (r (Auxiliary r))
forall a. a -> Maybe a
Just (ReadMeInfo -> r (Auxiliary r)
forall (r :: * -> *).
AuxiliarySym r =>
ReadMeInfo -> r (Auxiliary r)
readMe ReadMeInfo
rmi) else Maybe (r (Auxiliary r))
forall a. Maybe a
Nothing
data ClassType = Primary | Auxiliary
mkClass :: (OOProg r) => ClassType -> Name -> Maybe Name -> Description ->
[CSStateVar r] -> GenState [SMethod r] ->
GenState (SClass r)
mkClass :: ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
mkClass s :: ClassType
s n :: Name
n l :: Maybe Name
l desc :: Name
desc vs :: [CSStateVar r]
vs mths :: GenState [SMethod r]
mths = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ds :: DrasilState
ds -> DrasilState
ds {currentClass :: Name
currentClass = Name
n})
[SMethod r]
ms <- GenState [SMethod r]
mths
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ds :: DrasilState
ds -> DrasilState
ds {currentClass :: Name
currentClass = ""})
let getFunc :: ClassType
-> [CS (r (StateVar r))] -> [MS (r (Method r))] -> CS (r (Class r))
getFunc Primary = Maybe Name
-> [CS (r (StateVar r))] -> [MS (r (Method r))] -> CS (r (Class r))
forall (r :: * -> *).
ClassSym r =>
Maybe Name
-> [CS (r (StateVar r))] -> [MS (r (Method r))] -> CS (r (Class r))
getFunc' Maybe Name
l
getFunc Auxiliary = Name
-> Maybe Name
-> [CS (r (StateVar r))]
-> [MS (r (Method r))]
-> CS (r (Class r))
forall (r :: * -> *).
ClassSym r =>
Name -> Maybe Name -> [CSStateVar r] -> [SMethod r] -> SClass r
extraClass Name
n Maybe Name
forall a. Maybe a
Nothing
getFunc' :: Maybe Name
-> [CS (r (StateVar r))] -> [MS (r (Method r))] -> CS (r (Class r))
getFunc' Nothing = Maybe Name
-> [CS (r (StateVar r))] -> [MS (r (Method r))] -> CS (r (Class r))
forall (r :: * -> *).
ClassSym r =>
Maybe Name
-> [CS (r (StateVar r))] -> [MS (r (Method r))] -> CS (r (Class r))
buildClass Maybe Name
forall a. Maybe a
Nothing
getFunc' (Just intfc :: Name
intfc) = Name
-> [Name]
-> [CS (r (StateVar r))]
-> [MS (r (Method r))]
-> CS (r (Class r))
forall (r :: * -> *).
ClassSym r =>
Name -> [Name] -> [CSStateVar r] -> [SMethod r] -> SClass r
implementingClass Name
n [Name
intfc]
c :: SClass r
c = ClassType -> [CSStateVar r] -> [SMethod r] -> SClass r
forall (r :: * -> *).
ClassSym r =>
ClassType
-> [CS (r (StateVar r))] -> [MS (r (Method r))] -> CS (r (Class r))
getFunc ClassType
s [CSStateVar r]
vs [SMethod r]
ms
SClass r -> GenState (SClass r)
forall (m :: * -> *) a. Monad m => a -> m a
return (SClass r -> GenState (SClass r))
-> SClass r -> GenState (SClass r)
forall a b. (a -> b) -> a -> b
$ if Comments
CommentClass Comments -> [Comments] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g
then Name -> SClass r -> SClass r
forall (r :: * -> *). ClassSym r => Name -> SClass r -> SClass r
docClass Name
desc SClass r
c
else SClass r
c
primaryClass :: (OOProg r) => Name -> Maybe Name -> Description ->
[CSStateVar r] -> GenState [SMethod r] ->
GenState (SClass r)
primaryClass :: Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
primaryClass = ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
forall (r :: * -> *).
OOProg r =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
mkClass ClassType
Primary
auxClass :: (OOProg r) => Name -> Maybe Name -> Description ->
[CSStateVar r] -> GenState [SMethod r] ->
GenState (SClass r)
auxClass :: Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
auxClass = ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
forall (r :: * -> *).
OOProg r =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
mkClass ClassType
Auxiliary
mkArg :: (OOProg r) => SValue r -> SValue r
mkArg :: SValue r -> SValue r
mkArg v :: SValue r
v = do
r (Value r)
vl <- SValue r
v
let mkArg' :: CodeType -> VS (r (Value r)) -> VS (r (Value r))
mkArg' (List _) = VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *). Argument r => SValue r -> SValue r
pointerArg
mkArg' (Object _) = VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *). Argument r => SValue r -> SValue r
pointerArg
mkArg' _ = VS (r (Value r)) -> VS (r (Value r))
forall a. a -> a
id
CodeType -> SValue r -> SValue r
forall (r :: * -> *).
Argument r =>
CodeType -> VS (r (Value r)) -> VS (r (Value r))
mkArg' (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Type r) -> CodeType) -> r (Type r) -> CodeType
forall a b. (a -> b) -> a -> b
$ r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
vl) (r (Value r) -> SValue r
forall (m :: * -> *) a. Monad m => a -> m a
return r (Value r)
vl)
fCall :: (OOProg r) => (Name -> [SValue r] -> NamedArgs r -> SValue r) ->
[SValue r] -> NamedArgs r -> GenState (SValue r)
fCall :: (Name -> [SValue r] -> NamedArgs r -> SValue r)
-> [SValue r] -> NamedArgs r -> GenState (SValue r)
fCall f :: Name -> [SValue r] -> NamedArgs r -> SValue r
f vl :: [SValue r]
vl ns :: NamedArgs r
ns = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let cm :: Name
cm = DrasilState -> Name
currentModule DrasilState
g
args :: [SValue r]
args = (SValue r -> SValue r) -> [SValue r] -> [SValue r]
forall a b. (a -> b) -> [a] -> [b]
map SValue r -> SValue r
forall (r :: * -> *). OOProg r => SValue r -> SValue r
mkArg [SValue r]
vl
nargs :: NamedArgs r
nargs = ((VS (r (Variable r)), SValue r)
-> (VS (r (Variable r)), SValue r))
-> NamedArgs r -> NamedArgs r
forall a b. (a -> b) -> [a] -> [b]
map ((SValue r -> SValue r)
-> (VS (r (Variable r)), SValue r)
-> (VS (r (Variable r)), SValue r)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second SValue r -> SValue r
forall (r :: * -> *). OOProg r => SValue r -> SValue r
mkArg) NamedArgs r
ns
SValue r -> GenState (SValue r)
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ Name -> [SValue r] -> NamedArgs r -> SValue r
f Name
cm [SValue r]
args NamedArgs r
nargs
fApp :: (OOProg r) => Name -> Name -> VSType r -> [SValue r] ->
NamedArgs r -> GenState (SValue r)
fApp :: Name
-> Name
-> VSType r
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
fApp m :: Name
m s :: Name
s t :: VSType r
t vl :: [SValue r]
vl ns :: NamedArgs r
ns = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(Name -> [SValue r] -> NamedArgs r -> SValue r)
-> [SValue r] -> NamedArgs r -> GenState (SValue r)
forall (r :: * -> *).
OOProg r =>
(Name -> [SValue r] -> NamedArgs r -> SValue r)
-> [SValue r] -> NamedArgs r -> GenState (SValue r)
fCall (\cm :: Name
cm args :: [SValue r]
args nargs :: NamedArgs r
nargs ->
if Name
m Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
cm then Name -> MixedCall r
forall (r :: * -> *). ValueExpression r => Name -> MixedCall r
extFuncAppMixedArgs Name
m Name
s VSType r
t [SValue r]
args NamedArgs r
nargs else
if Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
s (DrasilState -> Map Name Name
eMap DrasilState
g) Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Maybe Name
forall a. a -> Maybe a
Just Name
cm then MixedCall r
forall (r :: * -> *). ValueExpression r => MixedCall r
funcAppMixedArgs Name
s VSType r
t [SValue r]
args NamedArgs r
nargs
else MixedCall r
forall (r :: * -> *). ValueExpression r => MixedCall r
selfFuncAppMixedArgs Name
s VSType r
t [SValue r]
args NamedArgs r
nargs) [SValue r]
vl NamedArgs r
ns
ctorCall :: (OOProg r) => Name -> VSType r -> [SValue r] -> NamedArgs r
-> GenState (SValue r)
ctorCall :: Name
-> VSType r -> [SValue r] -> NamedArgs r -> GenState (SValue r)
ctorCall m :: Name
m t :: VSType r
t = (Name -> [SValue r] -> NamedArgs r -> SValue r)
-> [SValue r] -> NamedArgs r -> GenState (SValue r)
forall (r :: * -> *).
OOProg r =>
(Name -> [SValue r] -> NamedArgs r -> SValue r)
-> [SValue r] -> NamedArgs r -> GenState (SValue r)
fCall (\cm :: Name
cm args :: [SValue r]
args nargs :: NamedArgs r
nargs -> if Name
m Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
cm then
Name -> MixedCtorCall r
forall (r :: * -> *). ValueExpression r => MixedCall r
extNewObjMixedArgs Name
m VSType r
t [SValue r]
args NamedArgs r
nargs else MixedCtorCall r
forall (r :: * -> *). ValueExpression r => MixedCtorCall r
newObjMixedArgs VSType r
t [SValue r]
args NamedArgs r
nargs)
fAppInOut :: (OOProg r) => Name -> Name -> [SValue r] ->
[SVariable r] -> [SVariable r] -> GenState (MSStatement r)
fAppInOut :: Name
-> Name
-> [SValue r]
-> [SVariable r]
-> [SVariable r]
-> GenState (MSStatement r)
fAppInOut m :: Name
m n :: Name
n ins :: [SValue r]
ins outs :: [SVariable r]
outs both :: [SVariable r]
both = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let cm :: Name
cm = DrasilState -> Name
currentModule DrasilState
g
MSStatement r -> GenState (MSStatement r)
forall (m :: * -> *) a. Monad m => a -> m a
return (MSStatement r -> GenState (MSStatement r))
-> MSStatement r -> GenState (MSStatement r)
forall a b. (a -> b) -> a -> b
$ if Name
m Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
cm then Name -> InOutCall r
forall (r :: * -> *). FuncAppStatement r => Name -> InOutCall r
extInOutCall Name
m Name
n [SValue r]
ins [SVariable r]
outs [SVariable r]
both else if Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n
(DrasilState -> Map Name Name
eMap DrasilState
g) Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Maybe Name
forall a. a -> Maybe a
Just Name
cm then InOutCall r
forall (r :: * -> *). FuncAppStatement r => InOutCall r
inOutCall Name
n [SValue r]
ins [SVariable r]
outs [SVariable r]
both else
InOutCall r
forall (r :: * -> *). FuncAppStatement r => InOutCall r
selfInOutCall Name
n [SValue r]
ins [SVariable r]
outs [SVariable r]
both