{-# LANGUAGE OverloadedStrings #-}

-- | Defines .json printers to generate jupyter notebooks. For more information on each of the helper functions, please view the [source files](https://jacquescarette.github.io/Drasil/docs/full/drasil-printers-0.1.10.0/src/Language.Drasil.JSON.Print.html).
module Language.Drasil.JSON.Print (
  genJupyterLessonPlan, genJupyterSRS
) where

import Prelude hiding (print, (<>))
import Text.PrettyPrint hiding (Str)
import Numeric (showEFloat)
import qualified Prettyprinter as PNew (Doc)

import Drasil.Data.Formats.JSON (JSON(..), JSONRenderOptions, JSONStyle(..),
  jsonRenderOpts, renderJSON)
import Language.Drasil (checkValidStr, RenderSpecial(..))
import Language.Drasil.Document (MaxWidthPercent)

import Language.Drasil.Printing.AST (Spec (Tooltip), ItemType(Flat, Nested),
  ListType(Ordered, Unordered, Definitions, Desc, Simple), Expr,
  Ops(..), Expr(..), Spec(Quote, EmptyS, Ref, HARDNL, Sp, S, E, (:+:)),
  Fonts(Bold), OverSymb(Hat), Label, LinkType(Internal, Cite2, External))
import Language.Drasil.Printing.Citation (BibRef)
import Language.Drasil.Printing.LayoutObj (Document(Document), LayoutObj(..))
import Language.Drasil.Printing.Helpers (sqbrac, unders, hat)
import qualified Language.Drasil.TeX.Print as TeX (spec, pExpr)
import Language.Drasil.TeX.Monad (runPrint, MathContext(Math), D, toMath, PrintLaTeX(PL))
import Language.Drasil.HTML.Helpers (th, bold, reflinkInfo)
import Language.Drasil.HTML.Print (renderCite, OpenClose(Open, Close), fence,
  htmlBibFormatter)
import Language.Drasil.HTML.Monad (unPH)

import Language.Drasil.JSON.Helpers (makeMetadata, h, stripnewLine,
 tr, td, image, li, pa, ba, table, refwrap, refID, reflink, reflinkURI, mkDiv,
 markdownCell, codeCell)

pretty :: JSONRenderOptions
pretty :: JSONRenderOptions
pretty = JSONStyle -> JSONRenderOptions
jsonRenderOpts (Natural -> JSONStyle
Pretty Natural
2)

-- | Build the general Jupyter Notebook document.
genJupyterLessonPlan :: Document -> PNew.Doc ann
genJupyterLessonPlan :: forall ann. Document -> Doc ann
genJupyterLessonPlan (Document Title
t Title
a [LayoutObj]
c) =
  let
    titleCell :: JSON
titleCell = Doc -> JSON
markdownCell ([Doc] -> Doc
vcat [[Char] -> Doc
text [Char]
"# " Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
t, [Char] -> Doc
text [Char]
"## " Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
a])
    cells :: JSON
cells = [JSON] -> JSON
JArray ([JSON] -> JSON) -> [JSON] -> JSON
forall a b. (a -> b) -> a -> b
$ JSON
titleCell JSON -> [JSON] -> [JSON]
forall a. a -> [a] -> [a]
: (LayoutObj -> [JSON]) -> [LayoutObj] -> [JSON]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LayoutObj -> [JSON]
printLO' [LayoutObj]
c
  in JSONRenderOptions -> JSON -> Doc ann
forall ann. JSONRenderOptions -> JSON -> Doc ann
renderJSON JSONRenderOptions
pretty (JSON -> Doc ann) -> JSON -> Doc ann
forall a b. (a -> b) -> a -> b
$ [(Text, JSON)] -> JSON
JObject ([(Text, JSON)] -> JSON) -> [(Text, JSON)] -> JSON
forall a b. (a -> b) -> a -> b
$ (Text
"cells", JSON
cells) (Text, JSON) -> [(Text, JSON)] -> [(Text, JSON)]
forall a. a -> [a] -> [a]
: [(Text, JSON)]
makeMetadata

-- | Build an SRS document in JSON format.
genJupyterSRS :: Document -> PNew.Doc ann
genJupyterSRS :: forall ann. Document -> Doc ann
genJupyterSRS (Document Title
t Title
a [LayoutObj]
c) =
  let
    titleCell :: JSON
titleCell = Doc -> JSON
markdownCell ([Doc] -> Doc
vcat [[Char] -> Doc
text [Char]
"# " Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
t, [Char] -> Doc
text [Char]
"## " Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
a])
    cells :: JSON
cells = [JSON] -> JSON
JArray ([JSON] -> JSON) -> [JSON] -> JSON
forall a b. (a -> b) -> a -> b
$ JSON
titleCell JSON -> [JSON] -> [JSON]
forall a. a -> [a] -> [a]
: [Doc -> JSON
markdownCell ([LayoutObj] -> Doc
print [LayoutObj]
c)]
  in JSONRenderOptions -> JSON -> Doc ann
forall ann. JSONRenderOptions -> JSON -> Doc ann
renderJSON JSONRenderOptions
pretty (JSON -> Doc ann) -> JSON -> Doc ann
forall a b. (a -> b) -> a -> b
$ [(Text, JSON)] -> JSON
JObject ([(Text, JSON)] -> JSON) -> [(Text, JSON)] -> JSON
forall a b. (a -> b) -> a -> b
$ (Text
"cells", JSON
cells) (Text, JSON) -> [(Text, JSON)] -> [(Text, JSON)]
forall a. a -> [a] -> [a]
: [(Text, JSON)]
makeMetadata

-- | Helper for rendering a D from Latex print
printMath :: D -> Doc
printMath :: D -> Doc
printMath = (D -> MathContext -> Doc
forall a. PrintLaTeX a -> MathContext -> a
`runPrint` MathContext
Math)

-- | Helper for rendering LayoutObjects into JSON
-- printLO is used for generating SRS
printLO :: LayoutObj -> Doc
printLO :: LayoutObj -> Doc
printLO (Header Int
n Title
contents Title
l)            = [Char] -> Doc
text [Char]
"" Doc -> Doc -> Doc
$$ Int -> Doc
h (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
contents Doc -> Doc -> Doc
$$ Doc -> Doc
refID (Title -> Doc
pSpec Title
l)
printLO (Cell [LayoutObj]
_)                         = Doc
empty
printLO (HDiv Tags
_ [LayoutObj]
layoutObs Title
_)             = [Doc] -> Doc
vcat ((LayoutObj -> Doc) -> [LayoutObj] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map LayoutObj -> Doc
printLO [LayoutObj]
layoutObs)
printLO (Paragraph Title
contents)             = [Char] -> Doc
text [Char]
"" Doc -> Doc -> Doc
$$ [Char] -> Doc
stripnewLine (Doc -> [Char]
forall a. Show a => a -> [Char]
show (Title -> Doc
pSpec Title
contents))
printLO (EqnBlock Title
contents)              = Doc
mathEqn
  where
    toMathHelper :: PrintLaTeX a -> PrintLaTeX a
toMathHelper (PL MathContext -> a
g) = (MathContext -> a) -> PrintLaTeX a
forall a. (MathContext -> a) -> PrintLaTeX a
PL (\MathContext
_ -> MathContext -> a
g MathContext
Math)
    mjDelimDisp :: a -> Doc
mjDelimDisp a
d  = [Char] -> Doc
text [Char]
"$$" Doc -> Doc -> Doc
<> [Char] -> Doc
stripnewLine (a -> [Char]
forall a. Show a => a -> [Char]
show a
d) Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"$$"
    mathEqn :: Doc
mathEqn = Doc -> Doc
forall {a}. Show a => a -> Doc
mjDelimDisp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ D -> Doc
printMath (D -> Doc) -> D -> Doc
forall a b. (a -> b) -> a -> b
$ D -> D
forall {a}. PrintLaTeX a -> PrintLaTeX a
toMathHelper (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Title -> D
TeX.spec Title
contents
printLO (Table Tags
_ [[Title]]
rows Title
r Bool
_ Title
_)            = [Char] -> Doc
text [Char]
"" Doc -> Doc -> Doc
$$ [[Title]] -> Doc -> Doc
makeTable [[Title]]
rows (Title -> Doc
pSpec Title
r)
printLO (Definition [([Char], [LayoutObj])]
ssPs Title
l)             = [Char] -> Doc
text [Char]
"<br>" Doc -> Doc -> Doc
$$ [([Char], [LayoutObj])] -> Doc -> Doc
makeDefn [([Char], [LayoutObj])]
ssPs (Title -> Doc
pSpec Title
l)
printLO (List ListType
t)                        = [Char] -> Doc
text [Char]
"" Doc -> Doc -> Doc
$$ ListType -> Bool -> Doc
makeList ListType
t Bool
False
printLO (Figure Title
r Maybe Title
c [Char]
f MaxWidthPercent
wp)               = Doc -> Maybe Doc -> Doc -> MaxWidthPercent -> Doc
makeFigure (Title -> Doc
pSpec Title
r) ((Title -> Doc) -> Maybe Title -> Maybe Doc
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Title -> Doc
pSpec Maybe Title
c) ([Char] -> Doc
text [Char]
f) MaxWidthPercent
wp
printLO (Bib BibRef
bib)                       = BibRef -> Doc
makeBib BibRef
bib
printLO Graph{}                         = Doc
empty
printLO CodeBlock {}                    = Doc
empty

-- printLO' is used for generating general notebook (lesson plans)
printLO' :: LayoutObj -> [JSON]
printLO' :: LayoutObj -> [JSON]
printLO' (Header Int
n Title
contents Title
l)            = [Doc -> JSON
markdownCell (Doc -> JSON) -> Doc -> JSON
forall a b. (a -> b) -> a -> b
$ (Int -> Doc
h (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
contents) Doc -> Doc -> Doc
$$ Doc -> Doc
refID (Title -> Doc
pSpec Title
l)]
printLO' (Cell [LayoutObj]
layoutObs)                 = (LayoutObj -> [JSON]) -> [LayoutObj] -> [JSON]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LayoutObj -> [JSON]
printLO' [LayoutObj]
layoutObs
printLO' HDiv{} = []
printLO' (Paragraph Title
contents)             = [Doc -> JSON
markdownCell (Doc -> JSON) -> Doc -> JSON
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
stripnewLine (Doc -> [Char]
forall a. Show a => a -> [Char]
show (Title -> Doc
pSpec Title
contents))]
printLO' (EqnBlock Title
contents)              = [Doc -> JSON
markdownCell Doc
mathEqn]
  where
    toMathHelper :: PrintLaTeX a -> PrintLaTeX a
toMathHelper (PL MathContext -> a
g) = (MathContext -> a) -> PrintLaTeX a
forall a. (MathContext -> a) -> PrintLaTeX a
PL (\MathContext
_ -> MathContext -> a
g MathContext
Math)
    mjDelimDisp :: a -> Doc
mjDelimDisp a
d  = [Char] -> Doc
text [Char]
"$$" Doc -> Doc -> Doc
<> [Char] -> Doc
stripnewLine (a -> [Char]
forall a. Show a => a -> [Char]
show a
d) Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"$$"
    mathEqn :: Doc
mathEqn = Doc -> Doc
forall {a}. Show a => a -> Doc
mjDelimDisp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ D -> Doc
printMath (D -> Doc) -> D -> Doc
forall a b. (a -> b) -> a -> b
$ D -> D
forall {a}. PrintLaTeX a -> PrintLaTeX a
toMathHelper (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Title -> D
TeX.spec Title
contents
printLO' (Table Tags
_ [[Title]]
rows Title
r Bool
_ Title
_)             = [Doc -> JSON
markdownCell (Doc -> JSON) -> Doc -> JSON
forall a b. (a -> b) -> a -> b
$ [[Title]] -> Doc -> Doc
makeTable [[Title]]
rows (Title -> Doc
pSpec Title
r)]
printLO' Definition{}                     = []
printLO' (List ListType
t)                         = [Doc -> JSON
markdownCell (Doc -> JSON) -> Doc -> JSON
forall a b. (a -> b) -> a -> b
$ ListType -> Bool -> Doc
makeList ListType
t Bool
False]
printLO' (Figure Title
r Maybe Title
c [Char]
f MaxWidthPercent
wp)                = [Doc -> JSON
markdownCell (Doc -> JSON) -> Doc -> JSON
forall a b. (a -> b) -> a -> b
$ Doc -> Maybe Doc -> Doc -> MaxWidthPercent -> Doc
makeFigure (Title -> Doc
pSpec Title
r) ((Title -> Doc) -> Maybe Title -> Maybe Doc
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Title -> Doc
pSpec Maybe Title
c) ([Char] -> Doc
text [Char]
f) MaxWidthPercent
wp]
printLO' (Bib BibRef
bib)                        = [Doc -> JSON
markdownCell (Doc -> JSON) -> Doc -> JSON
forall a b. (a -> b) -> a -> b
$ BibRef -> Doc
makeBib BibRef
bib]
printLO' Graph{}                          = []
printLO' (CodeBlock Title
contents)             = [Doc -> JSON
codeCell (Doc -> JSON) -> Doc -> JSON
forall a b. (a -> b) -> a -> b
$ Title -> Doc
cSpec Title
contents]

