{-# LANGUAGE PostfixOperators #-}

-- | The structure for a class of renderers is defined here.
module GOOL.Drasil.LanguageRenderer (
  -- * Common Syntax
  classDec, dot, commentStart, returnLabel, ifLabel, elseLabel, elseIfLabel, 
  forLabel, inLabel, whileLabel, tryLabel, catchLabel, throwLabel, throwsLabel, 
  importLabel, blockCmtStart, blockCmtEnd, docCmtStart, bodyStart, bodyEnd, 
  endStatement, constDec', exceptionObj', new', this', self', array', listSep', 
  argc, argv, args, printLabel, constDec, exceptionObj, mainFunc, new, this, 
  self, nullLabel, array, listSep, sqrt, abs, fabs, log10, log, exp, sin, cos, 
  tan, asin, acos, atan, floor, ceil, pow, piLabel, access, containing, tuple,
  mathFunc, addExt,
  
  -- * Default Functions available for use in renderers
  package, file, module', class', multiStmt, block, body, print, printFile, 
  param, method, stateVar, constVar, stateVarList, switch, assign, 
  addAssign, subAssign, increment, decrement, listDec, getTerm, return', 
  comment, var, extVar, arg, classVar, objVar, unOpDocD, unOpDocD', binOpDocD, 
  binOpDocD', constDecDef, func, cast, listAccessFunc, listSetFunc, objAccess, 
  castObj, break, continue, static, dynamic, private, public, blockCmt, docCmt, 
  commentedItem, addComments, FuncDocRenderer, functionDox, ClassDocRenderer,
  classDox, ModuleDocRenderer, moduleDox, commentedMod, valueList, 
  variableList, parameterList, namedArgList, prependToBody, appendToBody, 
  surroundBody, getterName, setterName, intValue
) where

import Utils.Drasil (blank, capitalize, indent, indentList, stringList)

import GOOL.Drasil.CodeType (CodeType(..))
import GOOL.Drasil.ClassInterface (Label, Library, SValue, BodySym(Body), 
  PermanenceSym(Permanence), TypeSym(Type), TypeElim(..), VariableSym(Variable),
  VariableElim(..), ValueSym(..), StatementSym(Statement), ScopeSym(Scope), 
  ParameterSym(Parameter))
import GOOL.Drasil.RendererClasses (RenderSym)
import qualified GOOL.Drasil.RendererClasses as RC (PermElim(..), BodyElim(..),
  InternalTypeElim(..), InternalVarElim(..), ValueElim(..), StatementElim(..),
  ScopeElim(..), ParamElim(..))
import GOOL.Drasil.AST (Terminator(..), FileData(..), fileD, updateFileMod, 
  updateMod, TypeData(..), VarData(..))
import GOOL.Drasil.Helpers (hicat, vibcat, vmap, emptyIfEmpty, emptyIfNull)

import Data.List (last, intercalate)
import Prelude hiding (break,print,last,sqrt,abs,log,exp,sin,cos,tan,asin,acos,
  atan,floor,mod,(<>))
import Text.PrettyPrint.HughesPJ (Doc, text, empty, render, (<>), (<+>), ($+$),
  space, brackets, parens, isEmpty, rbrace, lbrace, vcat, semi, equals, colon,
  comma)
import Metadata.Drasil.DrasilMetaCall(watermark)

----------------------------------------
-- Syntax common to several renderers --
----------------------------------------

classDec, dot, commentStart, returnLabel, ifLabel, elseLabel, elseIfLabel, 
  forLabel, inLabel, whileLabel, tryLabel, catchLabel, throwLabel, throwsLabel,
  importLabel, blockCmtStart, blockCmtEnd, docCmtStart, bodyStart, bodyEnd, 
  endStatement, constDec', exceptionObj', new', this', self', array', 
  listSep' :: Doc
classDec :: Doc
classDec = String -> Doc
text String
"class"
dot :: Doc
dot = String -> Doc
text String
"."
commentStart :: Doc
commentStart = String -> Doc
text String
"//"
returnLabel :: Doc
returnLabel = String -> Doc
text String
"return"
ifLabel :: Doc
ifLabel = String -> Doc
text String
"if"
elseLabel :: Doc
elseLabel = String -> Doc
text String
"else"
elseIfLabel :: Doc
elseIfLabel = Doc
elseLabel Doc -> Doc -> Doc
<+> Doc
ifLabel
forLabel :: Doc
forLabel = String -> Doc
text String
"for"
inLabel :: Doc
inLabel = String -> Doc
text String
"in"
whileLabel :: Doc
whileLabel = String -> Doc
text String
"while"
tryLabel :: Doc
tryLabel = String -> Doc
text String
"try"
catchLabel :: Doc
catchLabel = String -> Doc
text String
"catch"
throwLabel :: Doc
throwLabel = String -> Doc
text String
"throw"
throwsLabel :: Doc
throwsLabel = String -> Doc
text String
"throws"
importLabel :: Doc
importLabel = String -> Doc
text String
"import"
blockCmtStart :: Doc
blockCmtStart = String -> Doc
text String
"/*"
blockCmtEnd :: Doc
blockCmtEnd = String -> Doc
text String
"*/"
docCmtStart :: Doc
docCmtStart = String -> Doc
text String
"/**"
bodyStart :: Doc
bodyStart = Doc
lbrace
bodyEnd :: Doc
bodyEnd = Doc
rbrace
endStatement :: Doc
endStatement = Doc
semi
constDec' :: Doc
constDec' = String -> Doc
text String
constDec
exceptionObj' :: Doc
exceptionObj' = String -> Doc
text String
exceptionObj
new' :: Doc
new' = String -> Doc
text String
new
this' :: Doc
this' = String -> Doc
text String
this
self' :: Doc
self' = String -> Doc
text String
self
array' :: Doc
array' = String -> Doc
text String
array
listSep' :: Doc
listSep' = String -> Doc
text String
listSep

argc, argv, args, printLabel, constDec, exceptionObj, mainFunc, new, this, 
  self, nullLabel, array, listSep :: String
argc :: String
argc = String
"argc"
argv :: String
argv = String
"argv"
args :: String
args = String
"args"
printLabel :: String
printLabel = String
"print"
constDec :: String
constDec = String
"const"
exceptionObj :: String
exceptionObj = String
"Exception"
mainFunc :: String
mainFunc = String
"main"
new :: String
new = String
"new"
this :: String
this = String
"this"
self :: String
self = String
"self"
nullLabel :: String
nullLabel = String
"null"
array :: String
array = String
"[]"
listSep :: String
listSep = String
", "

sqrt, abs, fabs, log10, log, exp, sin, cos, tan, asin, acos, atan, floor, 
  ceil, pow, piLabel :: String
sqrt :: String
sqrt = String
"sqrt"
abs :: String
abs = String
"abs"
fabs :: String
fabs = String
"fabs"
log10 :: String
log10 = String
"log10"
log :: String
log = String
"log"
exp :: String
exp = String
"exp"
sin :: String
sin = String
"sin"
cos :: String
cos = String
"cos"
tan :: String
tan = String
"tan"
asin :: String
asin = String
"asin"
acos :: String
acos = String
"acos"
atan :: String
atan = String
"atan"
floor :: String
floor = String
"floor"
ceil :: String
ceil = String
"ceil"
pow :: String
pow = String
"pow"
piLabel :: String
piLabel = String
"pi"

access :: String -> String -> String
access :: String -> String -> String
access String
q String
n = String
q forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
n

containing :: String -> String -> String
containing :: String -> String -> String
containing String
l String
e = String
l forall a. [a] -> [a] -> [a]
++ String
"<" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
">"

tuple :: [String] -> String
tuple :: [String] -> String
tuple [String]
ts = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
listSep [String]
ts forall a. [a] -> [a] -> [a]
++ String
")"

mathFunc :: String -> String
mathFunc :: String -> String
mathFunc = String -> String -> String
access String
"Math"

addExt :: String -> String -> String
addExt :: String -> String -> String
addExt String
ext String
nm = String
nm forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
ext

----------------------------------
-- Functions for rendering code --
----------------------------------

package :: Label -> Doc -> FileData -> FileData
package :: String -> Doc -> FileData -> FileData
package String
n Doc
end FileData
f = String -> ModData -> FileData
fileD (String
n forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ FileData -> String
filePath FileData
f) ((Doc -> Doc) -> ModData -> ModData
updateMod 
  (\Doc
d -> Doc -> Doc -> Doc
emptyIfEmpty Doc
d ([Doc] -> Doc
vibcat [String -> Doc
text String
"package" Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<> Doc
end, Doc
d])) 
  (FileData -> ModData
fileMod FileData
f))

file :: Doc -> Doc -> Doc -> Doc
file :: Doc -> Doc -> Doc -> Doc
file Doc
t Doc
m Doc
b = [Doc] -> Doc
vibcat [
  Doc
t,
  Doc
m,
  Doc
b]

-- Many function names in this module conflict with names of functions that are 
-- part of GOOL's interface. This module is thus intended to be imported 
-- qualified.

-----------------------------------------------
-- 'Default' functions used in the renderers --
-----------------------------------------------

-- Module --

module' :: Doc -> Doc -> Doc -> Doc
module' :: Doc -> Doc -> Doc -> Doc
module' Doc
ls Doc
fs Doc
cs = Doc -> Doc -> Doc
emptyIfEmpty (Doc
fs Doc -> Doc -> Doc
<> Doc
cs) ([Doc] -> Doc
vibcat (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty) 
  [Doc
ls, Doc
fs, Doc
cs]))

