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)

-- | Defines a GOOL module. If the user chose 'CommentMod', the module will have
-- Doxygen comments. If the user did not choose 'CommentMod' but did choose
-- 'CommentFunc', a module-level Doxygen comment is still created, though it only
-- documents the file name, because without this Doxygen will not find the
-- function-level comments in the file.
genModuleWithImports :: (OOProg r) => Name -> Description -> [Import] ->
  [GenState (Maybe (SMethod r))] ->
  [GenState (Maybe (SClass r))] -> GenState (SFile r)
genModuleWithImports :: forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModuleWithImports Name
n Name
desc [Name]
is [GenState (Maybe (SMethod r))]
maybeMs [GenState (Maybe (SClass r))]
maybeCs = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
s -> DrasilState
s { currentModule :: Name
currentModule = Name
n })
  -- Below line of code cannot be simplified because authors has a generic type
  let as :: [Name]
as = case DrasilState -> CodeSpec
codeSpec DrasilState
g of CodeSpec {authors :: ()
authors = [a]
a} -> forall a b. (a -> b) -> [a] -> [b]
map forall n. HasName n => n -> Name
name [a]
a
  [Maybe (SClass r)]
cs <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [GenState (Maybe (SClass r))]
maybeCs
  [Maybe (SMethod r)]
ms <- 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g                   = forall (r :: * -> *).
FileSym r =>
Name -> [Name] -> Name -> SFile r -> SFile r
docMod Name
desc
                  [Name]
as (DrasilState -> Name
date DrasilState
g)
              | Comments
CommentFunc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe (SMethod r)]
ms) = forall (r :: * -> *).
FileSym r =>
Name -> [Name] -> Name -> SFile r -> SFile r
docMod Name
"" []
                  Name
""
              | Bool
otherwise                                       = forall a. a -> a
id
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SFile r -> SFile r
commMod forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). FileSym r => FSModule r -> SFile r
fileDoc forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
ModuleSym r =>
Name -> [Name] -> [SMethod r] -> [SClass r] -> FSModule r
buildModule Name
n [Name]
is (forall a. [Maybe a] -> [a]
catMaybes [Maybe (SMethod r)]
ms) (forall a. [Maybe a] -> [a]
catMaybes [Maybe (SClass r)]
cs)

-- | Generates a module for when imports do not need to be explicitly stated.
genModule :: (OOProg r) => Name -> Description ->
  [GenState (Maybe (SMethod r))] ->
  [GenState (Maybe (SClass r))] -> GenState (SFile r)
genModule :: forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
n Name
desc = forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModuleWithImports Name
n Name
desc []

-- | Generates a Doxygen configuration file if the user has comments enabled.
genDoxConfig :: (AuxiliarySym r) => GOOLState -> GenState (Maybe (r (Auxiliary r)))
genDoxConfig :: forall (r :: * -> *).
AuxiliarySym r =>
GOOLState -> GenState (Maybe (r (Auxiliary r)))
genDoxConfig GOOLState
s = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let n :: Name
n = CodeSpec -> Name
pName 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Comments]
cms) then forall a. a -> Maybe a
Just (forall (r :: * -> *).
AuxiliarySym r =>
Name -> GOOLState -> Verbosity -> r (Auxiliary r)
doxConfig Name
n GOOLState
s Verbosity
v) else forall a. Maybe a
Nothing

-- | Generates a README file.
genReadMe :: (AuxiliarySym r) => ReadMeInfo -> GenState (Maybe (r (Auxiliary r)))
genReadMe :: forall (r :: * -> *).
AuxiliarySym r =>
ReadMeInfo -> GenState (Maybe (r (Auxiliary r)))
genReadMe ReadMeInfo
rmi = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let n :: Name
n = CodeSpec -> Name
pName forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
AuxiliarySym r =>
[AuxFile] -> ReadMeInfo -> Maybe (r (Auxiliary r))
getReadMe (DrasilState -> [AuxFile]
auxiliaries DrasilState
g) ReadMeInfo
rmi {caseName :: Name
caseName = Name
n}

-- | Helper for generating a README file.
getReadMe :: (AuxiliarySym r) => [AuxFile] -> ReadMeInfo -> Maybe (r (Auxiliary r))
getReadMe :: forall (r :: * -> *).
AuxiliarySym r =>
[AuxFile] -> ReadMeInfo -> Maybe (r (Auxiliary r))
getReadMe [AuxFile]
auxl ReadMeInfo
rmi = if AuxFile
ReadME forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AuxFile]
auxl then forall a. a -> Maybe a
Just (forall (r :: * -> *).
AuxiliarySym r =>
ReadMeInfo -> r (Auxiliary r)
readMe ReadMeInfo
rmi) else forall a. Maybe a
Nothing

