-- | Defines main LaTeX printer functions. 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.TeX.Print.html).
module Language.Drasil.TeX.Print(genTeX, pExpr, pUnit, spec, fence, OpenClose(..),
  pMatrix, cases) where

import Prelude hiding (print)
import Data.Bifunctor (bimap)
import Data.List (transpose, partition)
import Text.PrettyPrint (integer, text, (<+>))
import qualified Text.PrettyPrint as TP
import Numeric (showEFloat)
import Control.Arrow (second)

import qualified Language.Drasil as L
import qualified Language.Drasil.Display as LD

import Language.Drasil.Config (colAwidth, colBwidth, bibStyleT, bibFname)
import Language.Drasil.Printing.AST (Spec, ItemType(Nested, Flat), 
  ListType(Ordered, Unordered, Desc, Definitions, Simple), 
  Spec(Quote, EmptyS, Ref, S, Sp, HARDNL, E, (:+:)), 
  Fence(Norm, Abs, Curly, Paren), Expr, 
  Ops(..), Spacing(Thin), Fonts(Emph, Bold), 
  Expr(..), OverSymb(Hat), Label,
  LinkType(Internal, Cite2, External))
import Language.Drasil.Printing.Citation (HP(Verb, URL), CiteField(HowPublished, 
  Year, Volume, Type, Title, Series, School, Publisher, Organization, Pages,
  Month, Number, Note, Journal, Editor, Chapter, Institution, Edition, BookTitle,
  Author, Address), Citation(Cite), BibRef)
import Language.Drasil.Printing.LayoutObj (Document(Document), LayoutObj(..))
import qualified Language.Drasil.Printing.Import as I
import Language.Drasil.Printing.Helpers hiding (br, paren, sq, sqbrac)
import Language.Drasil.TeX.Helpers (author, bold, br, caption, center, centering,
  cite, command, command0, commandD, command2D, description, description', document, 
  empty, enumerate, externalref, figure, fraction, includegraphics, item, item',
  itemize, label, maketitle, maketoc, mathbb, mkEnv, mkEnvArgBr, mkEnvArgSq,
  mkMinipage, newline, newpage, parens, quote, sec, snref, sq, superscript,
  symbDescription, texSym, title, toEqn)
import Language.Drasil.TeX.Monad (D, MathContext(Curr, Math, Text), (%%), ($+$),
  hpunctuate, lub, runPrint, switch, toMath, toText, unPL, vcat, vpunctuate)
