module Language.Drasil.Code.Imperative.GenerateGOOL (ClassType(..),
  genModuleWithImports, genModuleWithImportsProc, genModule, genModuleProc,
  genDoxConfig, genReadMe, primaryClass, auxClass, fApp, fAppProc, ctorCall,
  fAppInOut, fAppInOutProc
) where

import Data.Bifunctor (second)
import qualified Data.Map as Map (lookup)
import Data.Maybe (catMaybes)
import Control.Monad.State (get, modify)
import Control.Lens ((^.))

import Drasil.FileHandling (FileLayout)
import Drasil.GProc (ProcProg)
import qualified Drasil.GProc as Proc (FileSym(..), ModuleSym(..))
import Language.Drasil hiding (List)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..),
  getDoxOutput, getSoftwareDossierFiles, HasChoices(..))
import Language.Drasil.SoftwareDossier.SoftwareDossierSym (SoftwareDossierSym(..),
  SoftwareDossierState)
import Language.Drasil.Code.Imperative.README.Core (ReadMeInfo(..))
import Language.Drasil.Choices (Comments(..), SoftwareDossierFile(..))
import Language.Drasil.Mod (Name, Description, Import)
import Drasil.Metadata (watermark)
import Drasil.System (HasSystemMeta(..), HasProjectName(..))

import Drasil.GOOL (CSStateVar, NamedArgs, OOProg, CS, FS, MS, VS, ValueSym(..),
  Argument(..), ValueExpression(..), InternalValueExp, OOValueExpression(..),
  SelfSym(..), VariableValue(..), FuncAppStatement(..), OOFuncAppStatement(..),
  ClassSym(..), CodeType(..), TypeElim(..), objMethodCallMixedArgs)
import qualified Drasil.GOOL as OO (FileSym(..), ModuleSym(..))

-- | 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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => Name
  -> Description
  -> [Import]
  -> [GenState (Maybe (MS (r mthd)))]
  -> [GenState (Maybe (CS (r cls)))]
  -> GenState (FS (r file))
genModuleWithImports :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r cls)))]
-> GenState (FS (r file))
genModuleWithImports Name
n Name
desc [Name]
is [GenState (Maybe (MS (r mthd)))]
maybeMs [GenState (Maybe (CS (r cls)))]
maybeCs = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
s -> DrasilState
s { currentModule = n })
  let as = Person -> Name
forall n. HasName n => n -> Name
fullName (Person -> Name) -> [Person] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DrasilState
g DrasilState -> Getting [Person] DrasilState [Person] -> [Person]
forall s a. s -> Getting a s a -> a
^. Getting [Person] DrasilState [Person]
forall c. HasSystemMeta c => Lens' c [Person]
Lens' DrasilState [Person]
authors)
  cs <- sequence maybeCs
  ms <- sequence maybeMs
  let commMod | Comments
CommentMod Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState
g DrasilState
-> Getting [Comments] DrasilState [Comments] -> [Comments]
forall s a. s -> Getting a s a -> a
^. Getting [Comments] DrasilState [Comments]
forall a. HasChoices a => Lens' a [Comments]
Lens' DrasilState [Comments]
commented                   = Name -> Name -> [Name] -> Name -> FS (r file) -> FS (r file)
forall {k} (r :: k -> *) (file :: k) (mod :: k).
FileSym r file mod =>
Name -> Name -> [Name] -> Name -> FS (r file) -> FS (r file)
OO.docMod Name
desc Name
watermark [Name]
as (DrasilState
g DrasilState -> Getting Name DrasilState Name -> Name
forall s a. s -> Getting a s a -> a
^. Getting Name DrasilState Name
forall a. HasChoices a => Lens' a Name
Lens' DrasilState Name
date)
              | Comments