data ClassType = Primary | Auxiliary

-- | Generates a primary or auxiliary class with the given name, description,
-- state variables, and methods. The 'Maybe' 'Name' parameter is the name of the
-- interface the class implements, if applicable.
mkClass :: (OOProg r) => ClassType -> Name -> Maybe Name -> Description ->
  [CSStateVar r] -> GenState [SMethod r] ->
  GenState (SClass r)
mkClass :: forall (r :: * -> *).
OOProg r =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
mkClass ClassType
s Name
n Maybe Name
l Name
desc [CSStateVar r]
vs GenState [SMethod r]
mths = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
ds -> DrasilState
ds {currentClass :: Name
currentClass = Name
n})
  [SMethod r]
ms <- GenState [SMethod r]
mths
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
ds -> DrasilState
ds {currentClass :: Name
currentClass = Name
""})
  let getFunc :: ClassType
-> [CS (r (StateVar r))] -> [MS (r (Method r))] -> CS (r (Class r))
getFunc ClassType
Primary = forall {r :: * -> *}.
ClassSym r =>
Maybe Name
-> [CS (r (StateVar r))] -> [MS (r (Method r))] -> CS (r (Class r))
getFunc' Maybe Name
l
      getFunc ClassType
Auxiliary = forall (r :: * -> *).
ClassSym r =>
Name -> Maybe Name -> [CSStateVar r] -> [SMethod r] -> SClass r
extraClass Name
n forall a. Maybe a
Nothing
      getFunc' :: Maybe Name
-> [CS (r (StateVar r))] -> [MS (r (Method r))] -> CS (r (Class r))
getFunc' Maybe Name
Nothing = forall {r :: * -> *}.
ClassSym r =>
Maybe Name
-> [CS (r (StateVar r))] -> [MS (r (Method r))] -> CS (r (Class r))
buildClass forall a. Maybe a
Nothing
      getFunc' (Just Name
intfc) = forall (r :: * -> *).
ClassSym r =>
Name -> [Name] -> [CSStateVar r] -> [SMethod r] -> SClass r
implementingClass Name
n [Name
intfc]
      c :: SClass r
c = 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Comments
CommentClass forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g
    then forall (r :: * -> *). ClassSym r => Name -> SClass r -> SClass r
docClass Name
desc SClass r
c
    else SClass r
c

-- | Generates a primary class.
primaryClass :: (OOProg r) => Name -> Maybe Name -> Description ->
  [CSStateVar r] -> GenState [SMethod r] ->
  GenState (SClass r)
primaryClass :: forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
primaryClass = forall (r :: * -> *).
OOProg r =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
mkClass ClassType
Primary

-- | Generates an auxiliary class (for when a module contains multiple classes).
auxClass :: (OOProg r) => Name -> Maybe Name -> Description ->
  [CSStateVar r] -> GenState [SMethod r] ->
  GenState (SClass r)
auxClass :: forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
auxClass = forall (r :: * -> *).
OOProg r =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
mkClass ClassType
Auxiliary

-- | Converts lists or objects to pointer arguments, since we use pointerParam
-- for list or object-type parameters.
mkArg :: (OOProg r) => SValue r -> SValue r
mkArg :: forall (r :: * -> *). OOProg r => SValue r -> SValue r
mkArg SValue r
v = do
  r (Value r)
vl <- SValue r
v
  let mkArg' :: CodeType -> SValue r -> SValue r
mkArg' (List CodeType
_) = forall (r :: * -> *). Argument r => SValue r -> SValue r
pointerArg
      mkArg' (Object Name
_) = forall (r :: * -> *). Argument r => SValue r -> SValue r
pointerArg
      mkArg' CodeType
_ = forall a. a -> a
id
  forall {r :: * -> *}.
Argument r =>
CodeType -> SValue r -> SValue r
mkArg' (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
vl) (forall (m :: * -> *) a. Monad m => a -> m a
return r (Value r)
vl)


-- | Gets the current module and calls mkArg on the arguments.
-- Called by more specific function call generators ('fApp' and 'ctorCall').
fCall :: (OOProg r) => (Name -> [SValue r] -> NamedArgs r -> SValue r) ->
  [SValue r] -> NamedArgs r -> GenState (SValue r)
fCall :: forall (r :: * -> *).
OOProg r =>
(Name -> [SValue r] -> NamedArgs r -> SValue r)
-> [SValue r] -> NamedArgs r -> GenState (SValue r)
fCall Name -> [SValue r] -> NamedArgs r -> SValue r
f [SValue r]
vl NamedArgs r
ns = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cm :: Name
cm = DrasilState -> Name
currentModule DrasilState
g
      args :: [SValue r]