-- | Called by build, uses 'printLO' to render the layout
-- objects in Doc format.
print :: [LayoutObj] -> Doc
print :: [LayoutObj] -> Doc
print = (LayoutObj -> Doc -> Doc) -> Doc -> [LayoutObj] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($$) (Doc -> Doc -> Doc)
-> (LayoutObj -> Doc) -> LayoutObj -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutObj -> Doc
printLO) Doc
empty

pSpec :: Spec -> Doc
pSpec :: Title -> Doc
pSpec (E Expr
e)  = [Char] -> Doc
text [Char]
"$" Doc -> Doc -> Doc
<> Expr -> Doc
pExpr Expr
e Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"$" -- symbols used
pSpec (Title
a :+: Title
b) = Title -> Doc
pSpec Title
a Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
b
pSpec (S [Char]
s)     = ([Char] -> Doc) -> ([Char] -> Doc) -> Either [Char] [Char] -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> Doc
text ([Char] -> Doc) -> ([Char] -> [Char]) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
escapeChars) (Either [Char] [Char] -> Doc) -> Either [Char] [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Either [Char] [Char]
checkValidStr [Char]
s [Char]
invalid
  where
    invalid :: [Char]
invalid = [Char
'<', Char
'>']
    escapeChars :: Char -> [Char]
escapeChars Char
'&' = [Char]
"\\&"
    escapeChars Char
c = [Char
c]
pSpec (Tooltip Title
_ Title
s) = Title -> Doc
pSpec Title
s
pSpec (Sp Special
s)    = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ PrintHTML -> [Char]
unPH (PrintHTML -> [Char]) -> PrintHTML -> [Char]
forall a b. (a -> b) -> a -> b
$ Special -> PrintHTML
forall r. RenderSpecial r => Special -> r
special Special
s
pSpec Title
HARDNL    = Doc
empty
pSpec (Ref LinkType
Internal [Char]
r Title
a)      = [Char] -> Doc -> Doc
reflink     [Char]
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
a
pSpec (Ref (Cite2 Title
EmptyS) [Char]
r Title
a) = [Char] -> Doc -> Doc
reflink     [Char]
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
a -- no difference for citations?
pSpec (Ref (Cite2 Title
n)   [Char]
r Title
a)    = [Char] -> Doc -> Doc -> Doc
reflinkInfo [Char]
r (Title -> Doc
pSpec Title
a) (Title -> Doc
pSpec Title
n)
pSpec (Ref LinkType
External [Char]
r Title
a)      = [Char] -> Doc -> Doc
reflinkURI  [Char]
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
a
pSpec Title
EmptyS    = [Char] -> Doc
text [Char]
"" -- Expected in the output
pSpec (Quote Title
q) = Doc -> Doc
doubleQuotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
q

cSpec :: Spec -> Doc
cSpec :: Title -> Doc
cSpec (E Expr
e)  = Expr -> Doc
pExpr Expr
e
cSpec Title
_      = Doc
empty

-- | Renders expressions in JSON (called by multiple functions)
pExpr :: Expr -> Doc
pExpr :: Expr -> Doc
pExpr (Dbl Double
d)        = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showEFloat Maybe Int
forall a. Maybe a
Nothing Double
d [Char]
""
pExpr (Int Integer
i)        = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i
pExpr (Str [Char]
s)        = Doc -> Doc
doubleQuotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
s
pExpr (Div Expr
n Expr
d)      = [Char] -> Doc -> Doc -> Doc
mkDiv [Char]
"frac" (Expr -> Doc
pExpr Expr
n) (Expr -> Doc
pExpr Expr
d)
pExpr (Row [Expr]
l)        = [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc
pExpr [Expr]
l
pExpr (Set [Expr]
l)        = [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc
pExpr [Expr]
l
pExpr (Ident [Char]
s)      = [Char] -> Doc
text [Char]
s
pExpr (Label [Char]
s)      = [Char] -> Doc
text [Char]
s
pExpr (Spec Special
s)       = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ PrintHTML -> [Char]
unPH (PrintHTML -> [Char]) -> PrintHTML -> [Char]
forall a b. (a -> b) -> a -> b
$ Special -> PrintHTML
forall r. RenderSpecial r => Special -> r
special Special
s
pExpr (Sub Expr
e)        = Doc
unders Doc -> Doc -> Doc
<> Expr -> Doc
pExpr Expr
e
pExpr (Sup Expr
e)        = Doc
hat Doc -> Doc -> Doc
<> Expr -> Doc
pExpr Expr
e
pExpr (Over OverSymb
Hat Expr
s)   = Expr -> Doc
pExpr Expr
s Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"&#770;"
pExpr (MO Ops
o)         = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Ops -> [Char]
pOps Ops
o
pExpr (Fenced Fence
l Fence
r Expr
e) = [Char] -> Doc
text (OpenClose -> Fence -> [Char]
fence OpenClose
Open Fence
l) Doc -> Doc -> Doc
<> Expr -> Doc
pExpr Expr
e Doc -> Doc -> Doc
<> [Char] -> Doc
text (OpenClose -> Fence -> [Char]
fence OpenClose
Close Fence
r)
pExpr (Font Fonts
Bold Expr
e)  = Expr -> Doc
pExpr Expr
e
--pExpr (Font Bold e)  = bold $ pExpr e -- used before
--pExpr (Font Emph e)  = text "<em>" <> pExpr e <> text "</em>" -- HTML used
--pExpr (Spc Thin)     = text "&#8239;" -- HTML used
-- Uses TeX for Mathjax for all other exprs
pExpr Expr
e              = D -> Doc
printMath (D -> Doc) -> D -> Doc
forall a b. (a -> b) -> a -> b
$ D -> D
toMath (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Expr -> D
TeX.pExpr Expr
e

-- TODO: edit all operations in markdown format
pOps :: Ops -> String
pOps :: Ops -> [Char]
pOps Ops
IsIn       = [Char]
"&thinsp;&isin;&thinsp;"
pOps Ops
Integer    = [Char]
"&#8484;"
pOps Ops
Rational   = [Char]
"&#8474;"
pOps Ops
Real       = [Char]
"&#8477;"
pOps Ops
Natural    = [Char]
"&#8469;"
pOps Ops
Boolean    = [Char]
"&#120121;"
pOps Ops
Comma      = [Char]
","
pOps Ops
Prime      = [Char]
"&prime;"
pOps Ops
Log        = [Char]
"log"
pOps Ops
Ln         = [Char]
"ln"
pOps Ops
Sin        = [Char]
"sin"
pOps Ops
Cos        = [Char]
"cos"
pOps Ops
Tan        = [Char]
"tan"
pOps Ops
Sec        = [Char]
"sec"
pOps Ops
Csc        = [Char]
"csc"
pOps Ops
Cot        = [Char]
"cot"
pOps Ops
Arcsin     = [Char]
"arcsin"
pOps Ops
Arccos     = [Char]
"arccos"
pOps Ops
Arctan     = [Char]
"arctan"
pOps Ops
Not        = [Char]
"&not;"
pOps Ops
Dim        = [Char]
"dim"
pOps Ops
Exp        = [Char]
"e"
pOps Ops
Neg        = [Char]
"-"
pOps Ops
Cross      = [Char]
"&#10799;"
pOps Ops
VAdd       = [Char]
" + "
pOps Ops
VSub       = [Char]
" - "
pOps Ops
Dot        = [Char]
"&sdot;"
pOps Ops
Scale      = [Char]
"" -- same as Mul
pOps Ops
Eq         = [Char]
" = " -- with spaces?
pOps Ops
NEq        = [Char]
"&ne;"
pOps Ops
Lt         = [Char]
"&thinsp;&lt;&thinsp;" --thin spaces make these more readable
pOps Ops
Gt         = [Char]
"&thinsp;&gt;&thinsp;"
pOps Ops
LEq        = [Char]
"&thinsp;&le;&thinsp;"
pOps Ops
GEq        = [Char]
"&thinsp;&ge;&thinsp;"
pOps Ops
Impl       = [Char]
" &rArr; "
pOps Ops
Iff        = [Char]
" &hArr; "
pOps Ops
Subt       = [Char]
" - "
pOps Ops
And        = [Char]
" &and; "
pOps Ops
Or         = [Char]
" &or; "
pOps Ops
Add        = [Char]
" + "
pOps Ops
Mul        = [Char]
""
pOps Ops
Summ       = [Char]
"&sum"
pOps Ops
Inte       = [Char]
"&int;"
pOps Ops
Prod       = [Char]
"&prod;"
pOps Ops
Point      = [Char]
"."
pOps Ops
Perc       = [Char]
"%"
pOps Ops
LArrow     = [Char]
" &larr; "
pOps Ops
RArrow     = [Char]
" &rarr; "
pOps Ops
ForAll     = [Char]
" ForAll "
pOps Ops
Partial    = [Char]
"&part;"
pOps Ops
SAdd       = [Char]
" + "
pOps Ops
SRemove    = [Char]
" - "
pOps Ops
SContains  = [Char]
" in "
pOps Ops
SUnion     = [Char]
" and "

-- | Renders Markdown table, called by 'printLO'
makeTable :: [[Spec]] -> Doc -> Doc
makeTable :: [[Title]] -> Doc -> Doc
makeTable [] Doc
_      = [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"No table to print"
makeTable ([Title]
l:[[Title]]
lls) Doc
r = Doc -> Doc
refID Doc
r Doc -> Doc -> Doc
$$ [Char] -> Doc
text [Char]
"" Doc -> Doc -> Doc
$$ ([Title] -> Doc
makeHeaderCols [Title]
l Doc -> Doc -> Doc
$$ [[Title]] -> Doc
makeRows [[Title]]
lls) Doc -> Doc -> Doc
$$ [Char] -> Doc
text [Char]
""

-- | Helper for creating table rows
makeRows :: [[Spec]] -> Doc
makeRows :: [[Title]] -> Doc
makeRows = ([Title] -> Doc -> Doc) -> Doc -> [[Title]] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($$) (Doc -> Doc -> Doc) -> ([Title] -> Doc) -> [Title] -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Title] -> Doc
makeColumns) Doc
empty

-- | makeHeaderCols: Helper for creating table header row (each of the column header cells)
-- | makeColumns: Helper for creating table columns
makeHeaderCols, makeColumns :: [Spec] -> Doc
makeHeaderCols :: [Title] -> Doc
makeHeaderCols [Title]
l = [Char] -> Doc
text [Char]
header Doc -> Doc -> Doc
$$ [Char] -> Doc
text ([Char]
genMDtable [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"|")
  where header :: [Char]
header = Doc -> [Char]
forall a. Show a => a -> [Char]
show ([Char] -> Doc
text [Char]
"|" Doc -> Doc -> Doc
<> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate ([Char] -> Doc
text [Char]
"|") ((Title -> Doc) -> [Title] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Title -> Doc
pSpec [Title]
l)) Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"|")
        c :: Int
c = Char -> [Char] -> Int
count Char
'|' [Char]
header
        genMDtable :: [Char]
genMDtable = Tags -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [Char] -> Tags
forall a. Int -> a -> [a]
replicate (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Char]
"|:--- ")

makeColumns :: [Title] -> Doc
makeColumns [Title]
ls = [Char] -> Doc
text [Char]
"|" Doc -> Doc -> Doc
<> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate ([Char] -> Doc
text [Char]
"|") ((Title -> Doc) -> [Title] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Title -> Doc
pSpec [Title]
ls)) Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"|"

count :: Char -> String -> Int
count :: Char -> [Char] -> Int
count Char
_ [] = Int
0
count Char
c (Char
x:[Char]
xs)
  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> [Char] -> Int
count Char
c [Char]
xs
  | Bool
otherwise = Char -> [Char] -> Int
count Char
c [Char]
xs

-- | Renders definition tables (Data, General, Theory, etc.)
makeDefn :: [(String, [LayoutObj])] -> Doc -> Doc
makeDefn :: [([Char], [LayoutObj])] -> Doc -> Doc
makeDefn [] Doc
_ = [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"Empty definition"
makeDefn [([Char], [LayoutObj])]
ps Doc
l = Doc -> Doc
refID Doc
l Doc -> Doc -> Doc
$$ Tags -> Doc -> Doc
table [[Char]
"defn-table"]
  (Doc -> Doc
tr (Doc -> Doc
th ([Char] -> Doc
text [Char]
"Refname") Doc -> Doc -> Doc
$$ Doc -> Doc
td (Doc -> Doc
bold Doc
l)) Doc -> Doc -> Doc
$$ [([Char], [LayoutObj])] -> Doc
makeDRows [([Char], [LayoutObj])]
ps)

-- | Helper for making the definition table rows
makeDRows :: [(String,[LayoutObj])] -> Doc
makeDRows :: [([Char], [LayoutObj])] -> Doc
makeDRows []         = [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"No fields to create defn table"
makeDRows [([Char]
f,[LayoutObj]
d)]    = Doc -> Doc
tr (Doc -> Doc
th ([Char] -> Doc
text [Char]
f) Doc -> Doc -> Doc
$$ Doc -> Doc
td ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (LayoutObj -> Doc) -> [LayoutObj] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map LayoutObj -> Doc
printLO [LayoutObj]
d))
makeDRows (([Char]
f,[LayoutObj]
d):[([Char], [LayoutObj])]
ps) = Doc -> Doc
tr (Doc -> Doc
th ([Char] -> Doc
text [Char]
f) Doc -> Doc -> Doc
$$ Doc -> Doc
td ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (LayoutObj -> Doc) -> [LayoutObj] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map LayoutObj -> Doc
printLO [LayoutObj]
d)) Doc -> Doc -> Doc
$$ [([Char], [LayoutObj])] -> Doc
makeDRows [([Char], [LayoutObj])]
ps

-- | Renders lists
makeList :: ListType -> Bool -> Doc -- FIXME: ref id's should be folded into the li
makeList :: ListType -> Bool -> Doc
makeList (Simple [(Title, ItemType, Maybe Title)]
items) Bool
_      = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
  ((Title, ItemType, Maybe Title) -> Doc)
-> [(Title, ItemType, Maybe Title)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Title
b,ItemType
e,Maybe Title
l) -> Maybe Title -> Doc -> Doc
mlref Maybe Title
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
b Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
": " Doc -> Doc -> Doc
<> ItemType -> Doc
sItem ItemType
e Doc -> Doc -> Doc
$$ [Char] -> Doc
text [Char]
"") [(Title, ItemType, Maybe Title)]
items
makeList (Desc [(Title, ItemType, Maybe Title)]
items) Bool
bl       = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
  ((Title, ItemType, Maybe Title) -> Doc)
