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

import Drasil.Shared.InterfaceCommon (Label,
  VariableElim(variableName, variableType), TypeSym, 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)
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 qualified Prelude as P ((<>))
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)
  pure $ 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]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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. Semigroup a => a -> a -> a
P.<> [Doc
bt])
  pure $ emptyIfEmpty fnDocs (vibcat (filter (not . isEmpty) [is, fnDocs])))

docMod
  :: (RC.BlockCommentSym r, RP.RenderFile r file mod)
  => String -> String -> String -> [String] -> String -> FS (r file) -> FS (r file)
docMod :: forall (r :: * -> *) file mod.
(BlockCommentSym r, 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 :: (TypeSym r typ, IC.TypeElim r typ) => VS (r typ) -> VS (r typ)
innerType :: forall {k} (r :: k -> *) (typ :: k).
(TypeSym r typ, TypeElim r typ) =>
VS (r typ) -> VS (r typ)
innerType VS (r typ)
t = VS (r typ)
t VS (r typ) -> (r typ -> VS (r typ)) -> VS (r typ)
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 typ)
forall {k} (r :: k -> *) (typ :: k).
TypeSym r typ =>
CodeType -> VS (r typ)
convType (CodeType -> VS (r typ))
-> (r typ -> CodeType) -> r typ -> VS (r typ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> CodeType
getInnerType (CodeType -> CodeType) -> (r typ -> CodeType) -> r typ -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r typ -> CodeType
forall {k} (r :: k -> *) (typ :: k).
TypeElim r typ =>
r typ -> CodeType
getCodeType)

-- | Call to append a value to a list using a function call
listAppend
  ::
    ( TypeSym r typ
    , ValueStatement r stmt val
    , ValueExpression r var val binder typ
    )
  => String -> VS (r val) -> VS (r val) -> MS (r stmt)
listAppend :: forall {k} (r :: k -> *) (typ :: k) (stmt :: k) (val :: k)
       (var :: k) (binder :: k).
(TypeSym r typ, ValueStatement r stmt val,
 ValueExpression r var val binder typ) =>
String -> VS (r val) -> VS (r val) -> MS (r stmt)
listAppend String
fnName VS (r val)
list VS (r val)
val = VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
ValueStatement r stmt val =>
VS (r val) -> MS (r stmt)
valStmt (VS (r val) -> MS (r stmt)) -> VS (r val) -> MS (r stmt)
forall a b. (a -> b) -> a -> b
$
  PosCall r val typ
forall {k} (r :: k -> *) (var :: k) (val :: k) (binder :: k)
       (typ :: k).
ValueExpression r var val binder typ =>
PosCall r val typ
funcApp String
fnName VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
IC.void [VS (r val)
list, VS (r val)
val]

-- | Call to insert a value into a list as a function call
listAdd
  ::
    ( TypeSym r typ
    , IndexTranslator r val
    , ValueStatement r stmt val
    , ValueExpression r var val binder typ
    )
  => String -> VS (r val) -> VS (r val) -> VS (r val) -> MS (r stmt)
listAdd :: forall {k} (r :: k -> *) (typ :: k) (val :: k) (stmt :: k)
       (var :: k) (binder :: k).
(TypeSym r typ, IndexTranslator r val, ValueStatement r stmt val,
 ValueExpression r var val binder typ) =>
String -> VS (r val) -> VS (r val) -> VS (r val) -> MS (r stmt)
listAdd String
fnName VS (r val)
list VS (r val)
idx VS (r val)
val = VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
ValueStatement r stmt val =>
VS (r val) -> MS (r stmt)
valStmt (VS (r val) -> MS (r stmt)) -> VS (r val) -> MS (r stmt)
forall a b. (a -> b) -> a -> b
$
  PosCall r val typ
forall {k} (r :: k -> *) (var :: k) (val :: k) (binder :: k)
       (typ :: k).
ValueExpression r var val binder typ =>
PosCall r val typ
funcApp String
fnName VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
IC.void [VS (r val)
list, VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
IndexTranslator r val =>
VS (r val) -> VS (r val)
IC.intToIndex VS (r val)
idx, VS (r val)
val]

arrayElem
  ::
    ( TypeSym r typ
    , IC.ValueSym r val typ
    , IndexTranslator r val
    , RC.RenderVariable r var typ
    , IC.TypeElim r typ
    , RC.ValueElim r val
    )
  => VS (r val) -> VS (r val) -> VS (r var)