args = forall a b. (a -> b) -> [a] -> [b]
map forall (r :: * -> *). OOProg r => SValue r -> SValue r
mkArg [SValue r]
vl
      nargs :: NamedArgs r
nargs = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall (r :: * -> *). OOProg r => SValue r -> SValue r
mkArg) NamedArgs r
ns
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Name -> [SValue r] -> NamedArgs r -> SValue r
f Name
cm [SValue r]
args NamedArgs r
nargs

-- | Function call generator.
-- The first parameter (@m@) is the module where the function is defined.
-- If @m@ is not the current module, use GOOL's function for calling functions from
--   external modules.
-- If @m@ is the current module and the function is in export map, use GOOL's basic
--   function for function applications.
-- If @m@ is the current module and function is not exported, use GOOL's function for
--   calling a method on self. This assumes all private methods are dynamic,
--   which is true for this generator.
fApp :: (OOProg r) => Name -> Name -> VSType r -> [SValue r] ->
  NamedArgs r -> GenState (SValue r)
fApp :: forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> VSType r
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
fApp Name
m Name
s VSType r
t [SValue r]
vl NamedArgs r
ns = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (r :: * -> *).
OOProg r =>
(Name -> [SValue r] -> NamedArgs r -> SValue r)
-> [SValue r] -> NamedArgs r -> GenState (SValue r)
fCall (\Name
cm [SValue r]
args NamedArgs r
nargs ->
    if Name
m forall a. Eq a => a -> a -> Bool
/= Name
cm then forall (r :: * -> *). ValueExpression r => Name -> MixedCall r
extFuncAppMixedArgs Name
m Name
s VSType r
t [SValue r]
args NamedArgs r
nargs else
      if forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
s (DrasilState -> ModExportMap
eMap DrasilState
g) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Name
cm then forall (r :: * -> *). ValueExpression r => MixedCall r
funcAppMixedArgs Name
s VSType r
t [SValue r]
args NamedArgs r
nargs
      else forall (r :: * -> *). ValueExpression r => MixedCall r
selfFuncAppMixedArgs Name
s VSType r
t [SValue r]
args NamedArgs r
nargs) [SValue r]
vl NamedArgs r
ns

-- | Logic similar to 'fApp', but the self case is not required here
-- (because constructor will never be private). Calls 'newObjMixedArgs'.
ctorCall :: (OOProg r) => Name -> VSType r -> [SValue r] -> NamedArgs r
  -> GenState (SValue r)
ctorCall :: forall (r :: * -> *).
OOProg r =>
Name
-> VSType r -> [SValue r] -> NamedArgs r -> GenState (SValue r)
ctorCall Name
m VSType r
t = forall (r :: * -> *).
OOProg r =>
(Name -> [SValue r] -> NamedArgs r -> SValue r)
-> [SValue r] -> NamedArgs r -> GenState (SValue r)
fCall (\Name
cm [SValue r]
args NamedArgs r
nargs -> if Name
m forall a. Eq a => a -> a -> Bool
/= Name
cm then
  forall (r :: * -> *). ValueExpression r => MixedCall r
extNewObjMixedArgs Name
m VSType r
t [SValue r]
args NamedArgs r
nargs else forall (r :: * -> *). ValueExpression r => MixedCtorCall r
newObjMixedArgs VSType r
t [SValue r]
args NamedArgs r
nargs)

-- | Logic similar to 'fApp', but for In/Out calls.
fAppInOut :: (OOProg r) => Name -> Name -> [SValue r] ->
  [SVariable r] -> [SVariable r] -> GenState (MSStatement r)
fAppInOut :: forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [SValue r]
-> [SVariable r]
-> [SVariable r]
-> GenState (MSStatement r)
fAppInOut Name
m Name
n [SValue r]
ins [SVariable r]
outs [SVariable r]
both = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cm :: Name
cm = DrasilState -> Name
currentModule DrasilState
g
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Name
m forall a. Eq a => a -> a -> Bool
/= Name
cm then forall (r :: * -> *). FuncAppStatement r => Name -> InOutCall r
extInOutCall Name
m Name
n [SValue r]
ins [SVariable r]
outs [SVariable r]
both else if forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n
    (DrasilState -> ModExportMap
eMap DrasilState
g) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Name
cm then forall (r :: * -> *). FuncAppStatement r => InOutCall r
inOutCall Name
n [SValue r]
ins [SVariable r]
outs [SVariable r]
both else
    forall (r :: * -> *). FuncAppStatement r => InOutCall r
selfInOutCall Name
n [SValue r]
ins [SVariable r]
outs [SVariable r]
both