-- | 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(genJSON) where

import Prelude hiding (print, (<>))
import Text.PrettyPrint hiding (Str)
import Numeric (showEFloat)

import qualified Language.Drasil as L

import Language.Drasil.Printing.Import (makeDocument)
import Language.Drasil.Printing.AST (Spec, 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 Language.Drasil.Printing.PrintingInformation (PrintingInformation)

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.Monad (unPH)
import Language.Drasil.HTML.Helpers (th, bold, reflinkInfo)
import Language.Drasil.HTML.Print(renderCite, OpenClose(Open, Close), fence)

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

-- | Generate a python notebook document (using json).
genJSON :: PrintingInformation -> L.Document -> Doc
genJSON :: PrintingInformation -> Document -> Doc
genJSON sm :: PrintingInformation
sm doc :: Document
doc = Document -> Doc
build (PrintingInformation -> Document -> Document
makeDocument PrintingInformation
sm Document
doc)

-- | Build the JSON Document, called by genJSON
build :: Document -> Doc
build :: Document -> Doc
build (Document t :: Title
t a :: Title
a c :: [LayoutObj]
c) = 
  String -> Doc
text "{" Doc -> Doc -> Doc
$$
  String -> Doc
text " \"cells\": [" Doc -> Doc -> Doc
$$
  String -> Doc
text "  {" Doc -> Doc -> Doc
$$
  String -> Doc
text "   \"cell_type\": \"markdown\"," Doc -> Doc -> Doc
$$
  String -> Doc
text "   \"metadata\": {}," Doc -> Doc -> Doc
$$
  String -> Doc
text "   \"source\": [" Doc -> Doc -> Doc
$$
  Doc -> Doc
nbformat (String -> Doc
text "# " Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
t) Doc -> Doc -> Doc
$$
  Doc -> Doc
nbformat (String -> Doc
text "## " Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
a) Doc -> Doc -> Doc
$$
  Doc
markdownE Doc -> Doc -> Doc
$$
  [LayoutObj] -> Doc
print [LayoutObj]
c Doc -> Doc -> Doc
$$
  Doc
markdownB Doc -> Doc -> Doc
$$
  String -> Doc
text "   ]" Doc -> Doc -> Doc
$$
  String -> Doc
text "  }" Doc -> Doc -> Doc
$$
  String -> Doc
text " ]," Doc -> Doc -> Doc
$$
  Doc
makeMetadata Doc -> Doc -> Doc
$$
  String -> Doc
text "}" 

-- Helper for building markdown cells
markdownB, markdownE :: Doc
markdownB :: Doc
markdownB = String -> Doc
text "  {\n   \"cell_type\": \"markdown\",\n   \"metadata\": {},\n   \"source\": [" 
markdownE :: Doc
markdownE = String -> Doc
text "    \"\\n\"\n   ]\n  },"

-- 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 :: LayoutObj -> Doc
printLO :: LayoutObj -> Doc
printLO (Header n :: Depth
n contents :: Title
contents l :: Title
l)            = Doc -> Doc
nbformat Doc
empty Doc -> Doc -> Doc
$$ Doc -> Doc
nbformat (Depth -> Doc
h (Depth
n Depth -> Depth -> Depth
forall a. Num a => a -> a -> a
+ 1) Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
contents) Doc -> Doc -> Doc
$$ Doc -> Doc
refID (Title -> Doc
pSpec Title
l)
printLO (Cell layoutObs :: [LayoutObj]
layoutObs)                 = Doc
markdownB Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((LayoutObj -> Doc) -> [LayoutObj] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map LayoutObj -> Doc
printLO [LayoutObj]
layoutObs) Doc -> Doc -> Doc
$$ Doc
markdownE
printLO (HDiv _ layoutObs :: [LayoutObj]
layoutObs _)             = [Doc] -> Doc
vcat ((LayoutObj -> Doc) -> [LayoutObj] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map LayoutObj -> Doc
printLO [LayoutObj]
layoutObs)
--printLO (HDiv _ layoutObs l)             = refID (pSpec l) $$ vcat (map printLO layoutObs)
printLO (Paragraph contents :: Title
contents)             = Doc -> Doc
nbformat Doc
empty Doc -> Doc -> Doc
$$ Doc -> Doc
nbformat (String -> Doc
stripnewLine (Doc -> String
forall a. Show a => a -> String
show(Title -> Doc
pSpec Title
contents)))
printLO (EqnBlock contents :: Title
contents)              = Doc -> Doc
nbformat Doc
mathEqn
  where
    toMathHelper :: PrintLaTeX a -> PrintLaTeX a
toMathHelper (PL g :: MathContext -> a
g) = (MathContext -> a) -> PrintLaTeX a
forall a. (MathContext -> a) -> PrintLaTeX a
PL (\_ -> MathContext -> a
g MathContext
Math)
    mjDelimDisp :: a -> Doc
mjDelimDisp d :: a
d  = String -> Doc
text "$$" Doc -> Doc -> Doc
<> String -> Doc
stripnewLine (a -> String
forall a. Show a => a -> String
show a
d) Doc -> Doc -> Doc
<> String -> Doc
text "$$" 
    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 _ rows :: [[Title]]
rows r :: Title
r _ _)            = Doc -> Doc
nbformat Doc
empty Doc -> Doc -> Doc
$$ [[Title]] -> Doc -> Doc
makeTable [[Title]]
rows (Title -> Doc
pSpec Title
r)
printLO (Definition dt :: DType
dt ssPs :: [(String, [LayoutObj])]
ssPs l :: Title
l)          = Doc -> Doc
nbformat (String -> Doc
text "<br>") Doc -> Doc -> Doc
$$ DType -> [(String, [LayoutObj])] -> Doc -> Doc
makeDefn DType
dt [(String, [LayoutObj])]
ssPs (Title -> Doc
pSpec Title
l)
printLO (List t :: ListType
t)                        = Doc -> Doc
nbformat Doc
empty Doc -> Doc -> Doc
$$ ListType -> Bool -> Doc
makeList ListType
t Bool
False
printLO (Figure r :: Title
r c :: Title
c f :: String
f wp :: MaxWidthPercent
wp)               = Doc -> Doc -> Doc -> MaxWidthPercent -> Doc
makeFigure (Title -> Doc
pSpec Title
r) (Title -> Doc
pSpec Title
c) (String -> Doc
text String
f) MaxWidthPercent
wp
printLO (Bib bib :: BibRef
bib)                       = BibRef -> Doc
makeBib BibRef
bib
printLO Graph{}                         = Doc
empty 

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