-- Class --

class' :: Label -> Doc -> Doc -> Doc -> Doc -> Doc
class' :: String -> Doc -> Doc -> Doc -> Doc -> Doc
class' String
n Doc
p Doc
s Doc
vs Doc
fs = [Doc] -> Doc
vcat [
  Doc
s Doc -> Doc -> Doc
<+> Doc
classDec Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<+> Doc
p Doc -> Doc -> Doc
<+> Doc
lbrace, 
  [Doc] -> Doc
indentList [
    Doc
vs,
    Doc
blank,
    Doc
fs],
  Doc
rbrace]

-- Groupings --

multiStmt :: [(Doc, Terminator)] -> (Doc, Terminator)
multiStmt :: [(Doc, Terminator)] -> (Doc, Terminator)
multiStmt [(Doc, Terminator)]
sts = ([Doc] -> Doc
vcat ([(Doc, Terminator)] -> [Doc]
applyEnd [(Doc, Terminator)]
statements), forall {a}. [(a, Terminator)] -> Terminator
needsEnd [(Doc, Terminator)]
statements)
  where applyEnd :: [(Doc, Terminator)] -> [Doc]
applyEnd [] = []
        applyEnd [(Doc
s, Terminator
_)] = [Doc
s]
        applyEnd ((Doc
s, Terminator
t):[(Doc, Terminator)]
ss) = (Doc
s Doc -> Doc -> Doc
<> Terminator -> Doc
getTerm Terminator
t) forall a. a -> [a] -> [a]
: [(Doc, Terminator)] -> [Doc]
applyEnd [(Doc, Terminator)]
ss
        needsEnd :: [(a, Terminator)] -> Terminator
