aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/LaTeX.hs
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends/LaTeX.hs')
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs89
1 files changed, 51 insertions, 38 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index a84e7e45..119bbc01 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -1,5 +1,7 @@
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Backends.LaTeX
@@ -22,6 +24,7 @@ import Haddock.GhcUtils
import Pretty hiding (Doc, quote)
import qualified Pretty
+import BasicTypes ( PromotionFlag(..) )
import GHC
import OccName
import Name ( nameOccName )
@@ -135,7 +138,7 @@ ppLaTeXTop doctitle packageStr odir prologue maybe_style ifaces = do
filename = odir </> (fromMaybe "haddock" packageStr <.> "tex")
- writeFile filename (show tex)
+ writeUtf8File filename (show tex)
ppLaTeXModule :: String -> FilePath -> Interface -> IO ()
@@ -168,7 +171,7 @@ ppLaTeXModule _title odir iface = do
body = processExports exports
--
- writeFile (odir </> moduleLaTeXFile mdl) (fullRender PageMode 80 1 txtPrinter "" tex)
+ writeUtf8File (odir </> moduleLaTeXFile mdl) (fullRender PageMode 80 1 txtPrinter "" tex)
-- | Prints out an entry in a module export list.
exportListItem :: ExportItem DocNameI -> LaTeX
@@ -342,7 +345,7 @@ ppFamDecl doc instances decl unicode =
ppFamDeclEqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ n
, feqn_rhs = rhs
, feqn_pats = ts } })
- = hsep [ ppAppNameTypes n (map unLoc ts) unicode
+ = hsep [ ppAppNameTypeArgs n ts unicode
, equals
, ppType unicode (unLoc rhs)
]
@@ -908,6 +911,11 @@ ppAppDocNameTyVarBndrs unicode n vs =
ppAppNameTypes :: DocName -> [HsType DocNameI] -> Bool -> LaTeX
ppAppNameTypes n ts unicode = ppTypeApp n ts ppDocName (ppParendType unicode)
+ppAppNameTypeArgs :: DocName -> [LHsTypeArg DocNameI] -> Bool -> LaTeX
+ppAppNameTypeArgs n args@(HsValArg _:HsValArg _:_) unicode
+ = ppTypeApp n args ppDocName (ppLHsTypeArg unicode)
+ppAppNameTypeArgs n args unicode
+ = ppDocName n <+> hsep (map (ppLHsTypeArg unicode) args)
-- | Print an application of a DocName and a list of Names
ppAppDocNameNames :: Bool -> DocName -> [Name] -> LaTeX
@@ -926,7 +934,6 @@ ppTypeApp n (t1:t2:rest) ppDN ppT
ppTypeApp n ts ppDN ppT = ppDN n <+> hsep (map ppT ts)
-
-------------------------------------------------------------------------------
-- * Contexts
-------------------------------------------------------------------------------
@@ -956,7 +963,7 @@ ppContext cxt unicode = ppContextNoLocs (map unLoc cxt) unicode
pp_hs_context :: [HsType DocNameI] -> Bool -> LaTeX
pp_hs_context [] _ = empty
-pp_hs_context [p] unicode = ppType unicode p
+pp_hs_context [p] unicode = ppCtxType unicode p
pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt)
@@ -977,7 +984,7 @@ tupleParens _ = parenList
sumParens :: [LaTeX] -> LaTeX
-sumParens = ubxparens . hsep . punctuate (text " | ")
+sumParens = ubxparens . hsep . punctuate (text " |")
-------------------------------------------------------------------------------
@@ -991,11 +998,17 @@ ppLType unicode y = ppType unicode (unLoc y)
ppLParendType unicode y = ppParendType unicode (unLoc y)
ppLFunLhType unicode y = ppFunLhType unicode (unLoc y)
-
-ppType, ppParendType, ppFunLhType :: Bool -> HsType DocNameI -> LaTeX
+ppType, ppParendType, ppFunLhType, ppCtxType :: Bool -> HsType DocNameI -> LaTeX
ppType unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode
ppParendType unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode
ppFunLhType unicode ty = ppr_mono_ty (reparenTypePrec PREC_FUN ty) unicode
+ppCtxType unicode ty = ppr_mono_ty (reparenTypePrec PREC_CTX ty) unicode
+
+ppLHsTypeArg :: Bool -> LHsTypeArg DocNameI -> LaTeX
+ppLHsTypeArg unicode (HsValArg ty) = ppLParendType unicode ty
+ppLHsTypeArg unicode (HsTypeArg ki) = atSign unicode <>
+ ppLParendType unicode ki
+ppLHsTypeArg _ (HsArgPar _) = text ""
ppHsTyVarBndr :: Bool -> HsTyVarBndr DocNameI -> LaTeX
ppHsTyVarBndr _ (UserTyVar _ (L _ name)) = ppDocName name
@@ -1034,27 +1047,30 @@ ppr_mono_ty (HsFunTy _ ty1 ty2) u
ppr_mono_ty (HsBangTy _ b ty) u = ppBang b <> ppLParendType u ty
ppr_mono_ty (HsTyVar _ NotPromoted (L _ name)) _ = ppDocName name
-ppr_mono_ty (HsTyVar _ Promoted (L _ name)) _ = char '\'' <> ppDocName name
+ppr_mono_ty (HsTyVar _ IsPromoted (L _ name)) _ = char '\'' <> ppDocName name
ppr_mono_ty (HsTupleTy _ con tys) u = tupleParens con (map (ppLType u) tys)
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 (HsKindSig _ ty kind) u = 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 = brackets (ppIPName n <+> dcolon u <+> 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 (HsRecTy {}) _ = text "{..}"
ppr_mono_ty (XHsType (NHsCoreTy {})) _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty (HsExplicitListTy _ Promoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty (HsExplicitListTy _ IsPromoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
ppr_mono_ty (HsExplicitListTy _ NotPromoted tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys
ppr_mono_ty (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
ppr_mono_ty (HsAppTy _ fun_ty arg_ty) unicode
= hsep [ppr_mono_lty fun_ty unicode, ppr_mono_lty arg_ty unicode]
+ppr_mono_ty (HsAppKindTy _ fun_ty arg_ki) unicode
+ = hsep [ppr_mono_lty fun_ty unicode, atSign unicode <> ppr_mono_lty arg_ki unicode]
+
ppr_mono_ty (HsOpTy _ ty1 op ty2) unicode
= ppr_mono_lty ty1 unicode <+> ppr_op <+> ppr_mono_lty ty2 unicode
where
- ppr_op = if not (isSymOcc occName) then char '`' <> ppLDocName op <> char '`' else ppLDocName op
- occName = nameOccName . getName . unLoc $ op
+ ppr_op | isSymOcc (getOccName op) = ppLDocName op
+ | otherwise = char '`' <> ppLDocName op <> char '`'
ppr_mono_ty (HsParTy _ ty) unicode
= parens (ppr_mono_lty ty unicode)
@@ -1063,7 +1079,7 @@ ppr_mono_ty (HsParTy _ ty) unicode
ppr_mono_ty (HsDocTy _ ty _) unicode
= ppr_mono_lty ty unicode
-ppr_mono_ty (HsWildCardTy (AnonWildCard _)) _ = text "\\_"
+ppr_mono_ty (HsWildCardTy _) _ = text "\\_"
ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u
ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode)
@@ -1083,16 +1099,13 @@ ppr_tylit (HsStrTy _ s) _ = text (show s)
ppBinder :: OccName -> LaTeX
ppBinder n
- | isInfixName n = parens $ ppOccName n
- | otherwise = ppOccName n
+ | isSymOcc n = parens $ ppOccName n
+ | otherwise = ppOccName n
ppBinderInfix :: OccName -> LaTeX
ppBinderInfix n
- | isInfixName n = ppOccName n
- | otherwise = cat [ char '`', ppOccName n, char '`' ]
-
-isInfixName :: OccName -> Bool
-isInfixName n = isVarSym n || isConSym n
+ | isSymOcc n = ppOccName n
+ | otherwise = cat [ char '`', ppOccName n, char '`' ]
ppSymName :: Name -> LaTeX
ppSymName name
@@ -1100,22 +1113,21 @@ ppSymName name
| otherwise = ppName name
-ppVerbOccName :: OccName -> LaTeX
-ppVerbOccName = text . latexFilter . occNameString
+ppVerbOccName :: Wrap OccName -> LaTeX
+ppVerbOccName = text . latexFilter . showWrapped occNameString
ppIPName :: HsIPName -> LaTeX
-ppIPName ip = text $ unpackFS $ hsIPNameFS ip
+ppIPName = text . ('?':) . unpackFS . hsIPNameFS
ppOccName :: OccName -> LaTeX
ppOccName = text . occNameString
-
-ppVerbDocName :: DocName -> LaTeX
-ppVerbDocName = ppVerbOccName . nameOccName . getName
+ppVerbDocName :: Wrap DocName -> LaTeX
+ppVerbDocName = text . latexFilter . showWrapped (occNameString . nameOccName . getName)
-ppVerbRdrName :: RdrName -> LaTeX
-ppVerbRdrName = ppVerbOccName . rdrNameOcc
+ppVerbRdrName :: Wrap RdrName -> LaTeX
+ppVerbRdrName = text . latexFilter . showWrapped (occNameString . rdrNameOcc)
ppDocName :: DocName -> LaTeX
@@ -1176,7 +1188,7 @@ parLatexMarkup ppId = Markup {
markupString = \s v -> text (fixString v s),
markupAppend = \l r v -> l v <> r v,
markupIdentifier = markupId ppId,
- markupIdentifierUnchecked = markupId (ppVerbOccName . snd),
+ markupIdentifierUnchecked = markupId (ppVerbOccName . fmap snd),
markupModule = \m _ -> let (mdl,_ref) = break (=='#') m in tt (text mdl),
markupWarning = \p v -> emph (p v),
markupEmphasis = \p v -> emph (p v),
@@ -1189,7 +1201,7 @@ parLatexMarkup ppId = Markup {
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 = \l _ -> markupLink l,
+ 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,
@@ -1209,8 +1221,8 @@ parLatexMarkup ppId = Markup {
fixString Verb s = s
fixString Mono s = latexMonoFilter s
- markupLink (Hyperlink url mLabel) = case mLabel of
- Just label -> text "\\href" <> braces (text url) <> braces (text label)
+ markupLink url mLabel = case mLabel of
+ Just label -> text "\\href" <> braces (text url) <> braces label
Nothing -> text "\\url" <> braces (text url)
-- Is there a better way of doing this? Just a space is an aribtrary choice.
@@ -1233,11 +1245,11 @@ parLatexMarkup ppId = Markup {
where theid = ppId_ id
-latexMarkup :: DocMarkup DocName (StringContext -> LaTeX)
+latexMarkup :: DocMarkup (Wrap DocName) (StringContext -> LaTeX)
latexMarkup = parLatexMarkup ppVerbDocName
-rdrLatexMarkup :: DocMarkup RdrName (StringContext -> LaTeX)
+rdrLatexMarkup :: DocMarkup (Wrap RdrName) (StringContext -> LaTeX)
rdrLatexMarkup = parLatexMarkup ppVerbRdrName
@@ -1322,12 +1334,13 @@ quote :: LaTeX -> LaTeX
quote doc = text "\\begin{quote}" $$ doc $$ text "\\end{quote}"
-dcolon, arrow, darrow, forallSymbol, starSymbol :: Bool -> LaTeX
+dcolon, arrow, darrow, forallSymbol, starSymbol, atSign :: Bool -> LaTeX
dcolon unicode = text (if unicode then "∷" else "::")
arrow unicode = text (if unicode then "→" else "->")
darrow unicode = text (if unicode then "⇒" else "=>")
forallSymbol unicode = text (if unicode then "∀" else "forall")
starSymbol unicode = text (if unicode then "★" else "*")
+atSign unicode = text (if unicode then "@" else "@")
dot :: LaTeX
dot = char '.'
@@ -1342,7 +1355,7 @@ ubxParenList = ubxparens . hsep . punctuate comma
ubxparens :: LaTeX -> LaTeX
-ubxparens h = text "(#" <> h <> text "#)"
+ubxparens h = text "(#" <+> h <+> text "#)"
nl :: LaTeX
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 06:56:06 +0000