{-# LANGUAGE PostfixOperators #-}
{-# LANGUAGE FlexibleContexts #-}

module Drasil.GProc.LanguageRenderer.AbstractProc (fileDoc, fileFromData,
  buildModule, docMod, modFromData, innerType, arrayElem, listAppend,
  listAdd, funcDecDef, function
) where

import Drasil.Shared.InterfaceCommon (Label, Body, SValue, SVariable,
  VariableElim(variableName, variableType), VisibilitySym(..), funcApp,
  getCodeType, convType, StatementSym, ValueExpression, IndexTranslator)
import qualified Drasil.Shared.InterfaceCommon as IC
import Drasil.GProc.InterfaceProc (File, Module)
import qualified Drasil.Shared.RendererClassesCommon as RC
import qualified Drasil.GProc.RendererClassesProc as RP
import Drasil.Shared.AST (isSource, ScopeData, TypeData, ParamData)
import Drasil.Shared.Helpers (vibcat, toState, emptyIfEmpty, getInnerType,
  onStateValue)
import Drasil.Shared.LanguageRenderer (addExt)
import qualified Drasil.Shared.LanguageRenderer.CommonPseudoOO as CP (modDoc')
import Drasil.Shared.LanguageRenderer.Constructors (mkStmtNoEnd, mkStateVar)
import Drasil.Shared.State (MS, VS, FS, lensFStoGS, lensFStoMS, lensMStoVS,
  getModuleName, setModuleName, setMainMod, currFileType, currMain, addFile,
  useVarName, currParameters, setVarScope)

import Prelude hiding ((<>))
import Control.Monad.State (get, modify)
import Control.Lens ((^.), over)
import qualified Control.Lens as L (set)
import Control.Lens.Zoom (zoom)
import Text.PrettyPrint.HughesPJ (Doc, isEmpty, brackets, (<>), render)

-- Files --

fileDoc :: (RP.RenderFile r) => String -> FS (r Module) -> FS (r File)
fileDoc :: forall (r :: * -> *).
RenderFile r =>
String -> FS (r Module) -> FS (r File)
fileDoc String
ext FS (r Module)
md = do
  r Module
m <- FS (r Module)
md
  String
nm <- FS String
getModuleName
  let fp :: String
fp = String -> String -> String
addExt String
ext String
nm
  String -> FS (r Module) -> FS (r File)
forall (r :: * -> *).
RenderFile r =>
String -> FS (r Module) -> FS (r File)
RP.fileFromData String
fp (r Module -> FS (r Module)
forall a s. a -> State s a
toState r Module
m)

fileFromData
  :: (RP.ModuleElim r)
  => (FilePath -> r Module -> r File) -> FilePath -> FS (r Module) -> FS (r File)
fileFromData :: forall (r :: * -> *).
ModuleElim r =>
(String -> r Module -> r File)
-> String -> FS (r Module) -> FS (r File)
fileFromData String -> r Module -> r File
f String
fpath FS (r Module)
mdl' = do
  -- Add this file to list of files as long as it is not empty
  r Module
mdl <- FS (r Module)
mdl'
  (FileState -> FileState) -> StateT FileState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FileState
s -> if Doc -> Bool
isEmpty (r Module -> Doc
forall (r :: * -> *). ModuleElim r => r Module -> Doc
RP.module' r Module
mdl)
    then FileState
s
    else ASetter FileState FileState GOOLState GOOLState
-> (GOOLState -> GOOLState) -> FileState -> FileState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter FileState FileState GOOLState GOOLState
Lens' FileState GOOLState
lensFStoGS (FileType -> String -> GOOLState -> GOOLState
addFile (FileState
s FileState -> Getting FileType FileState FileType -> FileType
forall s a. s -> Getting a s a -> a
^. Getting FileType FileState FileType
Lens' FileState FileType
currFileType) String
fpath) (FileState -> FileState) -> FileState -> FileState
forall a b. (a -> b) -> a -> b
$
      -- If this is the main source file, set it as the main module in the state
      if FileState
s FileState -> Getting Bool FileState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool FileState Bool
Lens' FileState Bool
currMain Bool -> Bool -> Bool
&& FileType -> Bool
isSource (FileState
s FileState -> Getting FileType FileState FileType -> FileType
forall s a. s -> Getting a s a -> a
^. Getting FileType FileState FileType
Lens' FileState FileType
currFileType)
        then ASetter FileState FileState GOOLState GOOLState
-> (GOOLState -> GOOLState) -> FileState -> FileState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter FileState FileState GOOLState GOOLState
Lens' FileState GOOLState
lensFStoGS (String -> GOOLState -> GOOLState
setMainMod String
fpath) FileState
s
        else FileState
s)
  r File -> FS (r File)
forall a. a -> StateT FileState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (r File -> FS (r File)) -> r File -> FS (r File)
forall a b. (a -> b) -> a -> b
$ String -> r Module -> r File
f String
fpath r Module
mdl

-- Parameters: Module name, Doc for imports, Doc to put at bottom of module,
-- methods
buildModule
  :: (RC.MethodElim r md, RP.RenderMod r)
  => Label -> FS Doc -> FS Doc -> [MS (r md)] -> FS (r Module)
buildModule :: forall (r :: * -> *) md.
(MethodElim r md, RenderMod r) =>
String -> FS Doc -> FS Doc -> [MS (r md)] -> FS (r Module)
buildModule String
n FS Doc
imps FS Doc
bot [MS (r md)]
fs = String -> FS Doc -> FS (r Module)
forall (r :: * -> *).
RenderMod r =>
String -> FS Doc -> FS (r Module)
RP.modFromData String
n (do
  [r md]
fns <- (MS (r md) -> StateT FileState Identity (r md))
-> [MS (r md)] -> StateT FileState Identity [r md]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (LensLike'
  (Zoomed (StateT MethodState Identity) (r md)) FileState MethodState
-> MS (r md) -> StateT FileState Identity (r md)
forall c.
LensLike'
  (Zoomed (StateT MethodState Identity) c) FileState MethodState
-> StateT MethodState Identity c -> StateT FileState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT MethodState Identity) (r md)) FileState MethodState
(MethodState -> Focusing Identity (r md) MethodState)
-> FileState -> Focusing Identity (r md) FileState
Lens' FileState MethodState
lensFStoMS) [MS (r md)]
fs
  Doc
is <- FS Doc
imps
  Doc
bt <- FS Doc
bot
  let fnDocs :: Doc
fnDocs = [Doc] -> Doc
vibcat ((r md -> Doc) -> [r md] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map r md -> Doc
forall (r :: * -> *) md. MethodElim r md => r md -> Doc
RC.method [r md]
fns [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
bt])
  Doc -> FS Doc
forall a. a -> StateT FileState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> FS Doc) -> Doc -> FS Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
emptyIfEmpty Doc
fnDocs ([Doc] -> Doc
vibcat ((Doc -> Bool) -> [Doc] -> [Doc]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc -> Bool) -> Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty) [Doc
is, Doc
fnDocs])))