needsEnd [] = Terminator
Empty
        needsEnd [(a, Terminator)]
ss = forall a b. (a, b) -> b
snd (forall a. [a] -> a
last [(a, Terminator)]
ss)
        statements :: [(Doc, Terminator)]
statements = forall a. (a -> Bool) -> [a] -> [a]
filter forall {b}. (Doc, b) -> Bool
notNullStatement [(Doc, Terminator)]
sts
        notNullStatement :: (Doc, b) -> Bool
notNullStatement (Doc, b)
s = Bool -> Bool
not (Doc -> Bool
isEmpty (forall a b. (a, b) -> a
fst (Doc, b)
s))

block :: [Doc] -> Doc
block :: [Doc] -> Doc
block [Doc]
sts = [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty) [Doc]
sts

body :: [Doc] -> Doc
body :: [Doc] -> Doc
body [Doc]
bs = [Doc] -> Doc
vibcat forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty) [Doc]
bs

-- IO --

print :: (RenderSym r) => r (Value r) -> r (Value r) -> Doc
print :: forall (r :: * -> *).
RenderSym r =>
r (Value r) -> r (Value r) -> Doc
print r (Value r)
printFn r (Value r)
v = forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
printFn Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v)

printFile :: Label -> Doc -> Doc
printFile :: String -> Doc -> Doc
printFile String
fn Doc
f = Doc
f Doc -> Doc -> Doc
<> Doc
dot Doc -> Doc -> Doc
<> String -> Doc
text String
fn

-- Parameters --

