-- | 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) 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, 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)

-- | 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 = 
  forall a. PrintLaTeX a -> MathContext -> a
runPrint (PrintingInformation -> ShowTableOfContents -> Document -> D
buildStd PrintingInformation
sm ShowTableOfContents
toC forall a b. (a -> b) -> a -> b
$ PrintingInformation -> Document -> Document
I.makeDocument PrintingInformation
sm 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 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 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 forall a b. (a -> b) -> a -> b
$ PrintingInformation -> [(String, [LayoutObj])] -> D -> D
makeDefn PrintingInformation
sm [(String, [LayoutObj])]
ssPs forall a b. (a -> b) -> a -> b
$ Title -> D
spec Title
l
lo (List ListType
l)               PrintingInformation
_ = D -> D
toText forall a b. (a -> b) -> a -> b
$ ListType -> D
makeList ListType
l
lo (Figure Title
r Title
c String
f Width
wp)      PrintingInformation
_ = D -> D
toText forall a b. (a -> b) -> a -> b
$ D -> D -> String -> Width -> D
makeFigure (Title -> D
spec Title
r) (Title -> D
spec Title
c) String
f Width
wp
lo (Bib BibRef
bib)             PrintingInformation
sm = D -> D
toText 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 forall a b. (a -> b) -> a -> b
$ [(D, D)] -> D -> D -> D -> D -> D
makeGraph
  (forall a b. (a -> b) -> [a] -> [b]
map (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)
  (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Width
x -> String
"text width = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Width
x forall a. [a] -> [a] -> [a]
++ String
"em ,") Maybe Width
w)
  (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Width
x -> String
"minimum height = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Width
x 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (D -> 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
'\\' forall a. a -> [a] -> [a]
: Char
'_' forall a. a -> [a] -> [a]
: String -> String
escapeIdentSymbols String
ss
escapeIdentSymbols (Char
s:String
ss) = Char
s 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)        = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Maybe Int -> a -> String -> String
showEFloat forall a. Maybe a
Nothing Double
d String
""
pExpr (Int Integer
i)        = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Doc
integer Integer
i)
pExpr (Str String
s)        = D -> D
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> D
quote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
mkEnv String
"cases" ([(Expr, Expr)] -> D
cases [(Expr, Expr)]
ps)
pExpr (Mtx [[Expr]]
a)        = String -> D -> D
mkEnv String
"bmatrix" ([[Expr]] -> D
pMatrix [[Expr]]
a)
pExpr (Row [Expr
x])      = D -> D
br 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)        = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall a. Semigroup a => a -> a -> a
(<>) (forall a b. (a -> b) -> [a] -> [b]
map Expr -> D
pExpr [Expr]
l)
pExpr (Ident s :: String
s@[Char
_])  = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escapeIdentSymbols forall a b. (a -> b) -> a -> b
$ String
s
pExpr (Ident String
s)      = String -> D -> D
commandD String
"mathit" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escapeIdentSymbols 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)       = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text forall a b. (a -> b) -> a -> b
$ Latex -> String
unPL forall a b. (a -> b) -> a -> b
$ forall r. RenderSpecial r => Special -> r
L.special Special
s
--pExpr (Gr g)         = unPL $ greek g
pExpr (Sub Expr
e)        = forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
unders forall a. Semigroup a => a -> a -> a
<> D -> D
br (Expr -> D
pExpr Expr
e)
pExpr (Sup Expr
e)        = forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
hat    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 forall a. Semigroup a => a -> a -> a
<> Expr -> D
pExpr Expr
m 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)     = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text 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    = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
","
pOps Ops
Prime    = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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      = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"e"
pOps Ops
Neg      = forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
hyph
pOps Ops
Cross    = String -> D
texSym String
"times"
pOps Ops
VAdd     = forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
pls
pOps Ops
VSub     = 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    = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
" "
pOps Ops
Eq       = 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     = 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
Add      = forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
pls
pOps Ops
Mul      = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
" "
pOps Ops
Summ     = String -> D
command0 String
"displaystyle" forall a. Semigroup a => a -> a -> a
<> String -> D
command0 String
"sum"
pOps Ops
Prod     = String -> D
command0 String
"displaystyle" forall a. Semigroup a => a -> a -> a
<> String -> D
command0 String
"prod"
pOps Ops
Inte     = String -> D
texSym String
"int"
pOps Ops
Point    = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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       = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"|"
fence OpenClose
_ Fence
Norm      = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"\\|"