docMod
  :: (RP.RenderFile r)
  => String -> String -> String -> [String] -> String -> FS (r File) -> FS (r File)
docMod :: forall (r :: * -> *).
RenderFile r =>
String
-> String
-> String
-> [String]
-> String
-> FS (r File)
-> FS (r File)
docMod String
e String
d String
wm [String]
a String
dt FS (r File)
fl = FS (r File) -> FS (r Doc) -> FS (r File)
forall (r :: * -> *).
RenderFile r =>
FS (r File) -> FS (r Doc) -> FS (r File)
RP.commentedMod FS (r File)
fl
  (State FileState [String] -> FS (r Doc)
forall a. State a [String] -> State a (r Doc)
forall (r :: * -> *) a.
BlockCommentSym r =>
State a [String] -> State a (r Doc)
RC.docComment (State FileState [String] -> FS (r Doc))
-> State FileState [String] -> FS (r Doc)
forall a b. (a -> b) -> a -> b
$ ModuleDocRenderer
CP.modDoc' String
d String
wm [String]
a String
dt (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
addExt String
e (String -> [String]) -> FS String -> State FileState [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FS String
getModuleName)

modFromData :: Label -> (Doc -> r Module) -> FS Doc -> FS (r Module)
modFromData :: forall (r :: * -> *).
String -> (Doc -> r Module) -> FS Doc -> FS (r Module)
modFromData String
n Doc -> r Module
f FS Doc
d = (FileState -> FileState) -> StateT FileState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> FileState -> FileState
setModuleName String
n) StateT FileState Identity ()
-> StateT FileState Identity (r Module)
-> StateT FileState Identity (r Module)
forall a b.
StateT FileState Identity a
-> StateT FileState Identity b -> StateT FileState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Doc -> r Module) -> FS Doc -> StateT FileState Identity (r Module)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue Doc -> r Module
f FS Doc
d