param :: (RenderSym r) => r (Variable r) -> Doc
param :: forall (r :: * -> *). RenderSym r => r (Variable r) -> Doc
param r (Variable r)
v = forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' (forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
v) Doc -> Doc -> Doc
<+> forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
v

-- Method --

method :: (RenderSym r) => Label -> r (Scope r) -> r (Permanence r) -> 
  r (Type r) -> [r (Parameter r)] -> r (Body r) -> Doc
method :: forall (r :: * -> *).
RenderSym r =>
String
-> r (Scope r)
-> r (Permanence r)
-> r (Type r)
-> [r (Parameter r)]
-> r (Body r)
-> Doc
method String
n r (Scope r)
s r (Permanence r)
p r (Type r)
t [r (Parameter r)]
ps r (Body r)
b = [Doc] -> Doc
vcat [
  forall (r :: * -> *). ScopeElim r => r (Scope r) -> Doc
RC.scope r (Scope r)
s Doc -> Doc -> Doc
<+> forall (r :: * -> *). PermElim r => r (Permanence r) -> Doc
RC.perm r (Permanence r)
p Doc -> Doc -> Doc
<+> forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' r (Type r)
t Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<> 
    Doc -> Doc
parens (forall (r :: * -> *). RenderSym r => [r (Parameter r)] -> Doc
parameterList [r (Parameter r)]
ps) Doc -> Doc -> Doc
<+> Doc
lbrace,
  Doc -> Doc
indent (forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b),
  Doc
rbrace]

-- StateVar --

stateVar :: Doc -> Doc -> Doc -> Doc
stateVar :: Doc -> Doc -> Doc -> Doc
stateVar Doc
s Doc
p Doc
dec = Doc
s Doc -> Doc -> Doc
<+> Doc
p Doc -> Doc -> Doc
<+> Doc
dec

constVar :: Doc -> Doc -> Doc -> VarData -> Doc
constVar :: Doc -> Doc -> Doc -> VarData -> Doc
constVar Doc
s Doc
end Doc
p VarData
v = Doc
s Doc -> Doc -> Doc
<+> Doc
p Doc -> Doc -> Doc
<+> Doc
constDec' Doc -> Doc -> Doc
<+> TypeData -> Doc
typeDoc (VarData -> TypeData
varType VarData
v) Doc -> Doc -> Doc
<+>
  VarData -> Doc
varDoc VarData
v Doc -> Doc -> Doc
<> Doc
end

stateVarList :: [Doc] -> Doc
stateVarList :: [Doc] -> Doc
stateVarList = [Doc] -> Doc
vcat

-- Controls --

switch :: (RenderSym r) => (Doc -> Doc) -> r (Statement r) -> r (Value r) -> r (Body r) -> 
  [(r (Value r), r (Body r))] -> Doc
switch :: forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc)
-> r (Statement r)
-> r (Value r)
-> r (Body r)
-> [(r (Value r), r (Body r))]
-> Doc
switch Doc -> Doc
f r (Statement r)
st r (Value r)
v r (Body r)
defBody [(r (Value r), r (Body r))]
cs = 
  let caseDoc :: (r (Value r), r (Body r)) -> Doc
caseDoc (r (Value r)
l, r (Body r)
result) = [Doc] -> Doc
vcat [
        String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
l Doc -> Doc -> Doc
<> Doc
colon,
        [Doc] -> Doc
indentList [
          forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
result,
          forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement r (Statement r)
st]]
      defaultSection :: Doc
defaultSection = [Doc] -> Doc
vcat [
        String -> Doc
text String
"default" Doc -> Doc -> Doc
<> Doc
colon,
        [Doc] -> Doc
indentList [
          forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
defBody,
          forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement r (Statement r)
st]]
  in [Doc] -> Doc
vcat [
      String -> Doc
text String
"switch" Doc -> Doc -> Doc
<> Doc -> Doc
f (forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v) Doc -> Doc -> Doc
<+> Doc
lbrace,
      [Doc] -> Doc
indentList [
        forall a. (a -> Doc) -> [a] -> Doc
vmap forall {r :: * -> *} {r :: * -> *}.
(ValueElim r, BodyElim r) =>
(r (Value r), r (Body r)) -> Doc
caseDoc [(r (Value r), r (Body r))]
cs,
        Doc
defaultSection],
      Doc
rbrace]

-- Statements --