-> [(Title, ItemType, Maybe Title)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Title
b,ItemType
e,Maybe Title
l) -> Doc -> Doc
pa (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Maybe Title -> Doc -> Doc
mlref Maybe Title
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
ba (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
b Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
": " Doc -> Doc -> Doc
<> ItemType -> Bool -> Doc
pItem ItemType
e Bool
bl) [(Title, ItemType, Maybe Title)]
items
makeList (Ordered [(ItemType, Maybe Title)]
items) Bool
bl    = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((ItemType, Maybe Title) -> Doc)
-> [(ItemType, Maybe Title)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(ItemType
i,Maybe Title
l) -> Maybe Title -> Doc -> Doc
mlref Maybe Title
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ ItemType -> Bool -> Doc
pItem ItemType
i Bool
bl) [(ItemType, Maybe Title)]
items
makeList (Unordered [(ItemType, Maybe Title)]
items) Bool
bl  = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((ItemType, Maybe Title) -> Doc)
-> [(ItemType, Maybe Title)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(ItemType
i,Maybe Title
l) -> Maybe Title -> Doc -> Doc
mlref Maybe Title
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ ItemType -> Bool -> Doc
pItem ItemType
i Bool
bl) [(ItemType, Maybe Title)]
items
--makeList (Definitions items) _ = ul ["hide-list-style-no-indent"] $ vcat $
  --map (\(b,e,l) -> li $ mlref l $ quote(pSpec b <> text " is the" <+> sItem e)) items
makeList (Definitions [(Title, ItemType, Maybe Title)]
items) Bool
_ = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Title, ItemType, Maybe Title) -> Doc)
-> [(Title, ItemType, Maybe Title)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Title
b,ItemType
e,Maybe Title
l) -> Doc -> Doc
li (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Maybe Title -> Doc -> Doc
mlref Maybe Title
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
b Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
" is the" Doc -> Doc -> Doc
<+> ItemType -> Doc
sItem ItemType
e) [(Title, ItemType, Maybe Title)]
items