CommentFunc Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState
g DrasilState
-> Getting [Comments] DrasilState [Comments] -> [Comments]
forall s a. s -> Getting a s a -> a
^. Getting [Comments] DrasilState [Comments]
forall a. HasChoices a => Lens' a [Comments]
Lens' DrasilState [Comments]
commented Bool -> Bool -> Bool
&& Bool -> Bool
not ([Maybe (MS (r mthd))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe (MS (r mthd))]
ms) = Name -> Name -> [Name] -> Name -> FS (r file) -> FS (r file)
forall {k} (r :: k -> *) (file :: k) (mod :: k).
FileSym r file mod =>
Name -> Name -> [Name] -> Name -> FS (r file) -> FS (r file)
OO.docMod Name
"" Name
watermark [] Name
""
              | Bool
otherwise                                          = FS (r file) -> FS (r file)
forall a. a -> a
id
  pure $ commMod $ OO.fileDoc $ OO.buildModule n is (catMaybes ms) (catMaybes cs)

-- | Generates a module for when imports do not need to be explicitly stated.
genModule
  :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => Name
  -> Description
  -> [GenState (Maybe (MS (r mthd)))]
  -> [GenState (Maybe (CS (r cls)))]
  -> GenState (FS (r file))
genModule :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
Name
-> Name
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r cls)))]
-> GenState (FS (r file))
genModule Name
n Name
desc = Name
-> Name
-> [Name]
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r cls)))]
-> GenState (FS (r file))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r cls)))]
-> GenState (FS (r file))
genModuleWithImports Name
n Name
desc []

-- | Generates a Doxygen configuration file if the user has comments enabled.
genDoxConfig :: (SoftwareDossierSym r) => SoftwareDossierState ->
  GenState (Maybe (r FileLayout))
genDoxConfig :: forall (r :: * -> *).
SoftwareDossierSym r =>
SoftwareDossierState -> GenState (Maybe (r FileLayout))
genDoxConfig SoftwareDossierState
s = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let n = DrasilState
g DrasilState -> Getting Name DrasilState Name -> Name
forall s a. s -> Getting a s a -> a
^. Getting Name DrasilState Name
forall c. HasProjectName c => Lens' c Name
Lens' DrasilState Name
projAbrv
      cms = DrasilState
g DrasilState
-> Getting [Comments] DrasilState [Comments] -> [Comments]
forall s a. s -> Getting a s a -> a
^. Getting [Comments] DrasilState [Comments]
forall a. HasChoices a => Lens' a [Comments]
Lens' DrasilState [Comments]
commented
      v = DrasilState -> Verbosity
getDoxOutput DrasilState
g
  pure $ if not (null cms) then doxConfig n s v else Nothing

-- | Generates a README file.
genReadMe :: (SoftwareDossierSym r) => ReadMeInfo -> GenState (Maybe (r FileLayout))
genReadMe :: forall (r :: * -> *).
SoftwareDossierSym r =>
ReadMeInfo -> GenState (Maybe (r FileLayout))
genReadMe ReadMeInfo
rmi = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let n = DrasilState
g DrasilState -> Getting Name DrasilState Name -> Name
forall s a. s -> Getting a s a -> a
^. Getting Name DrasilState Name
forall c. HasProjectName c => Lens' c Name
Lens' DrasilState Name
projAbrv
  pure $ getReadMe (getSoftwareDossierFiles g) rmi {caseName = n}

-- | Helper for generating a README file.
getReadMe :: (SoftwareDossierSym r) => [SoftwareDossierFile] -> ReadMeInfo -> Maybe (r FileLayout)
getReadMe :: forall (r :: * -> *).
SoftwareDossierSym r =>
[SoftwareDossierFile] -> ReadMeInfo -> Maybe (r FileLayout)
getReadMe [SoftwareDossierFile]
auxl ReadMeInfo
rmi = if SoftwareDossierFile
ReadME SoftwareDossierFile -> [SoftwareDossierFile] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SoftwareDossierFile]
auxl then r FileLayout -> Maybe (r FileLayout)
forall a. a -> Maybe a
Just (ReadMeInfo -> r FileLayout
forall (r :: * -> *).
SoftwareDossierSym r =>
ReadMeInfo -> r FileLayout
readMe ReadMeInfo
rmi) else Maybe (r FileLayout)
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
  :: (ClassSym r cls stvr mthd)
  => ClassType
  -> Name
  -> Maybe Name
  -> Description
  -> [CSStateVar r stvr]
  -> GenState [MS (r mthd)]
  -> GenState [MS (r mthd)]
  -> GenState (CS (r cls))