import Language.Drasil.TeX.Preamble (genPreamble)
import Language.Drasil.Printing.PrintingInformation (PrintingInformation)
import Data.Foldable (foldl')

-- | Generates a LaTeX document.
genTeX :: L.Document -> PrintingInformation -> TP.Doc
genTeX :: Document -> PrintingInformation -> Doc
genTeX doc :: Document
doc@(L.Document Title
_ Title
_ ShowTableOfContents
toC [Section]
_) PrintingInformation
sm = 
  D -> MathContext -> Doc
forall a. PrintLaTeX a -> MathContext -> a
runPrint (PrintingInformation -> ShowTableOfContents -> Document -> D
buildStd PrintingInformation
sm ShowTableOfContents
toC (Document -> D) -> Document -> D
forall a b. (a -> b) -> a -> b
$ PrintingInformation -> Document -> Document
I.makeDocument PrintingInformation
sm (Document -> Document) -> Document -> Document
forall a b. (a -> b) -> a -> b
$ Document -> Document
L.checkToC Document
doc) MathContext
Text
genTeX L.Notebook{} PrintingInformation
_ = Doc
TP.empty

-- | Helper to build the document.
buildStd :: PrintingInformation -> L.ShowTableOfContents -> Document -> D
buildStd :: PrintingInformation -> ShowTableOfContents -> Document -> D
buildStd PrintingInformation
sm ShowTableOfContents
toC (Document Title
t Title
a [LayoutObj]
c) =
  [LayoutObj] -> D
genPreamble [LayoutObj]
c D -> D -> D
%%
  D -> D
title (Title -> D
spec Title
t) D -> D -> D
%%
  D -> D
author (Title -> D
spec Title
a) D -> D -> D
%%
  case ShowTableOfContents
toC of 
    ShowTableOfContents
L.ToC -> D -> D
document (D
maketitle D -> D -> D
%% D
maketoc D -> D -> D
%% D
newpage D -> D -> D
%% PrintingInformation -> [LayoutObj] -> D
print PrintingInformation
sm [LayoutObj]
c) -- includes ToC generation
    ShowTableOfContents
_ -> D -> D
document (D
maketitle D -> D -> D
%% D
newpage D -> D -> D
%% PrintingInformation -> [LayoutObj] -> D
print PrintingInformation
sm [LayoutObj]
c) -- omits ToC generation

-- clean until here; lo needs its sub-functions fixed first though
-- | Helper for converting layout objects into a more printable form.
lo :: LayoutObj -> PrintingInformation -> D
lo :: LayoutObj -> PrintingInformation -> D
lo (Header Int
d Title
t Title
l)         PrintingInformation
_ = Int -> D -> D
sec Int
d (Title -> D
spec Title
t) D -> D -> D
%% D -> D
label (Title -> D
spec Title
l)
lo (HDiv Tags
_ [LayoutObj]
con Title
_)        PrintingInformation
sm = PrintingInformation -> [LayoutObj] -> D
print PrintingInformation
sm [LayoutObj]
con -- FIXME ignoring 2 arguments?
lo (Paragraph Title
contents)   PrintingInformation
_ = D -> D
toText (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ D -> D
newline (Title -> D
spec Title
contents)
lo (EqnBlock Title
contents)    PrintingInformation
_ = Title -> D
makeEquation Title
contents
lo (Table Tags
_ [[Title]]
rows Title
r Bool
bl Title
t)  PrintingInformation
_ = D -> D
toText (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ [[Title]] -> D -> Bool -> D -> D
makeTable [[Title]]
rows (Title -> D
spec Title
r) Bool
bl (Title -> D
spec Title
t)
lo (Definition DType
_ [(String, [LayoutObj])]
ssPs Title
l) PrintingInformation
sm = D -> D
toText (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ PrintingInformation -> [(String, [LayoutObj])] -> D -> D
makeDefn PrintingInformation
sm [(String, [LayoutObj])]
ssPs (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Title -> D
spec Title
l
lo (List ListType
l)               PrintingInformation
_ = D -> D
toText (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ ListType -> D
makeList ListType
l
lo (Figure Title
r Maybe Title
c String
f Width
wp)      PrintingInformation
_ = D -> D
toText (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ D -> D -> String -> Width -> D
makeFigure (Title -> D
spec Title
r) (D -> (Title -> D) -> Maybe Title -> D
forall b a. b -> (a -> b) -> Maybe a -> b
maybe D
empty Title -> D
spec Maybe Title
c) String
f Width
wp
lo (Bib BibRef
bib)             PrintingInformation
sm = D -> D
toText (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ PrintingInformation -> BibRef -> D
makeBib PrintingInformation
sm BibRef
bib
lo (Graph [(Title, Title)]
ps Maybe Width
w Maybe Width
h Title
c Title
l)    PrintingInformation
_  = D -> D
toText (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ [(D, D)] -> D -> D -> D -> D -> D
makeGraph
  (((Title, Title) -> (D, D)) -> [(Title, Title)] -> [(D, D)]
forall a b. (a -> b) -> [a] -> [b]
map ((Title -> D) -> (Title -> D) -> (Title, Title) -> (D, D)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Title -> D
spec Title -> D
spec) [(Title, Title)]
ps)
  (Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> (Width -> String) -> Maybe Width -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Width
x -> String
"text width = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"em ,") Maybe Width
w)
  (Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> (Width -> String) -> Maybe Width -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Width
x -> String
"minimum height = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"em, ") Maybe Width
h)
  (Title -> D
spec Title
c) (Title -> D
spec Title
l)
lo (Cell [LayoutObj]
_) PrintingInformation
_               = D
empty
lo (CodeBlock Title
_) PrintingInformation
_          = D
empty

-- | Converts layout objects into a document form.
print :: PrintingInformation -> [LayoutObj] -> D
print :: PrintingInformation -> [LayoutObj] -> D
print PrintingInformation
sm = (LayoutObj -> D -> D) -> D -> [LayoutObj] -> D
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (D -> D -> D
($+$) (D -> D -> D) -> (LayoutObj -> D) -> LayoutObj -> D -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutObj -> PrintingInformation -> D
`lo` PrintingInformation
sm)) D
empty

-- | Determine wether braces and brackets are opening or closing.
data OpenClose = Open | Close

-----------------------------------------------------------------
------------------ EXPRESSION PRINTING----------------------
-----------------------------------------------------------------
-- (Since this is all implicitly in Math, leave it as String for now)

-- | Escape all special TeX characters.
-- TODO: This function should be improved. It should escape all special
--       TeX symbols that would affect rendering. For example, `_`
--       turns the RHS of text into subscript, and `^` would turn it
--       into superscript. This will need to be much more comprehensive.
--       e.g., `%`, `&`, `#`, etc
escapeIdentSymbols :: String -> String
escapeIdentSymbols :: String -> String
escapeIdentSymbols (Char
'_':String
ss) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeIdentSymbols String
ss
escapeIdentSymbols (Char
s:String
ss) = Char
s Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeIdentSymbols String
ss
escapeIdentSymbols [] = []

-- | Print an expression to a document.
pExpr :: Expr -> D
pExpr :: Expr -> D
pExpr (Dbl Double
d)        = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> (String -> Doc) -> String -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text (String -> D) -> String -> D
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showEFloat Maybe Int
forall a. Maybe a
Nothing Double
d String
""
pExpr (Int Integer
i)        = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Doc
integer Integer
i)
pExpr (Str String
s)        = D -> D
toText (D -> D) -> (Doc -> D) -> Doc -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> D
quote (D -> D) -> (Doc -> D) -> Doc -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s
pExpr (Div Expr
n Expr
d)      = String -> D -> D -> D
command2D String
"frac" (Expr -> D
pExpr Expr
n) (Expr -> D
pExpr Expr
d)
pExpr (Case [(Expr, Expr)]
ps)      = String -> (D -> D -> D) -> D -> D
mkEnv String
"cases" D -> D -> D
($+$) ([(Expr, Expr)] -> (Doc -> [D] -> D) -> Doc -> (Expr -> D) -> D
cases [(Expr, Expr)]
ps Doc -> [D] -> D
vpunctuate Doc
dbs Expr -> D
pExpr)
pExpr (Mtx [[Expr]]
a)        = String -> (D -> D -> D) -> D -> D
mkEnv String
"bmatrix" D -> D -> D
($+$) ([[Expr]] -> (Doc -> [D] -> D) -> Doc -> (Expr -> D) -> D
pMatrix [[Expr]]
a Doc -> [D] -> D
vpunctuate Doc
dbs Expr -> D
pExpr)
pExpr (Row [Expr
x])      = D -> D
br (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Expr -> D
pExpr Expr
x -- FIXME: Hack needed for symbols with multiple subscripts, etc.
pExpr (Row [Expr]
l)        = (D -> D -> D) -> [D] -> D
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 D -> D -> D
forall a. Semigroup a => a -> a -> a
(<>) ((Expr -> D) -> [Expr] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> D
pExpr [Expr]
l)
pExpr (Set [Expr]
l)        = (D -> D -> D) -> [D] -> D
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 D -> D -> D
forall a. Semigroup a => a -> a -> a
(<>) ((Expr -> D) -> [Expr] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> D
pExpr [Expr]
l)
pExpr (Ident s :: String
s@[Char
_])  = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> (String -> Doc) -> String -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escapeIdentSymbols (String -> D) -> String -> D
forall a b. (a -> b) -> a -> b
$ String
s
pExpr (Ident String
s)      = String -> D -> D
commandD String
"mathit" (Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> (String -> Doc) -> String -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escapeIdentSymbols (String -> D) -> String -> D
forall a b. (a -> b) -> a -> b
$ String
s)
pExpr (Label String
s)      = String -> String -> D
command String
"text" String
s
pExpr (Spec Special
s)       = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> (String -> Doc) -> String -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text (String -> D) -> String -> D
forall a b. (a -> b) -> a -> b
$ Latex -> String
unPL (Latex -> String) -> Latex -> String
forall a b. (a -> b) -> a -> b
$ Special -> Latex
forall r. RenderSpecial r => Special -> r
L.special Special
s
--pExpr (Gr g)         = unPL $ greek g
pExpr (Sub Expr
e)        = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
unders D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br (Expr -> D
pExpr Expr
e)
pExpr (Sup Expr
e)        = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
hat    D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br (Expr -> D
pExpr Expr
e)
pExpr (Over OverSymb
Hat Expr
s)   = String -> D -> D
commandD String
"hat" (Expr -> D
pExpr Expr
s)
pExpr (MO Ops
o)         = Ops -> D
pOps Ops
o
pExpr (Fenced Fence
l Fence
r Expr
m) = OpenClose -> Fence -> D
fence OpenClose
Open Fence
l D -> D -> D
forall a. Semigroup a => a -> a -> a
<> Expr -> D
pExpr Expr
m D -> D -> D
forall a. Semigroup a => a -> a -> a
<> OpenClose -> Fence -> D
fence OpenClose
Close Fence
r
pExpr (Font Fonts
Bold Expr
e)  = String -> D -> D
commandD String
"symbf" (Expr -> D
pExpr Expr
e)
pExpr (Font Fonts
Emph Expr
e)  = Expr -> D
pExpr Expr
e -- Emph is ignored here because we're in Math mode
pExpr (Spc Spacing
Thin)     = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> (String -> Doc) -> String -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text (String -> D) -> String -> D
forall a b. (a -> b) -> a -> b
$ String
"\\,"
pExpr (Sqrt Expr
e)       = String -> D -> D
commandD String
"sqrt" (Expr -> D
pExpr Expr
e)

-- | Prints operators.
pOps :: Ops -> D
pOps :: Ops -> D
pOps Ops
IsIn     = String -> D -> D
commandD String
"in" D
empty
pOps Ops
Integer  = String -> D
mathbb String
"Z"
pOps Ops
Rational = String -> D
mathbb String
"Q"
pOps Ops
Real     = String -> D
mathbb String
"R"
pOps Ops
Natural  = String -> D
mathbb String
"N"
pOps Ops
Boolean  = String -> D
mathbb String
"B"
pOps Ops
Comma    = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
","
pOps Ops
Prime    = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"'"
pOps Ops
Log      = String -> D
texSym String
"log"
pOps Ops
Ln       = String -> D
texSym String
"ln"
pOps Ops
Sin      = String -> D
texSym String
"sin"
pOps Ops
Cos      = String -> D
texSym String
"cos"
pOps Ops
Tan      = String -> D
texSym String
"tan"
pOps Ops
Sec      = String -> D
texSym String
"sec"
pOps Ops
Csc      = String -> D
texSym String
"csc"
pOps Ops
Cot      = String -> D
texSym String
"cot"
pOps Ops
Arcsin   = String -> D
texSym String
"arcsin"
pOps Ops
Arccos   = String -> D
texSym String
"arccos"
pOps Ops
Arctan   = String -> D
texSym String
"arctan"
pOps Ops
Not      = String -> D -> D
commandD String
"neg" D
empty
pOps Ops
Dim      = String -> String -> D
command String
"mathsf" String
"dim"
pOps Ops
Exp      = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"e"
pOps Ops
Neg      = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
hyph
pOps Ops
Cross    = String -> D
texSym String
"times"
pOps Ops
VAdd     = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
pls
pOps Ops
VSub     = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
hyph -- unfortunately, hyphen and - are the same
pOps Ops
Dot      = String -> D -> D
commandD String
"cdot" D
empty
pOps Ops
Scale    = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
" "
pOps Ops
Eq       = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
assign
pOps Ops
NEq      = String -> D -> D
commandD String
"neq" D
empty
pOps Ops
Lt       = String -> D -> D
commandD String
"lt" D
empty
pOps Ops
Gt       = String -> D -> D
commandD String
"gt" D
empty
pOps Ops
GEq      = String -> D -> D
commandD String
"geq" D
empty
pOps Ops
LEq      = String -> D -> D
commandD String
"leq" D
empty
pOps Ops
Impl     = String -> D -> D
commandD String
"implies" D
empty
pOps Ops
Iff      = String -> D -> D
commandD String
"iff" D
empty
pOps Ops
Subt     = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
hyph
pOps Ops
And      = String -> D -> D
commandD String
"land" D
empty
pOps Ops
Or       = String -> D -> D
commandD String
"lor" D
empty
pOps Ops
SAdd     = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
pls
pOps Ops
SRemove  = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
hyph
pOps Ops
SContains = String -> D -> D
commandD String
" in " D
empty
pOps Ops
SUnion   = String -> D -> D
commandD String
"+" D
empty
pOps Ops
Add      = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
pls
pOps Ops
Mul      = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"\\,"
pOps Ops
Summ     = String -> D
command0 String
"displaystyle" D -> D -> D
forall a. Semigroup a => a -> a -> a
<> String -> D
command0 String
"sum"
pOps Ops
Prod     = String -> D
command0 String
"displaystyle" D -> D -> D
forall a. Semigroup a => a -> a -> a
<> String -> D
command0 String
"prod"
pOps Ops
Inte     = String -> D
texSym String
"int"
pOps Ops
Point    = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"."
pOps Ops
Perc     = String -> D
texSym String
"%"
pOps Ops
LArrow   = String -> D -> D
commandD String
"leftarrow"  D
empty
pOps Ops
RArrow   = String -> D -> D
commandD String
"rightarrow" D
empty
pOps Ops
ForAll   = String -> D -> D
commandD String
"ForAll"     D
empty
pOps Ops
Partial  = String -> D -> D
commandD String
"partial"    D
empty

-- | Prints fencing notation ("(),{},|,||").
fence :: OpenClose -> Fence -> D
fence :: OpenClose -> Fence -> D
fence OpenClose
Open Fence
Paren  = String -> D
texSym String
"left("
fence OpenClose
Close Fence
Paren = String -> D
texSym String
"right)"
fence OpenClose
Open Fence
Curly  = String -> D
texSym String
"{"
fence OpenClose
Close Fence
Curly = String -> D
texSym String
"}"
fence OpenClose
_ Fence
Abs       = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"|"
fence OpenClose
_ Fence
Norm      = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"\\|"

-- | For printing a Matrix.
pMatrix :: [[Expr]] -> (TP.Doc -> [D] -> D) -> TP.Doc -> (Expr -> D) -> D
pMatrix :: [[Expr]] -> (Doc -> [D] -> D) -> Doc -> (Expr -> D) -> D
pMatrix [[Expr]]
e Doc -> [D] -> D
catf Doc
esc Expr -> D
f = Doc -> [D] -> D
catf Doc
esc (([Expr] -> D) -> [[Expr]] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map [Expr] -> D
pIn [[Expr]]
e)
  where pIn :: [Expr] -> D
pIn [Expr]
x = Doc -> [D] -> D
hpunctuate (String -> Doc
text String
" & ") ((Expr -> D) -> [Expr] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> D
f [Expr]
x)

-- | Helper for printing case expression.
cases :: [(Expr,Expr)] -> (TP.Doc -> [D] -> D) -> TP.Doc -> (Expr -> D) -> D
cases :: [(Expr, Expr)] -> (Doc -> [D] -> D) -> Doc -> (Expr -> D) -> D
cases [] Doc -> [D] -> D
_ Doc
_ Expr -> D
_ = String -> D
forall a. HasCallStack => String -> a
error String
"Attempt to create case expression without cases"
cases [(Expr, Expr)]
e Doc -> [D] -> D
catf Doc
esc Expr -> D
f = Doc -> [D] -> D
catf Doc
esc (((Expr, Expr) -> D) -> [(Expr, Expr)] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map (Expr, Expr) -> D
_case [(Expr, Expr)]
e)
  where _case :: (Expr, Expr) -> D
_case (Expr
x, Expr
y) = Doc -> [D] -> D
hpunctuate (String -> Doc
text String
", & ") ((Expr -> D) -> [Expr] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> D
f [Expr
x, Expr
y])

-----------------------------------------------------------------
------------------ TABLE PRINTING---------------------------
-----------------------------------------------------------------

-- | Prints a table. Takes in data for the table, a label,
-- a boolean that determines if the caption is shown, and a caption.
makeTable :: [[Spec]] -> D -> Bool -> D -> D
makeTable :: [[Title]] -> D -> Bool -> D -> D
makeTable [] D
_ Bool
_ D
_ = String -> D
forall a. HasCallStack => String -> a
error String
"Completely empty table (not even header)"
makeTable [[Title]
_] D
_ Bool
_ D
_ = D
empty -- table with no actual contents... don't error
makeTable lls :: [[Title]]
lls@([Title]
h:[[Title]]
tlines) D
r Bool
bool D
t = String -> (D -> D -> D) -> D -> D
mkEnv String
"longtblr" D -> D -> D
($+$) (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$
  (if Bool
bool then D -> D
sq (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"caption=") D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br D
t else D
empty)
  D -> D -> D
%% D -> D
br (Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"colspec=") D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br (Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Tags -> String
unwords (Tags -> String) -> Tags -> String
forall a b. (a -> b) -> a -> b
$ [[Title]] -> Tags
anyBig [[Title]]
lls)
    D -> D -> D
forall a. Semigroup a => a -> a -> a
<> Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
", rowhead=1, hline{1,Z}=\\heavyrulewidth, hline{2}=\\lightrulewidth"))
  D -> D -> D
%% [Title] -> D
makeHeaders [Title]
h
  D -> D -> D
%% [[Title]] -> D
makeRows [[Title]]
tlines
  D -> D -> D
%% D -> D
label D
r
  where
    descr :: Bool -> String
descr Bool
True  = String
"X[l]"
    descr Bool
False = String
"l"
    --returns "X[l]" for columns with long fields
    anyBig :: [[Title]] -> Tags
anyBig = ([Title] -> String) -> [[Title]] -> Tags
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String
descr (Bool -> String) -> ([Title] -> Bool) -> [Title] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Title] -> Bool
longColumn) ([[Title]] -> Tags)
-> ([[Title]] -> [[Title]]) -> [[Title]] -> Tags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Title]] -> [[Title]]
forall a. [[a]] -> [[a]]
transpose
    longColumn :: [Title] -> Bool
longColumn = (Title -> Bool) -> [Title] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Title
x -> Title -> Int
specLength Title
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
50)

-- | Determines the length of a 'Spec'.
specLength :: Spec -> Int
specLength :: Title -> Int
specLength (E Expr
x)       = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
dontCount) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Doc -> String
TP.render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ D -> MathContext -> Doc
forall a. PrintLaTeX a -> MathContext -> a
runPrint (Expr -> D
pExpr Expr
x) MathContext
Curr
specLength (S String
x)       = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x
specLength (Title
a :+: Title
b)   = Title -> Int
specLength Title
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Title -> Int
specLength Title
b
specLength (Sp Special
_)      = Int
1
specLength (Ref LinkType
Internal String
r Title
_) = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r
specLength (Ref (Cite2 Title
n)   String
r Title
i ) = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Title -> Int
specLength Title
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Title -> Int
specLength Title
n --may need to change?
specLength (Ref LinkType
External String
_ Title
t) = Title -> Int
specLength Title
t
specLength Title
EmptyS      = Int
0
specLength (Quote Title
q)   = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Title -> Int
specLength Title
q
specLength Title
HARDNL      = Int
0

-- | Invalid characters, not included in an expression.
dontCount :: String
dontCount :: String
dontCount = String
"\\/[]{}()_^$:"

-- | Creates the header for a table.
makeHeaders :: [Spec] -> D
makeHeaders :: [Title] -> D
makeHeaders [Title]
ls = Doc -> [D] -> D
hpunctuate (String -> Doc
text String
" & ") ((Title -> D) -> [Title] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map (D -> D
bold (D -> D) -> (Title -> D) -> Title -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> D
spec) [Title]
ls) D -> D -> D
%% Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
dbs

-- | Create rows for a table with a single line break between them.
makeRows :: [[Spec]] -> D
makeRows :: [[Title]] -> D
makeRows [] = D
forall a. Monoid a => a
mempty
makeRows [[Title]]
lls = (D -> D -> D) -> [D] -> D
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (D -> D -> D
(%%) (D -> D -> D) -> (D -> D) -> D -> D -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> D -> D
%% Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
dbs)) ([D] -> D) -> [D] -> D
forall a b. (a -> b) -> a -> b
$ ([Title] -> D) -> [[Title]] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map [Title] -> D
makeColumns [[Title]]
lls

