diff options
author | alexbiehl <alex.biehl@gmail.com> | 2017-10-08 19:38:21 +0200 |
---|---|---|
committer | alexbiehl <alex.biehl@gmail.com> | 2017-10-08 19:38:21 +0200 |
commit | 671b62d104751fd0ab8daf6b9cda1b971abf331f (patch) | |
tree | 43e1605c5e49ce0cf6d060fffb838f23e0e136aa /haddock-api/src/Haddock/Backends/LaTeX.hs | |
parent | 406030f2782590799e44470da7ca80e85f3cf026 (diff) | |
parent | e498b7871bfbee8b38858b546390246ddddb9509 (diff) |
Merge remote-tracking branch 'origin/ghc-head' into HEAD
Diffstat (limited to 'haddock-api/src/Haddock/Backends/LaTeX.hs')
-rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 97 |
1 files changed, 49 insertions, 48 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 1b248d2e..1cc23e6e 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -37,6 +37,7 @@ import Data.Char import Control.Monad import Data.Maybe import Data.List +import Prelude hiding ((<>)) import Haddock.Doc (combineDocumentation) @@ -179,7 +180,7 @@ string_txt (ZStr s1) s2 = zString s1 ++ s2 string_txt (LStr s1 _) s2 = unpackLitString s1 ++ s2 -exportListItem :: ExportItem DocName -> LaTeX +exportListItem :: ExportItem DocNameI -> LaTeX exportListItem ExportDecl { expItemDecl = decl, expItemSubDocs = subdocs } = sep (punctuate comma . map ppDocBinder $ declNames decl) <> case subdocs of @@ -197,7 +198,7 @@ exportListItem _ -- Deal with a group of undocumented exports together, to avoid lots -- of blank vertical space between them. -processExports :: [ExportItem DocName] -> LaTeX +processExports :: [ExportItem DocNameI] -> LaTeX processExports [] = empty processExports (decl : es) | Just sig <- isSimpleSig decl @@ -213,19 +214,19 @@ processExports (e : es) = processExport e $$ processExports es -isSimpleSig :: ExportItem DocName -> Maybe ([DocName], HsType DocName) +isSimpleSig :: ExportItem DocNameI -> Maybe ([DocName], HsType DocNameI) isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames t)) , expItemMbDoc = (Documentation Nothing Nothing, argDocs) } | Map.null argDocs = Just (map unLoc lnames, unLoc (hsSigWcType t)) isSimpleSig _ = Nothing -isExportModule :: ExportItem DocName -> Maybe Module +isExportModule :: ExportItem DocNameI -> Maybe Module isExportModule (ExportModule m) = Just m isExportModule _ = Nothing -processExport :: ExportItem DocName -> LaTeX +processExport :: ExportItem DocNameI -> LaTeX processExport (ExportGroup lev _id0 doc) = ppDocGroup lev (docToLaTeX doc) processExport (ExportDecl decl pats doc subdocs insts fixities _splice) @@ -248,7 +249,7 @@ ppDocGroup lev doc = sec lev <> braces doc sec _ = text "\\paragraph" -declNames :: LHsDecl DocName -> [DocName] +declNames :: LHsDecl DocNameI -> [DocName] declNames (L _ decl) = case decl of TyClD d -> [tcdName d] SigD (TypeSig lnames _ ) -> map unLoc lnames @@ -258,7 +259,7 @@ declNames (L _ decl) = case decl of _ -> error "declaration not supported by declNames" -forSummary :: (ExportItem DocName) -> Bool +forSummary :: (ExportItem DocNameI) -> Bool forSummary (ExportGroup _ _ _) = False forSummary (ExportDoc _) = False forSummary _ = True @@ -278,10 +279,10 @@ moduleBasename mdl = map (\c -> if c == '.' then '-' else c) ------------------------------------------------------------------------------- -ppDecl :: LHsDecl DocName - -> [(HsDecl DocName,DocForDecl DocName)] +ppDecl :: LHsDecl DocNameI + -> [(HsDecl DocNameI, DocForDecl DocName)] -> DocForDecl DocName - -> [DocInstance DocName] + -> [DocInstance DocNameI] -> [(DocName, DocForDecl DocName)] -> [(DocName, Fixity)] -> LaTeX @@ -309,12 +310,12 @@ ppDecl (L loc decl) pats (doc, fnArgsDoc) instances subdocs _fixities = case dec ppTyFam :: Bool -> SrcSpan -> Documentation DocName -> - TyClDecl DocName -> Bool -> LaTeX + TyClDecl DocNameI -> Bool -> LaTeX ppTyFam _ _ _ _ _ = error "type family declarations are currently not supported by --latex" -ppFor :: SrcSpan -> DocForDecl DocName -> ForeignDecl DocName -> Bool -> LaTeX +ppFor :: SrcSpan -> DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX ppFor loc doc (ForeignImport (L _ name) typ _ _) unicode = ppFunSig loc doc [name] (hsSigType typ) unicode ppFor _ _ _ _ = error "ppFor error in Haddock.Backends.LaTeX" @@ -327,7 +328,7 @@ ppFor _ _ _ _ = error "ppFor error in Haddock.Backends.LaTeX" -- we skip type patterns for now -ppTySyn :: SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool -> LaTeX +ppTySyn :: SrcSpan -> DocForDecl DocName -> TyClDecl DocNameI -> Bool -> LaTeX ppTySyn loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars , tcdRhs = ltype }) unicode @@ -346,7 +347,7 @@ ppTySyn _ _ _ _ = error "declaration not supported by ppTySyn" ------------------------------------------------------------------------------- -ppFunSig :: SrcSpan -> DocForDecl DocName -> [DocName] -> LHsType DocName +ppFunSig :: SrcSpan -> DocForDecl DocName -> [DocName] -> LHsType DocNameI -> Bool -> LaTeX ppFunSig loc doc docnames (L _ typ) unicode = ppTypeOrFunSig loc docnames typ doc @@ -358,7 +359,7 @@ ppFunSig loc doc docnames (L _ typ) unicode = names = map getName docnames ppLPatSig :: SrcSpan -> DocForDecl DocName -> [DocName] - -> LHsSigType DocName + -> LHsSigType DocNameI -> Bool -> LaTeX ppLPatSig _loc (doc, _argDocs) docnames ty unicode = declWithDoc pref1 (documentationToLaTeX doc) @@ -369,7 +370,7 @@ ppLPatSig _loc (doc, _argDocs) docnames ty unicode , ppLType unicode (hsSigType ty) ] -ppTypeOrFunSig :: SrcSpan -> [DocName] -> HsType DocName +ppTypeOrFunSig :: SrcSpan -> [DocName] -> HsType DocNameI -> DocForDecl DocName -> (LaTeX, LaTeX, LaTeX) -> Bool -> LaTeX ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0) @@ -387,7 +388,7 @@ ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0) arg_doc n = rDoc . fmap _doc $ Map.lookup n argDocs - do_args :: Int -> LaTeX -> HsType DocName -> LaTeX + do_args :: Int -> LaTeX -> HsType DocNameI -> LaTeX do_args _n leader (HsForAllTy tvs ltype) = decltt leader <-> decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot])) @@ -403,18 +404,18 @@ ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0) = decltt leader <-> decltt (ppType unicode t) <-> arg_doc n <+> nl -ppTypeSig :: [Name] -> HsType DocName -> Bool -> LaTeX +ppTypeSig :: [Name] -> HsType DocNameI -> Bool -> LaTeX ppTypeSig nms ty unicode = hsep (punctuate comma $ map ppSymName nms) <+> dcolon unicode <+> ppType unicode ty -ppTyVars :: [LHsTyVarBndr DocName] -> [LaTeX] +ppTyVars :: [LHsTyVarBndr DocNameI] -> [LaTeX] ppTyVars = map (ppSymName . getName . hsLTyVarName) -tyvarNames :: LHsQTyVars DocName -> [Name] +tyvarNames :: LHsQTyVars DocNameI -> [Name] tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit @@ -463,8 +464,8 @@ rDoc = maybeDoc . fmap latexStripTrailingWhitespace ------------------------------------------------------------------------------- -ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName - -> LHsQTyVars DocName -> [Located ([Located DocName], [Located DocName])] +ppClassHdr :: Bool -> Located [LHsType DocNameI] -> DocName + -> LHsQTyVars DocNameI -> [Located ([Located DocName], [Located DocName])] -> Bool -> LaTeX ppClassHdr summ lctxt n tvs fds unicode = keyword "class" @@ -482,9 +483,9 @@ ppFds fds unicode = hsep (map (ppDocName . unLoc) vars2) -ppClassDecl :: [DocInstance DocName] -> SrcSpan +ppClassDecl :: [DocInstance DocNameI] -> SrcSpan -> Documentation DocName -> [(DocName, DocForDecl DocName)] - -> TyClDecl DocName -> Bool -> LaTeX + -> TyClDecl DocNameI -> Bool -> LaTeX ppClassDecl instances loc doc subdocs (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars, tcdFDs = lfds , tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs }) unicode @@ -519,7 +520,7 @@ ppClassDecl instances loc doc subdocs ppClassDecl _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl" -ppDocInstances :: Bool -> [DocInstance DocName] -> LaTeX +ppDocInstances :: Bool -> [DocInstance DocNameI] -> LaTeX ppDocInstances _unicode [] = empty ppDocInstances unicode (i : rest) | Just ihead <- isUndocdInstance i @@ -537,16 +538,16 @@ isUndocdInstance _ = Nothing -- | Print a possibly commented instance. The instance header is printed inside -- an 'argBox'. The comment is printed to the right of the box in normal comment -- style. -ppDocInstance :: Bool -> DocInstance DocName -> LaTeX +ppDocInstance :: Bool -> DocInstance DocNameI -> LaTeX ppDocInstance unicode (instHead, doc, _) = declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX $ fmap _doc doc) -ppInstDecl :: Bool -> InstHead DocName -> LaTeX +ppInstDecl :: Bool -> InstHead DocNameI -> LaTeX ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead -ppInstHead :: Bool -> InstHead DocName -> LaTeX +ppInstHead :: Bool -> InstHead DocNameI -> LaTeX ppInstHead unicode (InstHead {..}) = case ihdInstType of ClassInst ctx _ _ _ -> ppContextNoLocs ctx unicode <+> typ TypeInst rhs -> keyword "type" <+> typ <+> tibody rhs @@ -567,9 +568,9 @@ lookupAnySubdoc n subdocs = case lookup n subdocs of ------------------------------------------------------------------------------- -ppDataDecl :: [(HsDecl DocName,DocForDecl DocName)] -> [DocInstance DocName] -> +ppDataDecl :: [(HsDecl DocNameI, DocForDecl DocName)] -> [DocInstance DocNameI] -> [(DocName, DocForDecl DocName)] -> SrcSpan -> - Maybe (Documentation DocName) -> TyClDecl DocName -> Bool -> + Maybe (Documentation DocName) -> TyClDecl DocNameI -> Bool -> LaTeX ppDataDecl pats instances subdocs _loc doc dataDecl unicode @@ -615,7 +616,7 @@ ppDataDecl pats instances subdocs _loc doc dataDecl unicode -- ppConstrHdr is for (non-GADT) existentials constructors' syntax -ppConstrHdr :: Bool -> [Name] -> HsContext DocName -> Bool -> LaTeX +ppConstrHdr :: Bool -> [Name] -> HsContext DocNameI -> Bool -> LaTeX ppConstrHdr forall tvs ctxt unicode = (if null tvs then empty else ppForall) <+> @@ -627,7 +628,7 @@ ppConstrHdr forall tvs ctxt unicode ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX - -> LConDecl DocName -> LaTeX + -> LConDecl DocNameI -> LaTeX ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) = leader <-> case con_details con of @@ -756,7 +757,7 @@ ppSideBySideConstr subdocs unicode leader (L loc con) = mkFunTy a b = noLoc (HsFunTy a b) -} -ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName -> LaTeX +ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocNameI -> LaTeX ppSideBySideField subdocs unicode (ConDeclField names ltype _) = decltt (cat (punctuate comma (map (ppBinder . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) <+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc @@ -814,7 +815,7 @@ ppSideBySideField subdocs unicode (ConDeclField names ltype _) = -- | Print the LHS of a data\/newtype declaration. -- Currently doesn't handle 'data instance' decls or kind signatures -ppDataHeader :: TyClDecl DocName -> Bool -> LaTeX +ppDataHeader :: TyClDecl DocNameI -> Bool -> LaTeX ppDataHeader (DataDecl { tcdLName = L _ name, tcdTyVars = tyvars , tcdDataDefn = HsDataDefn { dd_ND = nd, dd_ctxt = ctxt } }) unicode = -- newtype or data @@ -831,7 +832,7 @@ ppDataHeader _ _ = error "ppDataHeader: illegal argument" -- | Print an application of a DocName and two lists of HsTypes (kinds, types) -ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName] -> Bool -> LaTeX +ppAppNameTypes :: DocName -> [HsType DocNameI] -> [HsType DocNameI] -> Bool -> LaTeX ppAppNameTypes n ks ts unicode = ppTypeApp n ks ts ppDocName (ppParendType unicode) @@ -858,29 +859,29 @@ ppTypeApp n ks ts ppDN ppT = ppDN n <+> hsep (map ppT $ ks ++ ts) ------------------------------------------------------------------------------- -ppLContext, ppLContextNoArrow :: Located (HsContext DocName) -> Bool -> LaTeX +ppLContext, ppLContextNoArrow :: Located (HsContext DocNameI) -> Bool -> LaTeX ppLContext = ppContext . unLoc ppLContextNoArrow = ppContextNoArrow . unLoc -ppContextNoLocsMaybe :: [HsType DocName] -> Bool -> Maybe LaTeX +ppContextNoLocsMaybe :: [HsType DocNameI] -> Bool -> Maybe LaTeX ppContextNoLocsMaybe [] _ = Nothing ppContextNoLocsMaybe cxt unicode = Just $ pp_hs_context cxt unicode -ppContextNoArrow :: HsContext DocName -> Bool -> LaTeX +ppContextNoArrow :: HsContext DocNameI -> Bool -> LaTeX ppContextNoArrow cxt unicode = fromMaybe empty $ ppContextNoLocsMaybe (map unLoc cxt) unicode -ppContextNoLocs :: [HsType DocName] -> Bool -> LaTeX +ppContextNoLocs :: [HsType DocNameI] -> Bool -> LaTeX ppContextNoLocs cxt unicode = maybe empty (<+> darrow unicode) $ ppContextNoLocsMaybe cxt unicode -ppContext :: HsContext DocName -> Bool -> LaTeX +ppContext :: HsContext DocNameI -> Bool -> LaTeX ppContext cxt unicode = ppContextNoLocs (map unLoc cxt) unicode -pp_hs_context :: [HsType DocName] -> Bool -> LaTeX +pp_hs_context :: [HsType DocNameI] -> Bool -> LaTeX pp_hs_context [] _ = empty pp_hs_context [p] unicode = ppType unicode p pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt) @@ -930,32 +931,32 @@ maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p | otherwise = p -ppLType, ppLParendType, ppLFunLhType :: Bool -> Located (HsType DocName) -> LaTeX +ppLType, ppLParendType, ppLFunLhType :: Bool -> Located (HsType DocNameI) -> LaTeX 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 DocName -> LaTeX +ppType, ppParendType, ppFunLhType :: Bool -> HsType DocNameI -> LaTeX ppType unicode ty = ppr_mono_ty pREC_TOP ty unicode ppParendType unicode ty = ppr_mono_ty pREC_CON ty unicode ppFunLhType unicode ty = ppr_mono_ty pREC_FUN ty unicode -ppLKind :: Bool -> LHsKind DocName -> LaTeX +ppLKind :: Bool -> LHsKind DocNameI -> LaTeX ppLKind unicode y = ppKind unicode (unLoc y) -ppKind :: Bool -> HsKind DocName -> LaTeX +ppKind :: Bool -> HsKind DocNameI -> LaTeX ppKind unicode ki = ppr_mono_ty pREC_TOP ki unicode -- Drop top-level for-all type variables in user style -- since they are implicit in Haskell -ppr_mono_lty :: Int -> LHsType DocName -> Bool -> LaTeX +ppr_mono_lty :: Int -> LHsType DocNameI -> Bool -> LaTeX ppr_mono_lty ctxt_prec ty unicode = ppr_mono_ty ctxt_prec (unLoc ty) unicode -ppr_mono_ty :: Int -> HsType DocName -> Bool -> LaTeX +ppr_mono_ty :: Int -> HsType DocNameI -> Bool -> LaTeX ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode = maybeParen ctxt_prec pREC_FUN $ sep [ hsep (forallSymbol unicode : ppTyVars tvs) <> dot @@ -1018,7 +1019,7 @@ ppr_tylit (HsStrTy _ s) _ = text (show s) -- XXX: Do something with Unicode parameter? -ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Bool -> LaTeX +ppr_fun_ty :: Int -> LHsType DocNameI -> LHsType DocNameI -> Bool -> LaTeX ppr_fun_ty ctxt_prec ty1 ty2 unicode = let p1 = ppr_mono_lty pREC_FUN ty1 unicode p2 = ppr_mono_lty pREC_TOP ty2 unicode |