haddock-api 2.21.0 → 2.22.0
raw patch · 6 files changed
+231/−155 lines, 6 filesnew-uploader
Files
- haddock-api.cabal +1/−1
- src/Haddock.hs +8/−3
- src/Haddock/Backends/Hoogle.hs +13/−8
- src/Haddock/Backends/LaTeX.hs +107/−24
- src/Haddock/Backends/Xhtml/Decl.hs +101/−119
- src/Haddock/Interface.hs +1/−0
haddock-api.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: haddock-api-version: 2.21.0+version: 2.22.0 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries
src/Haddock.hs view
@@ -48,6 +48,7 @@ import Data.Maybe import Data.IORef import Data.Map (Map)+import Data.Version (makeVersion) import qualified Data.Map as Map import System.IO import System.Exit@@ -363,9 +364,13 @@ -- might want to fix that if/when these two get some work on them when (Flag_Hoogle `elem` flags) $ do case pkgNameVer of- (Just (PackageName pkgNameFS), Just pkgVer) ->- let pkgNameStr | unpackFS pkgNameFS == "main" && title /= [] = title- | otherwise = unpackFS pkgNameFS+ (Just (PackageName pkgNameFS), mpkgVer) ->+ let+ pkgNameStr | unpackFS pkgNameFS == "main" && title /= [] = title+ | otherwise = unpackFS pkgNameFS++ pkgVer =+ fromMaybe (makeVersion []) mpkgVer in ppHoogle dflags' pkgNameStr pkgVer title (fmap _doc prologue) visibleIfaces odir _ -> putStrLn . unlines $
src/Haddock/Backends/Hoogle.hs view
@@ -122,10 +122,14 @@ ppExport :: DynFlags -> ExportItem GhcRn -> [String] ppExport dflags ExportDecl { expItemDecl = L _ decl- , expItemMbDoc = (dc, _)+ , expItemPats = bundledPats+ , expItemMbDoc = mbDoc , expItemSubDocs = subdocs , expItemFixities = fixities- } = ppDocumentation dflags dc ++ f decl ++ ppFixities+ } = concat [ ppDocumentation dflags dc ++ f d+ | (d, (dc, _)) <- (decl, mbDoc) : bundledPats+ ] +++ ppFixities where f (TyClD _ d@DataDecl{}) = ppData dflags d subdocs f (TyClD _ d@SynDecl{}) = ppSynonym dflags d@@ -140,12 +144,13 @@ ppExport _ _ = [] ppSigWithDoc :: DynFlags -> Sig GhcRn -> [(Name, DocForDecl Name)] -> [String]-ppSigWithDoc dflags (TypeSig _ names sig) subdocs- = concatMap mkDocSig names- where- mkDocSig n = mkSubdoc dflags n subdocs [pp_sig dflags [n] (hsSigWcType sig)]--ppSigWithDoc _ _ _ = []+ppSigWithDoc dflags sig subdocs = case sig of+ TypeSig _ names t -> concatMap (mkDocSig "" (hsSigWcType t)) names+ PatSynSig _ names t -> concatMap (mkDocSig "pattern " (hsSigType t)) names+ _ -> []+ where+ mkDocSig leader typ n = mkSubdoc dflags n subdocs+ [leader ++ pp_sig dflags [n] typ] ppSig :: DynFlags -> Sig GhcRn -> [String] ppSig dflags x = ppSigWithDoc dflags x []
src/Haddock/Backends/LaTeX.hs view
@@ -12,10 +12,9 @@ -- Portability : portable ----------------------------------------------------------------------------- module Haddock.Backends.LaTeX (- ppLaTeX+ ppLaTeX, ) where - import Documentation.Haddock.Markup import Haddock.Types import Haddock.Utils@@ -285,7 +284,7 @@ -> LaTeX ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of- TyClD _ d@FamDecl {} -> ppTyFam False doc d unicode+ TyClD _ d@FamDecl {} -> ppFamDecl 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@@ -303,12 +302,6 @@ unicode = False -ppTyFam :: Bool -> Documentation DocName ->- TyClDecl DocNameI -> Bool -> LaTeX-ppTyFam _ _ _ _ =- error "type family declarations are currently not supported by --latex"-- ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX ppFor doc (ForeignImport _ (L _ name) typ _) unicode = ppFunSig doc [name] (hsSigType typ) unicode@@ -317,6 +310,83 @@ -------------------------------------------------------------------------------+-- * Type families+-------------------------------------------------------------------------------++-- | Pretty-print a data\/type family declaration+ppFamDecl :: 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)+ (if null body then Nothing else Just (vcat body))+ $$ instancesBit+ where+ body = catMaybes [familyEqns, documentationToLaTeX doc]++ whereBit = case fdInfo (tcdFam decl) of+ ClosedTypeFamily _ -> keyword "where"+ _ -> empty++ familyEqns+ | FamilyDecl { fdInfo = ClosedTypeFamily (Just eqns) } <- tcdFam decl+ = Just (text "\\haddockbeginargs" $$+ vcat [ decltt (ppFamDeclEqn eqn) <+> nl | L _ eqn <- eqns ] $$+ text "\\end{tabulary}\\par")+ | otherwise = Nothing++ -- Individual equations of a closed type family+ ppFamDeclEqn :: TyFamInstEqn DocNameI -> LaTeX+ ppFamDeclEqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ n+ , feqn_rhs = rhs+ , feqn_pats = ts } })+ = hsep [ ppAppNameTypes n (map unLoc ts) unicode+ , equals+ , ppType unicode (unLoc rhs)+ ]+ ppFamDeclEqn (XHsImplicitBndrs _) = panic "haddock:ppFamDecl"+ ppFamDeclEqn (HsIB { hsib_body = XFamEqn _}) = panic "haddock:ppFamDecl"++ instancesBit = ppDocInstances unicode instances++-- | Print the LHS of a type\/data family declaration.+ppFamHeader :: FamilyDecl DocNameI -- ^ family header to print+ -> Bool -- ^ unicode+ -> LaTeX+ppFamHeader (XFamilyDecl _) _ = panic "haddock;ppFamHeader"+ppFamHeader (FamilyDecl { fdLName = L _ name+ , fdTyVars = tvs+ , fdInfo = info+ , fdResultSig = L _ result+ , fdInjectivityAnn = injectivity })+ unicode =+ leader <+> keyword "family" <+> famName <+> famSig <+> injAnn+ where+ leader = case info of+ OpenTypeFamily -> keyword "type"+ ClosedTypeFamily _ -> keyword "type"+ DataFamily -> keyword "data"++ famName = ppAppDocNameTyVarBndrs unicode name (hsq_explicit tvs)++ famSig = case result of+ NoSig _ -> empty+ KindSig _ kind -> dcolon unicode <+> ppLKind unicode kind+ TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode bndr+ XFamilyResultSig _ -> panic "haddock:ppFamHeader"++ injAnn = case injectivity of+ Nothing -> empty+ Just (L _ (InjectivityAnn lhs rhs)) -> hsep ( decltt (text "|")+ : ppLDocName lhs+ : arrow unicode+ : map ppLDocName rhs)++++------------------------------------------------------------------------------- -- * Type Synonyms ------------------------------------------------------------------------------- @@ -538,12 +608,14 @@ | otherwise = error "LaTeX.ppClassDecl" methodTable =- text "\\haddockpremethods{}\\textbf{Methods}" $$- vcat [ ppFunSig doc [name] (hsSigWcType typ) unicode+ text "\\haddockpremethods{}" <> emph (text "Methods") $$+ vcat [ ppFunSig doc names (hsSigWcType typ) unicode | L _ (TypeSig _ lnames typ) <- lsigs- , name <- map unLoc lnames- , let doc = lookupAnySubdoc name subdocs- ]+ , 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? instancesBit = ppDocInstances unicode instances @@ -573,14 +645,13 @@ ppInstDecl :: Bool -> InstHead DocNameI -> LaTeX-ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead---ppInstHead :: Bool -> InstHead DocNameI -> LaTeX-ppInstHead unicode (InstHead {..}) = case ihdInstType of- ClassInst ctx _ _ _ -> ppContextNoLocs ctx unicode <+> typ- TypeInst rhs -> keyword "type" <+> typ <+> tibody rhs- DataInst _ -> error "data instances not supported by --latex yet"+ppInstDecl unicode (InstHead {..}) = case ihdInstType of+ ClassInst ctx _ _ _ -> keyword "instance" <+> ppContextNoLocs ctx unicode <+> typ+ TypeInst rhs -> keyword "type" <+> keyword "instance" <+> typ <+> tibody rhs+ DataInst dd ->+ let nd = dd_ND (tcdDataDefn dd)+ pref = case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }+ in pref <+> keyword "instance" <+> typ where typ = ppAppNameTypes ihdClsName ihdTypes unicode tibody = maybe empty (\t -> equals <+> ppType unicode t)@@ -613,7 +684,7 @@ cons = dd_cons (tcdDataDefn dataDecl) resTy = (unLoc . head) cons - body = catMaybes [constrBit,patternBit, doc >>= documentationToLaTeX]+ body = catMaybes [doc >>= documentationToLaTeX, constrBit,patternBit] (whereBit, leaders) | null cons@@ -823,7 +894,13 @@ -- * Type applications -------------------------------------------------------------------------------- +ppAppDocNameTyVarBndrs :: Bool -> DocName -> [LHsTyVarBndr DocNameI] -> LaTeX+ppAppDocNameTyVarBndrs unicode n vs =+ ppTypeApp n vs ppDN (ppHsTyVarBndr unicode . unLoc)+ where+ ppDN = ppBinder . nameOccName . getName + -- | Print an application of a DocName to its list of HsTypes ppAppNameTypes :: DocName -> [HsType DocNameI] -> Bool -> LaTeX ppAppNameTypes n ts unicode = ppTypeApp n ts ppDocName (ppParendType unicode)@@ -917,6 +994,12 @@ ppParendType unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode ppFunLhType unicode ty = ppr_mono_ty (reparenTypePrec PREC_FUN ty) unicode +ppHsTyVarBndr :: Bool -> HsTyVarBndr DocNameI -> LaTeX+ppHsTyVarBndr _ (UserTyVar _ (L _ name)) = ppDocName name+ppHsTyVarBndr unicode (KindedTyVar _ (L _ name) kind) =+ parens (ppDocName name) <+> dcolon unicode <+> ppLKind unicode kind+ppHsTyVarBndr _ (XTyVarBndr _) = panic "haddock:ppHsTyVarBndr"+ ppLKind :: Bool -> LHsKind DocNameI -> LaTeX ppLKind unicode y = ppKind unicode (unLoc y) @@ -973,7 +1056,7 @@ ppr_mono_ty (HsDocTy _ ty _) unicode = ppr_mono_lty ty unicode -ppr_mono_ty (HsWildCardTy (AnonWildCard _)) _ = char '_'+ppr_mono_ty (HsWildCardTy (AnonWildCard _)) _ = text "\\_" ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode)
src/Haddock/Backends/Xhtml/Decl.hs view
@@ -15,9 +15,7 @@ ----------------------------------------------------------------------------- module Haddock.Backends.Xhtml.Decl ( ppDecl,-- ppTyName, ppTyFamHeader, ppTypeApp, ppOrphanInstances,- tyvarNames+ ppOrphanInstances, ) where import Haddock.Backends.Xhtml.DocMarkup@@ -56,7 +54,7 @@ -> Qualification -> Html ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode pkg qual = case decl of- TyClD _ (FamDecl _ d) -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode pkg qual+ TyClD _ (FamDecl _ d) -> ppFamDecl summ False links instances fixities loc mbDoc d splice unicode pkg qual TyClD _ d@(DataDecl {}) -> ppDataDecl summ links instances fixities subdocs loc mbDoc d pats splice unicode pkg qual TyClD _ d@(SynDecl {}) -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode pkg qual TyClD _ d@(ClassDecl {}) -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode pkg qual@@ -67,7 +65,7 @@ ForD _ d -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode pkg qual InstD _ _ -> noHtml DerivD _ _ -> noHtml- _ -> error "declaration not supported by ppDecl"+ _ -> error "declaration not supported by ppDecl" ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->@@ -222,10 +220,7 @@ ppTyVars :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> [Html] ppTyVars unicode qual tvs = map (ppHsTyVarBndr unicode qual . unLoc) tvs -tyvarNames :: LHsQTyVars DocNameI -> [Name]-tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit - ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> ForeignDecl DocNameI -> [(DocName, Fixity)] -> Splice -> Unicode -> Maybe Package -> Qualification -> Html@@ -283,113 +278,113 @@ -------------------------------------------------------------------------------- -ppFamilyInfo :: Bool -> FamilyInfo DocNameI -> Html-ppFamilyInfo assoc OpenTypeFamily- | assoc = keyword "type"- | otherwise = keyword "type family"-ppFamilyInfo assoc DataFamily- | assoc = keyword "data"- | otherwise = keyword "data family"-ppFamilyInfo _ (ClosedTypeFamily _) = keyword "type family"---ppTyFamHeader :: Bool -> Bool -> FamilyDecl DocNameI- -> Unicode -> Qualification -> Html-ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info- , fdResultSig = L _ result- , fdInjectivityAnn = injectivity })- unicode qual =- (case info of- OpenTypeFamily- | associated -> keyword "type"- | otherwise -> keyword "type family"- DataFamily- | associated -> keyword "data"- | otherwise -> keyword "data family"- ClosedTypeFamily _- -> keyword "type family"- ) <+>-- ppFamDeclBinderWithVars summary unicode qual d <+>- ppResultSig result unicode qual <+>-- (case injectivity of- Nothing -> noHtml- Just (L _ injectivityAnn) -> ppInjectivityAnn unicode qual injectivityAnn- ) <+>-- (case info of- ClosedTypeFamily _ -> keyword "where ..."- _ -> mempty- )-ppTyFamHeader _ _ (XFamilyDecl _) _ _ = panic "haddock;ppTyFamHeader"--ppResultSig :: FamilyResultSig DocNameI -> Unicode -> Qualification -> Html-ppResultSig result unicode qual = case result of- NoSig _ -> noHtml- KindSig _ kind -> dcolon unicode <+> ppLKind unicode qual kind- TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr- XFamilyResultSig _ -> panic "haddock:ppResultSig"--ppPseudoFamilyHeader :: Unicode -> Qualification -> PseudoFamilyDecl DocNameI- -> Html-ppPseudoFamilyHeader unicode qual (PseudoFamilyDecl { .. }) =- ppFamilyInfo True pfdInfo <+>- ppAppNameTypes (unLoc pfdLName) (map unLoc pfdTyVars) unicode qual <+>- ppResultSig (unLoc pfdKindSig) unicode qual--ppInjectivityAnn :: Bool -> Qualification -> InjectivityAnn DocNameI -> Html-ppInjectivityAnn unicode qual (InjectivityAnn lhs rhs) =- char '|' <+> ppLDocName qual Raw lhs <+> arrow unicode <+>- hsep (map (ppLDocName qual Raw) rhs)---ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocNameI] ->- [(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->- FamilyDecl DocNameI -> Splice -> Unicode -> Maybe Package ->- Qualification -> Html-ppTyFam summary associated links instances fixities loc doc decl splice unicode- pkg qual-- | summary = ppTyFamHeader True associated decl unicode qual+-- | Print a data\/type family declaration+ppFamDecl :: Bool -- ^ is a summary+ -> Bool -- ^ is an associated type+ -> LinksInfo+ -> [DocInstance DocNameI] -- ^ relevant instances+ -> [(DocName, Fixity)] -- ^ relevant fixities+ -> SrcSpan+ -> Documentation DocName -- ^ this decl's documentation+ -> FamilyDecl DocNameI -- ^ this decl+ -> Splice -> Unicode -> Maybe Package -> Qualification -> Html+ppFamDecl summary associated links instances fixities loc doc decl splice unicode pkg qual+ | summary = ppFamHeader True associated decl unicode qual | otherwise = header_ +++ docSection Nothing pkg qual doc +++ instancesBit where docname = unLoc $ fdLName decl header_ = topDeclElem links loc splice [docname] $- ppTyFamHeader summary associated decl unicode qual <+> ppFixities fixities qual+ ppFamHeader summary associated decl unicode qual <+> ppFixities fixities qual instancesBit | FamilyDecl { fdInfo = ClosedTypeFamily mb_eqns } <- decl , not summary- = subEquations pkg qual $ map (ppTyFamEqn . unLoc) $ fromMaybe [] mb_eqns+ = subEquations pkg qual $ map (ppFamDeclEqn . unLoc) $ fromMaybe [] mb_eqns | otherwise = ppInstances links (OriginFamily docname) instances splice unicode pkg qual -- Individual equation of a closed type family- ppTyFamEqn :: TyFamInstEqn DocNameI -> SubDecl- ppTyFamEqn (HsIB { hsib_body = FamEqn { feqn_tycon = n, feqn_rhs = rhs- , feqn_pats = ts } })- = ( ppAppNameTypes (unLoc n) (map unLoc ts) unicode qual+ ppFamDeclEqn :: TyFamInstEqn DocNameI -> SubDecl+ ppFamDeclEqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ n+ , feqn_rhs = rhs+ , feqn_pats = ts } })+ = ( ppAppNameTypes n (map unLoc ts) unicode qual <+> equals <+> ppType unicode qual HideEmptyContexts (unLoc rhs)- , Nothing, [] )- ppTyFamEqn (XHsImplicitBndrs _) = panic "haddock:ppTyFam"- ppTyFamEqn (HsIB { hsib_body = XFamEqn _}) = panic "haddock:ppTyFam"+ , Nothing+ , []+ )+ ppFamDeclEqn (XHsImplicitBndrs _) = panic "haddock:ppFamDecl"+ ppFamDeclEqn (HsIB { hsib_body = XFamEqn _}) = panic "haddock:ppFamDecl" +-- | Print a pseudo family declaration+ppPseudoFamDecl :: LinksInfo -> Splice+ -> PseudoFamilyDecl DocNameI -- ^ this decl+ -> Unicode -> Qualification -> Html+ppPseudoFamDecl links splice+ (PseudoFamilyDecl { pfdInfo = info+ , pfdKindSig = L _ kindSig+ , pfdTyVars = tvs+ , pfdLName = L loc name })+ unicode qual =+ topDeclElem links loc splice [name] leader+ where+ leader = hsep [ ppFamilyLeader True info+ , ppAppNameTypes name (map unLoc tvs) unicode qual+ , ppResultSig kindSig unicode qual+ ] -ppPseudoFamilyDecl :: LinksInfo -> Splice -> Unicode -> Qualification- -> PseudoFamilyDecl DocNameI- -> Html-ppPseudoFamilyDecl links splice unicode qual- decl@(PseudoFamilyDecl { pfdLName = L loc name, .. }) =- wrapper $ ppPseudoFamilyHeader unicode qual decl+-- | Print the LHS of a type\/data family declaration+ppFamHeader :: Bool -- ^ is a summary+ -> Bool -- ^ is an associated type+ -> FamilyDecl DocNameI -- ^ family declaration+ -> Unicode -> Qualification -> Html+ppFamHeader _ _ (XFamilyDecl _) _ _ = panic "haddock;ppFamHeader"+ppFamHeader summary associated (FamilyDecl { fdInfo = info+ , fdResultSig = L _ result+ , fdInjectivityAnn = injectivity+ , fdLName = L _ name+ , fdTyVars = tvs })+ unicode qual =+ hsep [ ppFamilyLeader associated info+ , ppAppDocNameTyVarBndrs summary unicode qual name (hsq_explicit tvs)+ , ppResultSig result unicode qual+ , injAnn+ , whereBit+ ] where- wrapper = topDeclElem links loc splice [name]+ whereBit = case info of+ ClosedTypeFamily _ -> keyword "where ..."+ _ -> noHtml + injAnn = case injectivity of+ Nothing -> noHtml+ Just (L _ (InjectivityAnn lhs rhs)) -> hsep ( keyword "|"+ : ppLDocName qual Raw lhs+ : arrow unicode+ : map (ppLDocName qual Raw) rhs) +-- | Print the keywords that begin the family declaration+ppFamilyLeader :: Bool -> FamilyInfo DocNameI -> Html+ppFamilyLeader assoc info = keyword (typ ++ if assoc then "" else " family")+ where+ typ = case info of+ OpenTypeFamily -> "type"+ ClosedTypeFamily _ -> "type"+ DataFamily -> "data"++-- | Print the signature attached to a family+ppResultSig :: FamilyResultSig DocNameI -> Unicode -> Qualification -> Html+ppResultSig result unicode qual = case result of+ NoSig _ -> noHtml+ KindSig _ kind -> dcolon unicode <+> ppLKind unicode qual kind+ TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr+ XFamilyResultSig _ -> panic "haddock:ppResultSig"++ -------------------------------------------------------------------------------- -- * Associated Types --------------------------------------------------------------------------------@@ -399,25 +394,10 @@ -> [(DocName, Fixity)] -> Splice -> Unicode -> Maybe Package -> Qualification -> Html ppAssocType summ links doc (L loc decl) fixities splice unicode pkg qual =- ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode pkg qual+ ppFamDecl summ True links [] fixities loc (fst doc) decl splice unicode pkg qual ----------------------------------------------------------------------------------- * TyClDecl helpers------------------------------------------------------------------------------------- | Print a type family and its variables-ppFamDeclBinderWithVars :: Bool -> Unicode -> Qualification -> FamilyDecl DocNameI -> Html-ppFamDeclBinderWithVars summ unicode qual (FamilyDecl { fdLName = lname, fdTyVars = tvs }) =- ppAppDocNameTyVarBndrs summ unicode qual (unLoc lname) (hsq_explicit tvs)-ppFamDeclBinderWithVars _ _ _ (XFamilyDecl _) = panic "haddock:ppFamDeclBinderWithVars"---- | Print a newtype / data binder and its variables-ppDataBinderWithVars :: Bool -> Unicode -> Qualification -> TyClDecl DocNameI -> Html-ppDataBinderWithVars summ unicode qual decl =- ppAppDocNameTyVarBndrs summ unicode qual (tcdName decl) (hsQTvExplicit $ tcdTyVars decl)---------------------------------------------------------------------------------- -- * Type applications -------------------------------------------------------------------------------- @@ -672,7 +652,9 @@ , mdoc , [subFamInstDetails iid pdecl mname]) where- pdata = keyword "data" <+> typ+ nd = dd_ND (tcdDataDefn dd)+ pref = case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }+ pdata = pref <+> typ pdecl = pdata <+> ppShortDataDecl False True dd [] unicode qual where mname = maybe noHtml (\m -> toHtml "Defined in" <+> ppModule m) mdl@@ -684,9 +666,7 @@ -> [PseudoFamilyDecl DocNameI] -> [Html] ppInstanceAssocTys links splice unicode qual =- map ppFamilyDecl'- where- ppFamilyDecl' = ppPseudoFamilyDecl links splice unicode qual+ map (\pseudo -> ppPseudoFamDecl links splice pseudo unicode qual) ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification@@ -1060,10 +1040,12 @@ -- | Print the LHS of a data\/newtype declaration. -- Currently doesn't handle 'data instance' decls or kind signatures ppDataHeader :: Bool -> TyClDecl DocNameI -> Unicode -> Qualification -> Html-ppDataHeader summary decl@(DataDecl { tcdDataDefn =- HsDataDefn { dd_ND = nd- , dd_ctxt = ctxt- , dd_kindSig = ks } })+ppDataHeader summary (DataDecl { tcdDataDefn =+ HsDataDefn { dd_ND = nd+ , dd_ctxt = ctxt+ , dd_kindSig = ks }+ , tcdLName = L _ name+ , tcdTyVars = tvs }) unicode qual = -- newtype or data (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" })@@ -1071,7 +1053,7 @@ -- context ppLContext ctxt unicode qual HideEmptyContexts <+> -- T a b c ..., or a :+: b- ppDataBinderWithVars summary unicode qual decl+ ppAppDocNameTyVarBndrs summary unicode qual name (hsQTvExplicit tvs) <+> case ks of Nothing -> mempty Just (L _ x) -> dcolon unicode <+> ppKind unicode qual x@@ -1120,7 +1102,7 @@ ppHsTyVarBndr unicode qual (KindedTyVar _ name kind) = parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+> ppLKind unicode qual kind)-ppHsTyVarBndr _ _ (XTyVarBndr _) = error "haddock:ppHsTyVarBndr"+ppHsTyVarBndr _ _ (XTyVarBndr _) = panic "haddock:ppHsTyVarBndr" ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html ppLKind unicode qual y = ppKind unicode qual (unLoc y)
src/Haddock/Interface.hs view
@@ -84,6 +84,7 @@ processModules verbosity modules flags extIfaces = do #if defined(mingw32_HOST_OS) -- Avoid internal error: <stderr>: hPutChar: invalid argument (invalid character)' non UTF-8 Windows+ liftIO $ hSetEncoding stdout $ mkLocaleEncoding TransliterateCodingFailure liftIO $ hSetEncoding stderr $ mkLocaleEncoding TransliterateCodingFailure #endif