-- | Creates the columns for a table.
makeColumns :: [Spec] -> D
makeColumns :: [Title] -> D
makeColumns [Title]
ls = Doc -> [D] -> D
hpunctuate (String -> Doc
text String
" & ") ([D] -> D) -> [D] -> D
forall a b. (a -> b) -> a -> b
$ (Title -> D) -> [Title] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map Title -> D
spec [Title]
ls

------------------ Spec -----------------------------------

-- | Helper that determines the printing context based on the kind of 'Spec'.
needs :: Spec -> MathContext
needs :: Title -> MathContext
needs (Title
a :+: Title
b) = Title -> MathContext
needs Title
a MathContext -> MathContext -> MathContext
`lub` Title -> MathContext
needs Title
b
needs (S String
_)     = MathContext
Text
needs (E Expr
_)     = MathContext
Math
needs (Sp Special
_)    = MathContext
Math
needs Title
HARDNL    = MathContext
Text
needs Ref{}     = MathContext
Text
needs Title
EmptyS    = MathContext
Text
needs (Quote Title
_) = MathContext
Text

-- | Prints all 'Spec's.
spec :: Spec -> D
spec :: Title -> D
spec a :: Title
a@(Title
s :+: Title
t) = D
s' D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
t'
  where
    ctx :: b -> MathContext