mkClass :: forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
mkClass ClassType
s Name
n Maybe Name
l Name
desc [CSStateVar r stvr]
vs GenState [MS (r mthd)]
cstrs GenState [MS (r mthd)]
mths = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
ds -> DrasilState
ds {currentClass = n})
  cs <- cstrs
  ms <- mths
  modify (\DrasilState
ds -> DrasilState
ds {currentClass = ""})
  let getFunc ClassType
Primary = Maybe Name
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r cls)
getFunc' Maybe Name
l
      getFunc ClassType
Auxiliary = Name
-> Maybe Name
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r cls)
forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
Name
-> Maybe Name
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r cls)
extraClass Name
n Maybe Name
forall a. Maybe a
Nothing
      getFunc' Maybe Name
Nothing = Maybe Name
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r cls)
forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
Maybe Name
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r cls)
buildClass Maybe Name
forall a. Maybe a
Nothing
      getFunc' (Just Name
intfc) = Name
-> [Name]
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r cls)
forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
Name
-> [Name]
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r cls)
implementingClass Name
n [Name
intfc]
      c = ClassType
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r cls)
getFunc ClassType
s [CSStateVar r stvr]
vs [MS (r mthd)]
cs [MS (r mthd)]
ms
  pure $ if CommentClass `elem` g ^. commented
    then docClass desc c
    else c

-- | Generates a primary class.
primaryClass
  :: (ClassSym r cls stvr mthd)
  => Name
  -> Maybe Name
  -> Description
  -> [CSStateVar r stvr]
  -> GenState [MS (r mthd)]
  -> GenState [MS (r mthd)]
  -> GenState (CS (r cls))
primaryClass :: forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
primaryClass = ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
mkClass ClassType
Primary

-- | Generates an auxiliary class (for when a module contains multiple classes).
auxClass
  :: (ClassSym r cls stvr mthd)
  => Name
  -> Maybe Name
  -> Description
  -> [CSStateVar r stvr]
  -> GenState [MS (r mthd)]
  -> GenState [MS (r mthd)]
  -> GenState (CS (r cls))
auxClass :: forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
auxClass = ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
mkClass ClassType
Auxiliary

-- | Converts lists or objects to pointer arguments, since we use pointerParam
-- for list or object-type parameters.
mkArg
  :: (ValueSym r val typ, Argument r val, TypeElim r typ)
  => VS (r val) -> VS (r val)
mkArg :: forall {k} (r :: k -> *) (val :: k) (typ :: k).
(ValueSym r val typ, Argument r val, TypeElim r typ) =>
VS (r val) -> VS (r val)
mkArg VS (r val)
v = do
  vl <- VS (r val)
v
  let mkArg' (List CodeType
_) = VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
Argument r val =>
VS (r val) -> VS (r val)
pointerArg
      mkArg' (Object Name
_) = VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
Argument r val =>
VS (r val) -> VS (r val)
pointerArg
      mkArg' CodeType
_ = VS (r val) -> VS (r val)
forall a. a -> a
id
  mkArg' (getCodeType $ valueType vl) (pure vl)

-- | Gets the current module and calls mkArg on the arguments.
-- Called by more specific function call generators ('fApp' and 'ctorCall').
fCall
  :: (ValueSym r val typ, Argument r val, TypeElim r typ)
  => (Name -> [VS (r val)] -> NamedArgs r var val -> VS (r val))
  -> [VS (r val)]
  -> NamedArgs r var val
  -> GenState (VS (r val))
fCall :: forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k).
(ValueSym r val typ, Argument r val, TypeElim r typ) =>
(Name -> [VS (r val)] -> NamedArgs r var val -> VS (r val))
-> [VS (r val)] -> NamedArgs r var val -> GenState (VS (r val))
fCall Name -> [VS (r val)] -> NamedArgs r var val -> VS (r val)
f [VS (r val)]
vl NamedArgs r var val
ns = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cm = DrasilState -> Name
currentModule DrasilState
g
      args = VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k) (typ :: k).