-- | For printing a Matrix.
pMatrix :: [[Expr]] -> D
pMatrix :: [[Expr]] -> D
pMatrix [[Expr]]
e = Doc -> [D] -> D
vpunctuate Doc
dbs (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
" & ") (forall a b. (a -> b) -> [a] -> [b]
map Expr -> D
pExpr [Expr]
x)

-- | Helper for printing case expression.
cases :: [(Expr,Expr)] -> D
cases :: [(Expr, Expr)] -> D
cases [] = forall a. HasCallStack => String -> a
error String
"Attempt to create case expression without cases"
cases [(Expr, Expr)]
e  = Doc -> [D] -> D
vpunctuate Doc
dbs (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
", & ") (forall a b. (a -> b) -> [a] -> [b]
map Expr -> D
pExpr [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
_ = 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
mkEnv String
"longtblr" forall a b. (a -> b) -> a -> b
$
  (if Bool
bool then D -> D
sq forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"caption=") forall a. Semigroup a => a -> a -> a
<> D -> D
br D
t else D
empty)
  D -> D -> D
%% D -> D
br (forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"colspec=") forall a. Semigroup a => a -> a -> a
<> D -> D
br (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ Tags -> String
unwords forall a b. (a -> b) -> a -> b
$ [[Title]] -> Tags
anyBig [[Title]]
lls)
    forall a. Semigroup a => a -> a -> 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 = forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String
descr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Title] -> Bool
longColumn) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose
    longColumn :: [Title] -> Bool
longColumn = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Title
x -> Title -> Int
specLength Title
x 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)       = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
dontCount) forall a b. (a -> b) -> a -> b
$ Doc -> String
TP.render forall a b. (a -> b) -> a -> b
$ forall a. PrintLaTeX a -> MathContext -> a
runPrint (Expr -> D
pExpr Expr
x) MathContext
Curr
specLength (S String
x)       = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x
specLength (Title
a :+: Title
b)   = Title -> Int
specLength Title
a forall a. Num a => a -> a -> a
+ Title -> Int
specLength Title
b
specLength (Sp Special
_)      = Int
1
specLength (Ref LinkType
Internal String
r Title
_) = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r
specLength (Ref (Cite2 Title
n)   String
r Title
i ) = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r forall a. Num a => a -> a -> a
+ Title -> Int
specLength Title
i 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 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
" & ") (forall a b. (a -> b) -> [a] -> [b]
map (D -> D
bold forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> D
spec) [Title]
ls) D -> D -> D
%% 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 [] = forall a. Monoid a => a
mempty
makeRows [[Title]]
lls = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (D -> D -> D
(%%) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> D -> D
%% forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
dbs)) forall a b. (a -> b) -> a -> b
$ 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
" & ") forall a b. (a -> b) -> a -> b
$ 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' forall a. Semigroup a => a -> a -> a
<> D
t'
  where
    ctx :: b -> MathContext
ctx = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Title -> MathContext
needs Title
a
    s' :: D
s' = (MathContext -> MathContext) -> D -> D
switch forall {b}. b -> MathContext
ctx forall a b. (a -> b) -> a -> b
$ Title -> D
spec Title
s
    t' :: D
t' = (MathContext -> MathContext) -> D -> D
switch forall {b}. b -> MathContext
ctx forall a b. (a -> b) -> a -> b
$ Title -> D
spec Title
t
spec (E Expr
ex) = D -> D
toMath forall a b. (a -> b) -> a -> b
$ Expr -> D
pExpr Expr
ex
spec (S String
s)  = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeChars) 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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ Latex -> String
unPL forall a b. (a -> b) -> a -> b
$ 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 = forall a. Maybe a
Nothing
    info Title