-- | Helper for setting up references
mlref :: Maybe Label -> Doc -> Doc
mlref :: Maybe Title -> Doc -> Doc
mlref = (Doc -> Doc) -> (Title -> Doc -> Doc) -> Maybe Title -> Doc -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc -> Doc
forall a. a -> a
id ((Title -> Doc -> Doc) -> Maybe Title -> Doc -> Doc)
-> (Title -> Doc -> Doc) -> Maybe Title -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
refwrap (Doc -> Doc -> Doc) -> (Title -> Doc) -> Title -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> Doc
pSpec

-- | Helper for rendering list items
pItem :: ItemType ->  Bool -> Doc
pItem :: ItemType -> Bool -> Doc
pItem (Flat Title
s)     Bool
b = (if Bool
b then [Char] -> Doc
text [Char]
" - " else [Char] -> Doc
text [Char]
"- ") Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
s
pItem (Nested Title
s ListType
l) Bool
_ = [Doc] -> Doc
vcat [[Char] -> Doc
text [Char]
"- " Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
s, ListType -> Bool -> Doc
makeList ListType
l Bool
True]
  --where listIndent = strBreak "\"" (show $ makeList l)
--indent <> text "\"- " <> pSpec s <> text "\\n\","

sItem :: ItemType -> Doc
sItem :: ItemType -> Doc
sItem (Flat Title
s)     = Title -> Doc
pSpec Title
s
sItem (Nested Title
s ListType
l) = [Doc] -> Doc
vcat [Title -> Doc
pSpec Title
s, ListType -> Bool -> Doc
makeList ListType
l Bool
False]