ctx = MathContext -> b -> MathContext
forall a b. a -> b -> a
const (MathContext -> b -> MathContext)
-> MathContext -> b -> MathContext
forall a b. (a -> b) -> a -> b
$ Title -> MathContext
needs Title
a
    s' :: D
s' = (MathContext -> MathContext) -> D -> D
switch MathContext -> MathContext
forall {b}. b -> MathContext
ctx (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Title -> D
spec Title
s
    t' :: D
t' = (MathContext -> MathContext) -> D -> D
switch MathContext -> MathContext
forall {b}. b -> MathContext
ctx (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Title -> D
spec Title
t
spec (E Expr
ex) = D -> D
toMath (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Expr -> D
pExpr Expr
ex
spec (S String
s)  = (String -> D) -> (String -> D) -> Either String String -> D
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> D
forall a. HasCallStack => String -> a
error (Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> (String -> Doc) -> String -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> D) -> Either String String -> D
forall a b. (a -> b) -> a -> b
$ String -> String -> Either String String
L.checkValidStr String
s String
invalid
  where
    invalid :: String
invalid = [Char
'&', Char
'#', Char
'$', Char
'%', Char
'&', Char
'~', Char
'^', Char
'\\', Char
'{', Char
'}']
    escapeChars :: Char -> String
escapeChars Char
'_' = String
"\\_"
    escapeChars Char
'&' = String
"\\&"
    escapeChars Char
c = [Char
c]
spec (Sp Special
s) = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Latex -> String
unPL (Latex -> String) -> Latex -> String
forall a b. (a -> b) -> a -> b
$ Special -> Latex
forall r. RenderSpecial r => Special -> r
L.special Special
s
spec Title
HARDNL = String -> D
command0 String
"newline"
spec (Ref LinkType
Internal String
r Title
sn) = String -> D -> D
snref String
r (Title -> D
spec Title
sn)
spec (Ref (Cite2 Title
n) String
r Title
_) = String -> Maybe D -> D
cite String
r (Title -> Maybe D
info Title
n)
  where
    info :: Title -> Maybe D
info Title
EmptyS = Maybe D
forall a. Maybe a
Nothing
    info Title
x      = D -> Maybe D
forall a. a -> Maybe a
Just (Title -> D
spec Title
x)
spec (Ref LinkType
External String
r Title
sn) = String -> D -> D
externalref String
r (Title -> D
spec Title
sn)
spec Title
EmptyS              = D
empty
spec (Quote Title
q)           = D -> D
quote (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Title -> D
spec Title
q

-- | Determines the needed context of a symbol.
symbolNeeds :: LD.Symbol -> MathContext
symbolNeeds :: Symbol -> MathContext
symbolNeeds (LD.Variable   String
_) = MathContext
Text
symbolNeeds (LD.Label      String
_) = MathContext
Text
symbolNeeds (LD.Integ      Int
_) = MathContext
Math
symbolNeeds (LD.Special    Special
_) = MathContext
Math
symbolNeeds (LD.Concat    []) = MathContext
Math
symbolNeeds (LD.Concat (Symbol
s:[Symbol]
_)) = Symbol -> MathContext
symbolNeeds Symbol
s
symbolNeeds LD.Corners{}      = MathContext
Math
symbolNeeds (LD.Atop     Decoration
_ Symbol
_) = MathContext
Math
symbolNeeds Symbol
LD.Empty          = MathContext
Curr

-- | Prints units.
pUnit :: L.USymb -> D
pUnit :: USymb -> D
pUnit (L.US [(Symbol, Integer)]
ls) = [(Symbol, Integer)] -> [(Symbol, Integer)] -> D
formatu [(Symbol, Integer)]
t [(Symbol, Integer)]
b
  where
    ([(Symbol, Integer)]
t,[(Symbol, Integer)]
b) = ((Symbol, Integer) -> Bool)
-> [(Symbol, Integer)]
-> ([(Symbol, Integer)], [(Symbol, Integer)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (Integer -> Bool)
-> ((Symbol, Integer) -> Integer) -> (Symbol, Integer) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol, Integer) -> Integer
forall a b. (a, b) -> b
snd) [(Symbol, Integer)]
ls
    formatu :: [(L.Symbol,Integer)] -> [(L.Symbol,Integer)] -> D
    formatu :: [(Symbol, Integer)] -> [(Symbol, Integer)] -> D
formatu [] [(Symbol, Integer)]
l = [(Symbol, Integer)] -> D
line [(Symbol, Integer)]
l
    formatu [(Symbol, Integer)]
l [] = ((Symbol, Integer) -> D -> D) -> D -> [(Symbol, Integer)] -> D
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (D -> D -> D
forall a. Semigroup a => a -> a -> a
(<>) (D -> D -> D)
-> ((Symbol, Integer) -> D) -> (Symbol, Integer) -> D -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol, Integer) -> D
pow) D
empty [(Symbol, Integer)]
l
    formatu [(Symbol, Integer)]
nu [(Symbol, Integer)]
de = D -> D
toMath (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ D -> D -> D
fraction ([(Symbol, Integer)] -> D
line [(Symbol, Integer)]
nu) (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)] -> D
line ([(Symbol, Integer)] -> D) -> [(Symbol, Integer)] -> D
forall a b. (a -> b) -> a -> b
$ ((Symbol, Integer) -> (Symbol, Integer))
-> [(Symbol, Integer)] -> [(Symbol, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Integer) -> (Symbol, Integer) -> (Symbol, Integer)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Integer -> Integer
forall a. Num a => a -> a
negate) [(Symbol, Integer)]
de
    line :: [(L.Symbol,Integer)] -> D
    line :: [(Symbol, Integer)] -> D
line []  = D
empty
    line [(Symbol, Integer)
n] = (Symbol, Integer) -> D
pow (Symbol, Integer)
n
    line [(Symbol, Integer)]
l   = D -> D
parens (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ ((Symbol, Integer) -> D -> D) -> D -> [(Symbol, Integer)] -> D
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (D -> D -> D
forall a. Semigroup a => a -> a -> a
(<>) (D -> D -> D)
-> ((Symbol, Integer) -> D) -> (Symbol, Integer) -> D -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol, Integer) -> D
pow) D
empty [(Symbol, Integer)]
l
    pow :: (L.Symbol,Integer) -> D
    pow :: (Symbol, Integer) -> D
pow (Symbol
n,Integer
1) = Symbol -> D
p_symb Symbol
n
    pow (Symbol
n,Integer
p) = D -> D
toMath (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ D -> D -> D
superscript (Symbol -> D
p_symb Symbol
n) (Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
p)
    -- printing of unit symbols is done weirdly... FIXME?
    p_symb :: Symbol -> D
p_symb (LD.Concat [Symbol]
s) = (D -> D -> D) -> D -> [D] -> D
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' D -> D -> D
forall a. Semigroup a => a -> a -> a
(<>) D
empty ([D] -> D) -> [D] -> D
forall a b. (a -> b) -> a -> b
$ (Symbol -> D) -> [Symbol] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> D
p_symb [Symbol]
s
    p_symb Symbol
n = let cn :: MathContext
cn = Symbol -> MathContext
symbolNeeds Symbol
n in (MathContext -> MathContext) -> D -> D
switch (MathContext -> MathContext -> MathContext
forall a b. a -> b -> a
const MathContext
cn) (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Expr -> D
pExpr (Expr -> D) -> Expr -> D
forall a b. (a -> b) -> a -> b
$ Symbol -> Expr
I.symbol Symbol
n

-----------------------------------------------------------------
------------------ DATA DEFINITION PRINTING-----------------
-----------------------------------------------------------------

-- | Prints a (data) definition.
makeDefn :: PrintingInformation -> [(String,[LayoutObj])] -> D -> D
makeDefn :: PrintingInformation -> [(String, [LayoutObj])] -> D -> D
makeDefn PrintingInformation
_  [] D
_ = String -> D
forall a. HasCallStack => String -> a
error String
"Empty definition"
makeDefn PrintingInformation
sm [(String, [LayoutObj])]
ps D
l = D -> D
mkMinipage (PrintingInformation -> [(String, [LayoutObj])] -> D -> D
makeDefTable PrintingInformation
sm [(String, [LayoutObj])]
ps D
l)

-- | Helper that creates the definition and associated table.
makeDefTable :: PrintingInformation -> [(String,[LayoutObj])] -> D -> D
makeDefTable :: PrintingInformation -> [(String, [LayoutObj])] -> D -> D
makeDefTable PrintingInformation
_ [] D
_ = String -> D
forall a. HasCallStack => String -> a
error String
"Trying to make empty Data Defn"
makeDefTable PrintingInformation
sm [(String, [LayoutObj])]
ps D
l = String -> String -> D -> D
mkEnvArgBr String
"tabular" (String -> Double -> String
forall {a}. Show a => String -> a -> String
col String
rr Double
colAwidth String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Double -> String
forall {a}. Show a => String -> a -> String
col (String
rr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\\arraybackslash") Double
colBwidth) (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat [
  String -> D
command0 String
"toprule " D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
bold (Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Refname") D -> D -> D
forall a. Semigroup a => a -> a -> a
<> Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
" & ") D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
bold D
l, --shortname instead of refname?
  String -> D
command0 String
"phantomsection ", D -> D
label D
l,
  PrintingInformation -> [(String, [LayoutObj])] -> D
makeDRows PrintingInformation
sm [(String, [LayoutObj])]
ps,
  Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ Doc
dbs Doc -> Doc -> Doc
<+> String -> Doc
text String
"\\bottomrule"
  ]
  where
    col :: String -> a -> String
col String
s a
x = String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
brace String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"p" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
brace (a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tw)
    rr :: String
rr = String
"\\raggedright"
    tw :: String
tw = String
"\\textwidth"

-- | Helper that makes the rows of a definition table.
makeDRows :: PrintingInformation -> [(String,[LayoutObj])] -> D
makeDRows :: PrintingInformation -> [(String, [LayoutObj])] -> D
makeDRows PrintingInformation
_  []      = String -> D
forall a. HasCallStack => String -> a
error String
"No fields to create Defn table"
makeDRows PrintingInformation
sm [(String, [LayoutObj])]
ls      = (D -> D -> D) -> [D] -> D
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 D -> D -> D
(%%) ([D] -> D) -> [D] -> D
forall a b. (a -> b) -> a -> b
$ ((String, [LayoutObj]) -> D) -> [(String, [LayoutObj])] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
f, [LayoutObj]
d) -> 
  Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
dbs Doc -> Doc -> Doc
<+> String -> Doc
text String
"\\midrule") D -> D -> D
%% 
  Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text (String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" & ")) D -> D -> D
forall a. Semigroup a => a -> a -> a
<> PrintingInformation -> [LayoutObj] -> D
print PrintingInformation
sm [LayoutObj]
d) [(String, [LayoutObj])]
ls

-----------------------------------------------------------------
------------------ EQUATION PRINTING------------------------
-----------------------------------------------------------------

-- | Prints an equation.
makeEquation :: Spec -> D
makeEquation :: Title -> D
makeEquation Title
contents = D -> D
toEqn (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Title -> D
spec Title
contents

  --TODO: Add auto-generated labels -> Need to be able to ensure labeling based
  --  on chunk (i.e. "eq:h_g" for h_g = ...

-----------------------------------------------------------------
------------------ LIST PRINTING----------------------------
-----------------------------------------------------------------

-- latex doesn't like empty lists, so don't put anything out for them.
-- empty lists here isn't quite wrong (though there should probably be
-- a warning higher up), so don't generate bad latex.
-- | Prints a list. LaTeX doesn't like empty lists, so those are rendered as 'empty'.
makeList :: ListType -> D
makeList :: ListType -> D
makeList (Simple []   )      = D
empty
makeList (Desc []   )        = D
empty
makeList (Unordered []   )   = D
empty
makeList (Ordered []   )     = D
empty
makeList (Definitions []   ) = D
empty
makeList (Simple [(Title, ItemType, Maybe Title)]
items)      = D -> D
description' (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat ([D] -> D) -> [D] -> D
forall a b. (a -> b) -> a -> b
$ [(Title, ItemType, Maybe Title)] -> [D]
simItem [(Title, ItemType, Maybe Title)]
items
makeList (Desc [(Title, ItemType, Maybe Title)]
items)        = D -> D
description  (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat ([D] -> D) -> [D] -> D
forall a b. (a -> b) -> a -> b
$ [(Title, ItemType, Maybe Title)] -> [D]
simItem [(Title, ItemType, Maybe Title)]
items
makeList (Unordered [(ItemType, Maybe Title)]
items)   = D -> D
itemize      (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat ([D] -> D) -> [D] -> D
forall a b. (a -> b) -> a -> b
$ ((ItemType, Maybe Title) -> D) -> [(ItemType, Maybe Title)] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map (ItemType, Maybe Title) -> D
plItem [(ItemType, Maybe Title)]
items
makeList (Ordered [(ItemType, Maybe Title)]
items)     = D -> D
enumerate    (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat ([D] -> D) -> [D] -> D
forall a b. (a -> b) -> a -> b
$ ((ItemType, Maybe Title) -> D) -> [(ItemType, Maybe Title)] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map (ItemType, Maybe Title) -> D
plItem [(ItemType, Maybe Title)]
items
makeList (Definitions [(Title, ItemType, Maybe Title)]
items) = D -> D
symbDescription (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat ([D] -> D) -> [D] -> D
forall a b. (a -> b) -> a -> b
$ [(Title, ItemType, Maybe Title)] -> [D]
defItem [(Title, ItemType, Maybe Title)]
items

-- | Helper that renders items in 'makeList'.
plItem :: (ItemType,Maybe Label) -> D
plItem :: (ItemType, Maybe Title) -> D
plItem (ItemType
i, Maybe Title
l) = Maybe Title -> D
mlref Maybe Title
l D -> D -> D
forall a. Semigroup a => a -> a -> a
<> ItemType -> D
pItem ItemType
i

-- | Helper that renders the 'Spec' part of labels in 'mlref'.
lspec :: Spec -> D  -- FIXME: Should be option rolled in to spec
lspec :: Title -> D
lspec (S String
s) = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s
lspec Title
r = Title -> D
spec Title
r

-- | Helper that renders labels in 'plItem'. 
mlref :: Maybe Label -> D
mlref :: Maybe Title -> D
mlref = D -> (Title -> D) -> Maybe Title -> D
forall b a. b -> (a -> b) -> Maybe a -> b
maybe D
empty ((Title -> D) -> Maybe Title -> D)
-> (Title -> D) -> Maybe Title -> D
forall a b. (a -> b) -> a -> b
$ D -> D -> D
forall a. Semigroup a => a -> a -> a
(<>) (String -> D
command0 String
"phantomsection") (D -> D) -> (Title -> D) -> Title -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> D
label (D -> D) -> (Title -> D) -> Title -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> D
lspec

-- | Helper that renders items in 'plItem'.
pItem :: ItemType -> D
pItem :: ItemType -> D
pItem (Flat Title
s) = D -> D
item (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Title -> D
spec Title
s
pItem (Nested Title
t ListType
s) = [D] -> D
vcat [D -> D
item (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Title -> D
spec Title
t, ListType -> D
makeList ListType
s]

-- | Helper that renders simple and descriptive items in 'makeList'.
simItem :: [(Spec,ItemType,Maybe Label)] -> [D]
simItem :: [(Title, ItemType, Maybe Title)] -> [D]
simItem = ((Title, ItemType, Maybe Title) -> D)
-> [(Title, ItemType, Maybe Title)] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map (\(Title
x,ItemType
y,Maybe Title
l) -> D -> D -> D
item' (Title -> D
spec (Title
x Title -> Title -> Title
:+: String -> Title
S String
":") D -> D -> D
forall a. Semigroup a => a -> a -> a
<> Maybe Title -> D
mlref Maybe Title
l) (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ ItemType -> D
sp_item ItemType
y)
  where sp_item :: ItemType -> D
sp_item (Flat Title
s) = Title -> D
spec Title
s
        sp_item (Nested Title
t ListType
s) = [D] -> D
vcat [Title -> D
spec Title
t, ListType -> D
makeList ListType
s]

-- | Helper that renders definitions in 'makeList'.
defItem :: [(Spec, ItemType,Maybe Label)] -> [D]
defItem :: [(Title, ItemType, Maybe Title)] -> [D]
defItem = ((Title, ItemType, Maybe Title) -> D)
-> [(Title, ItemType, Maybe Title)] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map (\(Title
x,ItemType
y,Maybe Title
l) -> D -> D
item (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Maybe Title -> D
mlref Maybe Title
l D -> D -> D
forall a. Semigroup a => a -> a -> a
<> Title -> D
spec (Title
x Title -> Title -> Title
:+: String -> Title
S String
" is the " Title -> Title -> Title
:+: ItemType -> Title
d_item ItemType
y))
  where d_item :: ItemType -> Title
d_item (Flat Title
s) = Title
s
        d_item (Nested Title
_ ListType
_) = String -> Title
forall a. HasCallStack => String -> a
error String
"Cannot use sublists in definitions"
-----------------------------------------------------------------
------------------ FIGURE PRINTING--------------------------
-----------------------------------------------------------------

-- | Prints figures. Takes in a label and caption along with information for 'includegraphics'.
makeFigure :: D -> D -> String -> L.MaxWidthPercent -> D
makeFigure :: D -> D -> String -> Width -> D
makeFigure D
r D
c String
f Width
wp =
  D -> D
figure (D -> D
center (
  [D] -> D
vcat [
    Width -> String -> D
includegraphics Width
wp String
f,
    D -> D
caption D
c,
    D -> D
label D
r
  ] ) )

-----------------------------------------------------------------
------------------ MODULE PRINTING----------------------------
-----------------------------------------------------------------

-- | Prints graphs.
makeGraph :: [(D,D)] -> D -> D -> D -> D -> D
makeGraph :: [(D, D)] -> D -> D -> D -> D -> D
makeGraph [(D, D)]
ps D
w D
h D
c D
l =
  String -> (D -> D -> D) -> D -> D
mkEnv String
"figure" D -> D -> D
($+$) (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ D
centering D -> D -> D
%%
  String -> String -> D -> D
mkEnvArgBr String
"adjustbox" String
"max width=\\textwidth" (
  String -> String -> D -> D
mkEnvArgSq String
"tikzpicture" String
">=latex,line join=bevel" (
  [D] -> D
vcat [String -> String -> D
command String
"tikzstyle" String
"n" D -> D -> D
forall a. Semigroup a => a -> a -> a
<> Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
" = ") D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
sq (
          Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"draw, shape=rectangle, ") D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
w D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
h D -> D -> D
forall a. Semigroup a => a -> a -> a
<>
          Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"font=\\Large, align=center]")),
        String -> String -> D -> D
mkEnvArgSq String
"dot2tex" String
"dot, codeonly, options=-t raw" (
        Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"digraph G ") D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br ( [D] -> D
vcat (
         Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"graph [sep = 0. esep = 0, nodesep = 0.1, ranksep = 2];") D -> [D] -> [D]
forall a. a -> [a] -> [a]
:
         Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"node [style = \"n\"];") D -> [D] -> [D]
forall a. a -> [a] -> [a]
:
         ((D, D) -> D) -> [(D, D)] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map (\(D
a,D
b) -> D -> D
forall {f :: * -> *}.
(Semigroup (f Doc), Applicative f) =>
f Doc -> f Doc
q D
a D -> D -> D
forall a. Semigroup a => a -> a -> a
<> Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
" -> ") D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
forall {f :: * -> *}.
(Semigroup (f Doc), Applicative f) =>
f Doc -> f Doc
q D
b D -> D -> D
forall a. Semigroup a => a -> a -> a
<> Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
";")) [(D, D)]
ps)
        ))
       ])) D -> D -> D
%% D -> D
caption D
c D -> D -> D
%% D -> D
label D
l
  where q :: f Doc -> f Doc
q f Doc
x = Doc -> f Doc
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"\"") f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
x f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> f Doc
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"\"")

---------------------------
-- Bibliography Printing --
---------------------------
-- **THE MAIN FUNCTION** --
-- | Prints a bibliography.
makeBib :: PrintingInformation -> BibRef -> D
makeBib :: PrintingInformation -> BibRef -> D
makeBib PrintingInformation
sm BibRef
bib = String -> String -> D -> D
mkEnvArgBr String
"filecontents*" (String
bibFname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".bib") (PrintingInformation -> BibRef -> D
mkBibRef PrintingInformation
sm BibRef
bib) D -> D -> D
%%
  String -> String -> D
command String
"nocite" String
"*" D -> D -> D
%% String -> String -> D
command String
"bibstyle" String
bibStyleT D -> D -> D
%%
  String -> D
command0 String
"printbibliography" D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
sq (Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"heading=none")

-- | Renders a bibliographical reference with a single line break between
-- entries.
mkBibRef :: PrintingInformation -> BibRef -> D
mkBibRef :: PrintingInformation -> BibRef -> D
mkBibRef PrintingInformation
sm = (Citation -> D -> D) -> D -> BibRef -> D
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (D -> D -> D
(%%) (D -> D -> D) -> (Citation -> D) -> Citation -> D -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintingInformation -> Citation -> D
renderF PrintingInformation
sm) D
forall a. Monoid a => a
mempty

-- | Helper that renders a citation.
renderF :: PrintingInformation -> Citation -> D
renderF :: PrintingInformation -> Citation -> D
renderF PrintingInformation
sm (Cite String
cid CitationKind
refType [CiteField]
fields) = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text (CitationKind -> String
showT CitationKind
refType)) D -> D -> D
forall a. Semigroup a => a -> a -> a
<>
  D -> D
br (Doc -> [D] -> D
hpunctuate (String -> Doc
text String
",\n") ([D] -> D) -> [D] -> D
forall a b. (a -> b) -> a -> b
$ Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
cid) D -> [D] -> [D]
forall a. a -> [a] -> [a]
: (CiteField -> D) -> [CiteField] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> CiteField -> D
showBibTeX PrintingInformation
sm) [CiteField]
fields)