x      = 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 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Ord a => a -> a -> Bool
> Integer
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 [] = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) 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 forall a b. (a -> b) -> a -> b
$ D -> D -> D
fraction ([(Symbol, Integer)] -> D
line [(Symbol, Integer)]
nu) forall a b. (a -> b) -> a -> b
$ [(Symbol, Integer)] -> D
line forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) 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 forall a b. (a -> b) -> a -> b
$ D -> D -> D
superscript (Symbol -> D
p_symb Symbol
n) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ 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) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Semigroup a => a -> a -> a
(<>) D
empty forall a b. (a -> b) -> a -> b
$ 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 (forall a b. a -> b -> a
const MathContext
cn) forall a b. (a -> b) -> a -> b
$ Expr -> D
pExpr 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
_ = 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
_ = 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" (forall {a}. Show a => String -> a -> String
col String
rr Double
colAwidth forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => String -> a -> String
col (String
rr forall a. [a] -> [a] -> [a]
++ String
"\\arraybackslash") Double
colBwidth) forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat [
  String -> D
command0 String
"toprule " forall a. Semigroup a => a -> a -> a
<> D -> D
bold (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Refname") forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
" & ") 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,
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
">" forall a. [a] -> [a] -> [a]
++ String -> String
brace String
s forall a. [a] -> [a] -> [a]
++ String
"p" forall a. [a] -> [a] -> [a]
++ String -> String
brace (forall a. Show a => a -> String
show a
x 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
_  []         = forall a. HasCallStack => String -> a
error String
"No fields to create Defn table"
makeDRows PrintingInformation
sm [(String, [LayoutObj])]
ls    = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 D -> D -> D
(%%) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(String
f, [LayoutObj]
d) -> D
dBoilerplate D -> D -> D
%%  forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text (String
f forall a. [a] -> [a] -> [a]
++ String
" & ")) forall a. Semigroup a => a -> a -> a
<> PrintingInformation -> [LayoutObj] -> D
print PrintingInformation
sm [LayoutObj]
d) [(String, [LayoutObj])]
ls
  where dBoilerplate :: D
dBoilerplate = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Doc
dbs Doc -> Doc -> Doc
<+> String -> Doc
text String
"\\midrule"

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

-- | Prints an equation.
makeEquation :: Spec -> D
makeEquation :: Title -> D
makeEquation Title
contents = D -> D
toEqn (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
itemize     forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat 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 forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat 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     forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat forall a b. (a -> b) -> a -> b
$ 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   forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ [D] -> D
vcat 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 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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe D
empty forall a b. (a -> b) -> a -> b
$ forall a. Semigroup a => a -> a -> a
(<>) (String -> D
command0 String
"phantomsection") forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> D
label 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 forall a b. (a -> b) -> a -> b
$ Title -> D
spec Title
s
pItem (Nested Title
t ListType
s) = [D] -> D
vcat [D -> D
item 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 = 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
":") forall a. Semigroup a => a -> a -> a
<> Maybe Title -> D
mlref Maybe Title
l) 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 = forall a b. (a -> b) -> [a] -> [b]
map (\(Title
x,ItemType
y,Maybe Title
l) -> D -> D
item forall a b. (a -> b) -> a -> b
$ Maybe Title -> D
mlref Maybe Title
l 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
_) = 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
mkEnv String
"figure" 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" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
" = ") forall a. Semigroup a => a -> a -> a
<> D -> D
sq (
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"draw, shape=rectangle, ") forall a. Semigroup a => a -> a -> a
<> D
w forall a. Semigroup a => a -> a -> a
<> D
h forall a. Semigroup a => a -> a -> 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" (
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"digraph G ") forall a. Semigroup a => a -> a -> a
<> D -> D
br ( [D] -> D
vcat (
         forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"graph [sep = 0. esep = 0, nodesep = 0.1, ranksep = 2];") forall a. a -> [a] -> [a]
:
         forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"node [style = \"n\"];") forall a. a -> [a] -> [a]
:
         forall a b. (a -> b) -> [a] -> [b]
map (\(D
a,D
b) -> forall {f :: * -> *}.
(Semigroup (f Doc), Applicative f) =>
f Doc -> f Doc
q D
a forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
" -> ") forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *}.
(Semigroup (f Doc), Applicative f) =>
f Doc -> f Doc
q D
b forall a. Semigroup a => a -> a -> 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
"\"") forall a. Semigroup a => a -> a -> a
<> f Doc
x forall a. Semigroup a => a -> a -> 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 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" forall a. Semigroup a => a -> a -> a
<> D -> D
sq (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (D -> D -> D
(%%) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintingInformation -> Citation -> D
renderF PrintingInformation
sm) 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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text (CitationKind -> String
showT CitationKind
refType)) forall a. Semigroup a => a -> a -> a
<>
  D -> D
br (Doc -> [D] -> D
hpunctuate (String -> Doc
text String
",\n") forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
cid) forall a. a -> [a] -> [a]
: 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" (forall a. Show a => a -> Title
wrapS Int
c)
showBibTeX  PrintingInformation
_ (Edition      Int
e) = String -> Title -> D
showField String
"edition" (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" (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 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" (forall a. Show a => a -> Title
wrapS Int
v)
showBibTeX  PrintingInformation
_ (Year         Int
y) = String -> Title -> D
showField String
"year" (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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text (String
f forall a. [a] -> [a] -> [a]
++ String
"=")) 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 = forall a. a -> a
id
    resolve (Command String
st) = D -> D
br 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 forall a b. (a -> b) -> a -> b
$
  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) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Title
L.S 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show