assign :: (RenderSym r) => r (Variable r) -> r (Value r) -> Doc
assign :: forall (r :: * -> *).
RenderSym r =>
r (Variable r) -> r (Value r) -> Doc
assign r (Variable r)
vr r (Value r)
vl = forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
vr Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
vl

addAssign :: (RenderSym r) => r (Variable r) -> r (Value r) -> Doc
addAssign :: forall (r :: * -> *).
RenderSym r =>
r (Variable r) -> r (Value r) -> Doc
addAssign r (Variable r)
vr r (Value r)
vl = forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
vr Doc -> Doc -> Doc
<+> String -> Doc
text String
"+=" Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
vl

subAssign :: (RenderSym r) => r (Variable r) -> r (Value r) -> Doc
subAssign :: forall (r :: * -> *).
RenderSym r =>
r (Variable r) -> r (Value r) -> Doc
subAssign r (Variable r)
vr r (Value r)
vl = forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
vr Doc -> Doc -> Doc
<+> String -> Doc
text String
"-=" Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
vl

increment :: (RenderSym r) => r (Variable r) -> Doc
increment :: forall (r :: * -> *). RenderSym r => r (Variable r) -> Doc
increment r (Variable r)
v = forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
v Doc -> Doc -> Doc
<> String -> Doc
text String
"++"

decrement :: (RenderSym r) => r (Variable r) -> Doc
decrement :: forall (r :: * -> *). RenderSym r => r (Variable r) -> Doc
decrement r (Variable r)
v = forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
v Doc -> Doc -> Doc
<> String -> Doc
text String
"--"

listDec :: (RenderSym r) => r (Variable r) -> r (Value r) -> Doc
listDec :: forall (r :: * -> *).
RenderSym r =>
r (Variable r) -> r (Value r) -> Doc
listDec r (Variable r)
v r (Value r)
n = Doc
space Doc -> Doc -> Doc
<> Doc
equals Doc -> Doc -> Doc
<+> Doc
new' Doc -> Doc -> Doc
<+> forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' (forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
v) 
  Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
n)

constDecDef :: (RenderSym r) => r (Variable r) -> r (Value r) -> Doc
constDecDef :: forall (r :: * -> *).
RenderSym r =>
r (Variable r) -> r (Value r) -> Doc
constDecDef r (Variable r)
v r (Value r)
def = Doc
constDec' Doc -> Doc -> Doc
<+> forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' (forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
v) Doc -> Doc -> Doc
<+> 
  forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
v Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
def

return' :: (RenderSym r) => [r (Value r)] -> Doc
return' :: forall (r :: * -> *). RenderSym r => [r (Value r)] -> Doc
return' [r (Value r)]
vs = Doc
returnLabel Doc -> Doc -> Doc
<+> forall (r :: * -> *). RenderSym r => [r (Value r)] -> Doc
valueList [r (Value r)]
vs

comment :: Label -> Doc -> Doc
comment :: String -> Doc -> Doc
comment String
cmt Doc
cStart = Doc
cStart Doc -> Doc -> Doc
<+> String -> Doc
text String
cmt

statement :: (Doc, Terminator) -> (Doc, Terminator)
statement :: (Doc, Terminator) -> (Doc, Terminator)
statement (Doc
s, Terminator
t) = (Doc
s Doc -> Doc -> Doc
<> Terminator -> Doc
getTerm Terminator
t, Terminator
Empty)

getTerm :: Terminator -> Doc
getTerm :: Terminator -> Doc
getTerm Terminator
Semi = Doc
semi
getTerm Terminator
Empty = Doc
empty

-- Value Printers --

var :: Label -> Doc
var :: String -> Doc
var = String -> Doc
text

extVar :: Library -> Label -> Doc
extVar :: String -> String -> Doc
extVar String
l String
n = String -> Doc
text String
l Doc -> Doc -> Doc
<> Doc
dot Doc -> Doc -> Doc
<> String -> Doc
text String
n

arg :: (RenderSym r) => r (Value r) -> r (Value r) -> Doc
arg :: forall (r :: * -> *).
RenderSym r =>
r (Value r) -> r (Value r) -> Doc
arg r (Value r)
n r (Value r)
argsList = forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
argsList Doc -> Doc -> Doc
<> Doc -> Doc
brackets (forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
n)

