diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/HaddockHtml.hs | 44 |
1 files changed, 30 insertions, 14 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index 9e976269..b9426342 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -694,12 +694,12 @@ ppSig summary links loc mbDoc (TypeSig lname ltype) do_args leader (HsForAllTy Explicit tvs lctxt ltype) = (argBox ( leader <+> - hsep (keyword "forall" : ppTyVars tvs ++ [toHtml "."]) <+> - ppLContext lctxt) + hsep (keyword "forall" : ppTyVars tvs ++ [dot]) <+> + ppLContextNoArrow lctxt) <-> rdocBox noHtml) </> do_largs darrow ltype do_args leader (HsForAllTy Implicit _ lctxt ltype) - = (argBox (leader <+> ppLContext lctxt) + = (argBox (leader <+> ppLContextNoArrow lctxt) <-> rdocBox noHtml) </> do_largs darrow ltype do_args leader (HsFunTy (L _ (HsDocTy lt ldoc)) r) @@ -729,13 +729,32 @@ ppTySyn summary links loc mbDoc (TySynonym lname ltyvars ltype) ppLType (L _ t) = ppType t -ppLContext (L _ c) = ppContext c +ppTypeSig :: Bool -> Name -> (HsType DocName) -> Html +ppTypeSig summary nm ty = ppBinder summary nm <+> dcolon <+> ppType ty + +-------------------------------------------------------------------------------- +-- Contexts +-------------------------------------------------------------------------------- + +ppLContext = ppContext . unLoc +ppLContextNoArrow = ppContextNoArrow . unLoc + +ppContextNoArrow :: HsContext DocName -> Html +ppContextNoArrow [] = empty +ppContextNoArrow cxt = pp_hs_context (map unLoc cxt) -ppContext = ppPreds . (map unLoc) +ppContextNoLocs :: [HsPred DocName] -> Html +ppContextNoLocs [] = empty +ppContextNoLocs cxt = pp_hs_context cxt <+> darrow -ppPreds [] = empty -ppPreds [pred] = ppPred pred -ppPreds preds = parenList (map ppPred preds) +ppContext :: HsContext DocName -> Html +ppContext cxt = ppContextNoLocs (map unLoc cxt) + +pp_hs_context [] = empty +pp_hs_context [p] = ppPred p +pp_hs_context cxt = parenList (map ppPred cxt) + +ppLPred = ppPred . unLoc ppPred (HsClassP n ts) = ppDocName n <+> hsep (map ppLType ts) ppPred (HsIParam (Dupable n) t) @@ -743,9 +762,6 @@ ppPred (HsIParam (Dupable n) t) ppPred (HsIParam (Linear n) t) = toHtml "%" +++ ppDocName n <+> dcolon <+> ppLType t -ppTypeSig :: Bool -> Name -> (HsType DocName) -> Html -ppTypeSig summary nm ty = ppBinder summary nm <+> dcolon <+> ppType ty - -- ----------------------------------------------------------------------------- -- Class declarations @@ -755,7 +771,7 @@ ppClassHdr summ (L _ []) n tvs fds = <+> ppBinder summ n <+> hsep (ppTyVars tvs) <+> ppFds fds ppClassHdr summ lctxt n tvs fds = - keyword "class" <+> ppLContext lctxt <+> darrow + keyword "class" <+> ppLContext lctxt <+> ppBinder summ n <+> hsep (ppTyVars tvs) <+> ppFds fds @@ -830,9 +846,9 @@ ppClassDecl summary links instances orig_c loc mbDoc docMap ppInstHead :: InstHead2 DocName -> Html ppInstHead ([], n, ts) = ppAsst n ts -ppInstHead (ctxt, n, ts) = ppPreds ctxt <+> ppAsst n ts +ppInstHead (ctxt, n, ts) = ppContextNoLocs ctxt <+> ppAsst n ts -ppAsst n ts = ppDocName n <+> hsep (map ppType ts) +ppAsst n ts = ppDocName n <+> hsep (map ppParendType ts) -- ----------------------------------------------------------------------------- -- Data & newtype declarations |