-- | Renders different kinds of citation mediums.
showT :: L.CitationKind -> String
showT :: CitationKind -> String
showT CitationKind
L.Article       = String
"@article"
showT CitationKind
L.Book          = String
"@book"
showT CitationKind
L.Booklet       = String
"@booklet"
showT CitationKind
L.InBook        = String
"@inbook"
showT CitationKind
L.InCollection  = String
"@incollection"
showT CitationKind
L.InProceedings = String
"@inproceedings"
showT CitationKind
L.Manual        = String
"@manual"
showT CitationKind
L.MThesis       = String
"@mastersthesis"
showT CitationKind
L.Misc          = String
"@misc"
showT CitationKind
L.PhDThesis     = String
"@phdthesis"
showT CitationKind
L.Proceedings   = String
"@proceedings"
showT CitationKind
L.TechReport    = String
"@techreport"
showT CitationKind
L.Unpublished   = String
"@unpublished"

-- | Renders different citation fields.
showBibTeX :: PrintingInformation -> CiteField -> D
showBibTeX :: PrintingInformation -> CiteField -> D
showBibTeX  PrintingInformation
_ (Address      Title
s) = String -> Title -> D
showField String
"address" Title
s
showBibTeX PrintingInformation
sm (Author       People
p) = String -> Title -> D
showField String
"author" (PrintingInformation -> People -> Title
rendPeople PrintingInformation
sm People
p)
showBibTeX  PrintingInformation
_ (BookTitle    Title
b) = String -> Title -> D
showField String
"booktitle" Title
b
showBibTeX  PrintingInformation
_ (Chapter      Int
c) = String -> Title -> D
showField String
"chapter" (Int -> Title
forall a. Show a => a -> Title
wrapS Int
c)
showBibTeX  PrintingInformation
_ (Edition      Int
e) = String -> Title -> D
showField String
"edition" (Int -> Title
forall a. Show a => a -> Title
wrapS Int
e)
showBibTeX PrintingInformation
sm (Editor       People
e) = String -> Title -> D
showField String
"editor" (PrintingInformation -> People -> Title
rendPeople PrintingInformation
sm People
e)
showBibTeX  PrintingInformation
_ (Institution  Title
i) = String -> Title -> D
showField String
"institution" Title
i
showBibTeX  PrintingInformation
_ (Journal      Title
j) = String -> Title -> D
showField String
"journal" Title
j
showBibTeX  PrintingInformation
_ (Month        Month
m) = String -> Title -> D
showFieldRaw String
"month" (Month -> Title
bibTeXMonth Month
m)
showBibTeX  PrintingInformation
_ (Note         Title
n) = String -> Title -> D
showField String
"note" Title
n
showBibTeX  PrintingInformation
_ (Number       Int
n) = String -> Title -> D
showField String
"number" (Int -> Title
forall a. Show a => a -> Title
wrapS Int
n)
showBibTeX  PrintingInformation
_ (Organization Title
o) = String -> Title -> D
showField String
"organization" Title
o
showBibTeX PrintingInformation
sm (Pages        [Int]
p) = String -> Title -> D
showField String
"pages" (PrintingInformation -> Title -> Title
I.spec PrintingInformation
sm (Title -> Title) -> Title -> Title
forall a b. (a -> b) -> a -> b
$ String -> [Int] -> Title
L.foldNums String
"--" [Int]
p)
showBibTeX  PrintingInformation
_ (Publisher    Title
p) = String -> Title -> D
showField String
"publisher" Title
p
showBibTeX  PrintingInformation
_ (School       Title
s) = String -> Title -> D
showField String
"school" Title
s
showBibTeX  PrintingInformation
_ (Series       Title
s) = String -> Title -> D
showField String
"series" Title
s
showBibTeX  PrintingInformation
_ (Title        Title
t) = String -> Title -> D
showField String
"title" Title
t
showBibTeX  PrintingInformation
_ (Type         Title
t) = String -> Title -> D
showField String
"type" Title
t
showBibTeX  PrintingInformation
_ (Volume       Int
v) = String -> Title -> D
showField String
"volume" (Int -> Title
forall a. Show a => a -> Title
wrapS Int
v)
showBibTeX  PrintingInformation
_ (Year         Int
y) = String -> Title -> D
showField String
"year" (Int -> Title
forall a. Show a => a -> Title
wrapS Int
y)
showBibTeX  PrintingInformation
_ (HowPublished (URL  Title
u)) = String -> String -> Title -> D
showFieldCom String
"url" String
"howpublished" Title
u
showBibTeX  PrintingInformation
_ (HowPublished (Verb Title
v)) = String -> Title -> D
showField String
"howpublished" Title
v