-- | Renders figures in HTML
makeFigure :: Doc -> Maybe Doc -> Doc -> MaxWidthPercent -> Doc
makeFigure :: Doc -> Maybe Doc -> Doc -> MaxWidthPercent -> Doc
makeFigure Doc
r Maybe Doc
c Doc
f MaxWidthPercent
wp = Doc -> Doc
refID Doc
r Doc -> Doc -> Doc
$$ Doc -> Maybe Doc -> MaxWidthPercent -> Doc
image Doc
f Maybe Doc
c MaxWidthPercent
wp

-- | Renders assumptions, requirements, likely changes
makeRefList :: Doc -> Doc -> Doc -> Doc
makeRefList :: Doc -> Doc -> Doc -> Doc
makeRefList Doc
a Doc
l Doc
i = Doc -> Doc
refID Doc
l Doc -> Doc -> Doc
$$ Doc
i Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
": " Doc -> Doc -> Doc
<> Doc
a

makeBib :: BibRef -> Doc
makeBib :: BibRef -> Doc
makeBib = [Doc] -> Doc
vcat ([Doc] -> Doc) -> (BibRef -> [Doc]) -> BibRef -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Doc -> (Doc, Doc) -> Doc) -> [Doc] -> [(Doc, Doc)] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Doc, (Doc, Doc)) -> Doc) -> Doc -> (Doc, Doc) -> Doc
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (\(Doc
x,(Doc
y,Doc
z)) -> Doc -> Doc -> Doc -> Doc
makeRefList Doc
z Doc
y Doc
x))
  [[Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
sqbrac ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x | Int
x <- [Int
1..] :: [Int]] ([(Doc, Doc)] -> [Doc])
-> (BibRef -> [(Doc, Doc)]) -> BibRef -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Citation -> (Doc, Doc)) -> BibRef -> [(Doc, Doc)]
forall a b. (a -> b) -> [a] -> [b]
map (BibFormatter -> Citation -> (Doc, Doc)
renderCite BibFormatter
htmlBibFormatter)