-- Lists and Arrays --

innerType :: (IC.TypeElim r) => VS (r TypeData) -> VS (r TypeData)
innerType :: forall (r :: * -> *).
TypeElim r =>
VS (r TypeData) -> VS (r TypeData)
innerType VS (r TypeData)
t = VS (r TypeData)
t VS (r TypeData)
-> (r TypeData -> VS (r TypeData)) -> VS (r TypeData)
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType (CodeType -> VS (r TypeData))
-> (r TypeData -> CodeType) -> r TypeData -> VS (r TypeData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> CodeType
getInnerType (CodeType -> CodeType)
-> (r TypeData -> CodeType) -> r TypeData -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r TypeData -> CodeType
forall (r :: * -> *). TypeElim r => r TypeData -> CodeType
getCodeType)

-- | Call to append a value to a list using a function call
listAppend
  :: (StatementSym r smt, ValueExpression r)
  => String -> SValue r -> SValue r -> MS (r smt)
listAppend :: forall (r :: * -> *) smt.
(StatementSym r smt, ValueExpression r) =>
String -> SValue r -> SValue r -> MS (r smt)
listAppend String
fnName SValue r
list SValue r
val = SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StatementSym r smt =>
SValue r -> MS (r smt)
IC.valStmt (SValue r -> MS (r smt)) -> SValue r -> MS (r smt)
forall a b. (a -> b) -> a -> b
$
  PosCall r
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp String
fnName VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.void [SValue r
list, SValue r
val]

-- | Call to insert a value into a list as a function call
listAdd
  :: (IndexTranslator r, StatementSym r smt, ValueExpression r)
  => String -> SValue r -> SValue r -> SValue r -> MS (r smt)
listAdd :: forall (r :: * -> *) smt.
(IndexTranslator r, StatementSym r smt, ValueExpression r) =>
String -> SValue r -> SValue r -> SValue r -> MS (r smt)
listAdd String
fnName SValue r
list SValue r
idx SValue r
val = SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StatementSym r smt =>
SValue r -> MS (r smt)
IC.valStmt (SValue r -> MS (r smt)) -> SValue r -> MS (r smt)
forall a b. (a -> b) -> a -> b
$
  PosCall r
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp String
fnName VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.void [SValue r
list, SValue r -> SValue r
forall (r :: * -> *). IndexTranslator r => SValue r -> SValue r
IC.intToIndex SValue r
idx, SValue r
val]

arrayElem
  :: (IndexTranslator r, RC.RenderVariable r, IC.TypeElim r, RC.ValueElim r)
  => SValue r -> SValue r -> SVariable r
arrayElem :: forall (r :: * -> *).
(IndexTranslator r, RenderVariable r, TypeElim r, ValueElim r) =>
SValue r -> SValue r -> SVariable r
arrayElem SValue r
arr' SValue r
i' = do
  r Value
i <- SValue r -> SValue r
forall (r :: * -> *). IndexTranslator r => SValue r -> SValue r
IC.intToIndex SValue r
i'
  r Value
arr <- SValue r
arr'
  let vName :: String
vName = Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
arr
      vType :: VS (r TypeData)
vType = VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeElim r =>
VS (r TypeData) -> VS (r TypeData)
innerType (VS (r TypeData) -> VS (r TypeData))
-> VS (r TypeData) -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ r TypeData -> VS (r TypeData)
forall a. a -> StateT ValueState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (r TypeData -> VS (r TypeData)) -> r TypeData -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
IC.valueType r Value
arr
      vRender :: Doc
vRender = r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
arr Doc -> Doc -> Doc
<> Doc -> Doc
brackets (r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
i)
  String -> VS (r TypeData) -> Doc -> SVariable r
