diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Haddock/Backends/LaTeX.hs | 144 |
1 files changed, 120 insertions, 24 deletions
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs index 4254810e..cdd33094 100644 --- a/src/Haddock/Backends/LaTeX.hs +++ b/src/Haddock/Backends/LaTeX.hs @@ -43,7 +43,7 @@ import Data.List \hrulefill {\haddockverb\begin{verbatim} module Data.List ( - (++), head, last, tail, init, null, length, map, reverse, + (++), head, last, tail, init, null, length, map, reverse, ) where\end{verbatim}} \hrulefill @@ -95,6 +95,7 @@ haddockSty = "haddock.sty" type LaTeX = Pretty.Doc + ppLaTeXTop :: String -> Maybe String @@ -131,6 +132,7 @@ ppLaTeXTop doctitle packageStr odir prologue maybe_style ifaces = do writeFile filename (render tex) + ppLaTeXModule :: String -> FilePath -> Interface -> IO () ppLaTeXModule _title odir iface = do createDirectoryIfMissing True odir @@ -172,6 +174,7 @@ string_txt (Str s1) s2 = s1 ++ s2 string_txt (PStr s1) s2 = unpackFS s1 ++ s2 string_txt (LStr s1 _) s2 = unpackLitString s1 ++ s2 + exportListItem :: ExportItem DocName -> LaTeX exportListItem (ExportDecl decl _doc subdocs _insts) = ppDocBinder (declName decl) <> @@ -187,6 +190,7 @@ exportListItem (ExportModule mdl) exportListItem _ = error "exportListItem" + -- Deal with a group of undocumented exports together, to avoid lots -- of blank vertical space between them. processExports :: [ExportItem DocName] -> LaTeX @@ -204,16 +208,19 @@ processExports (ExportModule mdl : es) processExports (e : es) = processExport e $$ processExports es + isSimpleSig :: ExportItem DocName -> Maybe (DocName, HsType DocName) isSimpleSig (ExportDecl (L _ (SigD (TypeSig (L _ n) (L _ t)))) (Nothing, argDocs) _ _) | Map.null argDocs = Just (n, t) isSimpleSig _ = Nothing + isExportModule :: ExportItem DocName -> Maybe Module isExportModule (ExportModule m) = Just m isExportModule _ = Nothing + processExport :: ExportItem DocName -> LaTeX processExport (ExportGroup lev _id0 doc) = ppDocGroup lev (docToLaTeX doc) @@ -228,6 +235,7 @@ processExport (ExportModule mdl) processExport (ExportDoc doc) = docToLaTeX doc + ppDocGroup :: Int -> LaTeX -> LaTeX ppDocGroup lev doc = sec lev <> braces doc where sec 1 = text "\\section" @@ -235,26 +243,33 @@ ppDocGroup lev doc = sec lev <> braces doc sec 3 = text "\\subsubsection" sec _ = text "\\paragraph" + declName :: LHsDecl DocName -> DocName declName (L _ decl) = case decl of TyClD d -> unLoc $ tcdLName d SigD (TypeSig (L _ n) _) -> n _ -> error "declaration not supported by declName" + forSummary :: (ExportItem DocName) -> Bool forSummary (ExportGroup _ _ _) = False forSummary (ExportDoc _) = False forSummary _ = True + moduleLaTeXFile :: Module -> FilePath moduleLaTeXFile mdl = moduleBasename mdl ++ ".tex" + moduleBasename :: Module -> FilePath moduleBasename mdl = map (\c -> if c == '.' then '-' else c) (moduleNameString (moduleName mdl)) --- ----------------------------------------------------------------------------- --- Decls + +------------------------------------------------------------------------------- +-- * Decls +------------------------------------------------------------------------------- + ppDecl :: LHsDecl DocName -> DocForDecl DocName @@ -278,24 +293,31 @@ ppDecl (L loc decl) (mbDoc, fnArgsDoc) instances subdocs = case decl of where unicode = False + ppTyFam :: t -> t1 -> t2 -> t3 -> t4 -> a ppTyFam _ _ _ _ _ = error "type family declarations are currently not supported by --latex" + ppDataInst :: t -> t1 -> t2 -> a ppDataInst _ _ _ = error "data instance declarations are currently not supported by --latex" + ppTyInst :: t -> t1 -> t2 -> t3 -> t4 -> a ppTyInst _ _ _ _ _ = error "type instance declarations are currently not supported by --latex" + ppFor :: t -> t1 -> t2 -> t3 -> a ppFor _ _ _ _ = error "foreign declarations are currently not supported by --latex" --- ----------------------------------------------------------------------------- --- Type Synonyms + +------------------------------------------------------------------------------- +-- * Type Synonyms +------------------------------------------------------------------------------- + -- we skip type patterns for now ppTySyn :: SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool -> LaTeX @@ -309,8 +331,11 @@ ppTySyn loc doc (TySynonym (L _ name) ltyvars _ ltype) unicode ppTySyn _ _ _ _ = error "declaration not supported by ppTySyn" --- ----------------------------------------------------------------------------- --- Function signatures + +------------------------------------------------------------------------------- +-- * Function signatures +------------------------------------------------------------------------------- + ppFunSig :: SrcSpan -> DocForDecl DocName -> DocName -> HsType DocName -> Bool -> Bool @@ -322,6 +347,7 @@ ppFunSig loc doc docname typ unicode methods = where name = getName docname + ppTypeOrFunSig :: SrcSpan -> DocName -> HsType DocName -> DocForDecl DocName -> (LaTeX, LaTeX, LaTeX) -> Bool -> Bool -> LaTeX @@ -361,16 +387,20 @@ ppTypeOrFunSig _loc _docname typ (doc, argDocs) (pref1, pref2, sep0) do_args n leader t = decltt leader <-> decltt (ppType unicode t) <-> arg_doc n <+> nl + ppTypeSig :: Name -> HsType DocName -> Bool -> LaTeX ppTypeSig nm ty unicode = ppSymName nm <+> dcolon unicode <+> ppType unicode ty + ppTyVars :: [LHsTyVarBndr DocName] -> [LaTeX] ppTyVars tvs = map ppSymName (tyvarNames tvs) + tyvarNames :: [LHsTyVarBndr DocName] -> [Name] tyvarNames = map (getName . hsTyVarName . unLoc) + declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX declWithDoc decl doc = text "\\begin{haddockdesc}" $$ @@ -381,6 +411,7 @@ declWithDoc decl doc = maybe empty id doc $$ text "\\end{haddockdesc}" + -- in a group of decls, we don't put them all in the same tabular, -- because that would prevent the group being broken over a page -- boundary (breaks Foreign.C.Error for example). @@ -394,21 +425,27 @@ multiDecl decls = | decl <- decls ] $$ text "\\end{haddockdesc}" + +------------------------------------------------------------------------------- +-- * Rendering Doc ------------------------------------------------------------------------------- --- Rendering Doc + maybeDoc :: Maybe (Doc DocName) -> LaTeX maybeDoc = maybe empty docToLaTeX + -- for table cells, we strip paragraphs out to avoid extra vertical space -- and don't add a quote environment. rDoc :: Maybe (Doc DocName) -> LaTeX rDoc = maybeDoc . fmap latexStripTrailingWhitespace + ------------------------------------------------------------------------------- --- Class declarations +-- * Class declarations ------------------------------------------------------------------------------- + ppClassHdr :: Bool -> Located [LHsPred DocName] -> DocName -> [Located (HsTyVarBndr DocName)] -> [Located ([DocName], [DocName])] -> Bool -> LaTeX @@ -475,21 +512,26 @@ ppDocInstance :: Bool -> DocInstance DocName -> LaTeX ppDocInstance unicode (instHead, mbDoc) = declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX mbDoc) + ppInstDecl :: Bool -> InstHead DocName -> LaTeX ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead + ppInstHead :: Bool -> InstHead DocName -> LaTeX ppInstHead unicode ([], n, ts) = ppAppNameTypes n ts unicode ppInstHead unicode (ctxt, n, ts) = ppContextNoLocs ctxt unicode <+> ppAppNameTypes n ts unicode + lookupAnySubdoc :: (Eq name1) => name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2 lookupAnySubdoc n subdocs = case lookup n subdocs of Nothing -> noDocForDecl Just docs -> docs --- ----------------------------------------------------------------------------- --- Data & newtype declarations + +------------------------------------------------------------------------------- +-- * Data & newtype declarations +------------------------------------------------------------------------------- ppDataDecl :: [DocInstance DocName] -> @@ -543,6 +585,7 @@ ppConstrHdr forall tvs ctxt unicode Explicit -> forallSymbol unicode <+> hsep (map ppName tvs) <+> text ". " Implicit -> empty + ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX -> LConDecl DocName -> LaTeX ppSideBySideConstr subdocs unicode leader (L _ con) = @@ -597,6 +640,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = mbDoc = join $ fmap fst $ lookup (unLoc $ con_name con) subdocs mkFunTy a b = noLoc (HsFunTy a b) + ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName -> LaTeX ppSideBySideField subdocs unicode (ConDeclField (L _ name) ltype _) = decltt (ppBinder (docNameOcc name) @@ -651,6 +695,7 @@ ppSideBySideField subdocs unicode (ConDeclField (L _ name) ltype _) = -- expandField (HsFieldDecl ns ty doc) = [ HsFieldDecl [n] ty doc | n <- ns ] -- -} + -- | Print the LHS of a data\/newtype declaration. -- Currently doesn't handle 'data instance' decls or kind signatures ppDataHeader :: TyClDecl DocName -> Bool -> LaTeX @@ -666,7 +711,7 @@ ppDataHeader decl unicode -------------------------------------------------------------------------------- --- TyClDecl helpers +-- * TyClDecl helpers -------------------------------------------------------------------------------- @@ -677,7 +722,7 @@ ppTyClBinderWithVars summ decl = -------------------------------------------------------------------------------- --- Type applications +-- * Type applications -------------------------------------------------------------------------------- @@ -705,7 +750,7 @@ ppTypeApp n ts ppDN ppT = ppDN n <+> hsep (map ppT ts) ------------------------------------------------------------------------------- --- Contexts +-- * Contexts ------------------------------------------------------------------------------- @@ -741,24 +786,31 @@ ppPred unicode (HsIParam (IPName n) t) = char '?' <> ppDocName n <> dcolon unicode <> ppLType unicode t --- ---------------------------------------------------------------------------- --- Types and contexts +------------------------------------------------------------------------------- +-- * Types and contexts +------------------------------------------------------------------------------- + ppKind :: Outputable a => a -> LaTeX ppKind k = text (showSDoc (ppr k)) + ppBang :: HsBang -> LaTeX ppBang HsNoBang = empty ppBang _ = char '!' -- Unpacked args is an implementation detail, + tupleParens :: Boxity -> [LaTeX] -> LaTeX tupleParens Boxed = parenList tupleParens Unboxed = ubxParenList --- ----------------------------------------------------------------------------- --- Rendering of HsType + +------------------------------------------------------------------------------- +-- * Rendering of HsType -- -- Stolen from Html and tweaked for LaTeX generation +------------------------------------------------------------------------------- + pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int @@ -860,49 +912,64 @@ ppr_fun_ty ctxt_prec ty1 ty2 unicode maybeParen ctxt_prec pREC_FUN $ sep [p1, arrow unicode <+> p2] --- ----------------------------------------------------------------------------- --- Names + +------------------------------------------------------------------------------- +-- * Names +------------------------------------------------------------------------------- + ppBinder :: OccName -> LaTeX ppBinder n | isVarSym n = parens $ ppOccName n | otherwise = ppOccName n + ppSymName :: Name -> LaTeX ppSymName name | isNameSym name = parens $ ppName name | otherwise = ppName name + ppVerbOccName :: OccName -> LaTeX ppVerbOccName = text . latexFilter . occNameString + ppOccName :: OccName -> LaTeX ppOccName = text . occNameString + ppVerbDocName :: DocName -> LaTeX ppVerbDocName = ppVerbOccName . docNameOcc + ppVerbRdrName :: RdrName -> LaTeX ppVerbRdrName = ppVerbOccName . rdrNameOcc + ppDocName :: DocName -> LaTeX ppDocName = ppOccName . docNameOcc + ppLDocName :: Located DocName -> LaTeX ppLDocName (L _ d) = ppDocName d + ppDocBinder :: DocName -> LaTeX ppDocBinder = ppBinder . docNameOcc + ppName :: Name -> LaTeX ppName = ppOccName . nameOccName + latexFilter :: String -> String latexFilter = foldr latexMunge "" + latexMonoFilter :: String -> String latexMonoFilter = foldr latexMonoMunge "" + latexMunge :: Char -> String -> String latexMunge '#' s = "{\\char '43}" ++ s latexMunge '$' s = "{\\char '44}" ++ s @@ -918,13 +985,17 @@ latexMunge '[' s = "{\\char 91}" ++ s latexMunge ']' s = "{\\char 93}" ++ s latexMunge c s = c : s + latexMonoMunge :: Char -> String -> String latexMonoMunge ' ' s = '\\' : ' ' : s latexMonoMunge '\n' s = '\\' : '\\' : s latexMonoMunge c s = latexMunge c s --- ----------------------------------------------------------------------------- --- Doc Markup + +------------------------------------------------------------------------------- +-- * Doc Markup +------------------------------------------------------------------------------- + parLatexMarkup :: (a -> LaTeX) -> (a -> Bool) -> DocMarkup a (StringContext -> LaTeX) @@ -969,20 +1040,26 @@ parLatexMarkup ppId isTyCon = Markup { | isTyCon x = x | otherwise = y + latexMarkup :: DocMarkup DocName (StringContext -> LaTeX) latexMarkup = parLatexMarkup ppVerbDocName (isTyConName . getName) + rdrLatexMarkup :: DocMarkup RdrName (StringContext -> LaTeX) rdrLatexMarkup = parLatexMarkup ppVerbRdrName isRdrTc + docToLaTeX :: Doc DocName -> LaTeX docToLaTeX doc = markup latexMarkup doc Plain + rdrDocToLaTeX :: Doc RdrName -> LaTeX rdrDocToLaTeX doc = markup rdrLatexMarkup doc Plain + data StringContext = Plain | Verb | Mono + latexStripTrailingWhitespace :: Doc a -> Doc a latexStripTrailingWhitespace (DocString s) | null s' = DocEmpty @@ -997,8 +1074,11 @@ latexStripTrailingWhitespace (DocParagraph p) = latexStripTrailingWhitespace p latexStripTrailingWhitespace other = other --- ----------------------------------------------------------------------------- --- LaTeX utils + +------------------------------------------------------------------------------- +-- * LaTeX utils +------------------------------------------------------------------------------- + itemizedList :: [LaTeX] -> LaTeX itemizedList items = @@ -1006,63 +1086,79 @@ itemizedList items = vcat (map (text "\\item" $$) items) $$ text "\\end{itemize}" + enumeratedList :: [LaTeX] -> LaTeX enumeratedList items = text "\\begin{enumerate}" $$ vcat (map (text "\\item " $$) items) $$ 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}" + tt :: LaTeX -> LaTeX tt ltx = text "\\haddocktt" <> braces ltx + decltt :: LaTeX -> LaTeX decltt ltx = text "\\haddockdecltt" <> braces ltx + emph :: LaTeX -> LaTeX emph ltx = text "\\emph" <> braces ltx + 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 -- \end{verbatim} directly, otherwise we get spurious blank lines at the -- end of code blocks. + quote :: LaTeX -> LaTeX quote doc = text "\\begin{quote}" $$ doc $$ text "\\end{quote}" + dcolon, arrow, darrow, forallSymbol :: 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") + dot :: LaTeX dot = char '.' + parenList :: [LaTeX] -> LaTeX parenList = parens . hsep . punctuate comma + ubxParenList :: [LaTeX] -> LaTeX ubxParenList = ubxparens . hsep . punctuate comma + ubxparens :: LaTeX -> LaTeX ubxparens h = text "(#" <> h <> text "#)" + pabrackets :: LaTeX -> LaTeX pabrackets h = text "[:" <> h <> text ":]" + nl :: LaTeX nl = text "\\\\" + keyword :: String -> LaTeX keyword = text + infixr 4 <-> -- combining table cells (<->) :: LaTeX -> LaTeX -> LaTeX a <-> b = a <+> char '&' <+> b |