{-# LANGUAGE PostfixOperators #-}

module Drasil.GOOL.LanguageRenderer.AbstractProc (fileDoc, fileFromData,
  buildModule, docMod, modFromData, listInnerType, arrayElem, funcDecDef,
  function
) where

import Drasil.GOOL.InterfaceCommon (Label, SMethod, MSBody, MSStatement, SValue,
  SVariable, MSParameter, VSType, VariableElim(variableName, variableType),
  VisibilitySym(..), getType, convType, ScopeSym(Scope))
import qualified Drasil.GOOL.InterfaceCommon as IC (MethodSym(function),
  List(intToIndex), ParameterSym(param))
import Drasil.GOOL.InterfaceProc (SFile, FSModule, FileSym (File),
  ModuleSym(Module))
import qualified Drasil.GOOL.RendererClassesCommon as RCC (MethodElim(..),
  BlockCommentSym(..), ValueElim(value), InternalVarElim(variable),
  MethodTypeSym(mType), ScopeElim(scopeData))
import Drasil.GOOL.RendererClassesProc (ProcRenderSym)
import qualified Drasil.GOOL.RendererClassesProc as RCP (RenderFile(..),
  ModuleElim(..), RenderMod(..), ProcRenderMethod(intFunc))
import Drasil.GOOL.AST (isSource)
import Drasil.GOOL.Helpers (vibcat, toState, emptyIfEmpty, getInnerType,
  onStateValue)
import Drasil.GOOL.LanguageRenderer (addExt)
import qualified Drasil.GOOL.LanguageRenderer.CommonPseudoOO as CP (modDoc')
import Drasil.GOOL.LanguageRenderer.Constructors (mkStmtNoEnd, mkStateVar)
import Drasil.GOOL.State (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, render, isEmpty, brackets, (<>))

-- Files --

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

fileFromData :: (ProcRenderSym r) => (FilePath -> r (Module r) -> r (File r)) 
  -> FilePath -> FSModule r -> SFile r
fileFromData :: forall (r :: * -> *).
ProcRenderSym r =>
(String -> r (Module r) -> r (File r))
-> String -> FSModule r -> SFile r
fileFromData String -> r (Module r) -> r (File r)
f String
fpath FSModule r
mdl' = do
  -- Add this file to list of files as long as it is not empty
  r (Module r)
mdl <- FSModule r
mdl'
  (FileState -> FileState) -> StateT FileState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FileState
s -> if Doc -> Bool
isEmpty (r (Module r) -> Doc
forall (r :: * -> *). ModuleElim r => r (Module r) -> Doc
RCP.module' r (Module r)
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 r) -> SFile r
forall a. a -> StateT FileState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (r (File r) -> SFile r) -> r (File r) -> SFile r
forall a b. (a -> b) -> a -> b
$ String -> r (Module r) -> r (File r)
f String
fpath r (Module r)
mdl

-- Parameters: Module name, Doc for imports, Doc to put at bottom of module,
-- methods
buildModule :: (ProcRenderSym r) => Label -> FS Doc -> FS Doc -> [SMethod r]
  -> FSModule r
buildModule :: forall (r :: * -> *).
ProcRenderSym r =>
String -> FS Doc -> FS Doc -> [SMethod r] -> FSModule r
buildModule String
n FS Doc
imps FS Doc
bot [SMethod r]
fs = String -> FS Doc -> StateT FileState Identity (r (Module r))
forall (r :: * -> *). RenderMod r => String -> FS Doc -> FSModule r
RCP.modFromData String
n (do
  [r (Method r)]
fns <- (SMethod r -> StateT FileState Identity (r (Method r)))
-> [SMethod r] -> StateT FileState Identity [r (Method r)]
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 (Method r)))
  FileState
  MethodState
-> SMethod r -> StateT FileState Identity (r (Method r))
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 (Method r)))
  FileState
  MethodState
(MethodState -> Focusing Identity (r (Method r)) MethodState)
-> FileState -> Focusing Identity (r (Method r)) FileState
Lens' FileState MethodState
lensFStoMS) [SMethod r]
fs
  Doc
is <- FS Doc
imps
  Doc
bt <- FS Doc
bot
  let fnDocs :: Doc
fnDocs = [Doc] -> Doc
vibcat ((r (Method r) -> Doc) -> [r (Method r)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map r (Method r) -> Doc
forall (r :: * -> *). MethodElim r => r (Method r) -> Doc
RCC.method [r (Method r)]
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 :: (ProcRenderSym r) => String -> String -> [String] -> String -> 
  SFile r -> SFile r
docMod :: forall (r :: * -> *).
ProcRenderSym r =>
String -> String -> [String] -> String -> SFile r -> SFile r
docMod String
e String
d [String]
a String
dt SFile r
fl = SFile r -> FS (r (BlockComment r)) -> SFile r
forall (r :: * -> *).
RenderFile r =>
SFile r -> FS (r (BlockComment r)) -> SFile r
RCP.commentedMod SFile r
fl (State FileState [String] -> FS (r (BlockComment r))
forall a. State a [String] -> State a (r (BlockComment r))
forall (r :: * -> *) a.
BlockCommentSym r =>
State a [String] -> State a (r (BlockComment r))
RCC.docComment (State FileState [String] -> FS (r (BlockComment r)))
-> State FileState [String] -> FS (r (BlockComment r))
forall a b. (a -> b) -> a -> b
$ ModuleDocRenderer
CP.modDoc' String
d [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 r)) -> FS Doc -> FSModule r
modFromData :: forall (r :: * -> *).
String -> (Doc -> r (Module r)) -> FS Doc -> FSModule r
modFromData String
n Doc -> r (Module r)
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 r))
-> StateT FileState Identity (r (Module r))
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 r))
-> FS Doc -> StateT FileState Identity (r (Module r))
forall a b s. (a -> b) -> State s a -> State s b
onStateValue Doc -> r (Module r)
f FS Doc
d