(ValueSym r val typ, Argument r val, TypeElim r typ) =>
VS (r val) -> VS (r val)
mkArg (VS (r val) -> VS (r val)) -> [VS (r val)] -> [VS (r val)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VS (r val)]
vl
      nargs = (VS (r val) -> VS (r val))
-> (VS (r var), VS (r val)) -> (VS (r var), VS (r val))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k) (typ :: k).
(ValueSym r val typ, Argument r val, TypeElim r typ) =>
VS (r val) -> VS (r val)
mkArg ((VS (r var), VS (r val)) -> (VS (r var), VS (r val)))
-> NamedArgs r var val -> NamedArgs r var val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedArgs r var val
ns
  pure $ f cm args 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
  ::
    ( ValueSym r val typ
    , Argument r val
    , VariableValue r var val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , TypeElim r typ
    )
  => Name
  -> Name
  -> VS (r typ)
  -> [VS (r val)]
  -> NamedArgs r var val
  -> GenState (VS (r val))
fApp :: forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, VariableValue r var val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ, TypeElim r typ) =>
Name
-> Name
-> VS (r typ)
-> [VS (r val)]
-> NamedArgs r var val
-> GenState (VS (r val))
fApp Name
m Name
s VS (r typ)
t [VS (r val)]
vl NamedArgs r var val
ns = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  fCall (\Name
cm [VS (r val)]
args NamedArgs r var val
nargs ->
    if Name
m Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
cm then Name -> MixedCall r var val typ
forall {k} (r :: k -> *) (var :: k) (val :: k) (binder :: k)
       (typ :: k).
ValueExpression r var val binder typ =>
Name -> MixedCall r var val typ
extFuncAppMixedArgs Name
m Name
s VS (r typ)
t [VS (r val)]
args NamedArgs r var val
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 var val typ
forall {k} (r :: k -> *) (var :: k) (val :: k) (binder :: k)
       (typ :: k).
ValueExpression r var val binder typ =>
MixedCall r var val typ
funcAppMixedArgs Name
s VS (r typ)
t [VS (r val)]
args NamedArgs r var val
nargs
      else VS (r typ)
-> VS (r val)
-> Name
-> [VS (r val)]
-> NamedArgs r var val
-> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
InternalValueExp r var val typ =>
VS (r typ)
-> VS (r val)
-> Name
-> [VS (r val)]
-> NamedArgs r var val
-> VS (r val)
objMethodCallMixedArgs VS (r typ)
t (VS (r var) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k).
VariableValue r var val =>
VS (r var) -> VS (r val)
valueOf VS (r var)
forall {k} (r :: k -> *) (var :: k). SelfSym r var => VS (r var)
self) Name
s [VS (r val)]
args NamedArgs r var val
nargs) vl ns

-- | Logic similar to 'fApp', but the self case is not required here
-- (because constructor will never be private). Calls 'newObjMixedArgs'.
ctorCall
  ::
    ( ValueSym r val typ
    , Argument r val
    , OOValueExpression r var val typ
    , TypeElim r typ
    )
  => Name
  -> VS (r typ)
  -> [VS (r val)]
  -> NamedArgs r var val
  -> GenState (VS (r val))
ctorCall :: forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k).
(ValueSym r val typ, Argument r val,
 OOValueExpression r var val typ, TypeElim r typ) =>
