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