-- | Renders expressions in the JSON (called by multiple functions)
pExpr :: Expr -> Doc
pExpr :: Expr -> Doc
pExpr (Dbl d :: Double
d)        = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Maybe Depth -> Double -> String -> String
forall a. RealFloat a => Maybe Depth -> a -> String -> String
showEFloat Maybe Depth
forall a. Maybe a
Nothing Double
d ""
pExpr (Int i :: Integer
i)        = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
i
pExpr (Str s :: String
s)        = Doc -> Doc
doubleQuotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s
pExpr (Div n :: Expr
n d :: Expr
d)      = String -> Doc -> Doc -> Doc
mkDiv "frac" (Expr -> Doc
pExpr Expr
n) (Expr -> Doc
pExpr Expr
d)
pExpr (Row l :: [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 s :: String
s)      = String -> Doc
text String
s
pExpr (Label s :: String
s)      = String -> Doc
text String
s
pExpr (Spec s :: Special
s)       = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ PrintHTML -> String
unPH (PrintHTML -> String) -> PrintHTML -> String
forall a b. (a -> b) -> a -> b
$ Special -> PrintHTML
forall r. RenderSpecial r => Special -> r
L.special Special
s
pExpr (Sub e :: Expr
e)        = Doc
unders Doc -> Doc -> Doc
<> Expr -> Doc
pExpr Expr
e
pExpr (Sup e :: Expr
e)        = Doc
hat Doc -> Doc -> Doc
<> Expr -> Doc
pExpr Expr
e
pExpr (Over Hat s :: Expr
s)   = Expr -> Doc
pExpr Expr
s Doc -> Doc -> Doc
<> String -> Doc
text "&#770;"
pExpr (MO o :: Ops
o)         = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Ops -> String
pOps Ops
o
pExpr (Fenced l :: Fence
l r :: Fence
r e :: Expr
e) = String -> Doc
text (OpenClose -> Fence -> String
fence OpenClose
Open Fence
l) Doc -> Doc -> Doc
<> Expr -> Doc
pExpr Expr
e Doc -> Doc -> Doc
<> String -> Doc
text (OpenClose -> Fence -> String
fence OpenClose
Close Fence
r)
pExpr (Font Bold e :: 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 e :: 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
  -- before
  --where mjDelimDisp d = text "$" <> d <> text "$"
  --      mathEqn = mjDelimDisp $ printMath $ toMath $ TeX.pExpr e


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


-- | Renders HTML table, called by 'printLO'
makeTable :: [[Spec]] -> Doc -> Doc
makeTable :: [[Title]] -> Doc -> Doc
makeTable [] _      = String -> Doc
forall a. HasCallStack => String -> a
error "No table to print"
makeTable (l :: [Title]
l:lls :: [[Title]]
lls) r :: Doc
r = Doc -> Doc
refID Doc
r Doc -> Doc -> Doc
$$ Doc -> Doc
nbformat Doc
empty Doc -> Doc -> Doc
$$ ([Title] -> Doc
makeHeaderCols [Title]
l Doc -> Doc -> Doc
$$ [[Title]] -> Doc
makeRows [[Title]]
lls) Doc -> Doc -> Doc
$$ Doc -> Doc
nbformat Doc
empty
--if b then t else empty
--htmlway
--makeTable (l:lls) r = refwrap r (table [] (tr (makeHeaderCols l) $$ makeRows lls)) $$ quote empty


-- | Helper for creating table rows
makeRows :: [[Spec]] -> Doc
makeRows :: [[Title]] -> Doc
makeRows = ([Title] -> Doc -> Doc) -> Doc -> [[Title]] -> Doc
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
--htmlway
--makeRows = foldr (($$) . tr . makeColumns) empty

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

        --genMDtable = concat [hl ++ "|:--- " | i <- [1..c-1]]

-- | Helper for creating table columns
makeColumns :: [Title] -> Doc
makeColumns ls :: [Title]
ls = Doc -> Doc
nbformat (String -> Doc
text "|" Doc -> Doc -> Doc
<> [Doc] -> Doc
hcat(Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text "|") ((Title -> Doc) -> [Title] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Title -> Doc
pSpec [Title]
ls)) Doc -> Doc -> Doc
<> String -> Doc
text "|")

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

{-htmlway
makeColumns, makeHeaderCols :: [Spec] -> Doc
-- | Helper for creating table header row (each of the column header cells)
makeHeaderCols = vcat . map (stripnewLine . show . quote . th . pSpec)
--makeHeaderCols = vcat . map (th . pSpec)

-- | Helper for creating table columns
makeColumns = vcat . map (td . quote . jf . show . pSpec)
-}

{- markdown way
-- | Renders definition tables (Data, General, Theory, etc.)
makeDefn :: L.DType -> [(String,[LayoutObj])] -> Doc -> Doc
makeDefn _ [] _  = error "L.Empty definition"
makeDefn dt ps l = refwrap l $ (quote (text "|Refname|" <> l <> text "|") $$ makeDRows ps)

-- | Helper for making the definition table rows
makeDRows :: [(String,[LayoutObj])] -> Doc
makeDRows []         = error "No fields to create defn table"
makeDRows [(f,d)] = text "|" <> text "**" <> text f <> text "**|" <> (vcat $ map printLO d) <> text "|"
makeDRows ((f,d):ps) = text "|" <> text "**" <> text f <> text "**|" <> (vcat $ map printLO d) $$ makeDRows ps
-}


-- | Renders definition tables (Data, General, Theory, etc.)
makeDefn :: L.DType -> [(String,[LayoutObj])] -> Doc -> Doc
makeDefn :: DType -> [(String, [LayoutObj])] -> Doc -> Doc
makeDefn _ [] _  = String -> Doc
forall a. HasCallStack => String -> a
error "L.Empty definition"
makeDefn dt :: DType
dt ps :: [(String, [LayoutObj])]
ps l :: Doc
l = Doc -> Doc
refID Doc
l Doc -> Doc -> Doc
$$ [String] -> Doc -> Doc
table [DType -> String
dtag DType
dt]
  (Doc -> Doc
tr (Doc -> Doc
nbformat (Doc -> Doc
th (String -> Doc
text "Refname")) Doc -> Doc -> Doc
$$ Doc -> Doc
td (Doc -> Doc
nbformat(Doc -> Doc
bold Doc
l))) Doc -> Doc -> Doc
$$ [(String, [LayoutObj])] -> Doc
makeDRows [(String, [LayoutObj])]
ps)
  where dtag :: DType -> String
dtag L.General  = "gdefn"
        dtag L.Instance = "idefn"
        dtag L.Theory   = "tdefn"
        dtag L.Data     = "ddefn"

-- | Helper for making the definition table rows
makeDRows :: [(String,[LayoutObj])] -> Doc
makeDRows :: [(String, [LayoutObj])] -> Doc
makeDRows []         = String -> Doc
forall a. HasCallStack => String -> a
error "No fields to create defn table"
makeDRows [(f :: String
f,d :: [LayoutObj]
d)]    = Doc -> Doc
tr (Doc -> Doc
nbformat (Doc -> Doc
th (String -> Doc
text String
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 ((f :: String
f,d :: [LayoutObj]
d):ps :: [(String, [LayoutObj])]
ps) = Doc -> Doc
tr (Doc -> Doc
nbformat (Doc -> Doc
th (String -> Doc
text String
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
$$ [(String, [LayoutObj])] -> Doc
makeDRows [(String, [LayoutObj])]
ps


-- | Renders lists
makeList :: ListType -> Bool -> Doc -- FIXME: ref id's should be folded into the li
makeList :: ListType -> Bool -> Doc
makeList (Simple items :: [(Title, ItemType, Maybe Title)]
items) _      = [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 (\(b :: Title
b,e :: ItemType
e,l :: Maybe Title
l) -> Maybe Title -> Doc -> Doc
mlref Maybe Title
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
nbformat (Title -> Doc
pSpec Title
b Doc -> Doc -> Doc
<> String -> Doc
text ": " Doc -> Doc -> Doc
<> ItemType -> Doc
sItem ItemType
e) Doc -> Doc -> Doc
$$ Doc -> Doc
nbformat Doc
empty) [(Title, ItemType, Maybe Title)]
items
makeList (Desc items :: [(Title, ItemType, Maybe Title)]
items) bl :: 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 (\(b :: Title
b,e :: ItemType
e,l :: 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
<> String -> Doc
text ": " Doc -> Doc -> Doc
<> ItemType -> Bool -> Doc
pItem ItemType
e Bool
bl) [(Title, ItemType, Maybe Title)]
items
makeList (Ordered items :: [(ItemType, Maybe Title)]
items) bl :: 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 (\(i :: ItemType
i,l :: 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 items :: [(ItemType, Maybe Title)]
items) bl :: 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 (\(i :: ItemType
i,l :: 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 items :: [(Title, ItemType, Maybe Title)]
items) _ = [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 (\(b :: Title
b,e :: ItemType
e,l :: Maybe Title
l) -> Doc -> Doc
nbformat (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 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
<> String -> Doc
text " 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 s :: Title
s)     b :: Bool
b = Doc -> Doc
nbformat (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (if Bool
b then String -> Doc
text " - " else String -> Doc
text "- ") Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
s
pItem (Nested s :: Title
s l :: ListType
l) _ = [Doc] -> Doc
vcat [Doc -> Doc
nbformat (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "- " 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 s :: Title
s)     = Title -> Doc
pSpec Title
s
sItem (Nested s :: Title
s l :: ListType
l) = [Doc] -> Doc
vcat [Title -> Doc
pSpec Title
s, ListType -> Bool -> Doc
makeList ListType
l Bool
False]

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

-- | Renders assumptions, requirements, likely changes
makeRefList :: Doc -> Doc -> Doc -> Doc
makeRefList :: Doc -> Doc -> Doc -> Doc
makeRefList a :: Doc
a l :: Doc
l i :: Doc
i = Doc -> Doc
refID Doc
l Doc -> Doc -> Doc
$$ Doc -> Doc
nbformat (Doc
i Doc -> Doc -> Doc
<> String -> Doc
text ": " 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 (\(x :: Doc
x,(y :: Doc
y,z :: Doc
z)) -> Doc -> Doc -> Doc -> Doc
makeRefList Doc
z Doc
y Doc
x))
  [String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
sqbrac (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Depth -> String
forall a. Show a => a -> String
show Depth
x | Depth
x <- [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 Citation -> (Doc, Doc)
renderCite