arrayElem :: forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k).
(TypeSym r typ, ValueSym r val typ, IndexTranslator r val,
 RenderVariable r var typ, TypeElim r typ, ValueElim r val) =>
VS (r val) -> VS (r val) -> VS (r var)
arrayElem VS (r val)
arr' VS (r val)
i' = do
  i <- VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
IndexTranslator r val =>
VS (r val) -> VS (r val)
IC.intToIndex VS (r val)
i'
  arr <- arr'
  let vName = Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ r val -> Doc
forall {k} (r :: k -> *) (val :: k).
ValueElim r val =>
r val -> Doc
RC.value r val
arr
      vType = VS (r typ) -> VS (r typ)
forall {k} (r :: k -> *) (typ :: k).
(TypeSym r typ, TypeElim r typ) =>
VS (r typ) -> VS (r typ)
innerType (VS (r typ) -> VS (r typ)) -> VS (r typ) -> VS (r typ)
forall a b. (a -> b) -> a -> b
$ r typ -> VS (r typ)
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r typ -> VS (r typ)) -> r typ -> VS (r typ)
forall a b. (a -> b) -> a -> b
$ r val -> r typ
forall {k} (r :: k -> *) (val :: k) (typ :: k).
ValueSym r val typ =>
r val -> r typ
IC.valueType r val
arr
      vRender = r val -> Doc
forall {k} (r :: k -> *) (val :: k).
ValueElim r val =>
r val -> Doc
RC.value r val
arr Doc -> Doc -> Doc
<> Doc -> Doc
brackets (r val -> Doc
forall {k} (r :: k -> *) (val :: k).
ValueElim r val =>
r val -> Doc
RC.value r val
i)
  mkStateVar vName vType vRender

funcDecDef
  :: (RP.ProcRenderSym r file mod mthd vis param bod block stmt var ScopeData val binder typ)
  => VS (r var)
  -> r ScopeData
  -> [VS (r var)]
  -> MS (r bod)
  -> MS (r stmt)
funcDecDef :: forall (r :: * -> *) file mod mthd vis param bod block stmt var val
       binder typ.
ProcRenderSym
  r
  file
  mod
  mthd
  vis
  param
  bod
  block
  stmt
  var
  ScopeData
  val
  binder
  typ =>
VS (r var)
-> r ScopeData -> [VS (r var)] -> MS (r bod) -> MS (r stmt)
funcDecDef VS (r var)
v r ScopeData
scp [VS (r var)]
ps MS (r bod)
b = do
  vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r var))
  MethodState
  ValueState
-> VS (r var) -> StateT MethodState Identity (r var)
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 var))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r var) ValueState)
-> MethodState -> Focusing Identity (r var) MethodState
Lens' MethodState ValueState
lensMStoVS VS (r var)
v
  modify $ useVarName $ variableName vr
  modify $ setVarScope (variableName vr) (RC.scopeData scp)
  s <- get
  f <- IC.function (variableName vr) private (pure $ variableType vr)
    (IC.param <$> ps) b
  modify (L.set currParameters (s ^. currParameters))
  mkStmtNoEnd $ RC.method f

function
  :: (RC.MethodTypeSym r typ, RP.ProcRenderMethod r mthd vis param bod typ)
  => Label
  -> r vis
  -> VS (r typ)
  -> [MS (r param)]
  -> MS (r bod)
  -> MS (r mthd)
function :: forall {k} (r :: k -> *) (typ :: k) (mthd :: k) (vis :: k)
       (param :: k) (bod :: k).
(MethodTypeSym r typ, ProcRenderMethod r mthd vis param bod typ) =>
String
-> r vis
-> VS (r typ)
-> [MS (r param)]
-> MS (r bod)
-> MS (r mthd)
function String
n r vis
s VS (r typ)
t = Bool
-> String
-> r vis
-> MS (r typ)
-> [MS (r param)]
-> MS (r bod)
-> MS (r mthd)
forall {k} (r :: k -> *) (mthd :: k) (vis :: k) (param :: k)
       (bod :: k) (typ :: k).
ProcRenderMethod r mthd vis param bod typ =>
Bool
-> String
-> r vis
-> MS (r typ)
-> [MS (r param)]
-> MS (r bod)
-> MS (r mthd)
RP.intFunc Bool
False String
n r vis
s (VS (r typ) -> MS (r typ)
forall {k} (r :: k -> *) (typ :: k).
MethodTypeSym r typ =>
VS (r typ) -> MS (r typ)
RC.mType VS (r typ)
t)