aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/LaTeX.hs
diff options
context:
space:
mode:
authoralexbiehl-gc <72160047+alexbiehl-gc@users.noreply.github.com>2021-02-07 18:14:46 +0100
committerGitHub <noreply@github.com>2021-02-07 18:14:46 +0100
commit0f7ff041fb824653a7930e1292b81f34df1e967d (patch)
tree3e7f15ac3b0abe417797ec89275aa1209f6ca297 /haddock-api/src/Haddock/Backends/LaTeX.hs
parent9f597b6647a53624eaf501a34bfb4d8d15425929 (diff)
parent010f0320dff64e3f86091ba4691bc69ce6999647 (diff)
Merge pull request #1317 from bgamari/wip/ghc-head-merge
Merge ghc-8.10 into ghc-head
Diffstat (limited to 'haddock-api/src/Haddock/Backends/LaTeX.hs')
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs284
1 files changed, 153 insertions, 131 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 03c1209a..5b27847e 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -39,7 +39,8 @@ import System.FilePath
import Data.Char
import Control.Monad
import Data.Maybe
-import Data.List (sort)
+import Data.List ( sort )
+import Data.Void ( absurd )
import Prelude hiding ((<>))
import Haddock.Doc (combineDocumentation)
@@ -104,6 +105,10 @@ haddockSty = "haddock.sty"
type LaTeX = Pretty.Doc
+-- | Default way of rendering a 'LaTeX'. The width is 90 by default (since 100
+-- often overflows the line).
+latex2String :: LaTeX -> String
+latex2String = fullRender (PageMode True) 90 1 txtPrinter ""
ppLaTeXTop
:: String
@@ -157,7 +162,7 @@ ppLaTeXModule _title odir iface = do
text "\\haddockbeginheader",
verb $ vcat [
text "module" <+> text mdl_str <+> lparen,
- text " " <> fsep (punctuate (text ", ") $
+ text " " <> fsep (punctuate (char ',') $
map exportListItem $
filter forSummary exports),
text " ) where"
@@ -288,7 +293,7 @@ ppDecl :: LHsDecl DocNameI -- ^ decl to print
-> LaTeX
ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
- TyClD _ d@FamDecl {} -> ppFamDecl doc instances d unicode
+ TyClD _ d@FamDecl {} -> ppFamDecl False doc instances d unicode
TyClD _ d@DataDecl {} -> ppDataDecl pats instances subdocs (Just doc) d unicode
TyClD _ d@SynDecl {} -> ppTySyn (doc, fnArgsDoc) d unicode
-- Family instances happen via FamInst now
@@ -296,7 +301,7 @@ ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
-- | Just _ <- tcdTyPats d -> ppTyInst False loc doc d unicode
-- Family instances happen via FamInst now
TyClD _ d@ClassDecl{} -> ppClassDecl instances doc subdocs d unicode
- SigD _ (TypeSig _ lnames ty) -> ppFunSig (doc, fnArgsDoc) (map unLoc lnames) (dropWildCards ty) unicode
+ SigD _ (TypeSig _ lnames ty) -> ppFunSig Nothing (doc, fnArgsDoc) (map unLoc lnames) (dropWildCards ty) unicode
SigD _ (PatSynSig _ lnames ty) -> ppLPatSig (doc, fnArgsDoc) (map unLoc lnames) ty unicode
ForD _ d -> ppFor (doc, fnArgsDoc) d unicode
InstD _ _ -> empty
@@ -308,7 +313,7 @@ ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
ppFor doc (ForeignImport _ (L _ name) typ _) unicode =
- ppFunSig doc [name] typ unicode
+ ppFunSig Nothing doc [name] typ unicode
ppFor _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
-- error "foreign declarations are currently not supported by --latex"
@@ -318,13 +323,14 @@ ppFor _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
-------------------------------------------------------------------------------
-- | Pretty-print a data\/type family declaration
-ppFamDecl :: Documentation DocName -- ^ this decl's docs
+ppFamDecl :: Bool -- ^ is the family associated?
+ -> Documentation DocName -- ^ this decl's docs
-> [DocInstance DocNameI] -- ^ relevant instances
-> TyClDecl DocNameI -- ^ family to print
-> Bool -- ^ unicode
-> LaTeX
-ppFamDecl doc instances decl unicode =
- declWithDoc (ppFamHeader (tcdFam decl) unicode <+> whereBit)
+ppFamDecl associated doc instances decl unicode =
+ declWithDoc (ppFamHeader (tcdFam decl) unicode associated <+> whereBit)
(if null body then Nothing else Just (vcat body))
$$ instancesBit
where
@@ -336,6 +342,7 @@ ppFamDecl doc instances decl unicode =
familyEqns
| FamilyDecl { fdInfo = ClosedTypeFamily (Just eqns) } <- tcdFam decl
+ , not (null eqns)
= Just (text "\\haddockbeginargs" $$
vcat [ decltt (ppFamDeclEqn eqn) <+> nl | L _ eqn <- eqns ] $$
text "\\end{tabulary}\\par")
@@ -355,21 +362,25 @@ ppFamDecl doc instances decl unicode =
-- | Print the LHS of a type\/data family declaration.
ppFamHeader :: FamilyDecl DocNameI -- ^ family header to print
- -> Bool -- ^ unicode
- -> LaTeX
+ -> Bool -- ^ unicode
+ -> Bool -- ^ is the family associated?
+ -> LaTeX
ppFamHeader (FamilyDecl { fdLName = L _ name
, fdTyVars = tvs
, fdInfo = info
, fdResultSig = L _ result
, fdInjectivityAnn = injectivity })
- unicode =
- leader <+> keyword "family" <+> famName <+> famSig <+> injAnn
+ unicode associated =
+ famly leader <+> famName <+> famSig <+> injAnn
where
leader = case info of
OpenTypeFamily -> keyword "type"
ClosedTypeFamily _ -> keyword "type"
DataFamily -> keyword "data"
+ famly | associated = id
+ | otherwise = (<+> keyword "family")
+
famName = ppAppDocNameTyVarBndrs unicode name (hsq_explicit tvs)
famSig = case result of
@@ -411,17 +422,23 @@ ppTySyn _ _ _ = error "declaration not supported by ppTySyn"
-------------------------------------------------------------------------------
-ppFunSig :: DocForDecl DocName -> [DocName] -> LHsSigType DocNameI
- -> Bool -> LaTeX
-ppFunSig doc docnames (L _ typ) unicode =
+ppFunSig
+ :: Maybe LaTeX -- ^ a prefix to put right before the signature
+ -> DocForDecl DocName -- ^ documentation
+ -> [DocName] -- ^ pattern names in the pattern signature
+ -> LHsSigType DocNameI -- ^ type of the pattern synonym
+ -> Bool -- ^ unicode
+ -> LaTeX
+ppFunSig leader doc docnames (L _ typ) unicode =
ppTypeOrFunSig typ doc
- ( ppTypeSig names typ False
- , hsep . punctuate comma $ map ppSymName names
+ ( lead $ ppTypeSig names typ False
+ , lead $ hsep . punctuate comma $ map ppSymName names
, dcolon unicode
)
unicode
where
names = map getName docnames
+ lead = maybe id (<+>) leader
-- | Pretty-print a pattern synonym
ppLPatSig :: DocForDecl DocName -- ^ documentation
@@ -430,15 +447,7 @@ ppLPatSig :: DocForDecl DocName -- ^ documentation
-> Bool -- ^ unicode
-> LaTeX
ppLPatSig doc docnames ty unicode
- = ppTypeOrFunSig typ doc
- ( keyword "pattern" <+> ppTypeSig names typ False
- , keyword "pattern" <+> (hsep . punctuate comma $ map ppSymName names)
- , dcolon unicode
- )
- unicode
- where
- typ = unLoc ty
- names = map getName docnames
+ = ppFunSig (Just (keyword "pattern")) doc docnames ty unicode
-- | Pretty-print a type, adding documentation to the whole type and its
-- arguments as needed.
@@ -458,7 +467,7 @@ ppTypeOrFunSig typ (doc, argDocs) (pref1, pref2, sep0) unicode
text "\\end{tabulary}\\par" $$
fromMaybe empty (documentationToLaTeX doc)
--- This splits up a type signature along `->` and adds docs (when they exist)
+-- | This splits up a type signature along @->@ and adds docs (when they exist)
-- to the arguments. The output is a list of (leader/seperator, argument and
-- its doc)
ppSubSigLike :: Bool -- ^ unicode
@@ -491,8 +500,9 @@ ppSubSigLike unicode typ argDocs subdocs leader = do_sig_args 0 leader typ
<+> ppLType unicode ltype
) ]
do_args n leader (HsQualTy _ lctxt ltype)
- = (decltt leader, ppLContextNoArrow lctxt unicode <+> nl)
- : do_largs n (darrow unicode) ltype
+ = ( decltt leader
+ , decltt (ppLContextNoArrow lctxt unicode) <+> nl
+ ) : do_largs n (darrow unicode) ltype
do_args n leader (HsFunTy _ _w (L _ (HsRecTy _ fields)) r)
= [ (decltt ldr, latex <+> nl)
@@ -511,9 +521,9 @@ ppSubSigLike unicode typ argDocs subdocs leader = do_sig_args 0 leader typ
-- We need 'gadtComma' and 'gadtEnd' to line up with the `{` from
-- 'gadtOpen', so we add 3 spaces to cover for `-> `/`:: ` (3 in unicode
-- mode since `->` and `::` are rendered as single characters.
- gadtComma = hcat (replicate (if unicode then 3 else 4) (text "\\ ")) <> text ","
- gadtEnd = hcat (replicate (if unicode then 3 else 4) (text "\\ ")) <> text "\\}"
- gadtOpen = text "\\{"
+ gadtComma = hcat (replicate (if unicode then 3 else 4) (char ' ')) <> char ','
+ gadtEnd = hcat (replicate (if unicode then 3 else 4) (char ' ')) <> char '}'
+ gadtOpen = char '{'
ppTypeSig :: [Name] -> HsSigType DocNameI -> Bool -> LaTeX
@@ -547,10 +557,9 @@ declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc decl doc =
text "\\begin{haddockdesc}" $$
text "\\item[\\begin{tabular}{@{}l}" $$
- text (latexMonoFilter (show decl)) $$
- text "\\end{tabular}]" <>
- (if isNothing doc then empty else text "\\haddockbegindoc") $$
- maybe empty id doc $$
+ text (latexMonoFilter (latex2String decl)) $$
+ text "\\end{tabular}]" $$
+ maybe empty (\x -> text "{\\haddockbegindoc" $$ x <> text "}") doc $$
text "\\end{haddockdesc}"
@@ -561,9 +570,9 @@ multiDecl :: [LaTeX] -> LaTeX
multiDecl decls =
text "\\begin{haddockdesc}" $$
vcat [
- text "\\item[" $$
- text (latexMonoFilter (show decl)) $$
- text "]"
+ text "\\item[\\begin{tabular}{@{}l}" $$
+ text (latexMonoFilter (latex2String decl)) $$
+ text "\\end{tabular}]"
| decl <- decls ] $$
text "\\end{haddockdesc}"
@@ -607,6 +616,7 @@ ppFds fds unicode =
hsep (map (ppDocName . unLoc) vars2)
+-- TODO: associated type defaults, docs on default methods
ppClassDecl :: [DocInstance DocNameI]
-> Documentation DocName -> [(DocName, DocForDecl DocName)]
-> TyClDecl DocNameI -> Bool -> LaTeX
@@ -627,18 +637,28 @@ ppClassDecl instances doc subdocs
body_
| null lsigs, null ats, null at_defs = Nothing
| null ats, null at_defs = Just methodTable
---- | otherwise = atTable $$ methodTable
- | otherwise = error "LaTeX.ppClassDecl"
+ | otherwise = Just (atTable $$ methodTable)
+
+ atTable =
+ text "\\haddockpremethods{}" <> emph (text "Associated Types") $$
+ vcat [ ppFamDecl True (fst doc) [] (FamDecl noExtField decl) True
+ | L _ decl <- ats
+ , let name = unLoc . fdLName $ decl
+ doc = lookupAnySubdoc name subdocs
+ ]
+
methodTable =
text "\\haddockpremethods{}" <> emph (text "Methods") $$
- vcat [ ppFunSig doc names (dropWildCards typ) unicode
- | L _ (TypeSig _ lnames typ) <- lsigs
- , let doc = lookupAnySubdoc (head names) subdocs
- names = map unLoc lnames ]
- -- FIXME: is taking just the first name ok? Is it possible that
- -- there are different subdocs for different names in a single
- -- type signature?
+ vcat [ ppFunSig leader doc names typ unicode
+ | L _ (ClassOpSig _ is_def lnames typ) <- lsigs
+ , let doc | is_def = noDocForDecl
+ | otherwise = lookupAnySubdoc (head names) subdocs
+ names = map unLoc lnames
+ leader = if is_def then Just (keyword "default") else Nothing
+ ]
+ -- N.B. taking just the first name is ok. Signatures with multiple
+ -- names are expanded so that each name gets its own signature.
instancesBit = ppDocInstances unicode instances
@@ -657,6 +677,7 @@ ppDocInstances unicode (i : rest)
isUndocdInstance :: DocInstance a -> Maybe (InstHead a)
isUndocdInstance (i,Nothing,_,_) = Just i
+isUndocdInstance (i,Just (MetaDoc _ DocEmpty),_,_) = Just i
isUndocdInstance _ = Nothing
-- | Print a possibly commented instance. The instance header is printed inside
@@ -739,15 +760,21 @@ ppDataDecl pats instances subdocs doc dataDecl unicode =
-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: Bool -> [Name] -> HsContext DocNameI -> Bool -> LaTeX
-ppConstrHdr forall tvs ctxt unicode
- = (if null tvs then empty else ppForall)
- <+>
- (if null ctxt then empty else ppContextNoArrow ctxt unicode <+> darrow unicode <+> text " ")
+ppConstrHdr
+ :: Bool -- ^ print explicit foralls
+ -> [LHsTyVarBndr Specificity DocNameI] -- ^ type variables
+ -> HsContext DocNameI -- ^ context
+ -> Bool -- ^ unicode
+ -> LaTeX
+ppConstrHdr forall_ tvs ctxt unicode = ppForall <> ppCtxt
where
- ppForall = case forall of
- True -> forallSymbol unicode <+> hsep (map ppName tvs) <+> text ". "
- False -> empty
+ ppForall
+ | null tvs || not forall_ = empty
+ | otherwise = ppHsForAllTelescope (mkHsForAllInvisTeleI tvs) unicode
+
+ ppCtxt
+ | null ctxt = empty
+ | otherwise = ppContextNoArrow ctxt unicode <+> darrow unicode <> space
-- | Pretty-print a constructor
@@ -776,11 +803,10 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
-- First line of the constructor (no doc, no fields, single-line)
decl = case con of
ConDeclH98{ con_args = det
- , con_ex_tvs = vars
+ , con_ex_tvs = tyVars
+ , con_forall = L _ forall_
, con_mb_cxt = cxt
- } -> let tyVars = map (getName . hsLTyVarNameI) vars
- context = unLoc (fromMaybe (noLoc []) cxt)
- forall_ = False
+ } -> let context = unLoc (fromMaybe (noLoc []) cxt)
header_ = ppConstrHdr forall_ tyVars context unicode
in case det of
-- Prefix constructor, e.g. 'Just a'
@@ -788,7 +814,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
| hasArgDocs -> header_ <+> ppOcc
| otherwise -> hsep [ header_
, ppOcc
- , hsep (map ((ppLParendType unicode) . hsScaledThing) args)
+ , hsep (map (ppLParendType unicode . hsScaledThing) args)
]
-- Record constructor, e.g. 'Identity { runIdentity :: a }'
@@ -1053,7 +1079,6 @@ ppLKind unicode y = ppKind unicode (unLoc y)
ppKind :: Bool -> HsKind DocNameI -> LaTeX
ppKind unicode ki = ppr_mono_ty (reparenTypePrec PREC_TOP ki) unicode
-
-- Drop top-level for-all type variables in user style
-- since they are implicit in Haskell
@@ -1089,7 +1114,7 @@ ppr_mono_ty (HsSumTy _ tys) u = sumParens (map (ppLType u) tys)
ppr_mono_ty (HsKindSig _ ty kind) u = parens (ppr_mono_lty ty u <+> dcolon u <+> ppLKind u kind)
ppr_mono_ty (HsListTy _ ty) u = brackets (ppr_mono_lty ty u)
ppr_mono_ty (HsIParamTy _ (L _ n) ty) u = ppIPName n <+> dcolon u <+> ppr_mono_lty ty u
-ppr_mono_ty (HsSpliceTy {}) _ = error "ppr_mono_ty HsSpliceTy"
+ppr_mono_ty (HsSpliceTy v _) _ = absurd v
ppr_mono_ty (HsRecTy {}) _ = text "{..}"
ppr_mono_ty (XHsType {}) _ = error "ppr_mono_ty HsCoreTy"
ppr_mono_ty (HsExplicitListTy _ IsPromoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
@@ -1115,7 +1140,7 @@ ppr_mono_ty (HsParTy _ ty) unicode
ppr_mono_ty (HsDocTy _ ty _) unicode
= ppr_mono_lty ty unicode
-ppr_mono_ty (HsWildCardTy _) _ = text "\\_"
+ppr_mono_ty (HsWildCardTy _) _ = char '_'
ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u
ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode)
@@ -1150,9 +1175,6 @@ ppSymName name
| otherwise = ppName name
-ppVerbOccName :: OccName -> LaTeX
-ppVerbOccName = text . latexFilter . occNameString
-
ppIPName :: HsIPName -> LaTeX
ppIPName = text . ('?':) . unpackFS . hsIPNameFS
@@ -1160,18 +1182,9 @@ ppOccName :: OccName -> LaTeX
ppOccName = text . occNameString
-ppVerbDocName :: DocName -> LaTeX
-ppVerbDocName = ppVerbOccName . nameOccName . getName
-
-
-ppVerbRdrName :: RdrName -> LaTeX
-ppVerbRdrName = ppVerbOccName . rdrNameOcc
-
-
ppDocName :: DocName -> LaTeX
ppDocName = ppOccName . nameOccName . getName
-
ppLDocName :: Located DocName -> LaTeX
ppLDocName (L _ d) = ppDocName d
@@ -1209,9 +1222,10 @@ latexMunge c s = c : s
latexMonoMunge :: Char -> String -> String
-latexMonoMunge ' ' s = '\\' : ' ' : s
+latexMonoMunge ' ' (' ':s) = "\\ \\ " ++ s
+latexMonoMunge ' ' ('\\':' ':s) = "\\ \\ " ++ s
latexMonoMunge '\n' s = '\\' : '\\' : s
-latexMonoMunge c s = latexMunge c s
+latexMonoMunge c s = latexMunge c s
-------------------------------------------------------------------------------
@@ -1219,34 +1233,40 @@ latexMonoMunge c s = latexMunge c s
-------------------------------------------------------------------------------
-parLatexMarkup :: (a -> LaTeX) -> DocMarkup a (StringContext -> LaTeX)
-parLatexMarkup ppId = Markup {
- markupParagraph = \p v -> p v <> text "\\par" $$ text "",
- markupEmpty = \_ -> empty,
- markupString = \s v -> text (fixString v s),
- markupAppend = \l r v -> l v <> r v,
- markupIdentifier = markupId ppId,
- markupIdentifierUnchecked = markupId (ppVerbOccName . snd),
- markupModule = \m _ -> let (mdl,_ref) = break (=='#') m in tt (text mdl),
- markupWarning = \p v -> emph (p v),
- markupEmphasis = \p v -> emph (p v),
- markupBold = \p v -> bold (p v),
- markupMonospaced = \p _ -> tt (p Mono),
- markupUnorderedList = \p v -> itemizedList (map ($ v) p) $$ text "",
- markupPic = \p _ -> markupPic p,
- markupMathInline = \p _ -> markupMathInline p,
- markupMathDisplay = \p _ -> markupMathDisplay p,
- markupOrderedList = \p v -> enumeratedList (map ($ v) p) $$ text "",
- markupDefList = \l v -> descriptionList (map (\(a,b) -> (a v, b v)) l),
- markupCodeBlock = \p _ -> quote (verb (p Verb)) $$ text "",
- markupHyperlink = \(Hyperlink u l) p -> markupLink u (fmap ($ p) l),
- markupAName = \_ _ -> empty,
- markupProperty = \p _ -> quote $ verb $ text p,
- markupExample = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e,
- markupHeader = \(Header l h) p -> header l (h p),
- markupTable = \(Table h b) p -> table h b p
+latexMarkup :: HasOccName a => DocMarkup (Wrap a) (StringContext -> LaTeX -> LaTeX)
+latexMarkup = Markup
+ { markupParagraph = \p v -> blockElem (p v (text "\\par"))
+ , markupEmpty = \_ -> id
+ , markupString = \s v -> inlineElem (text (fixString v s))
+ , markupAppend = \l r v -> l v . r v
+ , markupIdentifier = \i v -> inlineElem (markupId v (fmap occName i))
+ , markupIdentifierUnchecked = \i v -> inlineElem (markupId v (fmap snd i))
+ , markupModule = \m _ -> inlineElem (let (mdl,_ref) = break (=='#') m in (tt (text mdl)))
+ , markupWarning = \p v -> p v
+ , markupEmphasis = \p v -> inlineElem (emph (p v empty))
+ , markupBold = \p v -> inlineElem (bold (p v empty))
+ , markupMonospaced = \p v -> inlineElem (markupMonospace p v)
+ , markupUnorderedList = \p v -> blockElem (itemizedList (map (\p' -> p' v empty) p))
+ , markupPic = \p _ -> inlineElem (markupPic p)
+ , markupMathInline = \p _ -> inlineElem (markupMathInline p)
+ , markupMathDisplay = \p _ -> blockElem (markupMathDisplay p)
+ , markupOrderedList = \p v -> blockElem (enumeratedList (map (\p' -> p' v empty) p))
+ , markupDefList = \l v -> blockElem (descriptionList (map (\(a,b) -> (a v empty, b v empty)) l))
+ , markupCodeBlock = \p _ -> blockElem (quote (verb (p Verb empty)))
+ , markupHyperlink = \(Hyperlink u l) v -> inlineElem (markupLink u (fmap (\x -> x v empty) l))
+ , markupAName = \_ _ -> id -- TODO
+ , markupProperty = \p _ -> blockElem (quote (verb (text p)))
+ , markupExample = \e _ -> blockElem (quote (verb (text $ unlines $ map exampleToString e)))
+ , markupHeader = \(Header l h) p -> blockElem (header l (h p empty))
+ , markupTable = \(Table h b) p -> blockElem (table h b p)
}
where
+ blockElem :: LaTeX -> LaTeX -> LaTeX
+ blockElem = ($$)
+
+ inlineElem :: LaTeX -> LaTeX -> LaTeX
+ inlineElem = (<>)
+
header 1 d = text "\\section*" <> braces d
header 2 d = text "\\subsection*" <> braces d
header l d
@@ -1259,6 +1279,9 @@ parLatexMarkup ppId = Markup {
fixString Verb s = s
fixString Mono s = latexMonoFilter s
+ markupMonospace p Verb = p Verb empty
+ markupMonospace p _ = tt (p Mono empty)
+
markupLink url mLabel = case mLabel of
Just label -> text "\\href" <> braces (text url) <> braces label
Nothing -> text "\\url" <> braces (text url)
@@ -1275,35 +1298,28 @@ parLatexMarkup ppId = Markup {
markupMathDisplay mathjax = text "\\[" <> text mathjax <> text "\\]"
- markupId ppId_ id v =
+ markupId v wrappedOcc =
case v of
- Verb -> theid
- Mono -> theid
- Plain -> text "\\haddockid" <> braces theid
- where theid = ppId_ id
-
-
-latexMarkup :: DocMarkup DocName (StringContext -> LaTeX)
-latexMarkup = parLatexMarkup ppVerbDocName
-
-
-rdrLatexMarkup :: DocMarkup RdrName (StringContext -> LaTeX)
-rdrLatexMarkup = parLatexMarkup ppVerbRdrName
-
+ Verb -> text i
+ Mono -> text "\\haddockid" <> braces (text . latexMonoFilter $ i)
+ Plain -> text "\\haddockid" <> braces (text . latexFilter $ i)
+ where i = showWrapped occNameString wrappedOcc
docToLaTeX :: Doc DocName -> LaTeX
-docToLaTeX doc = markup latexMarkup doc Plain
-
+docToLaTeX doc = markup latexMarkup doc Plain empty
documentationToLaTeX :: Documentation DocName -> Maybe LaTeX
documentationToLaTeX = fmap docToLaTeX . fmap _doc . combineDocumentation
rdrDocToLaTeX :: Doc RdrName -> LaTeX
-rdrDocToLaTeX doc = markup rdrLatexMarkup doc Plain
+rdrDocToLaTeX doc = markup latexMarkup doc Plain empty
-data StringContext = Plain | Verb | Mono
+data StringContext
+ = Plain -- ^ all special characters have to be escape
+ | Mono -- ^ on top of special characters, escape space chraacters
+ | Verb -- ^ don't escape anything
latexStripTrailingWhitespace :: Doc a -> Doc a
@@ -1328,23 +1344,23 @@ latexStripTrailingWhitespace other = other
itemizedList :: [LaTeX] -> LaTeX
itemizedList items =
- text "\\begin{itemize}" $$
+ text "\\vbox{\\begin{itemize}" $$
vcat (map (text "\\item" $$) items) $$
- text "\\end{itemize}"
+ text "\\end{itemize}}"
enumeratedList :: [LaTeX] -> LaTeX
enumeratedList items =
- text "\\begin{enumerate}" $$
+ text "\\vbox{\\begin{enumerate}" $$
vcat (map (text "\\item " $$) items) $$
- text "\\end{enumerate}"
+ text "\\end{enumerate}}"
descriptionList :: [(LaTeX,LaTeX)] -> LaTeX
descriptionList items =
- text "\\begin{description}" $$
- vcat (map (\(a,b) -> text "\\item" <> brackets a <+> b) items) $$
- text "\\end{description}"
+ text "\\vbox{\\begin{description}" $$
+ vcat (map (\(a,b) -> text "\\item" <> brackets a <> text "\\hfill \\par" $$ b) items) $$
+ text "\\end{description}}"
tt :: LaTeX -> LaTeX
@@ -1352,8 +1368,8 @@ tt ltx = text "\\haddocktt" <> braces ltx
decltt :: LaTeX -> LaTeX
-decltt ltx = text "\\haddockdecltt" <> braces ltx
-
+decltt ltx = text "\\haddockdecltt" <> braces (text filtered)
+ where filtered = latexMonoFilter (latex2String ltx)
emph :: LaTeX -> LaTeX
emph ltx = text "\\emph" <> braces ltx
@@ -1361,6 +1377,12 @@ emph ltx = text "\\emph" <> braces ltx
bold :: LaTeX -> LaTeX
bold ltx = text "\\textbf" <> braces ltx
+-- TODO: @verbatim@ is too much since
+--
+-- * Haddock supports markup _inside_ of codeblocks. Right now, the LaTeX
+-- representing that markup gets printed verbatim
+-- * Verbatim environments are not supported everywhere (example: not nested
+-- inside a @tabulary@ environment)
verb :: LaTeX -> LaTeX
verb doc = text "{\\haddockverb\\begin{verbatim}" $$ doc <> text "\\end{verbatim}}"
-- NB. swallow a trailing \n in the verbatim text by appending the