classVar :: Doc -> Doc -> Doc
classVar :: Doc -> Doc -> Doc
classVar Doc
c Doc
v = Doc
c Doc -> Doc -> Doc
<> Doc
dot Doc -> Doc -> Doc
<> Doc
v

objVar :: Doc -> Doc ->  Doc
objVar :: Doc -> Doc -> Doc
objVar Doc
n1 Doc
n2 = Doc
n1 Doc -> Doc -> Doc
<> Doc
dot Doc -> Doc -> Doc
<> Doc
n2

unOpDocD :: Doc -> Doc -> Doc
unOpDocD :: Doc -> Doc -> Doc
unOpDocD Doc
op Doc
v = Doc
op Doc -> Doc -> Doc
<> Doc -> Doc
parens Doc
v

unOpDocD' :: Doc -> Doc -> Doc
unOpDocD' :: Doc -> Doc -> Doc
unOpDocD' Doc
op Doc
v = Doc
op Doc -> Doc -> Doc
<> Doc
v

binOpDocD :: Doc -> Doc -> Doc -> Doc
binOpDocD :: Doc -> Doc -> Doc -> Doc
binOpDocD Doc
op Doc
v1 Doc
v2 = Doc
v1 Doc -> Doc -> Doc
<+> Doc
op Doc -> Doc -> Doc
<+> Doc
v2

binOpDocD' :: Doc -> Doc -> Doc -> Doc
binOpDocD' :: Doc -> Doc -> Doc -> Doc
binOpDocD' Doc
op Doc
v1 Doc
v2 = Doc
op Doc -> Doc -> Doc
<> Doc -> Doc
parens (Doc
v1 Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Doc
v2)

-- Functions --

func :: Doc -> Doc
func :: Doc -> Doc
func Doc
fnApp = Doc
dot Doc -> Doc -> Doc
<> Doc
fnApp

cast :: Doc -> Doc
cast :: Doc -> Doc
cast = Doc -> Doc
parens

listAccessFunc :: (RenderSym r) => r (Value r) -> Doc
listAccessFunc :: forall (r :: * -> *). RenderSym r => r (Value r) -> Doc
listAccessFunc r (Value r)
v = Doc -> Doc
brackets forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v

listSetFunc :: Doc -> Doc -> Doc
listSetFunc :: Doc -> Doc -> Doc
listSetFunc Doc
i Doc
v = Doc -> Doc
brackets Doc
i Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Doc
v

objAccess :: Doc -> Doc -> Doc
objAccess :: Doc -> Doc -> Doc
objAccess Doc
v Doc
f = Doc
v Doc -> Doc -> Doc
<> Doc
f

castObj :: Doc -> Doc -> Doc
castObj :: Doc -> Doc -> Doc
castObj Doc
t Doc
v = Doc
t Doc -> Doc -> Doc
<> Doc -> Doc
parens Doc
v

-- Permanence --

static :: Doc
static :: Doc
static = String -> Doc
text String
"static"

dynamic :: Doc
dynamic :: Doc
dynamic = Doc
empty

-- Jumps --

break :: Doc
break :: Doc
break = String -> Doc
text String
"break"

continue :: Doc
continue :: Doc
continue = String -> Doc
text String
"continue"

-- Scope --

private :: Doc
private :: Doc
private = String -> Doc
text String
"private"

public :: Doc
public :: Doc
public = String -> Doc
text String
"public"

-- Comment Functions -- 

blockCmt :: [String] -> Doc -> Doc -> Doc
blockCmt :: [String] -> Doc -> Doc -> Doc
blockCmt [String]
lns Doc
start Doc
end = Doc
start Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String]
lns) Doc -> Doc -> Doc
<+> Doc
end

docCmt :: [String] -> Doc -> Doc -> Doc
docCmt :: [String] -> Doc -> Doc -> Doc
docCmt [String]
lns Doc
start Doc
end = forall a. [a] -> Doc -> Doc
emptyIfNull [String]
lns forall a b. (a -> b) -> a -> b
$
  [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ Doc
start forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
indent forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text) [String]
lns forall a. [a] -> [a] -> [a]
++ [Doc
end]

commentedItem :: Doc -> Doc -> Doc
commentedItem :: Doc -> Doc -> Doc
commentedItem Doc
cmt Doc
itm = Doc -> Doc -> Doc
emptyIfEmpty Doc
itm Doc
cmt Doc -> Doc -> Doc
$+$ Doc
itm