forall (r :: * -> *).
RenderVariable r =>
String -> VS (r TypeData) -> Doc -> SVariable r
mkStateVar String
vName VS (r TypeData)
vType Doc
vRender

funcDecDef :: (RP.ProcRenderSym r vis smt md) => SVariable r -> r ScopeData ->
  [SVariable r] -> MS (r Body) -> MS (r smt)
funcDecDef :: forall (r :: * -> *) vis smt md.
ProcRenderSym r vis smt md =>
SVariable r
-> r ScopeData -> [SVariable r] -> MS (r Doc) -> MS (r smt)
funcDecDef SVariable r
v r ScopeData
scp [SVariable r]
ps MS (r Doc)
b = do
  r Variable
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Variable))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r Variable)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (r Variable))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Variable) ValueState)
-> MethodState -> Focusing Identity (r Variable) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
v
  (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MethodState -> MethodState) -> StateT MethodState Identity ())
-> (MethodState -> MethodState) -> StateT MethodState Identity ()
forall a b. (a -> b) -> a -> b
$ String -> MethodState -> MethodState
useVarName (String -> MethodState -> MethodState)
-> String -> MethodState -> MethodState
forall a b. (a -> b) -> a -> b
$ r Variable -> String
forall (r :: * -> *). VariableElim r => r Variable -> String
variableName r Variable
vr
  (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MethodState -> MethodState) -> StateT MethodState Identity ())
-> (MethodState -> MethodState) -> StateT MethodState Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ScopeData -> MethodState -> MethodState
setVarScope (r Variable -> String
forall (r :: * -> *). VariableElim r => r Variable -> String
variableName r Variable
vr) (r ScopeData -> ScopeData
forall (r :: * -> *). ScopeElim r => r ScopeData -> ScopeData
RC.scopeData r ScopeData
scp)
  MethodState
s <- StateT MethodState Identity MethodState
forall s (m :: * -> *). MonadState s m => m s
get
  r md
f <- String
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Doc)
-> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
String
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Doc)
-> MS (r md)
IC.function (r Variable -> String
forall (r :: * -> *). VariableElim r => r Variable -> String
variableName r Variable
vr) r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
private (r TypeData -> VS (r TypeData)
forall a. a -> StateT ValueState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (r TypeData -> VS (r TypeData)) -> r TypeData -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ r Variable -> r TypeData
forall (r :: * -> *). VariableElim r => r Variable -> r TypeData
variableType r Variable
vr)
    ((SVariable r -> MS (r ParamData))
-> [SVariable r] -> [MS (r ParamData)]
forall a b. (a -> b) -> [a] -> [b]
map SVariable r -> MS (r ParamData)
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MS (r ParamData)
IC.param [SVariable r]
ps) MS (r Doc)
b
  (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter MethodState MethodState [String] [String]
-> [String] -> MethodState -> MethodState
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter MethodState MethodState [String] [String]
Lens' MethodState [String]
currParameters (MethodState
s MethodState -> Getting [String] MethodState [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] MethodState [String]
Lens' MethodState [String]
currParameters))
  Doc -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
Doc -> MS (r smt)
mkStmtNoEnd (Doc -> MS (r smt)) -> Doc -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ r md -> Doc
forall (r :: * -> *) md. MethodElim r md => r md -> Doc
RC.method r md
f

function :: (RP.ProcRenderMethod r vis md) => Label -> r vis -> VS (r TypeData) ->
  [MS (r ParamData)] -> MS (r Body) -> MS (r md)
function :: forall (r :: * -> *) vis md.
ProcRenderMethod r vis md =>
String
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Doc)
-> MS (r md)
function String
n r vis
s VS (r TypeData)
t = Bool
-> String
-> r vis
-> MSMthdType r
-> [MS (r ParamData)]
-> MS (r Doc)
-> MS (r md)
forall (r :: * -> *) vis md.
ProcRenderMethod r vis md =>
Bool
-> String
-> r vis
-> MSMthdType r
-> [MS (r ParamData)]
-> MS (r Doc)
-> MS (r md)
RP.intFunc Bool
False String
n r vis
s (VS (r TypeData) -> MSMthdType r
forall (r :: * -> *).
MethodTypeSym r =>
VS (r TypeData) -> MSMthdType r
RC.mType VS (r TypeData)
t)