--showBibTeX sm (Author p@(Person {_convention=Mono}:_)) = showField "author"
  -- (LS.spec sm (rendPeople p)) :+: S ",\n" :+:
  -- showField "sortkey" (LS.spec sm (rendPeople p))
-- showBibTeX sm (Author    p) = showField "author" $ LS.spec sm (rendPeople p)

-- | Citation fields may be wrapped with braces, nothing, or a command.
data FieldWrap = Braces | NoDelimiters | Command String

-- | Helper that renders citation fields with a wrapper.
wrapField :: FieldWrap -> String -> Spec -> D
wrapField :: FieldWrap -> String -> Title -> D
wrapField FieldWrap
fw String
f Title
s = Doc -> D
forall a. a -> PrintLaTeX a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text (String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=")) D -> D -> D
forall a. Semigroup a => a -> a -> a
<> FieldWrap -> D -> D
resolve FieldWrap
fw (Title -> D
spec Title
s)
  where
    resolve :: FieldWrap -> D -> D
resolve FieldWrap
Braces       = D -> D
br
    resolve FieldWrap
NoDelimiters = D -> D
forall a. a -> a
id
    resolve (Command String
st) = D -> D
br (D -> D) -> (D -> D) -> D -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> D -> D
commandD String
st

showField, showFieldRaw :: String -> Spec -> D
-- | Helper that renders citation fields wrapped with braces.
showField :: String -> Title -> D
showField    = FieldWrap -> String -> Title -> D
wrapField FieldWrap
Braces
-- | Helper that renders citation fields with no delimiters.
showFieldRaw :: String -> Title -> D
showFieldRaw = FieldWrap -> String -> Title -> D
wrapField FieldWrap
NoDelimiters

-- | Helper that renders citation fields with a command.
showFieldCom   :: String -> String -> Spec -> D
showFieldCom :: String -> String -> Title -> D
showFieldCom String
s = FieldWrap -> String -> Title -> D
wrapField (String -> FieldWrap
Command String
s)

-- | Helper that renders people for citations.
rendPeople :: PrintingInformation -> L.People -> Spec
rendPeople :: PrintingInformation -> People -> Title
rendPeople PrintingInformation
_ []  = String -> Title
S String
"N.a." -- "No authors given"
rendPeople PrintingInformation
sm People
people = PrintingInformation -> Title -> Title
I.spec PrintingInformation
sm (Title -> Title) -> Title -> Title
forall a b. (a -> b) -> a -> b
$
  (Title -> Title -> Title) -> [Title] -> Title
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\Title
x Title
y -> Title
x Title -> Title -> Title
L.+:+ String -> Title
L.S String
"and" Title -> Title -> Title
L.+:+ Title
y) ([Title] -> Title) -> [Title] -> Title
forall a b. (a -> b) -> a -> b
$ (Person -> Title) -> People -> [Title]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Title
L.S (String -> Title) -> (Person -> String) -> Person -> Title
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Person -> String
L.rendPersLFM) People
people