commentLength :: Int
commentLength :: Int
commentLength = Int
75

endCommentLabel :: Label
endCommentLabel :: String
endCommentLabel = String
"End"

addComments :: Label -> Doc -> Doc -> Doc
addComments :: String -> Doc -> Doc -> Doc
addComments String
c Doc
cStart Doc
b = [Doc] -> Doc
vcat [
  String -> Doc -> Doc
commentDelimit String
c Doc
cStart,
  Doc
b,
  String -> Doc -> Doc
endCommentDelimit String
c Doc
cStart]

commentDelimit :: Label -> Doc -> Doc
commentDelimit :: String -> Doc -> Doc
commentDelimit String
c Doc
cStart = 
  let com :: Doc
com = Doc
cStart Doc -> Doc -> Doc
<> String -> Doc
text (String
" " forall a. [a] -> [a] -> [a]
++ String
c forall a. [a] -> [a] -> [a]
++ String
" ")
  in Doc
com Doc -> Doc -> Doc
<> String -> Doc
text (String -> Int -> String
dashes (Doc -> String
render Doc
com) Int
commentLength)

endCommentDelimit :: Label -> Doc -> Doc
endCommentDelimit :: String -> Doc -> Doc
endCommentDelimit String
c = String -> Doc -> Doc
commentDelimit (String
endCommentLabel forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
c)

dashes :: String -> Int -> String
dashes :: String -> Int -> String
dashes String
s Int
l = forall a. Int -> a -> [a]
replicate (Int
l forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'-'

type FuncDocRenderer = String -> [(String, String)] -> [String] -> [String]

functionDox :: FuncDocRenderer
functionDox :: FuncDocRenderer
functionDox String
desc [(String, String)]
params [String]
returns = [String
doxBrief forall a. [a] -> [a] -> [a]
++ String
desc | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
desc)]
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(String
v, String
vDesc) -> String
doxParam forall a. [a] -> [a] -> [a]
++ String
v forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
vDesc) [(String, String)]
params
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (String
doxReturn ++) [String]
returns

type ClassDocRenderer = String -> [String]

classDox :: ClassDocRenderer
classDox :: ClassDocRenderer
classDox String
desc = [String
doxBrief forall a. [a] -> [a] -> [a]
++ String
desc | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
desc)]

type ModuleDocRenderer = String -> [String] -> String -> String -> [String]

moduleDox :: ModuleDocRenderer
moduleDox :: ModuleDocRenderer
moduleDox String
desc [String]
as String
date String
m = (String
doxFile forall a. [a] -> [a] -> [a]
++ String
m) forall a. a -> [a] -> [a]
: 
  [String
doxAuthor forall a. [a] -> [a] -> [a]
++ [String] -> String
stringList [String]
as | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
as)] forall a. [a] -> [a] -> [a]
++
  [String
doxDate forall a. [a] -> [a] -> [a]
++ String
date | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
date)] forall a. [a] -> [a] -> [a]
++ 
  [String
doxBrief forall a. [a] -> [a] -> [a]
++ String
desc | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
desc)] forall a. [a] -> [a] -> [a]
++ 
  [String
doxNote forall a. [a] -> [a] -> [a]
++ String
watermark]

commentedMod :: FileData -> Doc -> FileData
commentedMod :: FileData -> Doc -> FileData
commentedMod FileData
m Doc
cmt = ModData -> FileData -> FileData
updateFileMod ((Doc -> Doc) -> ModData -> ModData
updateMod (Doc -> Doc -> Doc
commentedItem Doc
cmt) (FileData -> ModData
fileMod FileData
m)) FileData
m

-- Helper Functions --

valueList :: (RenderSym r) => [r (Value r)] -> Doc
valueList :: forall (r :: * -> *). RenderSym r => [r (Value r)] -> Doc
valueList = Doc -> [Doc] -> Doc
hicat Doc
listSep' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value

variableList :: (RenderSym r) => [r (Variable r)] -> Doc
variableList :: forall (r :: * -> *). RenderSym r => [r (Variable r)] -> Doc
variableList = Doc -> [Doc] -> Doc
hicat Doc
listSep' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable

parameterList :: (RenderSym r) => [r (Parameter r)] -> Doc
parameterList :: forall (r :: * -> *). RenderSym r => [r (Parameter r)] -> Doc
parameterList = Doc -> [Doc] -> Doc
hicat Doc
listSep' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (r :: * -> *). ParamElim r => r (Parameter r) -> Doc
RC.parameter

