{-# 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 qualified Prelude as P ((<>))
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, Special(Circle))
import Language.Drasil.Document (MaxWidthPercent)

import Drasil.Printers.Common
import Language.Drasil.Printing.AST (ItemType(..), ListType(..), Spec(..),
  Expr(..), Label, Fonts(Bold), OverSymb(Hat), Fence(..), Ops(..), LinkType(..))
import Language.Drasil.Printing.Citation (BibRef)
import Language.Drasil.Printing.LayoutObj (Document(Document), LayoutObj(..))
import Language.Drasil.Printing.Helpers (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.Markdown.Citation (BibFormatter(..), renderCite)

import Language.Drasil.JSON.Helpers (makeMetadata, h, stripnewLine,
 tr, td, th, bold, em, image, li, pa, ba, table, refwrap, refID, reflink,
 reflinkInfo, 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
printLO (LayoutObj -> Doc) -> [LayoutObj] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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 :: Doc -> Doc
mjDelimDisp = Doc -> Doc
forall a. CanTextWrap a => a -> a
ddollars (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
stripnewLine ([Char] -> Doc) -> (Doc -> [Char]) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Char]
forall a. Show a => a -> [Char]
show
    mathEqn :: Doc
mathEqn = Doc -> 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
pSpec (Title -> Doc) -> Maybe Title -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: Doc -> Doc
mjDelimDisp = Doc -> Doc
forall a. CanTextWrap a => a -> a
ddollars (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
stripnewLine ([Char] -> Doc) -> (Doc -> [Char]) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Char]
forall a. Show a => a -> [Char]
show
    mathEqn :: Doc
mathEqn = Doc -> 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
pSpec (Title -> Doc) -> Maybe Title -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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

data ExprContext = NotebookMath | NotebookCode

pSpec :: Spec -> Doc
pSpec :: Title -> Doc
pSpec (E Expr
e)  = Doc -> Doc
forall a. CanTextWrap a => a -> a
dollar (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Expr -> Doc
pMathExpr Expr
e
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
Circle) = [Char] -> Doc
text [Char]
"&deg;"
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
forall a. CanTextWrap a => a -> a
dquote (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)  = ExprContext -> Expr -> Doc
pExpr ExprContext
NotebookCode Expr
e
cSpec Title
_      = Doc
empty

-- | Render math where the enclosing context already delimits the expression.
pMathExpr :: Expr -> Doc
pMathExpr :: Expr -> Doc
pMathExpr (Row [Expr
e]) = Expr -> Doc
pMathExpr Expr
e
pMathExpr Expr
e = ExprContext -> Expr -> Doc
pExpr ExprContext
NotebookMath Expr
e

-- | Renders expressions in JSON (called by multiple functions)
pExpr :: ExprContext -> Expr -> Doc
pExpr :: ExprContext -> Expr -> Doc
pExpr ExprContext
_ (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 ExprContext
_ (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 ExprContext
_ (Str [Char]
s)        = Doc -> Doc
forall a. CanTextWrap a => a -> a
dquote (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
s
pExpr ExprContext
NotebookMath (Div Expr
n Expr
d) =
  [Char] -> Doc -> Doc -> Doc
mkDiv [Char]
"frac" (Expr -> Doc
pMathExpr Expr
n) (Expr -> Doc
pMathExpr Expr
d)
pExpr ExprContext
ctx (Div Expr
n Expr
d)    = [Char] -> Doc -> Doc -> Doc
mkDiv [Char]
"frac" (ExprContext -> Expr -> Doc
pExpr ExprContext
ctx Expr
n) (ExprContext -> Expr -> Doc
pExpr ExprContext
ctx Expr
d)
pExpr ExprContext
NotebookMath (Row [Expr
x]) =
  Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ ExprContext -> Expr -> Doc
pExpr ExprContext
NotebookMath Expr
x
pExpr ExprContext
ctx (Row [Expr]
l)      = [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ExprContext -> Expr -> Doc
pExpr ExprContext
ctx (Expr -> Doc) -> [Expr] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr]
l
pExpr ExprContext
ctx (Set [Expr]
l)      = [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ExprContext -> Expr -> Doc
pExpr ExprContext
ctx (Expr -> Doc) -> [Expr] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr]
l
pExpr ExprContext
_ (Ident [Char]
s)      = [Char] -> Doc
text [Char]
s
pExpr ExprContext
NotebookMath (Label [Char]
s) =
  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 ([Char] -> Expr
Label [Char]
s)
pExpr ExprContext
NotebookCode (Label [Char]
s) = [Char] -> Doc
text [Char]
s
pExpr ExprContext
_ (Spec Special
Circle)  = [Char] -> Doc
text [Char]
"&deg;"
pExpr ExprContext
NotebookMath (Sub Expr
e) =
  Doc
unders Doc -> Doc -> Doc
<> Doc -> Doc
braces (Expr -> Doc
pMathExpr Expr
e)
pExpr ExprContext
NotebookCode (Sub Expr
e) =
  Doc
unders Doc -> Doc -> Doc
<> ExprContext -> Expr -> Doc
pExpr ExprContext
NotebookCode Expr
e
pExpr ExprContext
NotebookMath (Sup Expr
e) =
  Doc
hat Doc -> Doc -> Doc
<> Doc -> Doc
braces (Expr -> Doc
pMathExpr Expr
e)
pExpr ExprContext
NotebookCode (Sup Expr
e) =
  Doc
hat Doc -> Doc -> Doc
<> ExprContext -> Expr -> Doc
pExpr ExprContext
NotebookCode Expr
e
pExpr ExprContext
ctx (Over OverSymb
Hat Expr
s) = ExprContext -> Expr -> Doc
pExpr ExprContext
ctx Expr
s Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"&#770;"
pExpr ExprContext
_ (MO Ops
o)         = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Ops -> [Char]
pOps Ops
o
pExpr ExprContext
ctx (Fenced Fence
l Fence
r Expr
e) =
  [Char] -> Doc
text (OpenClose -> Fence -> [Char]
fence OpenClose
Open Fence
l) Doc -> Doc -> Doc
<> ExprContext -> Expr -> Doc
pExpr ExprContext
ctx Expr
e Doc -> Doc -> Doc
<> [Char] -> Doc
text (OpenClose -> Fence -> [Char]
fence OpenClose
Close Fence
r)
pExpr ExprContext
ctx (Font Fonts
Bold Expr
e) = ExprContext -> Expr -> Doc
pExpr ExprContext
ctx 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 ExprContext
_ 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 "

-- | Referring to 'fence' (for parenthesis and brackets). Either opened or closed.
data OpenClose = Open | Close

-- | Allows for open/closed variants of parenthesis, curly brackets, absolute value symbols, and normal symbols.
fence :: OpenClose -> Fence -> String
fence :: OpenClose -> Fence -> [Char]
fence OpenClose
Open  Fence
Paren = [Char]
"("
fence OpenClose
Close Fence
Paren = [Char]
")"
fence OpenClose
Open  Fence
Curly = [Char]
"{"
fence OpenClose
Close Fence
Curly = [Char]
"}"
fence OpenClose
_     Fence
Abs   = [Char]
"|"
fence OpenClose
_     Fence
Norm  = [Char]
"||"

-- | 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. Semigroup a => a -> a -> a
P.<> [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
pSpec (Title -> Doc) -> [Title] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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
pSpec (Title -> Doc) -> [Title] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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
printLO (LayoutObj -> Doc) -> [LayoutObj] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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
printLO (LayoutObj -> Doc) -> [LayoutObj] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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
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) -> Doc)
-> [(Title, ItemType, Maybe Title)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(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
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) -> Doc)
-> [(Title, ItemType, Maybe Title)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(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
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) -> Doc)
-> [(ItemType, Maybe Title)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(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
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) -> Doc)
-> [(ItemType, Maybe Title)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ItemType, Maybe Title)]
items
makeList (Definitions [(Title, ItemType, Maybe Title)]
items) Bool
_ = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (\(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) -> Doc)
-> [(Title, ItemType, Maybe Title)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(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]

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

-- | JSON specific bib rendering functions
jsonBibFormatter :: BibFormatter
jsonBibFormatter :: BibFormatter
jsonBibFormatter = BibFormatter {
  emph :: Doc -> Doc
emph = Doc -> Doc
em,
  spec :: Title -> Doc
spec = Title -> Doc
pSpecBib
}

pSpecBib :: Spec -> Doc
pSpecBib :: Title -> Doc
pSpecBib (Ref LinkType
External [Char]
r Title
a) = [Char] -> Doc
text ([Char]
"<a href=\"" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
P.<> [Char]
r [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
P.<> [Char]
"\">") Doc -> Doc -> Doc
<> Title -> Doc
pSpecBib Title
a Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"</a>"
pSpecBib Title
s                  = Title -> Doc
pSpec Title
s

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))
  [Doc -> Doc
forall a. CanTextWrap a => a -> a
brak (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
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]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BibFormatter -> Citation -> (Doc, Doc)
renderCite BibFormatter
jsonBibFormatter)