-- | Helper that renders months for citations.
bibTeXMonth :: L.Month -> Spec
bibTeXMonth :: Month -> Title
bibTeXMonth Month
L.Jan = String -> Title
S String
"jan"
bibTeXMonth Month
L.Feb = String -> Title
S String
"feb"
bibTeXMonth Month
L.Mar = String -> Title
S String
"mar"
bibTeXMonth Month
L.Apr = String -> Title
S String
"apr"
bibTeXMonth Month
L.May = String -> Title
S String
"may"
bibTeXMonth Month
L.Jun = String -> Title
S String
"jun"
bibTeXMonth Month
L.Jul = String -> Title
S String
"jul"
bibTeXMonth Month
L.Aug = String -> Title
S String
"aug"
bibTeXMonth Month
L.Sep = String -> Title
S String
"sep"
bibTeXMonth Month
L.Oct = String -> Title
S String
"oct"
bibTeXMonth Month
L.Nov = String -> Title
S String
"nov"
bibTeXMonth Month
L.Dec = String -> Title
S String
"dec"

-- | Helper that lifts something showable into a 'Spec'.
wrapS :: Show a => a -> Spec
wrapS :: forall a. Show a => a -> Title
wrapS = String -> Title
S (String -> Title) -> (a -> String) -> a -> Title
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show