Name
-> VS (r typ)
-> [VS (r val)]
-> NamedArgs r var val
-> GenState (VS (r val))
ctorCall Name
m VS (r typ)
t = (Name -> [VS (r val)] -> NamedArgs r var val -> VS (r val))
-> [VS (r val)] -> NamedArgs r var val -> GenState (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k).
(ValueSym r val typ, Argument r val, TypeElim r typ) =>
(Name -> [VS (r val)] -> NamedArgs r var val -> VS (r val))
-> [VS (r val)] -> NamedArgs r var val -> GenState (VS (r val))
fCall (\Name
cm [VS (r val)]
args NamedArgs r var val
nargs -> if Name
m Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
cm then
  Name -> MixedCtorCall r var val typ
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
OOValueExpression r var val typ =>
Name -> MixedCtorCall r var val typ
extNewObjMixedArgs Name
m VS (r typ)
t [VS (r val)]
args NamedArgs r var val
nargs else MixedCtorCall r var val typ
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
OOValueExpression r var val typ =>
MixedCtorCall r var val typ
newObjMixedArgs VS (r typ)
t [VS (r val)]
args NamedArgs r var val
nargs)

-- | Logic similar to 'fApp', but for In/Out calls.
fAppInOut
  :: (FuncAppStatement r stmt var val, OOFuncAppStatement r stmt var val)
  => Name
  -> Name
  -> [VS (r val)]
  -> [VS (r var)]
  -> [VS (r var)]
  -> GenState (MS (r stmt))
fAppInOut :: forall {k} (r :: k -> *) (stmt :: k) (var :: k) (val :: k).
(FuncAppStatement r stmt var val,
 OOFuncAppStatement r stmt var val) =>
Name
-> Name
-> [VS (r val)]
-> [VS (r var)]
-> [VS (r var)]
-> GenState (MS (r stmt))
fAppInOut Name
m Name
n [VS (r val)]
ins [VS (r var)]
outs [VS (r var)]
both = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cm = DrasilState -> Name
currentModule DrasilState
g
  pure $ if m /= cm then extInOutCall m n ins outs both else if Map.lookup n
    (eMap g) == Just cm then inOutCall n ins outs both else
    selfInOutCall n ins outs both

-- Procedural Versions --

-- | 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.
genModuleWithImportsProc
  :: (ProcProg r prg file mod mthd vis param bod block stmt var scope val binder typ)
  => Name
  -> Description
  -> [Import]
  -> [GenState (Maybe (MS (r mthd)))]
  -> GenState (FS (r file))
genModuleWithImportsProc :: forall (r :: * -> *) prg file mod mthd vis param bod block stmt var
       scope val binder typ.
ProcProg
  r
  prg
  file
  mod
  mthd
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
genModuleWithImportsProc Name
n Name
desc [Name]
is [GenState (Maybe (MS (r mthd)))]
maybeMs = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
s -> DrasilState
s { currentModule = n })
  let as = Person -> Name
forall n. HasName n => n -> Name
fullName (Person -> Name) -> [Person] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DrasilState
g DrasilState -> Getting [Person] DrasilState [Person] -> [Person]
forall s a. s -> Getting a s a -> a
^. Getting [Person] DrasilState [Person]
forall c. HasSystemMeta c => Lens' c [Person]
Lens' DrasilState [Person]
authors)
  ms <- sequence maybeMs
  let commMod | Comments
CommentMod Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState
g DrasilState
-> Getting [Comments] DrasilState [Comments] -> [Comments]
forall s a. s -> Getting a s a -> a
^. Getting [Comments] DrasilState [Comments]
forall a. HasChoices a => Lens' a [Comments]
Lens' DrasilState [Comments]
commented                   = Name -> Name -> [Name] -> Name -> FS (r file) -> FS (r file)
forall {k} (r :: k -> *) (file :: k) (mod :: k).
FileSym r file mod =>
Name -> Name -> [Name] -> Name -> FS (r file) -> FS (r file)
Proc.docMod Name
desc Name
watermark [Name]
as (DrasilState
g DrasilState -> Getting Name DrasilState Name -> Name
forall s a. s -> Getting a s a -> a
^. Getting Name DrasilState Name
forall a. HasChoices a => Lens' a Name
Lens' DrasilState Name
date)
              | Comments