namedArgList :: (RenderSym r) => Doc -> [(r (Variable r), r (Value r))] -> Doc
namedArgList :: forall (r :: * -> *).
RenderSym r =>
Doc -> [(r (Variable r), r (Value r))] -> Doc
namedArgList Doc
sep = Doc -> [Doc] -> Doc
hicat Doc
listSep' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(r (Variable r)
vr,r (Value r)
vl) -> forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
vr Doc -> Doc -> Doc
<> Doc
sep
  Doc -> Doc -> Doc
<> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
vl)

prependToBody :: (Doc, Terminator) -> Doc -> Doc
prependToBody :: (Doc, Terminator) -> Doc -> Doc
prependToBody (Doc, Terminator)
s Doc
b = [Doc] -> Doc
vcat [forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ (Doc, Terminator) -> (Doc, Terminator)
statement (Doc, Terminator)
s, Doc
maybeBlank, Doc
b]
  where maybeBlank :: Doc
maybeBlank = Doc -> Doc -> Doc
emptyIfEmpty (forall a b. (a, b) -> a
fst (Doc, Terminator)
s) (Doc -> Doc -> Doc
emptyIfEmpty Doc
b Doc
blank)

appendToBody :: Doc -> (Doc, Terminator) -> Doc
appendToBody :: Doc -> (Doc, Terminator) -> Doc
appendToBody Doc
b (Doc, Terminator)
s = [Doc] -> Doc
vcat [Doc
b, Doc
maybeBlank, forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ (Doc, Terminator) -> (Doc, Terminator)
statement (Doc, Terminator)
s]
  where maybeBlank :: Doc
maybeBlank = Doc -> Doc -> Doc
emptyIfEmpty Doc
b (Doc -> Doc -> Doc
emptyIfEmpty (forall a b. (a, b) -> a
fst (Doc, Terminator)
s) Doc
blank)

surroundBody :: (Doc, Terminator) -> Doc -> (Doc, Terminator) -> Doc
surroundBody :: (Doc, Terminator) -> Doc -> (Doc, Terminator) -> Doc
surroundBody (Doc, Terminator)
p Doc
b (Doc, Terminator)
a = (Doc, Terminator) -> Doc -> Doc
prependToBody (Doc, Terminator)
p (Doc -> (Doc, Terminator) -> Doc
appendToBody Doc
b (Doc, Terminator)
a)

getterName :: String -> String
getterName :: String -> String
getterName String
s = String
"get" forall a. [a] -> [a] -> [a]
++ String -> String
capitalize String
s

setterName :: String -> String
setterName :: String -> String
setterName String
s = String
"set" forall a. [a] -> [a] -> [a]
++ String -> String
capitalize String
s

intValue :: (RenderSym r) => SValue r -> SValue r
intValue :: forall (r :: * -> *). RenderSym r => SValue r -> SValue r
intValue SValue r
i = SValue r
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeType -> SValue r
intValue' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType
  where intValue' :: CodeType -> SValue r
intValue' CodeType
Integer = SValue r
i
        intValue' CodeType
_ = forall a. HasCallStack => String -> a
error String
"Value passed to intValue must be Integer"

doxCommand, doxBrief, doxParam, doxReturn, doxFile, doxAuthor, doxDate, doxNote :: String
doxCommand :: String
doxCommand = String
"\\"
doxBrief :: String
doxBrief = String
doxCommand forall a. [a] -> [a] -> [a]
++ String
"brief "
doxParam :: String
doxParam = String
doxCommand forall a. [a] -> [a] -> [a]
++ String
"param "
doxReturn :: String
doxReturn = String
doxCommand forall a. [a] -> [a] -> [a]
++ String
"return "
doxFile :: String
doxFile = String
doxCommand  forall a. [a] -> [a] -> [a]
++ String
"file "
doxAuthor :: String
doxAuthor = String
doxCommand forall a. [a] -> [a] -> [a]
++ String
"author "
doxDate :: String
doxDate = String
doxCommand forall a. [a] -> [a] -> [a]
++ String
"date "
doxNote :: String
doxNote = String
doxCommand forall a. [a] -> [a] -> [a]
++ String
"note "