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

import Drasil.Shared.InterfaceCommon (Label, SValue, SVariable,
  VariableElim(variableName, variableType), VisibilitySym(..), funcApp,
  getCodeType, convType, ValueStatement(..), ValueExpression, IndexTranslator)
import qualified Drasil.Shared.InterfaceCommon as IC
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 file mod) => String -> FS (r mod) -> FS (r file)
fileDoc :: forall (r :: * -> *) file mod.
RenderFile r file mod =>
String -> FS (r mod) -> FS (r file)
fileDoc String
ext FS (r mod)
md = do
  m <- FS (r mod)
md
  nm <- getModuleName
  let fp = String -> String -> String
addExt String
ext String
nm
  RP.fileFromData fp (toState m)

fileFromData
  :: (RP.ModuleElim r mod)
  => (FilePath -> r mod -> r file) -> FilePath -> FS (r mod) -> FS (r file)
fileFromData :: forall {k} (r :: k -> *) (mod :: k) (file :: k).
ModuleElim r mod =>
(String -> r mod -> r file) -> String -> FS (r mod) -> FS (r file)
fileFromData String -> r mod -> r file
f String
fpath FS (r mod)
mdl' = do
  -- Add this file to list of files as long as it is not empty
  mdl <- FS (r mod)
mdl'
  modify (\FileState
s -> if Doc -> Bool
isEmpty (r mod -> Doc
forall {k} (r :: k -> *) (mod :: k).
ModuleElim r mod =>
r mod -> Doc
RP.module' r mod
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)
  return $ f fpath mdl

-- Parameters: Module name, Doc for imports, Doc to put at bottom of module,
-- methods
buildModule
  :: (RC.MethodElim r mthd, RP.RenderMod r mod)
  => Label -> FS Doc -> FS Doc -> [MS (r mthd)] -> FS (r mod)
buildModule :: forall {k} (r :: k -> *) (mthd :: k) (mod :: k).
(MethodElim r mthd, RenderMod r mod) =>
String -> FS Doc -> FS Doc -> [MS (r mthd)] -> FS (r mod)
buildModule String
n FS Doc
imps FS Doc
bot [MS (r mthd)]
fs = String -> FS Doc -> FS (r mod)
forall {k} (r :: k -> *) (mod :: k).
RenderMod r mod =>
String -> FS Doc -> FS (r mod)
RP.modFromData String
n (do
  fns <- (MS (r mthd) -> StateT FileState Identity (r mthd))
-> [MS (r mthd)] -> StateT FileState Identity [r mthd]
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 mthd))
  FileState
  MethodState
-> MS (r mthd) -> StateT FileState Identity (r mthd)
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 mthd))
  FileState
  MethodState
(MethodState -> Focusing Identity (r mthd) MethodState)
-> FileState -> Focusing Identity (r mthd) FileState
Lens' FileState MethodState
lensFStoMS) [MS (r mthd)]
fs
  is <- imps
  bt <- bot
  let fnDocs = [Doc] -> Doc
vibcat ((r mthd -> Doc) -> [r mthd] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map r mthd -> Doc
forall {k} (r :: k -> *) (mthd :: k).
MethodElim r mthd =>
r mthd -> Doc
RC.method [r mthd]
fns [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
bt])
  return $ emptyIfEmpty fnDocs (vibcat (filter (not . isEmpty) [is, fnDocs])))

docMod
  :: (RP.RenderFile r file mod)
  => String -> String -> String -> [String] -> String -> FS (r file) -> FS (r file)
docMod :: forall (r :: * -> *) file mod.
RenderFile r file mod =>
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 :: * -> *) file mod.
RenderFile r file mod =>
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 mod) -> FS Doc -> FS (r mod)
modFromData :: forall {k} (r :: k -> *) (mod :: k).
String -> (Doc -> r mod) -> FS Doc -> FS (r mod)
modFromData String
n Doc -> r mod
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 mod)
-> StateT FileState Identity (r mod)
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 mod) -> FS Doc -> StateT FileState Identity (r mod)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue Doc -> r mod
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
  :: (ValueStatement r stmt, ValueExpression r)
  => String -> SValue r -> SValue r -> MS (r stmt)
listAppend :: forall (r :: * -> *) stmt.
(ValueStatement r stmt, ValueExpression r) =>
String -> SValue r -> SValue r -> MS (r stmt)
listAppend String
fnName SValue r
list SValue r
val = SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
ValueStatement r stmt =>
SValue r -> MS (r stmt)
valStmt (SValue r -> MS (r stmt)) -> SValue r -> MS (r stmt)
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, ValueStatement r stmt, ValueExpression r)
  => String -> SValue r -> SValue r -> SValue r -> MS (r stmt)
listAdd :: forall (r :: * -> *) stmt.
(IndexTranslator r, ValueStatement r stmt, ValueExpression r) =>
String -> SValue r -> SValue r -> SValue r -> MS (r stmt)
listAdd String
fnName SValue r
list SValue r
idx SValue r
val = SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
ValueStatement r stmt =>
SValue r -> MS (r stmt)
valStmt (SValue r -> MS (r stmt)) -> SValue r -> MS (r stmt)
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
  i <- SValue r -> SValue r
forall (r :: * -> *). IndexTranslator r => SValue r -> SValue r
IC.intToIndex SValue r
i'
  arr <- arr'
  let 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) -> 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 = 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)
  mkStateVar vName vType vRender

funcDecDef
  :: (RP.ProcRenderSym r vis stmt mthd file mod bod block)
  => SVariable r -> r ScopeData -> [SVariable r] -> MS (r bod) -> MS (r stmt)
funcDecDef :: forall (r :: * -> *) vis stmt mthd file mod bod block.
ProcRenderSym r vis stmt mthd file mod bod block =>
SVariable r
-> r ScopeData -> [SVariable r] -> MS (r bod) -> MS (r stmt)
funcDecDef SVariable r
v r ScopeData
scp [SVariable r]
ps MS (r bod)
b = do
  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
  modify $ useVarName $ variableName vr
  modify $ setVarScope (variableName vr) (RC.scopeData scp)
  s <- get
  f <- IC.function (variableName vr) private (return $ variableType vr)
    (map IC.param ps) b
  modify (L.set currParameters (s ^. currParameters))
  mkStmtNoEnd $ RC.method f

function
  :: (RP.ProcRenderMethod r vis mthd bod) => Label -> r vis -> VS (r TypeData) ->
  [MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
function :: forall (r :: * -> *) vis mthd bod.
ProcRenderMethod r vis mthd bod =>
String
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
function String
n r vis
s VS (r TypeData)
t = Bool
-> String
-> r vis
-> MSMthdType r
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd bod.
ProcRenderMethod r vis mthd bod =>
Bool
-> String
-> r vis
-> MSMthdType r
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
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)