aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2017-10-24 07:07:15 -0400
committerAlexander Biehl <alexbiehl@gmail.com>2017-10-24 13:07:15 +0200
commitd4375d8ec96991de2578fd65c79d0487f6a440d8 (patch)
tree99e72fdac3168ff484beefab3f56e9ed3dd2f341 /haddock-api/src/Haddock/Backends
parent88e30124499df08eb1a37ec44e342c1e69cf5029 (diff)
Overhaul Haddock's rendering of kind signatures (#681)
* Overhaul Haddock's rendering of kind signatures * Strip off kind signatures when specializing As an added bonus, this lets us remove an ugly hack specifically for `(->)`. Yay! * Update due to 0390e4a0f61e37bd1dcc24a36d499e92f2561b67 * @alexbiehl's suggestions * Import injectiveVarsOfBinder from GHC
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs16
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs23
2 files changed, 19 insertions, 20 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 1cc23e6e..d79e0e6c 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -553,7 +553,7 @@ ppInstHead unicode (InstHead {..}) = case ihdInstType of
TypeInst rhs -> keyword "type" <+> typ <+> tibody rhs
DataInst _ -> error "data instances not supported by --latex yet"
where
- typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode
+ typ = ppAppNameTypes ihdClsName ihdTypes unicode
tibody = maybe empty (\t -> equals <+> ppType unicode t)
lookupAnySubdoc :: (Eq name1) =>
@@ -831,27 +831,27 @@ ppDataHeader _ _ = error "ppDataHeader: illegal argument"
--------------------------------------------------------------------------------
--- | Print an application of a DocName and two lists of HsTypes (kinds, types)
-ppAppNameTypes :: DocName -> [HsType DocNameI] -> [HsType DocNameI] -> Bool -> LaTeX
-ppAppNameTypes n ks ts unicode = ppTypeApp n ks ts ppDocName (ppParendType unicode)
+-- | 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)
-- | Print an application of a DocName and a list of Names
ppAppDocNameNames :: Bool -> DocName -> [Name] -> LaTeX
ppAppDocNameNames _summ n ns =
- ppTypeApp n [] ns (ppBinder . nameOccName . getName) ppSymName
+ ppTypeApp n ns (ppBinder . nameOccName . getName) ppSymName
-- | General printing of type applications
-ppTypeApp :: DocName -> [a] -> [a] -> (DocName -> LaTeX) -> (a -> LaTeX) -> LaTeX
-ppTypeApp n [] (t1:t2:rest) ppDN ppT
+ppTypeApp :: DocName -> [a] -> (DocName -> LaTeX) -> (a -> LaTeX) -> LaTeX
+ppTypeApp n (t1:t2:rest) ppDN ppT
| operator, not . null $ rest = parens opApp <+> hsep (map ppT rest)
| operator = opApp
where
operator = isNameSym . getName $ n
opApp = ppT t1 <+> ppDN n <+> ppT t2
-ppTypeApp n ks ts ppDN ppT = ppDN n <+> hsep (map ppT $ ks ++ ts)
+ppTypeApp n ts ppDN ppT = ppDN n <+> hsep (map ppT ts)
-------------------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 3b53b1eb..3b85f96c 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -286,7 +286,7 @@ ppPseudoFamilyHeader :: Unicode -> Qualification -> PseudoFamilyDecl DocNameI
-> Html
ppPseudoFamilyHeader unicode qual (PseudoFamilyDecl { .. }) =
ppFamilyInfo True pfdInfo <+>
- ppAppNameTypes (unLoc pfdLName) [] (map unLoc pfdTyVars) unicode qual <+>
+ ppAppNameTypes (unLoc pfdLName) (map unLoc pfdTyVars) unicode qual <+>
ppResultSig (unLoc pfdKindSig) unicode qual
ppInjectivityAnn :: Bool -> Qualification -> InjectivityAnn DocNameI -> Html
@@ -321,7 +321,7 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
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
+ = ( ppAppNameTypes (unLoc n) (map unLoc ts) unicode qual
<+> equals <+> ppType unicode qual HideEmptyContexts (unLoc rhs)
, Nothing, [] )
@@ -368,29 +368,28 @@ ppDataBinderWithVars summ unicode qual decl =
ppAppDocNameTyVarBndrs :: Bool -> Unicode -> Qualification -> DocName -> [LHsTyVarBndr DocNameI] -> Html
ppAppDocNameTyVarBndrs summ unicode qual n vs =
- ppTypeApp n [] vs ppDN (ppHsTyVarBndr unicode qual . unLoc)
+ ppTypeApp n vs ppDN (ppHsTyVarBndr unicode qual . unLoc)
where
ppDN notation = ppBinderFixity notation summ . nameOccName . getName
ppBinderFixity Infix = ppBinderInfix
ppBinderFixity _ = ppBinder
--- | Print an application of a 'DocName' and two lists of 'HsTypes' (kinds, types)
-ppAppNameTypes :: DocName -> [HsType DocNameI] -> [HsType DocNameI]
- -> Unicode -> Qualification -> Html
-ppAppNameTypes n ks ts unicode qual =
- ppTypeApp n ks ts (\p -> ppDocName qual p True) (ppParendType unicode qual HideEmptyContexts)
+-- | Print an application of a 'DocName' to its list of 'HsType's
+ppAppNameTypes :: DocName -> [HsType DocNameI] -> Unicode -> Qualification -> Html
+ppAppNameTypes n ts unicode qual =
+ ppTypeApp n ts (\p -> ppDocName qual p True) (ppParendType unicode qual HideEmptyContexts)
-- | General printing of type applications
-ppTypeApp :: DocName -> [a] -> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
-ppTypeApp n [] (t1:t2:rest) ppDN ppT
+ppTypeApp :: DocName -> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
+ppTypeApp n (t1:t2:rest) ppDN ppT
| operator, not . null $ rest = parens opApp <+> hsep (map ppT rest)
| operator = opApp
where
operator = isNameSym . getName $ n
opApp = ppT t1 <+> ppDN Infix n <+> ppT t2
-ppTypeApp n ks ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT $ ks ++ ts)
+ppTypeApp n ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT ts)
-------------------------------------------------------------------------------
@@ -621,7 +620,7 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
pdecl = pdata <+> ppShortDataDecl False True dd [] unicode qual
where
iid = instanceId origin no orphan ihd
- typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual
+ typ = ppAppNameTypes ihdClsName ihdTypes unicode qual
ppInstanceAssocTys :: LinksInfo -> Splice -> Unicode -> Qualification