From 9f2d1b933897a6330e5c8f9fa904e56ab40050ef Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sat, 4 Aug 2018 11:51:30 -0400 Subject: Latex type families (#734) * Support for type families in LaTeX The code is ported over from the XHTML backend. * Refactor XHTML and LaTeX family handling This is mostly a consolidation effort: stripping extra exports, inlining some short definitions, and trying to make the backends match. The LaTeX backend now has preliminary support for data families, although the only the data instance head is printed (not the actual constructors). Both backends also now use "newtype" for newtype data family instances. * Add some tests --- haddock-api/src/Haddock/Backends/LaTeX.hs | 131 ++++++++++++--- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 222 ++++++++++++------------- 2 files changed, 209 insertions(+), 144 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 4a3e9d03..4e0e6eba 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -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 @@ ppDecl :: LHsDecl DocNameI -- ^ decl to print -> 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 @@ ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of 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 @@ -316,6 +309,83 @@ ppFor _ _ _ = error "ppFor error in Haddock.Backends.LaTeX" -- error "foreign declarations are currently not supported by --latex" +------------------------------------------------------------------------------- +-- * 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 @@ ppClassDecl instances doc subdocs | 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 @@ ppDocInstance unicode (instHead, doc, _, _) = 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 @@ ppDataDecl pats instances subdocs doc dataDecl unicode = 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,6 +894,12 @@ ppDataHeader _ _ = error "ppDataHeader: illegal argument" -- * 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 @@ -917,6 +994,12 @@ 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 +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 (HsParTy _ ty) unicode 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) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index cc271fef..12e65716 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -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 @@ ppDecl :: Bool -- ^ print summary info only -> 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 @@ ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdoc 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,9 +220,6 @@ ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge 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)] @@ -283,111 +278,111 @@ ppSimpleSig links splice unicode qual emptyCtxts loc names typ = -------------------------------------------------------------------------------- -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" -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 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 + ] + +-- | 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" -------------------------------------------------------------------------------- @@ -399,24 +394,9 @@ ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocNameI -> [(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 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) m , 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 @@ ppInstanceAssocTys :: LinksInfo -> Splice -> Unicode -> Qualification -> [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 @@ ppSideBySidePat fixities unicode qual lnames typ (doc, argDocs) = -- | 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 @@ ppDataHeader summary decl@(DataDecl { tcdDataDefn = -- 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 _ qual (UserTyVar _ (L _ name)) = 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) -- cgit v1.2.3 From b21c806740fd41e3fd25e17edc412aa69825611d Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Tue, 16 Oct 2018 17:42:05 -0700 Subject: Output pattern synonyms in Hoogle backend (#947) * Output pattern synonyms in Hoogle backend We were previously weren't outputting _any_ pattern synonyms, bundled or not. Now, we output both. Fixes #946. * Update changelog --- CHANGES.md | 2 ++ haddock-api/src/Haddock/Backends/Hoogle.hs | 21 +++++++++++++-------- hoogle-test/ref/Bug946/test.txt | 19 +++++++++++++++++++ hoogle-test/src/Bug946/Bug946.hs | 16 ++++++++++++++++ 4 files changed, 50 insertions(+), 8 deletions(-) create mode 100644 hoogle-test/ref/Bug946/test.txt create mode 100644 hoogle-test/src/Bug946/Bug946.hs (limited to 'haddock-api/src/Haddock') diff --git a/CHANGES.md b/CHANGES.md index c1801716..7ed90cdc 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,8 @@ * Support type and data families in the LaTeX backend (#734) + * Support pattern synonyms in the Hoogle backend (#947) + ## Changes in version 2.21.0 * Overhaul handling of data declarations in XHTML and LaTeX. Adds support for diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 885c608b..5f77c38c 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -122,10 +122,14 @@ commaSeparate dflags = showSDocUnqual dflags . interpp'SP 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 dflags ExportDecl { expItemDecl = L _ decl 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 [] diff --git a/hoogle-test/ref/Bug946/test.txt b/hoogle-test/ref/Bug946/test.txt new file mode 100644 index 00000000..ff63a766 --- /dev/null +++ b/hoogle-test/ref/Bug946/test.txt @@ -0,0 +1,19 @@ +-- Hoogle documentation, generated by Haddock +-- See Hoogle, http://www.haskell.org/hoogle/ + +@package test +@version 0.0.0 + +module Bug946 + +-- | A wrapper around Int +data AnInt + +-- | some Int +AnInt :: Int -> AnInt + +-- | The Int 0 +pattern Zero :: AnInt + +-- | The double 2.5 +pattern TwoPointFive :: Double diff --git a/hoogle-test/src/Bug946/Bug946.hs b/hoogle-test/src/Bug946/Bug946.hs new file mode 100644 index 00000000..606b5ac4 --- /dev/null +++ b/hoogle-test/src/Bug946/Bug946.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} +module Bug946 ( + AnInt(AnInt, Zero), + pattern TwoPointFive, +) where + +-- | A wrapper around 'Int' +data AnInt = AnInt Int -- ^ some 'Int' + +-- | The 'Int' 0 +pattern Zero :: AnInt +pattern Zero = AnInt 0 + +-- | The double 2.5 +pattern TwoPointFive :: Double +pattern TwoPointFive = 2.5 -- cgit v1.2.3 From 3d52abbce02de506f6ca01a7b23bd5e2f7c9cc59 Mon Sep 17 00:00:00 2001 From: NunoAlexandre Date: Tue, 26 Dec 2017 17:53:44 +0100 Subject: Include custom font in the html head --- haddock-api/src/Haddock/Backends/Xhtml.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 6da6a2e8..41c11361 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -124,14 +124,15 @@ headHtml docTitle themes mathjax_url = meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"], thetitle << docTitle, styleSheet themes, + thelink ! [ rel "stylesheet", thetype "text/css", href fontUrl] << noHtml, thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << noHtml, script ! [src haddockJsFile, emptyAttr "async", thetype "text/javascript"] << noHtml, script ! [src mjUrl, thetype "text/javascript"] << noHtml ] where + fontUrl = "https://fonts.googleapis.com/css?family=Merriweather+Sans:300,300i,400,700" mjUrl = maybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url - srcButton :: SourceURLs -> Maybe Interface -> Maybe Html srcButton (Just src_base_url, _, _, _) Nothing = Just (anchor ! [href src_base_url] << "Source") -- cgit v1.2.3 From 1c1c4001cf7d2167e545d88bd58f97a71778621b Mon Sep 17 00:00:00 2001 From: NunoAlexandre Date: Tue, 26 Dec 2017 21:23:49 +0100 Subject: Update html test reference files --- haddock-api/resources/html/NewOcean.std-theme/new-ocean.css | 3 +-- haddock-api/src/Haddock/Backends/Xhtml.hs | 2 +- html-test/ref/A.html | 3 ++- html-test/ref/B.html | 3 ++- html-test/ref/Bold.html | 1 + html-test/ref/Bug1.html | 1 + html-test/ref/Bug195.html | 1 + html-test/ref/Bug2.html | 1 + html-test/ref/Bug201.html | 1 + html-test/ref/Bug253.html | 1 + html-test/ref/Bug26.html | 1 + html-test/ref/Bug280.html | 1 + html-test/ref/Bug294.html | 1 + html-test/ref/Bug298.html | 1 + html-test/ref/Bug3.html | 1 + html-test/ref/Bug308.html | 1 + html-test/ref/Bug308CrossModule.html | 1 + html-test/ref/Bug310.html | 1 + html-test/ref/Bug313.html | 1 + html-test/ref/Bug335.html | 1 + html-test/ref/Bug387.html | 1 + html-test/ref/Bug4.html | 1 + html-test/ref/Bug546.html | 1 + html-test/ref/Bug548.html | 1 + html-test/ref/Bug6.html | 1 + html-test/ref/Bug613.html | 1 + html-test/ref/Bug647.html | 1 + html-test/ref/Bug7.html | 1 + html-test/ref/Bug8.html | 1 + html-test/ref/Bug85.html | 1 + html-test/ref/BugDeprecated.html | 1 + html-test/ref/BugExportHeadings.html | 1 + html-test/ref/Bugs.html | 1 + html-test/ref/BundledPatterns.html | 1 + html-test/ref/BundledPatterns2.html | 1 + html-test/ref/ConstructorPatternExport.html | 1 + html-test/ref/DeprecatedClass.html | 1 + html-test/ref/DeprecatedData.html | 1 + html-test/ref/DeprecatedFunction.html | 1 + html-test/ref/DeprecatedFunction2.html | 1 + html-test/ref/DeprecatedFunction3.html | 1 + html-test/ref/DeprecatedModule.html | 1 + html-test/ref/DeprecatedModule2.html | 1 + html-test/ref/DeprecatedNewtype.html | 1 + html-test/ref/DeprecatedReExport.html | 1 + html-test/ref/DeprecatedRecord.html | 1 + html-test/ref/DeprecatedTypeFamily.html | 1 + html-test/ref/DeprecatedTypeSynonym.html | 1 + html-test/ref/DuplicateRecordFields.html | 1 + html-test/ref/Examples.html | 1 + html-test/ref/Extensions.html | 1 + html-test/ref/FunArgs.html | 1 + html-test/ref/GADTRecords.html | 1 + html-test/ref/Hash.html | 1 + html-test/ref/HiddenInstances.html | 1 + html-test/ref/HiddenInstancesB.html | 1 + html-test/ref/Hyperlinks.html | 1 + html-test/ref/IgnoreExports.html | 1 + html-test/ref/ImplicitParams.html | 1 + html-test/ref/Instances.html | 1 + html-test/ref/Math.html | 1 + html-test/ref/Minimal.html | 1 + html-test/ref/ModuleWithWarning.html | 1 + html-test/ref/NamedDoc.html | 1 + html-test/ref/Nesting.html | 1 + html-test/ref/NoLayout.html | 1 + html-test/ref/NonGreedy.html | 1 + html-test/ref/Operators.html | 1 + html-test/ref/OrphanInstances.html | 1 + html-test/ref/OrphanInstancesClass.html | 1 + html-test/ref/OrphanInstancesType.html | 1 + html-test/ref/PR643.html | 1 + html-test/ref/PR643_1.html | 1 + html-test/ref/PatternSyns.html | 1 + html-test/ref/PromotedTypes.html | 1 + html-test/ref/Properties.html | 1 + html-test/ref/PruneWithWarning.html | 1 + html-test/ref/QuasiExpr.html | 1 + html-test/ref/QuasiQuote.html | 1 + html-test/ref/SpuriousSuperclassConstraints.html | 1 + html-test/ref/TH.html | 1 + html-test/ref/TH2.html | 1 + html-test/ref/Table.html | 1 + html-test/ref/Test.html | 1 + html-test/ref/Threaded.html | 1 + html-test/ref/Threaded_TH.html | 1 + html-test/ref/Ticket112.html | 1 + html-test/ref/Ticket61.html | 1 + html-test/ref/Ticket75.html | 1 + html-test/ref/TitledPicture.html | 1 + html-test/ref/TypeFamilies.html | 1 + html-test/ref/TypeFamilies2.html | 1 + html-test/ref/TypeOperators.html | 1 + html-test/ref/Unicode.html | 1 + html-test/ref/Visible.html | 1 + 95 files changed, 97 insertions(+), 5 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css b/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css index 6c4357b0..f1523143 100644 --- a/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css +++ b/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css @@ -142,8 +142,7 @@ ul.links { text-align: left; float: right; display: inline-table; - margin: 0 0 0 1em; - margin-right: 22vw; + margin: 0 22vw 0 1em; } ul.links li { diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 41c11361..0264b7f7 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -124,8 +124,8 @@ headHtml docTitle themes mathjax_url = meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"], thetitle << docTitle, styleSheet themes, - thelink ! [ rel "stylesheet", thetype "text/css", href fontUrl] << noHtml, thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << noHtml, + thelink ! [ rel "stylesheet", thetype "text/css", href fontUrl] << noHtml, script ! [src haddockJsFile, emptyAttr "async", thetype "text/javascript"] << noHtml, script ! [src mjUrl, thetype "text/javascript"] << noHtml ] diff --git a/html-test/ref/A.html b/html-test/ref/A.html index e4802966..537a7bac 100644 --- a/html-test/ref/A.html +++ b/html-test/ref/A.html @@ -4,6 +4,7 @@ />A \ No newline at end of file +> diff --git a/html-test/ref/B.html b/html-test/ref/B.html index 12d8e907..1d7d436c 100644 --- a/html-test/ref/B.html +++ b/html-test/ref/B.html @@ -4,6 +4,7 @@ />B \ No newline at end of file +> diff --git a/html-test/ref/Bold.html b/html-test/ref/Bold.html index 112d7aca..276e7b23 100644 --- a/html-test/ref/Bold.html +++ b/html-test/ref/Bold.html @@ -4,6 +4,7 @@ />BoldBug1Bug195Bug2Bug201Bug253Bug26Bug280Bug294Bug298Bug3Bug308Bug308CrossModuleBug310Bug313Bug335Bug387Bug4Bug546Bug548Bug6Bug613Bug647Bug7Bug8Bug85BugDeprecatedBugExportHeadingsBugsBundledPatternsBundledPatterns2ConstructorPatternExportDeprecatedClassDeprecatedDataDeprecatedFunctionDeprecatedFunction2DeprecatedFunction3DeprecatedModuleDeprecatedModule2DeprecatedNewtypeDeprecatedReExportDeprecatedRecordDeprecatedTypeFamilyDeprecatedTypeSynonymDuplicateRecordFieldsExamplesExtensionsFunArgsGADTRecordsHashHiddenInstancesHiddenInstancesBHyperlinksIgnoreExportsImplicitParamsInstancesMathMinimalModuleWithWarningNamedDocNestingNoLayoutNonGreedyOperatorsOrphanInstancesOrphanInstancesClassOrphanInstancesTypePR643PR643_1PatternSynsPromotedTypesPropertiesPruneWithWarningQuasiExprQuasiQuoteSpuriousSuperclassConstraintsTHTH2TableTestThreadedThreaded_THTicket112Ticket61Ticket75TitledPictureTypeFamiliesTypeFamilies2TypeOperatorsUnicodeVisible Date: Sat, 3 Feb 2018 21:39:30 +0100 Subject: Make the style consistent with hackage Several things are addressed here: - better responsive behaviour on the header - better space usage - consistent colors overall - other nit PR comments --- .../html/NewOcean.std-theme/new-ocean.css | 106 ++++++++++++--------- haddock-api/src/Haddock/Backends/Xhtml.hs | 4 +- haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 4 +- 3 files changed, 66 insertions(+), 48 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css b/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css index 4191c8b0..8a7fdf97 100644 --- a/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css +++ b/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css @@ -37,8 +37,8 @@ dd { } a { text-decoration: none; } -a[href]:link { color: rgb(196,69,29); } -a[href]:visited { color: rgb(171,105,84); } +a[href]:link {color: #9C5791;} +a[href]:visited {color: #5E3558;} a[href]:hover { text-decoration:underline; } a[href].def:link, a[href].def:visited { color: rgba(69, 59, 97, 0.8); } @@ -57,45 +57,68 @@ body.js-enabled .hide-when-js-enabled { /* @group responsive */ -@media only screen and (min-width: 950px) { - #page-header { - text-align: left; - text-align: left; - } +#package-header .caption { + margin: 0px 1em 0 2em; +} +@media only screen and (min-width: 1280px) { #content { width: 60vw; + max-width: 1450px; + min-width: 830px; } +} - #package-header .caption { - margin: 0 0 0 20vw; +@media only screen and (max-width: 1280px) { + #content { + width: 75vw; } +} - ul.links { - margin: 0px 20vw 0 0; +@media only screen and (max-width: 950px) { + #content { + width: 88vw; } - } -@media only screen and (max-width: 950px) { - #page-header { - text-align: center; + +/* menu for wider screens + + Display the package name at the left and the menu links at the right, + inline with each other: + The package name Source . Contents . Index +*/ +@media only screen and (min-width: 1000px) { + #package-header .caption { + display: inline-block; + margin: 3px 1em 2px 2em; } - #content { - width: 80vw; + #package-header ul.links { + float: right; + margin: 3px 2em 2px 1em; } +} +/* menu for smaller screens + +Display the package name on top of the menu links and center both elements: + The package name + Source . Contents . Index +*/ +@media only screen and (max-width: 1000px) { #package-header .caption { - margin: 0 0 0 10vw; + display: block; + margin: 4px 0; + text-align: center; } - ul.links { - margin: 0px 10vw 0 0; + #package-header ul.links { + float: none; + text-align: center; + margin: 0.6em 0 0 0; } -} -@media only screen and (max-width: 500px) { #module-header table.info { float: none; top: 0; @@ -107,6 +130,7 @@ body.js-enabled .hide-when-js-enabled { /* @end */ + /* @group Fonts & Sizes */ /* Basic technique & IE workarounds from YUI 3 @@ -115,7 +139,7 @@ body.js-enabled .hide-when-js-enabled { */ body { - font: 300 13px/1.85 "Merriweather Sans", sans-serif; + font: 400 16px/1.6 'Open Sans', sans-serif; *font-size:small; /* for IE */ *font:x-small; /* for IE in quirks mode */ } @@ -150,18 +174,17 @@ pre, code, kbd, samp, tt, .src { } #module-header .caption sup { - font-size: 70%; + font-size: 80%; font-weight: normal; } +#package-header #page-menu a:link, #package-header #page-menu a:visited { color: white; } + + .info { font-size: 85%; /* 11pt */ } -#table-of-contents, #synopsis { - /* font-size: 85%; /* 11pt */ -} - /* @end */ @@ -169,11 +192,11 @@ pre, code, kbd, samp, tt, .src { .caption, h1, h2, h3, h4, h5, h6, summary { font-weight: bold; - color: rgb(78,98,114); - color: rgb(142, 80, 132); + color: #5E5184; margin: 2em 0 1em 0; } + * + h1, * + h2, * + h3, * + h4, * + h5, * + h6 { margin-top: 2em; } @@ -190,15 +213,10 @@ ul + p { margin-top: 2em; } -ul.links, #package-header p.caption { - padding-top: 3px; -} - ul.links { list-style: none; text-align: left; - float: right; - font-size: 13px; + font-size: 1em; } ul.links li { @@ -258,7 +276,7 @@ details[open] > summary { pre { padding: 17px; margin: 1em 0 2em 0; - background-color: rgba(0, 0, 0, .025); + background-color: rgba(0, 0, 0, .033); overflow: auto; border-bottom: 0.25em solid white; /* white border adds some space below the box to compensate @@ -291,22 +309,21 @@ pre { background: rgb(94, 81, 132); border-bottom: 5px solid rgba(69, 59, 97, 0.5); color: #ddd; - padding: 8px 0; + padding: 0.6em 0 0.2em 0; position: relative; text-align: left; margin: 0 auto; + overflow: hidden; } #package-header .caption { - background: url(hslogo-16.png) no-repeat 0em; color: white; - font-weight: normal; font-style: normal; - padding-left: 35px; + font-size: 1.1rem; + font-weight: bold; } #module-header .caption { - color: rgb(94, 81, 132); font-weight: bold; border-bottom: 1px solid #ddd; } @@ -414,11 +431,12 @@ div#style-menu-holder { #synopsis { display: block; position: fixed; - right: 0; height: 80%; - top: 10%; + top: 9vh; + right: 10px; padding: 0; max-width: 75%; + z-index: 1; /* Ensure that synopsis covers everything (including MathJAX markup) */ z-index: 1; } diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 0264b7f7..6f1f1f60 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -130,8 +130,8 @@ headHtml docTitle themes mathjax_url = script ! [src mjUrl, thetype "text/javascript"] << noHtml ] where - fontUrl = "https://fonts.googleapis.com/css?family=Merriweather+Sans:300,300i,400,700" - mjUrl = maybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url + fontUrl = "https://fonts.googleapis.com/css?family=Open+Sans:400,400i,700" + mjUrl = fromMaybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" mathjax_url srcButton :: SourceURLs -> Maybe Interface -> Maybe Html srcButton (Just src_base_url, _, _, _) Nothing = diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index 1c44ffda..bdf989ed 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -74,8 +74,8 @@ sectionName = paragraph ! [theclass "caption"] -- If it would have otherwise been empty, then give it the class ".empty". nonEmptySectionName :: Html -> Html nonEmptySectionName c - | isNoHtml c = paragraph ! [theclass "caption empty"] $ spaceHtml - | otherwise = paragraph ! [theclass "caption"] $ c + | isNoHtml c = thediv ! [theclass "caption empty"] $ spaceHtml + | otherwise = thediv ! [theclass "caption"] $ c divPackageHeader, divContent, divModuleHeader, divFooter, -- cgit v1.2.3 From 1861ff90dbe652c22f0dcd220d2f15dd6cfdfefb Mon Sep 17 00:00:00 2001 From: Nuno Alexandre Date: Sun, 4 Feb 2018 12:51:30 +0100 Subject: Place the package name before the menu links This supports the expected responsive menu design, where the package name appears above the menu links. --- haddock-api/src/Haddock/Backends/Xhtml.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 6f1f1f60..e4a0137e 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -178,13 +178,13 @@ bodyHtml doctitle iface pageContent = body << [ divPackageHeader << [ + nonEmptySectionName << doctitle, unordList (catMaybes [ srcButton maybe_source_url iface, wikiButton maybe_wiki_url (ifaceMod <$> iface), contentsButton maybe_contents_url, indexButton maybe_index_url]) - ! [theclass "links", identifier "page-menu"], - nonEmptySectionName << doctitle + ! [theclass "links", identifier "page-menu"] ], divContent << pageContent, divFooter << paragraph << ( -- cgit v1.2.3 From 0cf790508a608ee9137a9b3e68e00a3157da760b Mon Sep 17 00:00:00 2001 From: Nuno Alexandre Date: Mon, 5 Feb 2018 21:35:22 +0100 Subject: Add an initial-scale property to all haddock pages This solves an issue reported about the content looking incredibly small on mobile devices. --- haddock-api/src/Haddock/Backends/Xhtml.hs | 5 +++-- html-test/ref/A.html | 1 + html-test/ref/B.html | 1 + html-test/ref/Bold.html | 1 + html-test/ref/Bug1.html | 1 + html-test/ref/Bug195.html | 1 + html-test/ref/Bug2.html | 1 + html-test/ref/Bug201.html | 1 + html-test/ref/Bug253.html | 1 + html-test/ref/Bug26.html | 1 + html-test/ref/Bug280.html | 1 + html-test/ref/Bug294.html | 1 + html-test/ref/Bug298.html | 1 + html-test/ref/Bug3.html | 1 + html-test/ref/Bug308.html | 1 + html-test/ref/Bug308CrossModule.html | 1 + html-test/ref/Bug310.html | 1 + html-test/ref/Bug313.html | 1 + html-test/ref/Bug335.html | 1 + html-test/ref/Bug387.html | 1 + html-test/ref/Bug4.html | 1 + html-test/ref/Bug546.html | 1 + html-test/ref/Bug548.html | 1 + html-test/ref/Bug6.html | 1 + html-test/ref/Bug613.html | 1 + html-test/ref/Bug647.html | 1 + html-test/ref/Bug679.html | 1 + html-test/ref/Bug7.html | 1 + html-test/ref/Bug8.html | 1 + html-test/ref/Bug85.html | 1 + html-test/ref/BugDeprecated.html | 1 + html-test/ref/BugExportHeadings.html | 1 + html-test/ref/Bugs.html | 1 + html-test/ref/BundledPatterns.html | 1 + html-test/ref/BundledPatterns2.html | 1 + html-test/ref/ConstructorPatternExport.html | 1 + html-test/ref/DeprecatedClass.html | 1 + html-test/ref/DeprecatedData.html | 1 + html-test/ref/DeprecatedFunction.html | 1 + html-test/ref/DeprecatedFunction2.html | 1 + html-test/ref/DeprecatedFunction3.html | 1 + html-test/ref/DeprecatedModule.html | 1 + html-test/ref/DeprecatedModule2.html | 1 + html-test/ref/DeprecatedNewtype.html | 1 + html-test/ref/DeprecatedReExport.html | 1 + html-test/ref/DeprecatedRecord.html | 1 + html-test/ref/DeprecatedTypeFamily.html | 1 + html-test/ref/DeprecatedTypeSynonym.html | 1 + html-test/ref/DuplicateRecordFields.html | 1 + html-test/ref/Examples.html | 1 + html-test/ref/Extensions.html | 1 + html-test/ref/FunArgs.html | 1 + html-test/ref/GADTRecords.html | 1 + html-test/ref/Hash.html | 1 + html-test/ref/HiddenInstances.html | 1 + html-test/ref/HiddenInstancesB.html | 1 + html-test/ref/Hyperlinks.html | 1 + html-test/ref/IgnoreExports.html | 1 + html-test/ref/ImplicitParams.html | 1 + html-test/ref/Instances.html | 1 + html-test/ref/Math.html | 1 + html-test/ref/Minimal.html | 1 + html-test/ref/ModuleWithWarning.html | 1 + html-test/ref/NamedDoc.html | 1 + html-test/ref/Nesting.html | 1 + html-test/ref/NoLayout.html | 1 + html-test/ref/NonGreedy.html | 1 + html-test/ref/Operators.html | 1 + html-test/ref/OrphanInstances.html | 1 + html-test/ref/OrphanInstancesClass.html | 1 + html-test/ref/OrphanInstancesType.html | 1 + html-test/ref/PR643.html | 1 + html-test/ref/PR643_1.html | 1 + html-test/ref/PatternSyns.html | 1 + html-test/ref/PromotedTypes.html | 1 + html-test/ref/Properties.html | 1 + html-test/ref/PruneWithWarning.html | 1 + html-test/ref/QuasiExpr.html | 1 + html-test/ref/QuasiQuote.html | 1 + html-test/ref/SpuriousSuperclassConstraints.html | 1 + html-test/ref/TH.html | 1 + html-test/ref/TH2.html | 1 + html-test/ref/Table.html | 1 + html-test/ref/Test.html | 1 + html-test/ref/Threaded.html | 1 + html-test/ref/Threaded_TH.html | 1 + html-test/ref/Ticket112.html | 1 + html-test/ref/Ticket61.html | 1 + html-test/ref/Ticket75.html | 1 + html-test/ref/TitledPicture.html | 1 + html-test/ref/TypeFamilies.html | 1 + html-test/ref/TypeFamilies2.html | 1 + html-test/ref/TypeOperators.html | 1 + html-test/ref/Unicode.html | 1 + html-test/ref/Visible.html | 1 + 95 files changed, 97 insertions(+), 2 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index e4a0137e..f589e4c9 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -32,7 +32,7 @@ import Haddock.Types import Haddock.Version import Haddock.Utils import Haddock.Utils.Json -import Text.XHtml hiding ( name, title, p, quote ) +import Text.XHtml hiding ( title, p, quote ) import Haddock.GhcUtils import Control.Monad ( when, unless ) @@ -121,7 +121,8 @@ copyHtmlBits odir libdir themes withQuickjump = do headHtml :: String -> Themes -> Maybe String -> Html headHtml docTitle themes mathjax_url = header << [ - meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"], + meta ! [ httpequiv "Content-Type", content "text/html; charset=UTF-8"], + meta ! [ name "viewport", content "width=device-width, initial-scale=1"], thetitle << docTitle, styleSheet themes, thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << noHtml, diff --git a/html-test/ref/A.html b/html-test/ref/A.html index 9e41e154..31885479 100644 --- a/html-test/ref/A.html +++ b/html-test/ref/A.html @@ -1,6 +1,7 @@ ABBoldBug1Bug195Bug2Bug201Bug253Bug26Bug280Bug294Bug298Bug3Bug308Bug308CrossModuleBug310Bug313Bug335Bug387Bug4Bug546Bug548Bug6Bug613Bug647Bug679Bug7Bug8Bug85BugDeprecatedBugExportHeadingsBugsBundledPatternsBundledPatterns2ConstructorPatternExportDeprecatedClassDeprecatedDataDeprecatedFunctionDeprecatedFunction2DeprecatedFunction3DeprecatedModuleDeprecatedModule2DeprecatedNewtypeDeprecatedReExportDeprecatedRecordDeprecatedTypeFamilyDeprecatedTypeSynonymDuplicateRecordFieldsExamplesExtensionsFunArgsGADTRecordsHashHiddenInstancesHiddenInstancesBHyperlinksIgnoreExportsImplicitParamsInstancesMathMinimalModuleWithWarningNamedDocNestingNoLayoutNonGreedyOperatorsOrphanInstancesOrphanInstancesClassOrphanInstancesTypePR643PR643_1PatternSynsPromotedTypesPropertiesPruneWithWarningQuasiExprQuasiQuoteSpuriousSuperclassConstraintsTHTH2TableTestThreadedThreaded_THTicket112Ticket61Ticket75TitledPictureTypeFamiliesTypeFamilies2TypeOperatorsUnicodeVisible Date: Wed, 21 Mar 2018 11:46:45 +0100 Subject: Avoid name shadowing --- haddock-api/src/Haddock/Backends/Xhtml.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index f589e4c9..f46c47f0 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -32,7 +32,8 @@ import Haddock.Types import Haddock.Version import Haddock.Utils import Haddock.Utils.Json -import Text.XHtml hiding ( title, p, quote ) +import Text.XHtml hiding ( name, title, p, quote ) +import qualified Text.XHtml as XHtml import Haddock.GhcUtils import Control.Monad ( when, unless ) @@ -122,7 +123,7 @@ headHtml :: String -> Themes -> Maybe String -> Html headHtml docTitle themes mathjax_url = header << [ meta ! [ httpequiv "Content-Type", content "text/html; charset=UTF-8"], - meta ! [ name "viewport", content "width=device-width, initial-scale=1"], + meta ! [ XHtml.name "viewport", content "width=device-width, initial-scale=1"], thetitle << docTitle, styleSheet themes, thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << noHtml, -- cgit v1.2.3 From 304e241f557e68222a33e1ba0be66aef32b95143 Mon Sep 17 00:00:00 2001 From: Nuno Alexandre Date: Sat, 14 Apr 2018 14:16:51 +0200 Subject: Update font in Xhtml.hs to PT Sans --- haddock-api/src/Haddock/Backends/Xhtml.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index f46c47f0..2b8bdd69 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -132,7 +132,7 @@ headHtml docTitle themes mathjax_url = script ! [src mjUrl, thetype "text/javascript"] << noHtml ] where - fontUrl = "https://fonts.googleapis.com/css?family=Open+Sans:400,400i,700" + fontUrl = "https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700" mjUrl = fromMaybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" mathjax_url srcButton :: SourceURLs -> Maybe Interface -> Maybe Html -- cgit v1.2.3 From 365c77dfc39a28e4b5fd7eaeb802edcc9df196f4 Mon Sep 17 00:00:00 2001 From: Nuno Alexandre Date: Sat, 21 Apr 2018 16:25:56 +0200 Subject: Make package-header caption backward-compatible The current html generator of this branch wraps the package-header caption as a div, which does not work (without style adjustments) with the old themes. Changing it from div to span does the trick, without needing to adjust the old stylesheets. --- haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index bdf989ed..10a6d499 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -74,8 +74,8 @@ sectionName = paragraph ! [theclass "caption"] -- If it would have otherwise been empty, then give it the class ".empty". nonEmptySectionName :: Html -> Html nonEmptySectionName c - | isNoHtml c = thediv ! [theclass "caption empty"] $ spaceHtml - | otherwise = thediv ! [theclass "caption"] $ c + | isNoHtml c = thespan ! [theclass "caption empty"] $ spaceHtml + | otherwise = thespan ! [theclass "caption"] $ c divPackageHeader, divContent, divModuleHeader, divFooter, -- cgit v1.2.3 From b4b68d73df3485f3b0ea59c6170805788a09c593 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Tue, 23 Oct 2018 11:29:14 +0200 Subject: Fix typo in a warning --- haddock-api/src/Haddock/Interface/LexParseRn.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index 87face7c..b6913012 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -165,8 +165,7 @@ outOfScope dflags x = where warnAndMonospace a = do tell ["Warning: '" ++ showPpr dflags a ++ "' is out of scope.\n" ++ - " If you qualify the identifier, haddock can try to link it\n" ++ - " it anyway."] + " If you qualify the identifier, haddock can try to link it anyway."] pure (monospaced a) monospaced a = DocMonospaced (DocString (showPpr dflags a)) -- cgit v1.2.3 From cd520e9907b9a56cae5a2e51413eef1522a37bbb Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Thu, 25 Oct 2018 20:16:46 -0700 Subject: Avoid more conflicts in generated ids (#954) This fixes #953 by passing more names into the generated ids. --- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 16 ++- html-test/ref/Bug953.html | 146 +++++++++++++++++++++++++ html-test/src/Bug953.hs | 17 +++ 3 files changed, 173 insertions(+), 6 deletions(-) create mode 100644 html-test/ref/Bug953.html create mode 100644 html-test/src/Bug953.hs (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 12e65716..9df6acc0 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -122,12 +122,12 @@ ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocNameI ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode pkg qual emptyCtxts | summary = pref1 - | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curName pkg qual doc + | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curname pkg qual doc | otherwise = topDeclElem links loc splice docnames pref2 +++ subArguments pkg qual (ppSubSigLike unicode qual typ argDocs [] sep emptyCtxts) - +++ docSection curName pkg qual doc + +++ docSection curname pkg qual doc where - curName = getName <$> listToMaybe docnames + curname = getName <$> listToMaybe docnames -- This splits up a type signature along `->` and adds docs (when they exist) to @@ -290,10 +290,11 @@ ppFamDecl :: Bool -- ^ is a summary -> 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 + | otherwise = header_ +++ docSection curname pkg qual doc +++ instancesBit where docname = unLoc $ fdLName decl + curname = Just $ getName docname header_ = topDeclElem links loc splice [docname] $ ppFamHeader summary associated decl unicode qual <+> ppFixities fixities qual @@ -528,9 +529,11 @@ ppClassDecl summary links instances fixities loc d subdocs , tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats }) splice unicode pkg qual | summary = ppShortClassDecl summary links decl loc subdocs splice unicode pkg qual - | otherwise = classheader +++ docSection Nothing pkg qual d + | otherwise = classheader +++ docSection curname pkg qual d +++ minimalBit +++ atBit +++ methodBit +++ instancesBit where + curname = Just $ getName nm + sigs = map unLoc lsigs classheader @@ -759,10 +762,11 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats splice unicode pkg qual | summary = ppShortDataDecl summary False dataDecl pats unicode qual - | otherwise = header_ +++ docSection Nothing pkg qual doc +++ constrBit +++ patternBit +++ instancesBit + | otherwise = header_ +++ docSection curname pkg qual doc +++ constrBit +++ patternBit +++ instancesBit where docname = tcdName dataDecl + curname = Just $ getName docname cons = dd_cons (tcdDataDefn dataDecl) isH98 = case unLoc (head cons) of ConDeclH98 {} -> True diff --git a/html-test/ref/Bug953.html b/html-test/ref/Bug953.html new file mode 100644 index 00000000..40b0f6a1 --- /dev/null +++ b/html-test/ref/Bug953.html @@ -0,0 +1,146 @@ +Bug953
Safe HaskellSafe

Bug953

Synopsis

Documentation

data Foo #

A foo

Examples

Expand

Foo example body

Constructors

Foo'

data Bar #

A bar

Examples

Expand

Bar example body

Constructors

Bar'
\ No newline at end of file diff --git a/html-test/src/Bug953.hs b/html-test/src/Bug953.hs new file mode 100644 index 00000000..63f2c45a --- /dev/null +++ b/html-test/src/Bug953.hs @@ -0,0 +1,17 @@ +module Bug953 where + +{- | A foo + +==== __Examples__ + +Foo example body +-} +data Foo = Foo' + +{- | A bar + +==== __Examples__ + +Bar example body +-} +data Bar = Bar' -- cgit v1.2.3 From 2b94a90a23f03a749e3703af330d9585a5de0bae Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Fri, 26 Oct 2018 14:22:23 -0700 Subject: Avoid some partiality AFAICT this wasn't causing any crashes, but that's mostly because we happen not to be forcing `pkgStr` when it would diverge. We come dangerously close to doing that in `ppHtmlIndex`. Fixes #569. --- haddock-api/src/Haddock.hs | 27 +++++++++++++++++---------- haddock-api/src/Haddock/Interface/Create.hs | 2 +- haddock-api/src/Haddock/Options.hs | 5 +++-- 3 files changed, 21 insertions(+), 13 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index dbfba0f4..7a2df3a2 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -268,9 +268,9 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do allIfaces = map toInstalledIface ifaces ++ installedIfaces allVisibleIfaces = [ i | i <- allIfaces, OptHide `notElem` instOptions i ] - pkgMod = ifaceMod (head ifaces) - pkgKey = moduleUnitId pkgMod - pkgStr = Just (unitIdString pkgKey) + pkgMod = fmap ifaceMod (listToMaybe ifaces) + pkgKey = fmap moduleUnitId pkgMod + pkgStr = fmap unitIdString pkgKey pkgNameVer = modulePackageInfo dflags flags pkgMod pkgName = fmap (unpackFS . (\(PackageName n) -> n)) (fst pkgNameVer) sincePkg = case sinceQual of @@ -289,16 +289,22 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do pkgSrcMap = Map.mapKeys moduleUnitId extSrcMap pkgSrcMap' - | Flag_HyperlinkedSource `elem` flags = - Map.insert pkgKey hypSrcModuleNameUrlFormat pkgSrcMap - | Just srcNameUrl <- srcEntity = Map.insert pkgKey srcNameUrl pkgSrcMap + | Flag_HyperlinkedSource `elem` flags + , Just k <- pkgKey + = Map.insert k hypSrcModuleNameUrlFormat pkgSrcMap + | Just srcNameUrl <- srcEntity + , Just k <- pkgKey + = Map.insert k srcNameUrl pkgSrcMap | otherwise = pkgSrcMap -- TODO: Get these from the interface files as with srcMap pkgSrcLMap' - | Flag_HyperlinkedSource `elem` flags = - Map.singleton pkgKey hypSrcModuleLineUrlFormat - | Just path <- srcLEntity = Map.singleton pkgKey path + | Flag_HyperlinkedSource `elem` flags + , Just k <- pkgKey + = Map.singleton k hypSrcModuleLineUrlFormat + | Just path <- srcLEntity + , Just k <- pkgKey + = Map.singleton k path | otherwise = Map.empty sourceUrls' = (srcBase, srcModule', pkgSrcMap', pkgSrcLMap') @@ -375,7 +381,8 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do visibleIfaces odir _ -> putStrLn . unlines $ [ "haddock: Unable to find a package providing module " - ++ moduleNameString (moduleName pkgMod) ++ ", skipping Hoogle." + ++ maybe "" (moduleNameString . moduleName) pkgMod + ++ ", skipping Hoogle." , "" , " Perhaps try specifying the desired package explicitly" ++ " using the --package-name" diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index c4df2090..a4408434 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -85,7 +85,7 @@ createInterface tm flags modMap instIfaceMap = do !instances = modInfoInstances mi !fam_instances = md_fam_insts md !exportedNames = modInfoExportsWithSelectors mi - (pkgNameFS, _) = modulePackageInfo dflags flags mdl + (pkgNameFS, _) = modulePackageInfo dflags flags (Just mdl) pkgName = fmap (unpackFS . (\(PackageName n) -> n)) pkgNameFS (TcGblEnv { tcg_rdr_env = gre diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index b5e987d8..bdc98406 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -371,9 +371,10 @@ modulePackageInfo :: DynFlags -> [Flag] -- ^ Haddock flags are checked as they may contain -- the package name or version provided by the user -- which we prioritise - -> Module + -> Maybe Module -> (Maybe PackageName, Maybe Data.Version.Version) -modulePackageInfo dflags flags modu = +modulePackageInfo _dflags _flags Nothing = (Nothing, Nothing) +modulePackageInfo dflags flags (Just modu) = ( optPackageName flags <|> fmap packageName pkgDb , optPackageVersion flags <|> fmap packageVersion pkgDb ) -- cgit v1.2.3 From 0d9a81e20238a6b72f9f5c005f1f7e9cf05f6fb9 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sat, 27 Oct 2018 10:05:04 -0700 Subject: Fix documentation in `haddock-api` (#957) * Fix misplaced Haddocks in Haddock itself Haddock should be able to generate documentation for 'haddock-api' again. * Make CI check that documentation can be built. * Add back a doc that is OK --- .travis.yml | 3 +++ haddock-api/src/Haddock/Backends/LaTeX.hs | 10 +++++----- 2 files changed, 8 insertions(+), 5 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/.travis.yml b/.travis.yml index 681399b9..35ee528d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -83,6 +83,9 @@ script: # cabal check - cabal check + # Build documentation + - cabal new-haddock -w ${HC} all + # Build without installed constraints for packages in global-db - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 4e0e6eba..613c6deb 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -243,8 +243,8 @@ ppDocGroup lev doc = sec lev <> braces doc -- | Given a declaration, extract out the names being declared declNames :: LHsDecl DocNameI - -> ( LaTeX -- ^ to print before each name in an export list - , [DocName] -- ^ names being declared + -> ( LaTeX -- to print before each name in an export list + , [DocName] -- names being declared ) declNames (L _ decl) = case decl of TyClD _ d -> (empty, [tcdName d]) @@ -444,9 +444,9 @@ ppLPatSig doc docnames ty unicode -- arguments as needed. ppTypeOrFunSig :: HsType DocNameI -> DocForDecl DocName -- ^ documentation - -> ( LaTeX -- ^ first-line (no-argument docs only) - , LaTeX -- ^ first-line (argument docs only) - , LaTeX -- ^ type prefix (argument docs only) + -> ( LaTeX -- first-line (no-argument docs only) + , LaTeX -- first-line (argument docs only) + , LaTeX -- type prefix (argument docs only) ) -> Bool -- ^ unicode -> LaTeX -- cgit v1.2.3 From 8a491e437f1c8379b66a420f8584c1761b45aa7e Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 5 Nov 2018 13:58:11 -0800 Subject: Only run MathJax on entities with "mathjax" class (#960) Correspondingly, we wrap all inline/diplay math in ... the math .... This fixes #959. --- haddock-api/src/Haddock/Backends/Xhtml.hs | 24 ++++++++++++++-------- .../src/Haddock/Backends/Xhtml/DocMarkup.hs | 4 ++-- html-test/ref/A.html | 4 +++- html-test/ref/Bold.html | 4 +++- html-test/ref/Bug1.html | 4 +++- html-test/ref/Bug195.html | 4 +++- html-test/ref/Bug2.html | 4 +++- html-test/ref/Bug201.html | 4 +++- html-test/ref/Bug253.html | 4 +++- html-test/ref/Bug26.html | 4 +++- html-test/ref/Bug280.html | 4 +++- html-test/ref/Bug294.html | 4 +++- html-test/ref/Bug298.html | 4 +++- html-test/ref/Bug3.html | 4 +++- html-test/ref/Bug308.html | 4 +++- html-test/ref/Bug308CrossModule.html | 4 +++- html-test/ref/Bug310.html | 4 +++- html-test/ref/Bug313.html | 4 +++- html-test/ref/Bug335.html | 4 +++- html-test/ref/Bug387.html | 4 +++- html-test/ref/Bug4.html | 4 +++- html-test/ref/Bug458.html | 4 +++- html-test/ref/Bug546.html | 4 +++- html-test/ref/Bug548.html | 4 +++- html-test/ref/Bug574.html | 4 +++- html-test/ref/Bug6.html | 4 +++- html-test/ref/Bug613.html | 4 +++- html-test/ref/Bug647.html | 4 +++- html-test/ref/Bug679.html | 4 +++- html-test/ref/Bug7.html | 4 +++- html-test/ref/Bug8.html | 4 +++- html-test/ref/Bug85.html | 4 +++- html-test/ref/Bug953.html | 4 +++- html-test/ref/BugDeprecated.html | 4 +++- html-test/ref/BugExportHeadings.html | 4 +++- html-test/ref/Bugs.html | 4 +++- html-test/ref/BundledPatterns.html | 4 +++- html-test/ref/BundledPatterns2.html | 4 +++- html-test/ref/ConstructorArgs.html | 4 +++- html-test/ref/ConstructorPatternExport.html | 4 +++- html-test/ref/DeprecatedClass.html | 4 +++- html-test/ref/DeprecatedData.html | 4 +++- html-test/ref/DeprecatedFunction.html | 4 +++- html-test/ref/DeprecatedFunction2.html | 4 +++- html-test/ref/DeprecatedFunction3.html | 4 +++- html-test/ref/DeprecatedModule.html | 4 +++- html-test/ref/DeprecatedModule2.html | 4 +++- html-test/ref/DeprecatedNewtype.html | 4 +++- html-test/ref/DeprecatedReExport.html | 4 +++- html-test/ref/DeprecatedRecord.html | 4 +++- html-test/ref/DeprecatedTypeFamily.html | 4 +++- html-test/ref/DeprecatedTypeSynonym.html | 4 +++- html-test/ref/DuplicateRecordFields.html | 4 +++- html-test/ref/Examples.html | 4 +++- html-test/ref/Extensions.html | 4 +++- html-test/ref/FunArgs.html | 4 +++- html-test/ref/GADTRecords.html | 4 +++- html-test/ref/GadtConstructorArgs.html | 4 +++- html-test/ref/Hash.html | 4 +++- html-test/ref/HiddenInstances.html | 4 +++- html-test/ref/HiddenInstancesB.html | 4 +++- html-test/ref/Hyperlinks.html | 4 +++- html-test/ref/ImplicitParams.html | 4 +++- html-test/ref/Instances.html | 4 +++- html-test/ref/Math.html | 22 ++++++++++++++------ html-test/ref/Minimal.html | 4 +++- html-test/ref/ModuleWithWarning.html | 4 +++- html-test/ref/NamedDoc.html | 4 +++- html-test/ref/Nesting.html | 4 +++- html-test/ref/NoLayout.html | 4 +++- html-test/ref/NonGreedy.html | 4 +++- html-test/ref/Operators.html | 4 +++- html-test/ref/OrphanInstances.html | 4 +++- html-test/ref/OrphanInstancesClass.html | 4 +++- html-test/ref/OrphanInstancesType.html | 4 +++- html-test/ref/PR643.html | 4 +++- html-test/ref/PR643_1.html | 4 +++- html-test/ref/PatternSyns.html | 4 +++- html-test/ref/PromotedTypes.html | 4 +++- html-test/ref/Properties.html | 4 +++- html-test/ref/PruneWithWarning.html | 4 +++- html-test/ref/QuantifiedConstraints.html | 4 +++- html-test/ref/QuasiExpr.html | 4 +++- html-test/ref/QuasiQuote.html | 4 +++- html-test/ref/SpuriousSuperclassConstraints.html | 4 +++- html-test/ref/TH.html | 4 +++- html-test/ref/TH2.html | 4 +++- html-test/ref/Table.html | 10 ++++++--- html-test/ref/Test.html | 4 +++- html-test/ref/Threaded.html | 4 +++- html-test/ref/Threaded_TH.html | 4 +++- html-test/ref/Ticket112.html | 4 +++- html-test/ref/Ticket61.html | 4 +++- html-test/ref/Ticket75.html | 4 +++- html-test/ref/TitledPicture.html | 4 +++- html-test/ref/TypeFamilies.html | 4 +++- html-test/ref/TypeFamilies2.html | 4 +++- html-test/ref/TypeFamilies3.html | 4 +++- html-test/ref/TypeOperators.html | 4 +++- html-test/ref/Unicode.html | 4 +++- html-test/ref/Unicode2.html | 4 +++- html-test/ref/Visible.html | 4 +++- 102 files changed, 334 insertions(+), 118 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 6da6a2e8..0a11ca08 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -120,17 +120,23 @@ copyHtmlBits odir libdir themes withQuickjump = do headHtml :: String -> Themes -> Maybe String -> Html headHtml docTitle themes mathjax_url = - header << [ - meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"], - thetitle << docTitle, - styleSheet themes, - thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << noHtml, - script ! [src haddockJsFile, emptyAttr "async", thetype "text/javascript"] << noHtml, - script ! [src mjUrl, thetype "text/javascript"] << noHtml + header << + [ meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"] + , thetitle << docTitle + , styleSheet themes + , thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << noHtml + , script ! [src haddockJsFile, emptyAttr "async", thetype "text/javascript"] << noHtml + , script ! [thetype "text/x-mathjax-config"] << primHtml mjConf + , script ! [src mjUrl, thetype "text/javascript"] << noHtml ] where - mjUrl = maybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url - + mjUrl = maybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url + mjConf = unwords [ "MathJax.Hub.Config({" + , "tex2jax: {" + , "processClass: \"mathjax\"," + , "ignoreClass: \".*\"" + , "}" + , "});" ] srcButton :: SourceURLs -> Maybe Interface -> Maybe Html srcButton (Just src_base_url, _, _, _) Nothing = diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs index ed323a90..38aa7b7e 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -69,8 +69,8 @@ parHtmlMarkup qual insertAnchors ppId = Markup { then namedAnchor aname << "" else noHtml, markupPic = \(Picture uri t) -> image ! ([src uri] ++ fromMaybe [] (return . title <$> t)), - markupMathInline = \mathjax -> toHtml ("\\(" ++ mathjax ++ "\\)"), - markupMathDisplay = \mathjax -> toHtml ("\\[" ++ mathjax ++ "\\]"), + markupMathInline = \mathjax -> thespan ! [theclass "mathjax"] << toHtml ("\\(" ++ mathjax ++ "\\)"), + markupMathDisplay = \mathjax -> thespan ! [theclass "mathjax"] << toHtml ("\\[" ++ mathjax ++ "\\]"), markupProperty = pre . toHtml, markupExample = examplesToHtml, markupHeader = \(Header l t) -> makeHeader l t, diff --git a/html-test/ref/A.html b/html-test/ref/A.html index e4802966..75fbb9ed 100644 --- a/html-test/ref/A.html +++ b/html-test/ref/A.html @@ -7,7 +7,9 @@ />normalDensity

\[ + >\[ \int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi} - \]

\(\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\)

\(\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\)

Math (inline) for normalDensity - \(\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\) - \[\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\]

\(\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\) + \[\int_{-\infty}^{\infty} e^{-x^2/2} = \sqrt{2\pi}\]

\[ + > \[ f(n) = \sum_{i=1} - \] Date: Wed, 7 Nov 2018 10:22:31 -0800 Subject: Fix issues around plus/minus * swap the minimize unicode to something more intuitive * use new unicode expander/collapser for instance lists * address some alignment issues in the "index" page --- ghc.mk | 3 --- haddock-api/haddock-api.cabal | 3 --- haddock-api/resources/html/NewOcean.std-theme/minus.gif | Bin 56 -> 0 bytes .../resources/html/NewOcean.std-theme/new-ocean.css | 14 ++++++-------- haddock-api/resources/html/NewOcean.std-theme/plus.gif | Bin 59 -> 0 bytes haddock-api/src/Haddock/Backends/Xhtml.hs | 1 + haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 7 ++++--- 7 files changed, 11 insertions(+), 17 deletions(-) delete mode 100644 haddock-api/resources/html/NewOcean.std-theme/minus.gif delete mode 100644 haddock-api/resources/html/NewOcean.std-theme/plus.gif (limited to 'haddock-api/src/Haddock') diff --git a/ghc.mk b/ghc.mk index a10fd61a..d3b02b6e 100644 --- a/ghc.mk +++ b/ghc.mk @@ -45,10 +45,7 @@ utils/haddock_dist_DATA_FILES += html/Ocean.theme/minus.gif utils/haddock_dist_DATA_FILES += html/Ocean.theme/ocean.css utils/haddock_dist_DATA_FILES += html/Ocean.theme/plus.gif utils/haddock_dist_DATA_FILES += html/Ocean.theme/synopsis.png -utils/haddock_dist_DATA_FILES += html/NewOcean.std-theme/hslogo-16.png -utils/haddock_dist_DATA_FILES += html/NewOcean.std-theme/minus.gif utils/haddock_dist_DATA_FILES += html/NewOcean.std-theme/new-ocean.css -utils/haddock_dist_DATA_FILES += html/NewOcean.std-theme/plus.gif utils/haddock_dist_DATA_FILES += html/NewOcean.std-theme/synopsis.png utils/haddock_dist_DATA_FILES += html/solarized.css utils/haddock_dist_DATA_FILES += html/highlight.js diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index d5c976b6..a410f436 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -34,10 +34,7 @@ data-files: html/Ocean.theme/ocean.css html/Ocean.theme/plus.gif html/Ocean.theme/synopsis.png - html/NewOcean.std-theme/hslogo-16.png - html/NewOcean.std-theme/minus.gif html/NewOcean.std-theme/new-ocean.css - html/NewOcean.std-theme/plus.gif html/NewOcean.std-theme/synopsis.png latex/haddock.sty diff --git a/haddock-api/resources/html/NewOcean.std-theme/minus.gif b/haddock-api/resources/html/NewOcean.std-theme/minus.gif deleted file mode 100644 index 1deac2fe..00000000 Binary files a/haddock-api/resources/html/NewOcean.std-theme/minus.gif and /dev/null differ diff --git a/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css b/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css index 8416176c..7568032f 100644 --- a/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css +++ b/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css @@ -352,7 +352,7 @@ ul.links li a { .show { display: inherit; } .clear { clear: both; } -.collapser:before, .expander:before { +.collapser:before, .expander:before, .noexpander:before { font-size: 1.2em; color: #9C5791; display: inline-block; @@ -360,11 +360,15 @@ ul.links li a { } .collapser:before { - content: '⊗'; + content: '⊖'; } .expander:before { content: "⊕"; } +.noexpander:before { + content: "⊕"; + visibility: hidden; +} .collapser, .expander { cursor: pointer; @@ -380,12 +384,6 @@ ul.links li a { summary { cursor: pointer; outline: none; - list-style-image: url(plus.gif); - list-style-position: outside; -} - -details[open] > summary { - list-style-image: url(minus.gif); } pre { diff --git a/haddock-api/resources/html/NewOcean.std-theme/plus.gif b/haddock-api/resources/html/NewOcean.std-theme/plus.gif deleted file mode 100644 index 2d15c141..00000000 Binary files a/haddock-api/resources/html/NewOcean.std-theme/plus.gif and /dev/null differ diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 2b8bdd69..2206b7dc 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -324,6 +324,7 @@ mkNode pkg qual ss p (Node s leaf _pkg srcPkg short ts) = cBtn = case (ts, leaf) of (_:_, Just _) -> thespan ! collapseControl p "" << spaceHtml + ([] , Just _) -> thespan ! [theclass "noexpander"] << spaceHtml (_, _ ) -> noHtml -- We only need an explicit collapser button when the module name -- is also a leaf, and so is a link to a module page. Indeed, the diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index 10a6d499..c935bc5f 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -195,17 +195,18 @@ subEquations :: Maybe Package -> Qualification -> [SubDecl] -> Html subEquations pkg qual = divSubDecls "equations" "Equations" . subTable pkg qual --- | Generate sub table for instance declarations, with source +-- | Generate collapsible sub table for instance declarations, with source subInstances :: Maybe Package -> Qualification -> String -- ^ Class name, used for anchor generation -> LinksInfo -> Bool -> [(SubDecl, Maybe Module, Located DocName)] -> Html subInstances pkg qual nm lnks splice = maybe noHtml wrap . instTable where - wrap contents = subSection (collapseDetails id_ DetailsOpen (summary +++ contents)) + wrap contents = subSection (hdr +++ collapseDetails id_ DetailsOpen (summary +++ contents)) instTable = subTableSrc pkg qual lnks splice subSection = thediv ! [theclass "subs instances"] - summary = thesummary << "Instances" + hdr = h4 ! collapseControl id_ "instances" << "Instances" + summary = thesummary ! [ theclass "hide-when-js-enabled" ] << "Instances details" id_ = makeAnchorId $ "i:" ++ nm -- cgit v1.2.3 From ad157c408cd7ad4badec71a84551a836a343f27b Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Wed, 7 Nov 2018 13:31:19 -0800 Subject: Allow "Contents" summary to scroll in a fixed div In the unfortunate event that the "Contents" summary doesn't fit vertically (like in the "Prelude"), it will be scrollable. --- .../resources/html/NewOcean.std-theme/new-ocean.css | 18 ++++++++---------- haddock-api/src/Haddock/Backends/Xhtml.hs | 4 ++-- haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 5 +++-- 3 files changed, 13 insertions(+), 14 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css b/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css index 7568032f..906b3954 100644 --- a/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css +++ b/haddock-api/resources/html/NewOcean.std-theme/new-ocean.css @@ -81,6 +81,9 @@ body.js-enabled .hide-when-js-enabled { position: fixed; max-width: 10vw; top: 10.2em; + left: 2em; + bottom: 1em; + overflow-y: scroll; } #synopsis { @@ -96,10 +99,6 @@ body.js-enabled .hide-when-js-enabled { z-index: 1; } - #table-of-contents { - left: 2em; - } - #synopsis .show { border: 1px solid #5E5184; padding: 0.7em; @@ -518,7 +517,7 @@ div#style-menu-holder { /* @group Front Matter */ #synopsis .caption, -#table-of-contents .caption { +#contents-list .caption { font-size: 1rem; } @@ -526,26 +525,25 @@ div#style-menu-holder { font-size: 16px; } -#table-of-contents { +#contents-list { background: #f7f7f7; padding: 1em; margin: 0; - margin-top: 1em; } -#table-of-contents .caption { +#contents-list .caption { text-align: left; margin: 0; } -#table-of-contents ul { +#contents-list ul { list-style: none; margin: 0; margin-top: 10px; font-size: 14px; } -#table-of-contents ul ul { +#contents-list ul ul { margin-left: 1.5em; } diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 2206b7dc..e2fdc509 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -633,9 +633,9 @@ ppModuleContents pkg qual exports orphan | null sections && not orphan = noHtml | otherwise = contentsDiv where - contentsDiv = divTableOfContents << ( + contentsDiv = divTableOfContents << (divContentsList << ( sectionName << "Contents" +++ - unordList (sections ++ orphanSection)) + unordList (sections ++ orphanSection))) (sections, _leftovers{-should be []-}) = process 0 exports orphanSection diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index c935bc5f..25d8b07a 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -15,7 +15,7 @@ module Haddock.Backends.Xhtml.Layout ( divPackageHeader, divContent, divModuleHeader, divFooter, divTableOfContents, divDescription, divSynopsis, divInterface, - divIndex, divAlphabet, divModuleList, + divIndex, divAlphabet, divModuleList, divContentsList, sectionName, nonEmptySectionName, @@ -80,7 +80,7 @@ nonEmptySectionName c divPackageHeader, divContent, divModuleHeader, divFooter, divTableOfContents, divDescription, divSynopsis, divInterface, - divIndex, divAlphabet, divModuleList + divIndex, divAlphabet, divModuleList, divContentsList :: Html -> Html divPackageHeader = sectionDiv "package-header" @@ -88,6 +88,7 @@ divContent = sectionDiv "content" divModuleHeader = sectionDiv "module-header" divFooter = sectionDiv "footer" divTableOfContents = sectionDiv "table-of-contents" +divContentsList = sectionDiv "contents-list" divDescription = sectionDiv "description" divSynopsis = sectionDiv "synopsis" divInterface = sectionDiv "interface" -- cgit v1.2.3 From 8344c3b6360b09e99b32c8c5f34f28d3310f9e1a Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Thu, 8 Nov 2018 18:49:57 -0800 Subject: Clicking on "Contents" navigates to top of page --- haddock-api/src/Haddock/Backends/Xhtml.hs | 2 +- html-test/ref/Bug387.html | 2 +- html-test/ref/BugExportHeadings.html | 2 +- html-test/ref/DeprecatedReExport.html | 2 +- html-test/ref/Hash.html | 2 +- html-test/ref/OrphanInstances.html | 2 +- html-test/ref/Test.html | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index e2fdc509..202fcdf1 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -634,7 +634,7 @@ ppModuleContents pkg qual exports orphan | otherwise = contentsDiv where contentsDiv = divTableOfContents << (divContentsList << ( - sectionName << "Contents" +++ + (sectionName << "Contents") ! [ strAttr "onclick" "window.scrollTo(0,0)" ] +++ unordList (sections ++ orphanSection))) (sections, _leftovers{-should be []-}) = process 0 exports diff --git a/html-test/ref/Bug387.html b/html-test/ref/Bug387.html index a6b19759..3193fc7f 100644 --- a/html-test/ref/Bug387.html +++ b/html-test/ref/Bug387.html @@ -42,7 +42,7 @@ >

Contents

Contents

Contents

Contents

Contents

Contents