listInnerType :: (ProcRenderSym r) => VSType r -> VSType r
listInnerType :: forall (r :: * -> *). ProcRenderSym r => VSType r -> VSType r
listInnerType VSType r
t = VSType r
t VSType r -> (r (Type r) -> VSType r) -> VSType r
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 -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType (CodeType -> VSType r)
-> (r (Type r) -> CodeType) -> r (Type r) -> VSType r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> CodeType
getInnerType (CodeType -> CodeType)
-> (r (Type r) -> CodeType) -> r (Type r) -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType)

arrayElem :: (ProcRenderSym r) => SValue r -> SVariable r -> SVariable r
arrayElem :: forall (r :: * -> *).
ProcRenderSym r =>
SValue r -> SVariable r -> SVariable r
arrayElem SValue r
i' SVariable r
v' = do
  r (Value r)
i <- SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
IC.intToIndex SValue r
i'
  r (Variable r)
v <- SVariable r
v'
  let vName :: String
vName = r (Variable r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
render (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RCC.value r (Value r)
i) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
      vType :: VSType r
vType = VSType r -> VSType r
forall (r :: * -> *). ProcRenderSym r => VSType r -> VSType r
listInnerType (VSType r -> VSType r) -> VSType r -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Type r) -> VSType r
forall a. a -> StateT ValueState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (r (Type r) -> VSType r) -> r (Type r) -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
v
      vRender :: Doc
vRender = r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RCC.variable r (Variable r)
v Doc -> Doc -> Doc
<> Doc -> Doc
brackets (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RCC.value r (Value r)
i)
  String -> VSType r -> Doc -> SVariable r
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> Doc -> SVariable r
mkStateVar String
vName VSType r
vType Doc
vRender

funcDecDef :: (ProcRenderSym r) => SVariable r -> r (Scope r) -> [SVariable r]
  -> MSBody r -> MSStatement r
funcDecDef :: forall (r :: * -> *).
ProcRenderSym r =>
SVariable r
-> r (Scope r) -> [SVariable r] -> MSBody r -> MSStatement r
funcDecDef SVariable r
v r (Scope r)
scp [SVariable r]
ps MSBody r
b = do
  r (Variable r)
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
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 r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) 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 r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
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 r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
vr) (r (Scope r) -> ScopeData
forall (r :: * -> *). ScopeElim r => r (Scope r) -> ScopeData
RCC.scopeData r (Scope r)
scp)
  MethodState
s <- StateT MethodState Identity MethodState
forall s (m :: * -> *). MonadState s m => m s
get
  r (Method r)
f <- String
-> r (Visibility r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> StateT MethodState Identity (r (Method r))
forall (r :: * -> *).
MethodSym r =>
String
-> r (Visibility r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
IC.function (r (Variable r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
vr) r (Visibility r)
forall (r :: * -> *). VisibilitySym r => r (Visibility r)
private (r (Type r) -> VSType r
forall a. a -> StateT ValueState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (r (Type r) -> VSType r) -> r (Type r) -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
vr) 
    ((SVariable r -> MSParameter r) -> [SVariable r] -> [MSParameter r]
forall a b. (a -> b) -> [a] -> [b]
map SVariable r -> MSParameter r
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
IC.param [SVariable r]
ps) MSBody r
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 -> MSStatement r
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (Doc -> MSStatement r) -> Doc -> MSStatement r
forall a b. (a -> b) -> a -> b
$ r (Method r) -> Doc
forall (r :: * -> *). MethodElim r => r (Method r) -> Doc
RCC.method r (Method r)
f

function :: (ProcRenderSym r) => Label -> r (Visibility r) -> VSType r -> 
  [MSParameter r] -> MSBody r -> SMethod r
function :: forall (r :: * -> *).
ProcRenderSym r =>
String
-> r (Visibility r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
function String
n r (Visibility r)
s VSType r
t = Bool
-> String
-> r (Visibility r)
-> MSMthdType r
-> [StateT MethodState Identity (r (Parameter r))]
-> StateT MethodState Identity (r (Body r))
-> StateT MethodState Identity (r (Method r))
forall (r :: * -> *).
ProcRenderMethod r =>
Bool
-> String
-> r (Visibility r)
-> MSMthdType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
RCP.intFunc Bool
False String
n r (Visibility r)
s (VSType r -> MSMthdType r
forall (r :: * -> *). MethodTypeSym r => VSType r -> MSMthdType r
RCC.mType VSType r
t)