module Language.Drasil.HTML.Print(
genHTML,
renderCite,
OpenClose(Open, Close),
fence) where
import Prelude hiding (print, (<>))
import Data.List (sortBy)
import Text.PrettyPrint hiding (Str)
import Numeric (showEFloat)
import qualified Language.Drasil as L
import Language.Drasil.HTML.Monad (unPH)
import Language.Drasil.HTML.Helpers (articleTitle, author, ba, body, bold,
caption, divTag, em, h, headTag, html, image, li, ol, pa,
paragraph, reflink, reflinkInfo, reflinkURI, refwrap, sub, sup, table, td,
th, title, tr, ul)
import Language.Drasil.HTML.CSS (linkCSS)
import Language.Drasil.Config (StyleGuide(APA, MLA, Chicago), bibStyleH)
import Language.Drasil.Printing.Import (makeDocument)
import Language.Drasil.Printing.AST (Spec, ItemType(Flat, Nested),
ListType(Ordered, Unordered, Definitions, Desc, Simple), Expr, Fence(Curly, Paren, Abs, Norm),
Ops(..), Expr(..), Spec(Quote, EmptyS, Ref, HARDNL, Sp, S, E, (:+:)),
Spacing(Thin), Fonts(Bold, Emph), OverSymb(Hat), Label,
LinkType(Internal, Cite2, External))
import Language.Drasil.Printing.Citation (CiteField(Year, Number, Volume, Title, Author,
Editor, Pages, Type, Month, Organization, Institution, Chapter, HowPublished, School, Note,
Journal, BookTitle, Publisher, Series, Address, Edition), HP(URL, Verb),
Citation(Cite), BibRef)
import Language.Drasil.Printing.LayoutObj (Document(Document), LayoutObj(..), Tags)
import Language.Drasil.Printing.Helpers (comm, dot, paren, sufxer, sqbrac, sufxPrint)
import Language.Drasil.Printing.PrintingInformation (PrintingInformation)
import qualified Language.Drasil.TeX.Print as TeX (pExpr, spec)
import Language.Drasil.TeX.Monad (runPrint, MathContext(Math), D, toMath, PrintLaTeX(PL))
data OpenClose = Open | Close
genHTML :: PrintingInformation -> String -> L.Document -> Doc
genHTML :: PrintingInformation -> String -> Document -> Doc
genHTML PrintingInformation
sm String
fn Document
doc = String -> Document -> Doc
build String
fn (PrintingInformation -> Document -> Document
makeDocument PrintingInformation
sm Document
doc)
mathJaxScript :: Doc
mathJaxScript :: Doc
mathJaxScript =
[Doc] -> Doc
vcat [String -> Doc
text String
"<script>",
String -> Doc
text String
"MathJax = {",
String -> Doc
text String
" loader: {load: ['[tex]/textmacros', 'output/chtml']},",
String -> Doc
text String
" tex: {",
String -> Doc
text String
" packages: {'[+]': ['textmacros']}",
String -> Doc
text String
" },",
String -> Doc
text String
" svg: {",
String -> Doc
text String
" fontCache: 'global'",
String -> Doc
text String
" }",
String -> Doc
text String
"};",
String -> Doc
text String
"</script>",
String -> Doc
text String
"<script type=\"text/javascript\" id=\"MathJax-script\" async",
String -> Doc
text String
" src=\"https://cdn.jsdelivr.net/npm/mathjax@3/es5/tex-chtml-full.js\">",
String -> Doc
text String
"</script>"]
build :: String -> Document -> Doc
build :: String -> Document -> Doc
build String
fn (Document Title
t Title
a [LayoutObj]
c) =
String -> Doc
text String
"<!DOCTYPE html>" Doc -> Doc -> Doc
$$
Doc -> Doc
html (Doc -> Doc
headTag (String -> Doc
linkCSS String
fn Doc -> Doc -> Doc
$$ Doc -> Doc
title (Title -> Doc
titleSpec Title
t) Doc -> Doc -> Doc
$$
String -> Doc
text String
"<meta charset=\"utf-8\">" Doc -> Doc -> Doc
$$
Doc
mathJaxScript) Doc -> Doc -> Doc
$$
Doc -> Doc
body (Doc -> Doc
articleTitle (Title -> Doc
pSpec Title
t) Doc -> Doc -> Doc
$$ Doc -> Doc
author (Title -> Doc
pSpec Title
a)
Doc -> Doc -> Doc
$$ [LayoutObj] -> Doc
print [LayoutObj]
c
))
printMath :: D -> Doc
printMath :: D -> Doc
printMath = (forall a. PrintLaTeX a -> MathContext -> a
`runPrint` MathContext
Math)
printLO :: LayoutObj -> Doc
printLO :: LayoutObj -> Doc
printLO (HDiv [String
"equation"] [LayoutObj]
layoutObs Title
EmptyS) = [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map LayoutObj -> Doc
printLO [LayoutObj]
layoutObs)
printLO (EqnBlock Title
contents) = Doc -> Doc
mjDelimDisp forall a b. (a -> b) -> a -> b
$ D -> Doc
printMath forall a b. (a -> b) -> a -> b
$ forall {a}. PrintLaTeX a -> PrintLaTeX a
toMathHelper forall a b. (a -> b) -> a -> b
$ Title -> D
TeX.spec Title
contents
where
toMathHelper :: PrintLaTeX a -> PrintLaTeX a
toMathHelper (PL MathContext -> a
g) = forall a. (MathContext -> a) -> PrintLaTeX a
PL (\MathContext
_ -> MathContext -> a
g MathContext
Math)
mjDelimDisp :: Doc -> Doc
mjDelimDisp Doc
d = String -> Doc
text String
"\\[" Doc -> Doc -> Doc
<> Doc
d Doc -> Doc -> Doc
<> String -> Doc
text String
"\\]"
printLO (HDiv [String]
ts [LayoutObj]
layoutObs Title
EmptyS) = [String] -> Doc -> Doc
divTag [String]
ts ([Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map LayoutObj -> Doc
printLO [LayoutObj]
layoutObs))
printLO (HDiv [String]
ts [LayoutObj]
layoutObs Title
l) = Doc -> Doc -> Doc
refwrap (Title -> Doc
pSpec Title
l) forall a b. (a -> b) -> a -> b
$
[String] -> Doc -> Doc
divTag [String]
ts ([Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map LayoutObj -> Doc
printLO [LayoutObj]
layoutObs))
printLO (Paragraph Title
contents) = Doc -> Doc
paragraph forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
contents
printLO (Table [String]
ts [[Title]]
rows Title
r Bool
b Title
t) = [String] -> [[Title]] -> Doc -> Bool -> Doc -> Doc
makeTable [String]
ts [[Title]]
rows (Title -> Doc
pSpec Title
r) Bool
b (Title -> Doc
pSpec Title
t)
printLO (Definition DType
dt [(String, [LayoutObj])]
ssPs Title
l) = DType -> [(String, [LayoutObj])] -> Doc -> Doc
makeDefn DType
dt [(String, [LayoutObj])]
ssPs (Title -> Doc
pSpec Title
l)
printLO (Header Int
n Title
contents Title
_) = Int -> Doc -> Doc
h (Int
n forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
contents
printLO (List ListType
t) = ListType -> Doc
makeList ListType
t
printLO (Figure Title
r Title
c String
f MaxWidthPercent
wp) = Doc -> Doc -> Doc -> MaxWidthPercent -> Doc
makeFigure (Title -> Doc
pSpec Title
r) (Title -> Doc
pSpec Title
c) (String -> Doc
text String
f) MaxWidthPercent
wp
printLO (Bib BibRef
bib) = BibRef -> Doc
makeBib BibRef
bib
printLO Graph{} = Doc
empty
printLO Cell{} = Doc
empty
printLO CodeBlock{} = Doc
empty
print :: [LayoutObj] -> Doc
print :: [LayoutObj] -> Doc
print = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutObj -> Doc
printLO) Doc
empty
titleSpec :: Spec -> Doc
titleSpec :: Title -> Doc
titleSpec (Title
a :+: Title
b) = Title -> Doc
titleSpec Title
a Doc -> Doc -> Doc
<> Title -> Doc
titleSpec Title
b
titleSpec Title
HARDNL = Doc
empty
titleSpec Title
s = Title -> Doc
pSpec Title
s
pSpec :: Spec -> Doc
pSpec :: Title -> Doc
pSpec (E Expr
e) = Doc -> Doc
em forall a b. (a -> b) -> a -> b
$ Expr -> Doc
pExpr Expr
e
pSpec (Title
a :+: Title
b) = Title -> Doc
pSpec Title
a Doc -> Doc -> Doc
<> Title -> Doc
pSpec Title
b
pSpec (S String
s) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error (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
'>']
escapeChars :: Char -> String
escapeChars Char
'&' = String
"\\&"
escapeChars Char
c = [Char
c]
pSpec (Sp Special
s) = String -> Doc
text forall a b. (a -> b) -> a -> b
$ PrintHTML -> String
unPH forall a b. (a -> b) -> a -> b
$ forall r. RenderSpecial r => Special -> r
L.special Special
s
pSpec Title
HARDNL = String -> Doc
text String
"<br />"
pSpec (Ref LinkType
Internal String
r Title
a) = String -> Doc -> Doc
reflink String
r forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
a
pSpec (Ref (Cite2 Title
EmptyS) String
r Title
a) = String -> Doc -> Doc
reflink String
r forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
a
pSpec (Ref (Cite2 Title
n) String
r Title
a) = String -> Doc -> Doc -> Doc
reflinkInfo String
r (Title -> Doc
pSpec Title
a) (Title -> Doc
pSpec Title
n)
pSpec (Ref LinkType
External String
r Title
a) = String -> Doc -> Doc
reflinkURI String
r forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
a
pSpec Title
EmptyS = String -> Doc
text String
""
pSpec (Quote Title
q) = Doc -> Doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
q
pExpr :: Expr -> Doc
pExpr :: Expr -> Doc
pExpr (Dbl Double
d) = String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat forall a. Maybe a
Nothing Double
d String
""
pExpr (Int Integer
i) = String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Integer
i
pExpr (Str String
s) = Doc -> Doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s
pExpr (Row [Expr]
l) = [Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc
pExpr [Expr]
l
pExpr (Ident String
s) = String -> Doc
text String
s
pExpr (Label String
s) = String -> Doc
text String
s
pExpr (Spec Special
s) = String -> Doc
text forall a b. (a -> b) -> a -> b
$ PrintHTML -> String
unPH forall a b. (a -> b) -> a -> b
$ forall r. RenderSpecial r => Special -> r
L.special Special
s
pExpr (Sub Expr
e) = Doc -> Doc
sub forall a b. (a -> b) -> a -> b
$ Expr -> Doc
pExpr Expr
e
pExpr (Sup Expr
e) = Doc -> Doc
sup forall a b. (a -> b) -> a -> b
$ Expr -> Doc
pExpr Expr
e
pExpr (Over OverSymb
Hat Expr
s) = Expr -> Doc
pExpr Expr
s Doc -> Doc -> Doc
<> String -> Doc
text String
"̂"
pExpr (MO Ops
o) = String -> Doc
text forall a b. (a -> b) -> a -> b
$ Ops -> String
pOps Ops
o
pExpr (Fenced Fence
l Fence
r Expr
e) = String -> Doc
text (OpenClose -> Fence -> String
fence OpenClose
Open Fence
l) Doc -> Doc -> Doc
<> Expr -> Doc
pExpr Expr
e Doc -> Doc -> Doc
<> String -> Doc
text (OpenClose -> Fence -> String
fence OpenClose
Close Fence
r)
pExpr (Font Fonts
Bold Expr
e) = Doc -> Doc
bold forall a b. (a -> b) -> a -> b
$ Expr -> Doc
pExpr Expr
e
pExpr (Font Fonts
Emph Expr
e) = String -> Doc
text String
"<em>" Doc -> Doc -> Doc
<> Expr -> Doc
pExpr Expr
e Doc -> Doc -> Doc
<> String -> Doc
text String
"</em>"
pExpr (Spc Spacing
Thin) = String -> Doc
text String
" "
pExpr Expr
e = Doc -> Doc
mjDelimDisp forall a b. (a -> b) -> a -> b
$ D -> Doc
printMath forall a b. (a -> b) -> a -> b
$ D -> D
toMath forall a b. (a -> b) -> a -> b
$ Expr -> D
TeX.pExpr Expr
e
where mjDelimDisp :: Doc -> Doc
mjDelimDisp Doc
d = String -> Doc
text String
"\\(" Doc -> Doc -> Doc
<> Doc
d Doc -> Doc -> Doc
<> String -> Doc
text String
"\\)"
pOps :: Ops -> String
pOps :: Ops -> String
pOps Ops
IsIn = String
" ∈ "
pOps Ops
Integer = String
"ℤ"
pOps Ops
Rational = String
"ℚ"
pOps Ops
Real = String
"ℝ"
pOps Ops
Natural = String
"ℕ"
pOps Ops
Boolean = String
"𝔹"
pOps Ops
Comma = String
","
pOps Ops
Prime = String
"′"
pOps Ops
Log = String
"log"
pOps Ops
Ln = String
"ln"
pOps Ops
Sin = String
"sin"
pOps Ops
Cos = String
"cos"
pOps Ops
Tan = String
"tan"
pOps Ops
Sec = String
"sec"
pOps Ops
Csc = String
"csc"
pOps Ops
Cot = String
"cot"
pOps Ops
Arcsin = String
"arcsin"
pOps Ops
Arccos = String
"arccos"
pOps Ops
Arctan = String
"arctan"
pOps Ops
Not = String
"¬"
pOps Ops
Dim = String
"dim"
pOps Ops
Exp = String
"e"
pOps Ops
Neg = String
"−"
pOps Ops
Cross = String
"⨯"
pOps Ops
VAdd = String
"+"
pOps Ops
VSub = String
"−"
pOps Ops
Dot = String
"⋅"
pOps Ops
Scale = String
" "
pOps Ops
Eq = String
" = "
pOps Ops
NEq = String
"≠"
pOps Ops
Lt = String
" < "
pOps Ops
Gt = String
" > "
pOps Ops
LEq = String
" ≤ "
pOps Ops
GEq = String
" ≥ "
pOps Ops
Impl = String
" ⇒ "
pOps Ops
Iff = String
" ⇔ "
pOps Ops
Subt = String
"−"
pOps Ops
And = String
" ∧ "
pOps Ops
Or = String
" ∨ "
pOps Ops
Add = String
"+"
pOps Ops
Mul = String
" "
pOps Ops
Summ = String
"∑"
pOps Ops
Inte = String
"∫"
pOps Ops
Prod = String
"∏"
pOps Ops
Point = String
"."
pOps Ops
Perc = String
"%"
pOps Ops
LArrow = String
" ← "
pOps Ops
RArrow = String
" → "
pOps Ops
ForAll = String
" ∀ "
pOps Ops
Partial = String
"∂"
fence :: OpenClose -> Fence -> String
fence :: OpenClose -> Fence -> String
fence OpenClose
Open Fence
Paren = String
"("
fence OpenClose
Close Fence
Paren = String
")"
fence OpenClose
Open Fence
Curly = String
"{"
fence OpenClose
Close Fence
Curly = String
"}"
fence OpenClose
_ Fence
Abs = String
"|"
fence OpenClose
_ Fence
Norm = String
"||"
makeTable :: Tags -> [[Spec]] -> Doc -> Bool -> Doc -> Doc
makeTable :: [String] -> [[Title]] -> Doc -> Bool -> Doc -> Doc
makeTable [String]
_ [] Doc
_ Bool
_ Doc
_ = forall a. HasCallStack => String -> a
error String
"No table to print (see PrintHTML)"
makeTable [String]
ts ([Title]
l:[[Title]]
lls) Doc
r Bool
b Doc
t = Doc -> Doc -> Doc
refwrap Doc
r ([String] -> Doc -> Doc
table [String]
ts (
Doc -> Doc
tr ([Title] -> Doc
makeHeaderCols [Title]
l) Doc -> Doc -> Doc
$$ [[Title]] -> Doc
makeRows [[Title]]
lls) Doc -> Doc -> Doc
$$ if Bool
b then Doc -> Doc
caption Doc
t else Doc
empty)
makeRows :: [[Spec]] -> Doc
makeRows :: [[Title]] -> Doc
makeRows = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
tr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Title] -> Doc
makeColumns) Doc
empty
makeColumns, makeHeaderCols :: [Spec] -> Doc
= [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
th forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> Doc
pSpec)
makeColumns :: [Title] -> Doc
makeColumns = [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
td forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> Doc
pSpec)
makeDefn :: L.DType -> [(String,[LayoutObj])] -> Doc -> Doc
makeDefn :: DType -> [(String, [LayoutObj])] -> Doc -> Doc
makeDefn DType
_ [] Doc
_ = forall a. HasCallStack => String -> a
error String
"L.Empty definition"
makeDefn DType
dt [(String, [LayoutObj])]
ps Doc
l = Doc -> Doc -> Doc
refwrap Doc
l forall a b. (a -> b) -> a -> b
$ [String] -> Doc -> Doc
table [DType -> String
dtag DType
dt]
(Doc -> Doc
tr (Doc -> Doc
th (String -> Doc
text String
"Refname") Doc -> Doc -> Doc
$$ Doc -> Doc
td (Doc -> Doc
bold Doc
l)) Doc -> Doc -> Doc
$$ [(String, [LayoutObj])] -> Doc
makeDRows [(String, [LayoutObj])]
ps)
where dtag :: DType -> String
dtag DType
L.General = String
"gdefn"
dtag DType
L.Instance = String
"idefn"
dtag DType
L.Theory = String
"tdefn"
dtag DType
L.Data = String
"ddefn"
makeDRows :: [(String,[LayoutObj])] -> Doc
makeDRows :: [(String, [LayoutObj])] -> Doc
makeDRows [] = forall a. HasCallStack => String -> a
error String
"No fields to create defn table"
makeDRows [(String
f,[LayoutObj]
d)] = Doc -> Doc
tr (Doc -> Doc
th (String -> Doc
text String
f) Doc -> Doc -> Doc
$$ Doc -> Doc
td ([Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LayoutObj -> Doc
printLO [LayoutObj]
d))
makeDRows ((String
f,[LayoutObj]
d):[(String, [LayoutObj])]
ps) = Doc -> Doc
tr (Doc -> Doc
th (String -> Doc
text String
f) Doc -> Doc -> Doc
$$ Doc -> Doc
td ([Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LayoutObj -> Doc
printLO [LayoutObj]
d)) Doc -> Doc -> Doc
$$ [(String, [LayoutObj])] -> Doc
makeDRows [(String, [LayoutObj])]
ps
makeList :: ListType -> Doc
makeList :: ListType -> Doc
makeList (Simple [(Title, ItemType, Maybe Title)]
items) = [String] -> Doc -> Doc
divTag [String
"list"] forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Title
b,ItemType
e,Maybe Title
l) -> Doc -> Doc
pa forall a b. (a -> b) -> a -> b
$ Maybe Title -> Doc -> Doc
mlref Maybe Title
l forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
b Doc -> Doc -> Doc
<> String -> Doc
text String
": "
Doc -> Doc -> Doc
<> ItemType -> Doc
pItem ItemType
e) [(Title, ItemType, Maybe Title)]
items
makeList (Desc [(Title, ItemType, Maybe Title)]
items) = [String] -> Doc -> Doc
divTag [String
"list"] forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Title
b,ItemType
e,Maybe Title
l) -> Doc -> Doc
pa forall a b. (a -> b) -> a -> b
$ Maybe Title -> Doc -> Doc
mlref Maybe Title
l forall a b. (a -> b) -> a -> b
$ Doc -> Doc
ba forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
b
Doc -> Doc -> Doc
<> String -> Doc
text String
": " Doc -> Doc -> Doc
<> ItemType -> Doc
pItem ItemType
e) [(Title, ItemType, Maybe Title)]
items
makeList (Ordered [(ItemType, Maybe Title)]
items) = [String] -> Doc -> Doc
ol [String
"list"] ([Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map
(Doc -> Doc
li forall b c a. (b -> c) -> (a -> b) -> a -> c
. \(ItemType
i,Maybe Title
l) -> Maybe Title -> Doc -> Doc
mlref Maybe Title
l forall a b. (a -> b) -> a -> b
$ ItemType -> Doc
pItem ItemType
i) [(ItemType, Maybe Title)]
items)
makeList (Unordered [(ItemType, Maybe Title)]
items) = [String] -> Doc -> Doc
ul [String
"list"] ([Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map
(Doc -> Doc
li forall b c a. (b -> c) -> (a -> b) -> a -> c
. \(ItemType
i,Maybe Title
l) -> Maybe Title -> Doc -> Doc
mlref Maybe Title
l forall a b. (a -> b) -> a -> b
$ ItemType -> Doc
pItem ItemType
i) [(ItemType, Maybe Title)]
items)
makeList (Definitions [(Title, ItemType, Maybe Title)]
items) = [String] -> Doc -> Doc
ul [String
"hide-list-style-no-indent"] forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Title
b,ItemType
e,Maybe Title
l) -> Doc -> Doc
li forall a b. (a -> b) -> a -> b
$ Maybe Title -> Doc -> Doc
mlref Maybe Title
l forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
b Doc -> Doc -> Doc
<> String -> Doc
text String
" is the"
Doc -> Doc -> Doc
<+> ItemType -> Doc
pItem ItemType
e) [(Title, ItemType, Maybe Title)]
items
mlref :: Maybe Label -> Doc -> Doc
mlref :: Maybe Title -> Doc -> Doc
mlref = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
refwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> Doc
pSpec
pItem :: ItemType -> Doc
pItem :: ItemType -> Doc
pItem (Flat Title
s) = Title -> Doc
pSpec Title
s
pItem (Nested Title
s ListType
l) = [Doc] -> Doc
vcat [Title -> Doc
pSpec Title
s, ListType -> Doc
makeList ListType
l]
makeFigure :: Doc -> Doc -> Doc -> L.MaxWidthPercent -> Doc
makeFigure :: Doc -> Doc -> Doc -> MaxWidthPercent -> Doc
makeFigure Doc
r Doc
c Doc
f MaxWidthPercent
wp = Doc -> Doc -> Doc
refwrap Doc
r (Doc -> Doc -> MaxWidthPercent -> Doc
image Doc
f Doc
c MaxWidthPercent
wp)
makeRefList :: Doc -> Doc -> Doc -> Doc
makeRefList :: Doc -> Doc -> Doc -> Doc
makeRefList Doc
a Doc
l Doc
i = Doc -> Doc
li (Doc -> Doc -> Doc
refwrap Doc
l (Doc
i Doc -> Doc -> Doc
<> String -> Doc
text String
": " Doc -> Doc -> Doc
<> Doc
a))
makeBib :: BibRef -> Doc
makeBib :: BibRef -> Doc
makeBib = [String] -> Doc -> Doc
ul [String
"hide-list-style"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (\(Doc
x,(Doc
y,Doc
z)) -> Doc -> Doc -> Doc -> Doc
makeRefList Doc
z Doc
y Doc
x))
[String -> Doc
text forall a b. (a -> b) -> a -> b
$ ShowS
sqbrac forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
x | Int
x <- [Int
1..] :: [Int]] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Citation -> (Doc, Doc)
renderCite
renderCite :: Citation -> (Doc, Doc)
renderCite :: Citation -> (Doc, Doc)
renderCite (Cite String
e CitationKind
L.Book [CiteField]
cfs) = (String -> Doc
text String
e, [CiteField] -> (StyleGuide -> CiteField -> Doc) -> Doc
renderF [CiteField]
cfs StyleGuide -> CiteField -> Doc
useStyleBk Doc -> Doc -> Doc
<> String -> Doc
text ([CiteField] -> String
sufxPrint [CiteField]
cfs))
renderCite (Cite String
e CitationKind
L.Article [CiteField]
cfs) = (String -> Doc
text String
e, [CiteField] -> (StyleGuide -> CiteField -> Doc) -> Doc
renderF [CiteField]
cfs StyleGuide -> CiteField -> Doc
useStyleArtcl Doc -> Doc -> Doc
<> String -> Doc
text ([CiteField] -> String
sufxPrint [CiteField]
cfs))
renderCite (Cite String
e CitationKind
L.MThesis [CiteField]
cfs) = (String -> Doc
text String
e, [CiteField] -> (StyleGuide -> CiteField -> Doc) -> Doc
renderF [CiteField]
cfs StyleGuide -> CiteField -> Doc
useStyleBk Doc -> Doc -> Doc
<> String -> Doc
text ([CiteField] -> String
sufxPrint [CiteField]
cfs))
renderCite (Cite String
e CitationKind
L.PhDThesis [CiteField]
cfs) = (String -> Doc
text String
e, [CiteField] -> (StyleGuide -> CiteField -> Doc) -> Doc
renderF [CiteField]
cfs StyleGuide -> CiteField -> Doc
useStyleBk Doc -> Doc -> Doc
<> String -> Doc
text ([CiteField] -> String
sufxPrint [CiteField]
cfs))
renderCite (Cite String
e CitationKind
L.Misc [CiteField]
cfs) = (String -> Doc
text String
e, [CiteField] -> (StyleGuide -> CiteField -> Doc) -> Doc
renderF [CiteField]
cfs StyleGuide -> CiteField -> Doc
useStyleBk)
renderCite (Cite String
e CitationKind
_ [CiteField]
cfs) = (String -> Doc
text String
e, [CiteField] -> (StyleGuide -> CiteField -> Doc) -> Doc
renderF [CiteField]
cfs StyleGuide -> CiteField -> Doc
useStyleArtcl)
renderF :: [CiteField] -> (StyleGuide -> (CiteField -> Doc)) -> Doc
renderF :: [CiteField] -> (StyleGuide -> CiteField -> Doc) -> Doc
renderF [CiteField]
fields StyleGuide -> CiteField -> Doc
styl = [Doc] -> Doc
hsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (StyleGuide -> CiteField -> Doc
styl StyleGuide
bibStyleH) (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy CiteField -> CiteField -> Ordering
compCiteField [CiteField]
fields)
compCiteField :: CiteField -> CiteField -> Ordering
compCiteField :: CiteField -> CiteField -> Ordering
compCiteField (Institution Title
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Institution Title
_) = Ordering
GT
compCiteField (Organization Title
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Organization Title
_) = Ordering
GT
compCiteField (Author People
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Author People
_) = Ordering
GT
compCiteField (Title Title
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Title Title
_) = Ordering
GT
compCiteField (Series Title
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Series Title
_) = Ordering
GT
compCiteField (BookTitle Title
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (BookTitle Title
_) = Ordering
GT
compCiteField (Editor People
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Editor People
_) = Ordering
GT
compCiteField (Journal Title
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Journal Title
_) = Ordering
GT
compCiteField (Volume Int
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Volume Int
_) = Ordering
GT
compCiteField (Number Int
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Number Int
_) = Ordering
GT
compCiteField (Edition Int
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Edition Int
_) = Ordering
GT
compCiteField (HowPublished (Verb Title
_)) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (HowPublished (Verb Title
_)) = Ordering
GT
compCiteField (School Title
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (School Title
_) = Ordering
GT
compCiteField (Address Title
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Address Title
_) = Ordering
GT
compCiteField (Publisher Title
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Publisher Title
_) = Ordering
GT
compCiteField (Month Month
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Month Month
_) = Ordering
GT
compCiteField (Year Int
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Year Int
_) = Ordering
GT
compCiteField (HowPublished (URL Title
_)) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (HowPublished (URL Title
_)) = Ordering
GT
compCiteField (Chapter Int
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Chapter Int
_) = Ordering
GT
compCiteField (Pages [Int]
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Pages [Int]
_) = Ordering
GT
compCiteField (Note Title
_) CiteField
_ = Ordering
LT
compCiteField CiteField
_ (Note Title
_) = Ordering
GT
compCiteField (Type Title
_) CiteField
_ = Ordering
LT
useStyleBk :: StyleGuide -> (CiteField -> Doc)
useStyleBk :: StyleGuide -> CiteField -> Doc
useStyleBk StyleGuide
MLA = CiteField -> Doc
bookMLA
useStyleBk StyleGuide
APA = CiteField -> Doc
bookAPA
useStyleBk StyleGuide
Chicago = CiteField -> Doc
bookChicago
useStyleArtcl :: StyleGuide -> (CiteField -> Doc)
useStyleArtcl :: StyleGuide -> CiteField -> Doc
useStyleArtcl StyleGuide
MLA = CiteField -> Doc
artclMLA
useStyleArtcl StyleGuide
APA = CiteField -> Doc
artclAPA
useStyleArtcl StyleGuide
Chicago = CiteField -> Doc
artclChicago
bookMLA :: CiteField -> Doc
bookMLA :: CiteField -> Doc
bookMLA (Address Title
s) = Title -> Doc
pSpec Title
s Doc -> Doc -> Doc
<> String -> Doc
text String
":"
bookMLA (Edition Int
s) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
s forall a. [a] -> [a] -> [a]
++ Int -> String
sufxer Int
s forall a. [a] -> [a] -> [a]
++ String
" ed."
bookMLA (Series Title
s) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ Doc -> Doc
em forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
s
bookMLA (Title Title
s) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ Doc -> Doc
em forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
s
bookMLA (Volume Int
s) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ String
"vol. " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
s
bookMLA (Publisher Title
s) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
s
bookMLA (Author People
p) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec (People -> Title
rendPeople' People
p)
bookMLA (Year Int
y) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
y
bookMLA (BookTitle Title
s) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ Doc -> Doc
em forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
s
bookMLA (Journal Title
s) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ Doc -> Doc
em forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
s
bookMLA (Pages [Int
p]) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ String
"pg. " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
p
bookMLA (Pages [Int]
p) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"pp. " Doc -> Doc -> Doc
<> [Int] -> Doc
foldPages [Int]
p
bookMLA (Note Title
s) = Title -> Doc
pSpec Title
s
bookMLA (Number Int
n) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String
"no. " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)
bookMLA (School Title
s) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
s
bookMLA (HowPublished (Verb Title
s)) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
s
bookMLA (HowPublished (URL l :: Title
l@(S String
s))) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec forall a b. (a -> b) -> a -> b
$ LinkType -> String -> Title -> Title
Ref LinkType
External String
s Title
l
bookMLA (HowPublished (URL Title
s)) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
s
bookMLA (Editor People
p) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Edited by " Doc -> Doc -> Doc
<> People -> Doc
foldPeople People
p
bookMLA (Chapter Int
_) = String -> Doc
text String
""
bookMLA (Institution Title
i) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
i
bookMLA (Organization Title
i) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
i
bookMLA (Month Month
m) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Month
m
bookMLA (Type Title
t) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
t
bookAPA :: CiteField -> Doc
bookAPA :: CiteField -> Doc
bookAPA (Author People
p) = Title -> Doc
pSpec ((Person -> String) -> People -> Title
rendPeople Person -> String
L.rendPersLFM' People
p)
bookAPA (Year Int
y) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ ShowS
paren forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
y
bookAPA (Pages [Int]
p) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ [Int] -> Doc
foldPages [Int]
p
bookAPA (Editor People
p) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ People -> Doc
foldPeople People
p Doc -> Doc -> Doc
<> String -> Doc
text String
" (Ed.)"
bookAPA CiteField
i = CiteField -> Doc
bookMLA CiteField
i
bookChicago :: CiteField -> Doc
bookChicago :: CiteField -> Doc
bookChicago (Author People
p) = Title -> Doc
pSpec ((Person -> String) -> People -> Title
rendPeople Person -> String
L.rendPersLFM'' People
p)
bookChicago (Pages [Int]
p) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ [Int] -> Doc
foldPages [Int]
p
bookChicago (Editor People
p) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ People -> Doc
foldPeople People
p Doc -> Doc -> Doc
<> String -> Doc
text (People -> ShowS
toPlural People
p String
" ed")
bookChicago CiteField
i = CiteField -> Doc
bookMLA CiteField
i
artclMLA :: CiteField -> Doc
artclMLA :: CiteField -> Doc
artclMLA (Title Title
s) = Doc -> Doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
s
artclMLA CiteField
i = CiteField -> Doc
bookMLA CiteField
i
artclAPA :: CiteField -> Doc
artclAPA :: CiteField -> Doc
artclAPA (Title Title
s) = Doc -> Doc
dot forall a b. (a -> b) -> a -> b
$ Title -> Doc
pSpec Title
s
artclAPA (Volume Int
n) = Doc -> Doc
em forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
n
artclAPA (Number Int
n) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ ShowS
paren forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
n
artclAPA CiteField
i = CiteField -> Doc
bookAPA CiteField
i
artclChicago :: CiteField -> Doc
artclChicago :: CiteField -> Doc
artclChicago i :: CiteField
i@(Title Title
_) = CiteField -> Doc
artclMLA CiteField
i
artclChicago (Volume Int
n) = Doc -> Doc
comm forall a b. (a -> b) -> a -> b
$ String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
n
artclChicago (Number Int
n) = String -> Doc
text forall a b. (a -> b) -> a -> b
$ String
"no. " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
artclChicago i :: CiteField
i@(Year Int
_) = CiteField -> Doc
bookAPA CiteField
i
artclChicago CiteField
i = CiteField -> Doc
bookChicago CiteField
i
rendPeople :: (L.Person -> String) -> L.People -> Spec
rendPeople :: (Person -> String) -> People -> Title
rendPeople Person -> String
_ [] = String -> Title
S String
"N.a."
rendPeople Person -> String
f People
people = String -> Title
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
foldlList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Person -> String
f People
people
rendPeople' :: L.People -> Spec
rendPeople' :: People -> Title
rendPeople' [] = String -> Title
S String
"N.a."
rendPeople' People
people = String -> Title
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
foldlList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Person -> String
rendPers (forall a. [a] -> [a]
init People
people) forall a. [a] -> [a] -> [a]
++ [Person -> String
rendPersL (forall a. [a] -> a
last People
people)]
foldPages :: [Int] -> Doc
foldPages :: [Int] -> Doc
foldPages = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
foldlList forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Int] -> [String]
L.numList String
"–"
foldPeople :: L.People -> Doc
foldPeople :: People -> Doc
foldPeople People
p = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
foldlList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall p. HasName p => p -> String
L.nameStr People
p
foldlList :: [String] -> String
foldlList :: [String] -> String
foldlList [] = String
""
foldlList [String
a,String
b] = String
a forall a. [a] -> [a] -> [a]
++ String
" and " forall a. [a] -> [a] -> [a]
++ String
b
foldlList [String]
lst = forall a. (a -> a -> a) -> (a -> a -> a) -> [a] -> a
foldle1 (\String
a String
b -> String
a forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ String
b) (\String
a String
b -> String
a forall a. [a] -> [a] -> [a]
++ String
", and " forall a. [a] -> [a] -> [a]
++ String
b) [String]
lst
foldle1 :: (a -> a -> a) -> (a -> a -> a) -> [a] -> a
foldle1 :: forall a. (a -> a -> a) -> (a -> a -> a) -> [a] -> a
foldle1 a -> a -> a
_ a -> a -> a
_ [] = forall a. HasCallStack => String -> a
error String
"foldle1 cannot be used with empty list"
foldle1 a -> a -> a
_ a -> a -> a
_ [a
x] = a
x
foldle1 a -> a -> a
_ a -> a -> a
g [a
x,a
y] = a -> a -> a
g a
x a
y
foldle1 a -> a -> a
f a -> a -> a
g (a
x:a
y:[a]
xs) = forall a. (a -> a -> a) -> (a -> a -> a) -> [a] -> a
foldle1 a -> a -> a
f a -> a -> a
g (a -> a -> a
f a
x a
y forall a. a -> [a] -> [a]
: [a]
xs)
rendPers :: L.Person -> String
rendPers :: Person -> String
rendPers = Person -> String
L.rendPersLFM
rendPersL :: L.Person -> String
rendPersL :: Person -> String
rendPersL =
(\String
n -> (if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n) Bool -> Bool -> Bool
&& forall a. [a] -> a
last String
n forall a. Eq a => a -> a -> Bool
== Char
'.' then forall a. [a] -> [a]
init else forall a. a -> a
id) String
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Person -> String
rendPers
toPlural :: L.People -> String -> String
toPlural :: People -> ShowS
toPlural (Person
_:People
_) String
str = String
str forall a. [a] -> [a] -> [a]
++ String
"s"
toPlural People
_ String
str = String
str