CommentFunc Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState
g DrasilState
-> Getting [Comments] DrasilState [Comments] -> [Comments]
forall s a. s -> Getting a s a -> a
^. Getting [Comments] DrasilState [Comments]
forall a. HasChoices a => Lens' a [Comments]
Lens' DrasilState [Comments]
commented Bool -> Bool -> Bool
&& Bool -> Bool
not ([Maybe (MS (r mthd))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe (MS (r mthd))]
ms) = Name -> Name -> [Name] -> Name -> FS (r file) -> FS (r file)
forall {k} (r :: k -> *) (file :: k) (mod :: k).
FileSym r file mod =>
Name -> Name -> [Name] -> Name -> FS (r file) -> FS (r file)
Proc.docMod Name
"" Name
watermark [] Name
""
              | Bool
otherwise                                          = FS (r file) -> FS (r file)
forall a. a -> a
id
  pure $ commMod $ Proc.fileDoc $ Proc.buildModule n is (catMaybes ms)

-- | Generates a module for when imports do not need to be explicitly stated.
genModuleProc
  :: (ProcProg r prg file mod mthd vis param bod block stmt var scope val binder typ)
  => Name
  -> Description
  -> [GenState (Maybe (MS (r mthd)))]
  -> GenState (FS (r file))
genModuleProc :: forall (r :: * -> *) prg file mod mthd vis param bod block stmt var
       scope val binder typ.
ProcProg
  r
  prg
  file
  mod
  mthd
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
Name
-> Name
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
genModuleProc Name
n Name
desc = Name
-> Name
-> [Name]
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
forall (r :: * -> *) prg file mod mthd vis param bod block stmt var
       scope val binder typ.
ProcProg
  r
  prg
  file
  mod
  mthd
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
genModuleWithImportsProc Name
n Name
desc []

-- | 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.
fAppProc
  ::
    ( ValueSym r val typ
    , Argument r val
    , TypeElim r typ
    , ValueExpression r var val binder typ
    )
  => Name
  -> Name
  -> VS (r typ)
  -> [VS (r val)]
  -> NamedArgs r var val
  -> GenState (VS (r val))
fAppProc :: forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, TypeElim r typ,
 ValueExpression r var val binder typ) =>
Name
-> Name
-> VS (r typ)
-> [VS (r val)]
-> NamedArgs r var val
-> GenState (VS (r val))
fAppProc Name
m Name
s VS (r typ)
t [VS (r val)]
vl NamedArgs r var val
ns = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  fCall (\Name
cm [VS (r val)]
args NamedArgs r var val
nargs ->
    if Name
m Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
cm then Name -> MixedCall r var val typ
forall {k} (r :: k -> *) (var :: k) (val :: k) (binder :: k)
       (typ :: k).
ValueExpression r var val binder typ =>
Name -> MixedCall r var val typ
extFuncAppMixedArgs Name
m Name
s VS (r typ)
t [VS (r val)]
args NamedArgs r var val
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 var val typ
forall {k} (r :: k -> *) (var :: k) (val :: k) (binder :: k)
       (typ :: k).
ValueExpression r var val binder typ =>
MixedCall r var val typ
funcAppMixedArgs Name
s VS (r typ)
t [VS (r val)]
args NamedArgs r var val
nargs
      else Name -> VS (r val)
forall a. HasCallStack => Name -> a
error Name
"fAppProc: Procedural languages do not support method calls.") vl ns

-- | Logic similar to 'fApp', but for In/Out calls.
fAppInOutProc
  :: (FuncAppStatement r stmt var val)
  => Name
  -> Name
  -> [VS (r val)]
  -> [VS (r var)]
  -> [VS (r var)]
  -> GenState (MS (r stmt))
fAppInOutProc :: forall {k} (r :: k -> *) (stmt :: k) (var :: k) (val :: k).
FuncAppStatement r stmt var val =>
Name
-> Name
-> [VS (r val)]
-> [VS (r var)]
-> [VS (r var)]
-> GenState (MS (r stmt))
fAppInOutProc Name
m Name
n [VS (r val)]
ins [VS (r var)]
outs [VS (r var)]
both = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cm = DrasilState -> Name
currentModule DrasilState
g
  pure $ if m /= cm then extInOutCall m n ins outs both else if Map.lookup n
    (eMap g) == Just cm then inOutCall n ins outs both
    else error "fAppInOutProc: Procedural languages do not support method calls."