aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
authoralexbiehl <alex.biehl@gmail.com>2017-10-08 19:38:21 +0200
committeralexbiehl <alex.biehl@gmail.com>2017-10-08 19:38:21 +0200
commit671b62d104751fd0ab8daf6b9cda1b971abf331f (patch)
tree43e1605c5e49ce0cf6d060fffb838f23e0e136aa /haddock-api/src/Haddock/Backends
parent406030f2782590799e44470da7ca80e85f3cf026 (diff)
parente498b7871bfbee8b38858b546390246ddddb9509 (diff)
Merge remote-tracking branch 'origin/ghc-head' into HEAD
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs34
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs30
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs97
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs12
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs150
5 files changed, 164 insertions, 159 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 3a9f6e43..f1d8ddb2 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -87,7 +87,7 @@ dropHsDocTy = f
f (HsDocTy a _) = f $ unL a
f x = x
-outHsType :: (OutputableBndrId a)
+outHsType :: (SourceTextX a, OutputableBndrId a)
=> DynFlags -> HsType a -> String
outHsType dflags = out dflags . dropHsDocTy
@@ -118,7 +118,7 @@ commaSeparate dflags = showSDocUnqual dflags . interpp'SP
---------------------------------------------------------------------
-- How to print each export
-ppExport :: DynFlags -> ExportItem Name -> [String]
+ppExport :: DynFlags -> ExportItem GhcRn -> [String]
ppExport dflags ExportDecl { expItemDecl = L _ decl
, expItemMbDoc = (dc, _)
, expItemSubDocs = subdocs
@@ -136,7 +136,7 @@ ppExport dflags ExportDecl { expItemDecl = L _ decl
ppFixities = concatMap (ppFixity dflags) fixities
ppExport _ _ = []
-ppSigWithDoc :: DynFlags -> Sig Name -> [(Name, DocForDecl Name)] -> [String]
+ppSigWithDoc :: DynFlags -> Sig GhcRn -> [(Name, DocForDecl Name)] -> [String]
ppSigWithDoc dflags (TypeSig names sig) subdocs
= concatMap mkDocSig names
where
@@ -148,17 +148,17 @@ ppSigWithDoc dflags (TypeSig names sig) subdocs
ppSigWithDoc _ _ _ = []
-ppSig :: DynFlags -> Sig Name -> [String]
+ppSig :: DynFlags -> Sig GhcRn -> [String]
ppSig dflags x = ppSigWithDoc dflags x []
-pp_sig :: DynFlags -> [Located Name] -> LHsType Name -> String
+pp_sig :: DynFlags -> [Located Name] -> LHsType GhcRn -> String
pp_sig dflags names (L _ typ) =
operator prettyNames ++ " :: " ++ outHsType dflags typ
where
prettyNames = intercalate ", " $ map (out dflags) names
-- note: does not yet output documentation for class methods
-ppClass :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> [String]
+ppClass :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> [String]
ppClass dflags decl subdocs =
(out dflags decl{tcdSigs=[], tcdATs=[], tcdATDefs=[], tcdMeths=emptyLHsBinds}
++ ppTyFams) : ppMethods
@@ -178,17 +178,17 @@ ppClass dflags decl subdocs =
whereWrapper elems = vcat'
[ text "where" <+> lbrace
- , nest 4 . vcat . map (<> semi) $ elems
+ , nest 4 . vcat . map (Outputable.<> semi) $ elems
, rbrace
]
- tyFamEqnToSyn :: TyFamDefltEqn Name -> TyClDecl Name
+ tyFamEqnToSyn :: TyFamDefltEqn GhcRn -> TyClDecl GhcRn
tyFamEqnToSyn tfe = SynDecl
- { tcdLName = tfe_tycon tfe
- , tcdTyVars = tfe_pats tfe
- , tcdFixity = tfe_fixity tfe
- , tcdRhs = tfe_rhs tfe
- , tcdFVs = emptyNameSet
+ { tcdLName = feqn_tycon tfe
+ , tcdTyVars = feqn_pats tfe
+ , tcdFixity = feqn_fixity tfe
+ , tcdRhs = feqn_rhs tfe
+ , tcdFVs = emptyNameSet
}
@@ -204,10 +204,10 @@ ppInstance dflags x =
cls = x { is_flag = OverlapFlag { overlapMode = NoOverlap NoSourceText
, isSafeOverlap = False } }
-ppSynonym :: DynFlags -> TyClDecl Name -> [String]
+ppSynonym :: DynFlags -> TyClDecl GhcRn -> [String]
ppSynonym dflags x = [out dflags x]
-ppData :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> [String]
+ppData :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> [String]
ppData dflags decl@(DataDecl { tcdDataDefn = defn }) subdocs
= showData decl{ tcdDataDefn = defn { dd_cons=[],dd_derivs=noLoc [] }} :
concatMap (ppCtor dflags decl subdocs . unL) (dd_cons defn)
@@ -228,7 +228,7 @@ lookupCon dflags subdocs (L _ name) = case lookup name subdocs of
Just (d, _) -> ppDocumentation dflags d
_ -> []
-ppCtor :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> ConDecl Name -> [String]
+ppCtor :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> ConDecl GhcRn -> [String]
ppCtor dflags dat subdocs con@ConDeclH98 {}
-- AZ:TODO get rid of the concatMap
= concatMap (lookupCon dflags subdocs) [con_name con] ++ f (getConDetails con)
@@ -262,7 +262,7 @@ ppCtor dflags _dat subdocs con@ConDeclGADT {}
ppFixity :: DynFlags -> (Name, Fixity) -> [String]
-ppFixity dflags (name, fixity) = [out dflags (FixitySig [noLoc name] fixity)]
+ppFixity dflags (name, fixity) = [out dflags ((FixitySig [noLoc name] fixity) :: FixitySig GhcRn)]
---------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 9d273417..57ff72ff 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -84,13 +84,13 @@ variables =
everythingInRenamedSource (var `Syb.combine` rec)
where
var term = case cast term of
- (Just (GHC.L sspan (GHC.HsVar name))) ->
+ (Just ((GHC.L sspan (GHC.HsVar name)) :: GHC.LHsExpr GHC.GhcRn)) ->
pure (sspan, RtkVar (GHC.unLoc name))
(Just (GHC.L _ (GHC.RecordCon (GHC.L sspan name) _ _ _))) ->
pure (sspan, RtkVar name)
_ -> empty
rec term = case cast term of
- Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LHsExpr GHC.Name) _) ->
+ Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LHsExpr GHC.GhcRn) _) ->
pure (sspan, RtkVar name)
_ -> empty
@@ -99,7 +99,7 @@ types :: GHC.RenamedSource -> LTokenDetails
types = everythingInRenamedSource ty
where
ty term = case cast term of
- (Just (GHC.L sspan (GHC.HsTyVar _ name))) ->
+ (Just ((GHC.L sspan (GHC.HsTyVar _ name)) :: GHC.LHsType GHC.GhcRn)) ->
pure (sspan, RtkType (GHC.unLoc name))
_ -> empty
@@ -114,11 +114,11 @@ binds = everythingInRenamedSource
(fun `Syb.combine` pat `Syb.combine` tvar)
where
fun term = case cast term of
- (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.Name)) ->
+ (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn)) ->
pure (sspan, RtkBind name)
_ -> empty
pat term = case cast term of
- (Just (GHC.L sspan (GHC.VarPat name))) ->
+ (Just ((GHC.L sspan (GHC.VarPat name)) :: GHC.LPat GHC.GhcRn)) ->
pure (sspan, RtkBind (GHC.unLoc name))
(Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) ->
[(sspan, RtkVar name)] ++ everythingInRenamedSource rec recs
@@ -126,11 +126,11 @@ binds = everythingInRenamedSource
pure (sspan, RtkBind name)
_ -> empty
rec term = case cast term of
- (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.Name) _)) ->
+ (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.GhcRn) _)) ->
pure (sspan, RtkVar name)
_ -> empty
tvar term = case cast term of
- (Just (GHC.L sspan (GHC.UserTyVar name))) ->
+ (Just ((GHC.L sspan (GHC.UserTyVar name)) :: GHC.LHsTyVarBndr GHC.GhcRn)) ->
pure (sspan, RtkBind (GHC.unLoc name))
(Just (GHC.L _ (GHC.KindedTyVar (GHC.L sspan name) _))) ->
pure (sspan, RtkBind name)
@@ -150,21 +150,23 @@ decls (group, _, _, _) = concatMap ($ group)
GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs
fun term = case cast term of
- (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.Name))
+ (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn))
| GHC.isExternalName name -> pure (sspan, RtkDecl name)
_ -> empty
con term = case cast term of
- (Just cdcl) ->
+ (Just (cdcl :: GHC.ConDecl GHC.GhcRn)) ->
map decl (GHC.getConNames cdcl)
++ everythingInRenamedSource fld cdcl
Nothing -> empty
ins term = case cast term of
- (Just (GHC.DataFamInstD inst)) -> pure . tyref $ GHC.dfid_tycon inst
- (Just (GHC.TyFamInstD (GHC.TyFamInstDecl (GHC.L _ eqn) _))) ->
- pure . tyref $ GHC.tfe_tycon eqn
+ (Just ((GHC.DataFamInstD (GHC.DataFamInstDecl eqn))
+ :: GHC.InstDecl GHC.GhcRn))
+ -> pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn
+ (Just (GHC.TyFamInstD (GHC.TyFamInstDecl eqn))) ->
+ pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn
_ -> empty
fld term = case cast term of
- Just (field :: GHC.ConDeclField GHC.Name)
+ Just (field :: GHC.ConDeclField GHC.GhcRn)
-> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field
Nothing -> empty
sig (GHC.L _ (GHC.TypeSig names _)) = map decl names
@@ -181,7 +183,7 @@ imports src@(_, imps, _, _) =
everythingInRenamedSource ie src ++ mapMaybe (imp . GHC.unLoc) imps
where
ie term = case cast term of
- (Just (GHC.IEVar v)) -> pure $ var $ GHC.ieLWrappedName v
+ (Just ((GHC.IEVar v) :: GHC.IE GHC.GhcRn)) -> pure $ var $ GHC.ieLWrappedName v
(Just (GHC.IEThingAbs t)) -> pure $ typ $ GHC.ieLWrappedName t
(Just (GHC.IEThingAll t)) -> pure $ typ $ GHC.ieLWrappedName t
(Just (GHC.IEThingWith t _ vs _fls)) ->
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 1b248d2e..1cc23e6e 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -37,6 +37,7 @@ import Data.Char
import Control.Monad
import Data.Maybe
import Data.List
+import Prelude hiding ((<>))
import Haddock.Doc (combineDocumentation)
@@ -179,7 +180,7 @@ string_txt (ZStr s1) s2 = zString s1 ++ s2
string_txt (LStr s1 _) s2 = unpackLitString s1 ++ s2
-exportListItem :: ExportItem DocName -> LaTeX
+exportListItem :: ExportItem DocNameI -> LaTeX
exportListItem ExportDecl { expItemDecl = decl, expItemSubDocs = subdocs }
= sep (punctuate comma . map ppDocBinder $ declNames decl) <>
case subdocs of
@@ -197,7 +198,7 @@ exportListItem _
-- Deal with a group of undocumented exports together, to avoid lots
-- of blank vertical space between them.
-processExports :: [ExportItem DocName] -> LaTeX
+processExports :: [ExportItem DocNameI] -> LaTeX
processExports [] = empty
processExports (decl : es)
| Just sig <- isSimpleSig decl
@@ -213,19 +214,19 @@ processExports (e : es) =
processExport e $$ processExports es
-isSimpleSig :: ExportItem DocName -> Maybe ([DocName], HsType DocName)
+isSimpleSig :: ExportItem DocNameI -> Maybe ([DocName], HsType DocNameI)
isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames t))
, expItemMbDoc = (Documentation Nothing Nothing, argDocs) }
| Map.null argDocs = Just (map unLoc lnames, unLoc (hsSigWcType t))
isSimpleSig _ = Nothing
-isExportModule :: ExportItem DocName -> Maybe Module
+isExportModule :: ExportItem DocNameI -> Maybe Module
isExportModule (ExportModule m) = Just m
isExportModule _ = Nothing
-processExport :: ExportItem DocName -> LaTeX
+processExport :: ExportItem DocNameI -> LaTeX
processExport (ExportGroup lev _id0 doc)
= ppDocGroup lev (docToLaTeX doc)
processExport (ExportDecl decl pats doc subdocs insts fixities _splice)
@@ -248,7 +249,7 @@ ppDocGroup lev doc = sec lev <> braces doc
sec _ = text "\\paragraph"
-declNames :: LHsDecl DocName -> [DocName]
+declNames :: LHsDecl DocNameI -> [DocName]
declNames (L _ decl) = case decl of
TyClD d -> [tcdName d]
SigD (TypeSig lnames _ ) -> map unLoc lnames
@@ -258,7 +259,7 @@ declNames (L _ decl) = case decl of
_ -> error "declaration not supported by declNames"
-forSummary :: (ExportItem DocName) -> Bool
+forSummary :: (ExportItem DocNameI) -> Bool
forSummary (ExportGroup _ _ _) = False
forSummary (ExportDoc _) = False
forSummary _ = True
@@ -278,10 +279,10 @@ moduleBasename mdl = map (\c -> if c == '.' then '-' else c)
-------------------------------------------------------------------------------
-ppDecl :: LHsDecl DocName
- -> [(HsDecl DocName,DocForDecl DocName)]
+ppDecl :: LHsDecl DocNameI
+ -> [(HsDecl DocNameI, DocForDecl DocName)]
-> DocForDecl DocName
- -> [DocInstance DocName]
+ -> [DocInstance DocNameI]
-> [(DocName, DocForDecl DocName)]
-> [(DocName, Fixity)]
-> LaTeX
@@ -309,12 +310,12 @@ ppDecl (L loc decl) pats (doc, fnArgsDoc) instances subdocs _fixities = case dec
ppTyFam :: Bool -> SrcSpan -> Documentation DocName ->
- TyClDecl DocName -> Bool -> LaTeX
+ TyClDecl DocNameI -> Bool -> LaTeX
ppTyFam _ _ _ _ _ =
error "type family declarations are currently not supported by --latex"
-ppFor :: SrcSpan -> DocForDecl DocName -> ForeignDecl DocName -> Bool -> LaTeX
+ppFor :: SrcSpan -> DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
ppFor loc doc (ForeignImport (L _ name) typ _ _) unicode =
ppFunSig loc doc [name] (hsSigType typ) unicode
ppFor _ _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
@@ -327,7 +328,7 @@ ppFor _ _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
-- we skip type patterns for now
-ppTySyn :: SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool -> LaTeX
+ppTySyn :: SrcSpan -> DocForDecl DocName -> TyClDecl DocNameI -> Bool -> LaTeX
ppTySyn loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
, tcdRhs = ltype }) unicode
@@ -346,7 +347,7 @@ ppTySyn _ _ _ _ = error "declaration not supported by ppTySyn"
-------------------------------------------------------------------------------
-ppFunSig :: SrcSpan -> DocForDecl DocName -> [DocName] -> LHsType DocName
+ppFunSig :: SrcSpan -> DocForDecl DocName -> [DocName] -> LHsType DocNameI
-> Bool -> LaTeX
ppFunSig loc doc docnames (L _ typ) unicode =
ppTypeOrFunSig loc docnames typ doc
@@ -358,7 +359,7 @@ ppFunSig loc doc docnames (L _ typ) unicode =
names = map getName docnames
ppLPatSig :: SrcSpan -> DocForDecl DocName -> [DocName]
- -> LHsSigType DocName
+ -> LHsSigType DocNameI
-> Bool -> LaTeX
ppLPatSig _loc (doc, _argDocs) docnames ty unicode
= declWithDoc pref1 (documentationToLaTeX doc)
@@ -369,7 +370,7 @@ ppLPatSig _loc (doc, _argDocs) docnames ty unicode
, ppLType unicode (hsSigType ty)
]
-ppTypeOrFunSig :: SrcSpan -> [DocName] -> HsType DocName
+ppTypeOrFunSig :: SrcSpan -> [DocName] -> HsType DocNameI
-> DocForDecl DocName -> (LaTeX, LaTeX, LaTeX)
-> Bool -> LaTeX
ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)
@@ -387,7 +388,7 @@ ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)
arg_doc n = rDoc . fmap _doc $ Map.lookup n argDocs
- do_args :: Int -> LaTeX -> HsType DocName -> LaTeX
+ do_args :: Int -> LaTeX -> HsType DocNameI -> LaTeX
do_args _n leader (HsForAllTy tvs ltype)
= decltt leader
<-> decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]))
@@ -403,18 +404,18 @@ ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)
= decltt leader <-> decltt (ppType unicode t) <-> arg_doc n <+> nl
-ppTypeSig :: [Name] -> HsType DocName -> Bool -> LaTeX
+ppTypeSig :: [Name] -> HsType DocNameI -> Bool -> LaTeX
ppTypeSig nms ty unicode =
hsep (punctuate comma $ map ppSymName nms)
<+> dcolon unicode
<+> ppType unicode ty
-ppTyVars :: [LHsTyVarBndr DocName] -> [LaTeX]
+ppTyVars :: [LHsTyVarBndr DocNameI] -> [LaTeX]
ppTyVars = map (ppSymName . getName . hsLTyVarName)
-tyvarNames :: LHsQTyVars DocName -> [Name]
+tyvarNames :: LHsQTyVars DocNameI -> [Name]
tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit
@@ -463,8 +464,8 @@ rDoc = maybeDoc . fmap latexStripTrailingWhitespace
-------------------------------------------------------------------------------
-ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
- -> LHsQTyVars DocName -> [Located ([Located DocName], [Located DocName])]
+ppClassHdr :: Bool -> Located [LHsType DocNameI] -> DocName
+ -> LHsQTyVars DocNameI -> [Located ([Located DocName], [Located DocName])]
-> Bool -> LaTeX
ppClassHdr summ lctxt n tvs fds unicode =
keyword "class"
@@ -482,9 +483,9 @@ ppFds fds unicode =
hsep (map (ppDocName . unLoc) vars2)
-ppClassDecl :: [DocInstance DocName] -> SrcSpan
+ppClassDecl :: [DocInstance DocNameI] -> SrcSpan
-> Documentation DocName -> [(DocName, DocForDecl DocName)]
- -> TyClDecl DocName -> Bool -> LaTeX
+ -> TyClDecl DocNameI -> Bool -> LaTeX
ppClassDecl instances loc doc subdocs
(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars, tcdFDs = lfds
, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs }) unicode
@@ -519,7 +520,7 @@ ppClassDecl instances loc doc subdocs
ppClassDecl _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
-ppDocInstances :: Bool -> [DocInstance DocName] -> LaTeX
+ppDocInstances :: Bool -> [DocInstance DocNameI] -> LaTeX
ppDocInstances _unicode [] = empty
ppDocInstances unicode (i : rest)
| Just ihead <- isUndocdInstance i
@@ -537,16 +538,16 @@ isUndocdInstance _ = Nothing
-- | Print a possibly commented instance. The instance header is printed inside
-- an 'argBox'. The comment is printed to the right of the box in normal comment
-- style.
-ppDocInstance :: Bool -> DocInstance DocName -> LaTeX
+ppDocInstance :: Bool -> DocInstance DocNameI -> LaTeX
ppDocInstance unicode (instHead, doc, _) =
declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX $ fmap _doc doc)
-ppInstDecl :: Bool -> InstHead DocName -> LaTeX
+ppInstDecl :: Bool -> InstHead DocNameI -> LaTeX
ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
-ppInstHead :: Bool -> InstHead DocName -> LaTeX
+ppInstHead :: Bool -> InstHead DocNameI -> LaTeX
ppInstHead unicode (InstHead {..}) = case ihdInstType of
ClassInst ctx _ _ _ -> ppContextNoLocs ctx unicode <+> typ
TypeInst rhs -> keyword "type" <+> typ <+> tibody rhs
@@ -567,9 +568,9 @@ lookupAnySubdoc n subdocs = case lookup n subdocs of
-------------------------------------------------------------------------------
-ppDataDecl :: [(HsDecl DocName,DocForDecl DocName)] -> [DocInstance DocName] ->
+ppDataDecl :: [(HsDecl DocNameI, DocForDecl DocName)] -> [DocInstance DocNameI] ->
[(DocName, DocForDecl DocName)] -> SrcSpan ->
- Maybe (Documentation DocName) -> TyClDecl DocName -> Bool ->
+ Maybe (Documentation DocName) -> TyClDecl DocNameI -> Bool ->
LaTeX
ppDataDecl pats instances subdocs _loc doc dataDecl unicode
@@ -615,7 +616,7 @@ ppDataDecl pats instances subdocs _loc doc dataDecl unicode
-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: Bool -> [Name] -> HsContext DocName -> Bool -> LaTeX
+ppConstrHdr :: Bool -> [Name] -> HsContext DocNameI -> Bool -> LaTeX
ppConstrHdr forall tvs ctxt unicode
= (if null tvs then empty else ppForall)
<+>
@@ -627,7 +628,7 @@ ppConstrHdr forall tvs ctxt unicode
ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX
- -> LConDecl DocName -> LaTeX
+ -> LConDecl DocNameI -> LaTeX
ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =
leader <->
case con_details con of
@@ -756,7 +757,7 @@ ppSideBySideConstr subdocs unicode leader (L loc con) =
mkFunTy a b = noLoc (HsFunTy a b)
-}
-ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName -> LaTeX
+ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocNameI -> LaTeX
ppSideBySideField subdocs unicode (ConDeclField names ltype _) =
decltt (cat (punctuate comma (map (ppBinder . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names))
<+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc
@@ -814,7 +815,7 @@ ppSideBySideField subdocs unicode (ConDeclField names ltype _) =
-- | Print the LHS of a data\/newtype declaration.
-- Currently doesn't handle 'data instance' decls or kind signatures
-ppDataHeader :: TyClDecl DocName -> Bool -> LaTeX
+ppDataHeader :: TyClDecl DocNameI -> Bool -> LaTeX
ppDataHeader (DataDecl { tcdLName = L _ name, tcdTyVars = tyvars
, tcdDataDefn = HsDataDefn { dd_ND = nd, dd_ctxt = ctxt } }) unicode
= -- newtype or data
@@ -831,7 +832,7 @@ ppDataHeader _ _ = error "ppDataHeader: illegal argument"
-- | Print an application of a DocName and two lists of HsTypes (kinds, types)
-ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName] -> Bool -> LaTeX
+ppAppNameTypes :: DocName -> [HsType DocNameI] -> [HsType DocNameI] -> Bool -> LaTeX
ppAppNameTypes n ks ts unicode = ppTypeApp n ks ts ppDocName (ppParendType unicode)
@@ -858,29 +859,29 @@ ppTypeApp n ks ts ppDN ppT = ppDN n <+> hsep (map ppT $ ks ++ ts)
-------------------------------------------------------------------------------
-ppLContext, ppLContextNoArrow :: Located (HsContext DocName) -> Bool -> LaTeX
+ppLContext, ppLContextNoArrow :: Located (HsContext DocNameI) -> Bool -> LaTeX
ppLContext = ppContext . unLoc
ppLContextNoArrow = ppContextNoArrow . unLoc
-ppContextNoLocsMaybe :: [HsType DocName] -> Bool -> Maybe LaTeX
+ppContextNoLocsMaybe :: [HsType DocNameI] -> Bool -> Maybe LaTeX
ppContextNoLocsMaybe [] _ = Nothing
ppContextNoLocsMaybe cxt unicode = Just $ pp_hs_context cxt unicode
-ppContextNoArrow :: HsContext DocName -> Bool -> LaTeX
+ppContextNoArrow :: HsContext DocNameI -> Bool -> LaTeX
ppContextNoArrow cxt unicode = fromMaybe empty $
ppContextNoLocsMaybe (map unLoc cxt) unicode
-ppContextNoLocs :: [HsType DocName] -> Bool -> LaTeX
+ppContextNoLocs :: [HsType DocNameI] -> Bool -> LaTeX
ppContextNoLocs cxt unicode = maybe empty (<+> darrow unicode) $
ppContextNoLocsMaybe cxt unicode
-ppContext :: HsContext DocName -> Bool -> LaTeX
+ppContext :: HsContext DocNameI -> Bool -> LaTeX
ppContext cxt unicode = ppContextNoLocs (map unLoc cxt) unicode
-pp_hs_context :: [HsType DocName] -> Bool -> LaTeX
+pp_hs_context :: [HsType DocNameI] -> Bool -> LaTeX
pp_hs_context [] _ = empty
pp_hs_context [p] unicode = ppType unicode p
pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt)
@@ -930,32 +931,32 @@ maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
| otherwise = p
-ppLType, ppLParendType, ppLFunLhType :: Bool -> Located (HsType DocName) -> LaTeX
+ppLType, ppLParendType, ppLFunLhType :: Bool -> Located (HsType DocNameI) -> LaTeX
ppLType unicode y = ppType unicode (unLoc y)
ppLParendType unicode y = ppParendType unicode (unLoc y)
ppLFunLhType unicode y = ppFunLhType unicode (unLoc y)
-ppType, ppParendType, ppFunLhType :: Bool -> HsType DocName -> LaTeX
+ppType, ppParendType, ppFunLhType :: Bool -> HsType DocNameI -> LaTeX
ppType unicode ty = ppr_mono_ty pREC_TOP ty unicode
ppParendType unicode ty = ppr_mono_ty pREC_CON ty unicode
ppFunLhType unicode ty = ppr_mono_ty pREC_FUN ty unicode
-ppLKind :: Bool -> LHsKind DocName -> LaTeX
+ppLKind :: Bool -> LHsKind DocNameI -> LaTeX
ppLKind unicode y = ppKind unicode (unLoc y)
-ppKind :: Bool -> HsKind DocName -> LaTeX
+ppKind :: Bool -> HsKind DocNameI -> LaTeX
ppKind unicode ki = ppr_mono_ty pREC_TOP ki unicode
-- Drop top-level for-all type variables in user style
-- since they are implicit in Haskell
-ppr_mono_lty :: Int -> LHsType DocName -> Bool -> LaTeX
+ppr_mono_lty :: Int -> LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty ctxt_prec ty unicode = ppr_mono_ty ctxt_prec (unLoc ty) unicode
-ppr_mono_ty :: Int -> HsType DocName -> Bool -> LaTeX
+ppr_mono_ty :: Int -> HsType DocNameI -> Bool -> LaTeX
ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode
= maybeParen ctxt_prec pREC_FUN $
sep [ hsep (forallSymbol unicode : ppTyVars tvs) <> dot
@@ -1018,7 +1019,7 @@ ppr_tylit (HsStrTy _ s) _ = text (show s)
-- XXX: Do something with Unicode parameter?
-ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Bool -> LaTeX
+ppr_fun_ty :: Int -> LHsType DocNameI -> LHsType DocNameI -> Bool -> LaTeX
ppr_fun_ty ctxt_prec ty1 ty2 unicode
= let p1 = ppr_mono_lty pREC_FUN ty1 unicode
p2 = ppr_mono_lty pREC_TOP ty2 unicode
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index e8148782..1205e57c 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -44,6 +44,7 @@ import System.Directory
import Data.Map ( Map )
import qualified Data.Map as Map hiding ( Map )
import qualified Data.Set as Set hiding ( Set )
+import Data.Function
import Data.Ord ( comparing )
import DynFlags (Language(..))
@@ -559,6 +560,7 @@ ppHtmlModule odir doctitle themes
signatureDocURL :: String
signatureDocURL = "https://wiki.haskell.org/Module_signature"
+
ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Qualification -> Html
ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
= ppModuleContents qual exports (not . null $ ifaceRnOrphanInstances iface) +++
@@ -610,7 +612,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
ppModuleContents :: Qualification
- -> [ExportItem DocName]
+ -> [ExportItem DocNameI]
-> Bool -- ^ Orphans sections
-> Html
ppModuleContents qual exports orphan
@@ -626,7 +628,7 @@ ppModuleContents qual exports orphan
| orphan = [ linkedAnchor "section.orphans" << "Orphan instances" ]
| otherwise = []
- process :: Int -> [ExportItem DocName] -> ([Html],[ExportItem DocName])
+ process :: Int -> [ExportItem DocNameI] -> ([Html],[ExportItem DocNameI])
process _ [] = ([], [])
process n items@(ExportGroup lev id0 doc : rest)
| lev <= n = ( [], items )
@@ -643,9 +645,9 @@ ppModuleContents qual exports orphan
-- we need to assign a unique id to each section heading so we can hyperlink
-- them from the contents:
-numberSectionHeadings :: [ExportItem DocName] -> [ExportItem DocName]
+numberSectionHeadings :: [ExportItem DocNameI] -> [ExportItem DocNameI]
numberSectionHeadings = go 1
- where go :: Int -> [ExportItem DocName] -> [ExportItem DocName]
+ where go :: Int -> [ExportItem DocNameI] -> [ExportItem DocNameI]
go _ [] = []
go n (ExportGroup lev _ doc : es)
= ExportGroup lev (show n) doc : go (n+1) es
@@ -654,7 +656,7 @@ numberSectionHeadings = go 1
processExport :: Bool -> LinksInfo -> Bool -> Qualification
- -> ExportItem DocName -> Maybe Html
+ -> ExportItem DocNameI -> Maybe Html
processExport _ _ _ _ ExportDecl { expItemDecl = L _ (InstD _) } = Nothing -- Hide empty instances
processExport summary _ _ qual (ExportGroup lev id0 doc)
= nothingIf summary $ groupHeading lev id0 << docToHtml (Just id0) qual (mkMeta doc)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index c78bee2d..3b53b1eb 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -40,9 +40,9 @@ import Name
import BooleanFormula
import RdrName ( rdrNameOcc )
-ppDecl :: Bool -> LinksInfo -> LHsDecl DocName
- -> [(HsDecl DocName, DocForDecl DocName)]
- -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, Fixity)]
+ppDecl :: Bool -> LinksInfo -> LHsDecl DocNameI
+ -> [(HsDecl DocNameI, DocForDecl DocName)]
+ -> DocForDecl DocName -> [DocInstance DocNameI] -> [(DocName, Fixity)]
-> [(DocName, DocForDecl DocName)] -> Splice -> Unicode -> Qualification -> Html
ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode qual = case decl of
TyClD (FamDecl d) -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual
@@ -60,14 +60,14 @@ ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdoc
ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
- [Located DocName] -> LHsType DocName -> [(DocName, Fixity)] ->
+ [Located DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->
Splice -> Unicode -> Qualification -> Html
ppLFunSig summary links loc doc lnames lty fixities splice unicode qual =
ppFunSig summary links loc doc (map unLoc lnames) lty fixities
splice unicode qual
ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
- [DocName] -> LHsType DocName -> [(DocName, Fixity)] ->
+ [DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->
Splice -> Unicode -> Qualification -> Html
ppFunSig summary links loc doc docnames typ fixities splice unicode qual =
ppSigLike summary links loc mempty doc docnames fixities (unLoc typ, pp_typ)
@@ -76,7 +76,7 @@ ppFunSig summary links loc doc docnames typ fixities splice unicode qual =
pp_typ = ppLType unicode qual HideEmptyContexts typ
ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
- [Located DocName] -> LHsSigType DocName ->
+ [Located DocName] -> LHsSigType DocNameI ->
[(DocName, Fixity)] ->
Splice -> Unicode -> Qualification -> Html
ppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice unicode qual
@@ -91,7 +91,7 @@ ppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice unicode
]
ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
- [DocName] -> [(DocName, Fixity)] -> (HsType DocName, Html) ->
+ [DocName] -> [(DocName, Fixity)] -> (HsType DocNameI, Html) ->
Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
splice unicode qual emptyCtxts =
@@ -108,7 +108,7 @@ ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
| otherwise = html <+> ppFixities fixities qual
-ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocName
+ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocNameI
-> DocForDecl DocName -> (Html, Html, Html)
-> Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode qual emptyCtxts
@@ -122,7 +122,7 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
do_largs n leader (L _ t) = do_args n leader t
- do_args :: Int -> Html -> HsType DocName -> [SubDecl]
+ do_args :: Int -> Html -> HsType DocNameI -> [SubDecl]
do_args n leader (HsForAllTy tvs ltype)
= do_largs n leader' ltype
where
@@ -141,7 +141,7 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
do_args n leader t
= [(leader <+> ppType unicode qual emptyCtxts t, argDoc n, [])]
-ppForAll :: [LHsTyVarBndr DocName] -> Unicode -> Qualification -> Html
+ppForAll :: [LHsTyVarBndr DocNameI] -> Unicode -> Qualification -> Html
ppForAll tvs unicode qual =
case [ppKTv n k | L _ (KindedTyVar (L _ n) k) <- tvs] of
[] -> noHtml
@@ -172,15 +172,15 @@ ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
-- | Pretty-print type variables.
-ppTyVars :: Unicode -> Qualification -> [LHsTyVarBndr DocName] -> [Html]
+ppTyVars :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> [Html]
ppTyVars unicode qual tvs = map (ppHsTyVarBndr unicode qual . unLoc) tvs
-tyvarNames :: LHsQTyVars DocName -> [Name]
+tyvarNames :: LHsQTyVars DocNameI -> [Name]
tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit
ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
- -> ForeignDecl DocName -> [(DocName, Fixity)]
+ -> ForeignDecl DocNameI -> [(DocName, Fixity)]
-> Splice -> Unicode -> Qualification -> Html
ppFor summary links loc doc (ForeignImport (L _ name) typ _ _) fixities
splice unicode qual
@@ -190,7 +190,7 @@ ppFor _ _ _ _ _ _ _ _ _ = error "ppFor"
-- we skip type patterns for now
ppTySyn :: Bool -> LinksInfo -> [(DocName, Fixity)] -> SrcSpan
- -> DocForDecl DocName -> TyClDecl DocName
+ -> DocForDecl DocName -> TyClDecl DocNameI
-> Splice -> Unicode -> Qualification -> Html
ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
, tcdRhs = ltype })
@@ -221,7 +221,7 @@ ppTyName = ppName Prefix
ppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> SrcSpan
- -> [DocName] -> HsType DocName
+ -> [DocName] -> HsType DocNameI
-> Html
ppSimpleSig links splice unicode qual emptyCtxts loc names typ =
topDeclElem' names $ ppTypeSig True occNames ppTyp unicode
@@ -236,7 +236,7 @@ ppSimpleSig links splice unicode qual emptyCtxts loc names typ =
--------------------------------------------------------------------------------
-ppFamilyInfo :: Bool -> FamilyInfo DocName -> Html
+ppFamilyInfo :: Bool -> FamilyInfo DocNameI -> Html
ppFamilyInfo assoc OpenTypeFamily
| assoc = keyword "type"
| otherwise = keyword "type family"
@@ -246,7 +246,7 @@ ppFamilyInfo assoc DataFamily
ppFamilyInfo _ (ClosedTypeFamily _) = keyword "type family"
-ppTyFamHeader :: Bool -> Bool -> FamilyDecl DocName
+ppTyFamHeader :: Bool -> Bool -> FamilyDecl DocNameI
-> Unicode -> Qualification -> Html
ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
, fdResultSig = L _ result
@@ -276,28 +276,28 @@ ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
_ -> mempty
)
-ppResultSig :: FamilyResultSig DocName -> Unicode -> Qualification -> Html
+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
-ppPseudoFamilyHeader :: Unicode -> Qualification -> PseudoFamilyDecl DocName
+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 DocName -> Html
+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 DocName] ->
+ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocNameI] ->
[(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->
- FamilyDecl DocName -> Splice -> Unicode -> Qualification -> Html
+ FamilyDecl DocNameI -> Splice -> Unicode -> Qualification -> Html
ppTyFam summary associated links instances fixities loc doc decl splice unicode qual
| summary = ppTyFamHeader True associated decl unicode qual
@@ -318,8 +318,9 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
= ppInstances links (OriginFamily docname) instances splice unicode qual
-- Individual equation of a closed type family
- ppTyFamEqn TyFamEqn { tfe_tycon = n, tfe_rhs = rhs
- , tfe_pats = HsIB { hsib_body = ts }}
+ 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
<+> equals <+> ppType unicode qual HideEmptyContexts (unLoc rhs)
, Nothing, [] )
@@ -327,7 +328,7 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
ppPseudoFamilyDecl :: LinksInfo -> Splice -> Unicode -> Qualification
- -> PseudoFamilyDecl DocName
+ -> PseudoFamilyDecl DocNameI
-> Html
ppPseudoFamilyDecl links splice unicode qual
decl@(PseudoFamilyDecl { pfdLName = L loc name, .. }) =
@@ -341,7 +342,7 @@ ppPseudoFamilyDecl links splice unicode qual
--------------------------------------------------------------------------------
-ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocName
+ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocNameI
-> [(DocName, Fixity)] -> Splice -> Unicode -> Qualification -> Html
ppAssocType summ links doc (L loc decl) fixities splice unicode qual =
ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode qual
@@ -352,12 +353,12 @@ ppAssocType summ links doc (L loc decl) fixities splice unicode qual =
--------------------------------------------------------------------------------
-- | Print a type family and its variables
-ppFamDeclBinderWithVars :: Bool -> Unicode -> Qualification -> FamilyDecl DocName -> Html
+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)
-- | Print a newtype / data binder and its variables
-ppDataBinderWithVars :: Bool -> Unicode -> Qualification -> TyClDecl DocName -> Html
+ppDataBinderWithVars :: Bool -> Unicode -> Qualification -> TyClDecl DocNameI -> Html
ppDataBinderWithVars summ unicode qual decl =
ppAppDocNameTyVarBndrs summ unicode qual (tcdName decl) (hsQTvExplicit $ tcdTyVars decl)
@@ -365,7 +366,7 @@ ppDataBinderWithVars summ unicode qual decl =
-- * Type applications
--------------------------------------------------------------------------------
-ppAppDocNameTyVarBndrs :: Bool -> Unicode -> Qualification -> DocName -> [LHsTyVarBndr DocName] -> Html
+ppAppDocNameTyVarBndrs :: Bool -> Unicode -> Qualification -> DocName -> [LHsTyVarBndr DocNameI] -> Html
ppAppDocNameTyVarBndrs summ unicode qual n vs =
ppTypeApp n [] vs ppDN (ppHsTyVarBndr unicode qual . unLoc)
where
@@ -374,7 +375,7 @@ ppAppDocNameTyVarBndrs summ unicode qual n vs =
ppBinderFixity _ = ppBinder
-- | Print an application of a 'DocName' and two lists of 'HsTypes' (kinds, types)
-ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName]
+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)
@@ -397,33 +398,33 @@ ppTypeApp n ks ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT $ ks ++ ts)
-------------------------------------------------------------------------------
-ppLContext, ppLContextNoArrow :: Located (HsContext DocName) -> Unicode
+ppLContext, ppLContextNoArrow :: Located (HsContext DocNameI) -> Unicode
-> Qualification -> HideEmptyContexts -> Html
ppLContext = ppContext . unLoc
ppLContextNoArrow = ppContextNoArrow . unLoc
-ppContextNoArrow :: HsContext DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppContextNoArrow :: HsContext DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppContextNoArrow cxt unicode qual emptyCtxts = fromMaybe noHtml $
ppContextNoLocsMaybe (map unLoc cxt) unicode qual emptyCtxts
-ppContextNoLocs :: [HsType DocName] -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppContextNoLocs :: [HsType DocNameI] -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppContextNoLocs cxt unicode qual emptyCtxts = maybe noHtml (<+> darrow unicode) $
ppContextNoLocsMaybe cxt unicode qual emptyCtxts
-ppContextNoLocsMaybe :: [HsType DocName] -> Unicode -> Qualification -> HideEmptyContexts -> Maybe Html
+ppContextNoLocsMaybe :: [HsType DocNameI] -> Unicode -> Qualification -> HideEmptyContexts -> Maybe Html
ppContextNoLocsMaybe [] _ _ emptyCtxts =
case emptyCtxts of
HideEmptyContexts -> Nothing
ShowEmptyToplevelContexts -> Just (toHtml "()")
ppContextNoLocsMaybe cxt unicode qual _ = Just $ ppHsContext cxt unicode qual
-ppContext :: HsContext DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppContext :: HsContext DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppContext cxt unicode qual emptyCtxts = ppContextNoLocs (map unLoc cxt) unicode qual emptyCtxts
-ppHsContext :: [HsType DocName] -> Unicode -> Qualification -> Html
+ppHsContext :: [HsType DocNameI] -> Unicode -> Qualification -> Html
ppHsContext [] _ _ = noHtml
ppHsContext [p] unicode qual = ppCtxType unicode qual p
ppHsContext cxt unicode qual = parenList (map (ppType unicode qual HideEmptyContexts) cxt)
@@ -434,8 +435,8 @@ ppHsContext cxt unicode qual = parenList (map (ppType unicode qual HideEmptyCont
-------------------------------------------------------------------------------
-ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
- -> LHsQTyVars DocName -> [Located ([Located DocName], [Located DocName])]
+ppClassHdr :: Bool -> Located [LHsType DocNameI] -> DocName
+ -> LHsQTyVars DocNameI -> [Located ([Located DocName], [Located DocName])]
-> Unicode -> Qualification -> Html
ppClassHdr summ lctxt n tvs fds unicode qual =
keyword "class"
@@ -452,7 +453,7 @@ ppFds fds unicode qual =
fundep (vars1,vars2) = ppVars vars1 <+> arrow unicode <+> ppVars vars2
ppVars = hsep . map ((ppDocName qual Prefix True) . unLoc)
-ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan
+ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocNameI -> SrcSpan
-> [(DocName, DocForDecl DocName)]
-> Splice -> Unicode -> Qualification -> Html
ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = tvs
@@ -484,9 +485,9 @@ ppShortClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppSh
-ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, Fixity)]
+ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)]
-> SrcSpan -> Documentation DocName
- -> [(DocName, DocForDecl DocName)] -> TyClDecl DocName
+ -> [(DocName, DocForDecl DocName)] -> TyClDecl DocNameI
-> Splice -> Unicode -> Qualification -> Html
ppClassDecl summary links instances fixities loc d subdocs
decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars
@@ -557,7 +558,7 @@ ppClassDecl _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppS
ppInstances :: LinksInfo
- -> InstOrigin DocName -> [DocInstance DocName]
+ -> InstOrigin DocName -> [DocInstance DocNameI]
-> Splice -> Unicode -> Qualification
-> Html
ppInstances links origin instances splice unicode qual
@@ -565,22 +566,22 @@ ppInstances links origin instances splice unicode qual
-- force Splice = True to use line URLs
where
instName = getOccString origin
- instDecl :: Int -> DocInstance DocName -> (SubDecl,Located DocName)
+ instDecl :: Int -> DocInstance DocNameI -> (SubDecl,Located DocName)
instDecl no (inst, mdoc, loc) =
((ppInstHead links splice unicode qual mdoc origin False no inst), loc)
ppOrphanInstances :: LinksInfo
- -> [DocInstance DocName]
+ -> [DocInstance DocNameI]
-> Splice -> Unicode -> Qualification
-> Html
ppOrphanInstances links instances splice unicode qual
= subOrphanInstances qual links True (zipWith instDecl [1..] instances)
where
- instOrigin :: InstHead name -> InstOrigin name
+ instOrigin :: InstHead name -> InstOrigin (IdP name)
instOrigin inst = OriginClass (ihdClsName inst)
- instDecl :: Int -> DocInstance DocName -> (SubDecl,Located DocName)
+ instDecl :: Int -> DocInstance DocNameI -> (SubDecl,Located DocName)
instDecl no (inst, mdoc, loc) =
((ppInstHead links splice unicode qual mdoc (instOrigin inst) True no inst), loc)
@@ -590,7 +591,7 @@ ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
-> InstOrigin DocName
-> Bool -- ^ Is instance orphan
-> Int -- ^ Normal
- -> InstHead DocName
+ -> InstHead DocNameI
-> SubDecl
ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
case ihdInstType of
@@ -624,7 +625,7 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
ppInstanceAssocTys :: LinksInfo -> Splice -> Unicode -> Qualification
- -> [PseudoFamilyDecl DocName]
+ -> [PseudoFamilyDecl DocNameI]
-> [Html]
ppInstanceAssocTys links splice unicode qual =
map ppFamilyDecl'
@@ -633,7 +634,7 @@ ppInstanceAssocTys links splice unicode qual =
ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
- -> [Sig DocName]
+ -> [Sig DocNameI]
-> [Html]
ppInstanceSigs links splice unicode qual sigs = do
TypeSig lnames typ <- sigs
@@ -648,7 +649,7 @@ lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
-instanceId :: InstOrigin DocName -> Int -> Bool -> InstHead DocName -> String
+instanceId :: InstOrigin DocName -> Int -> Bool -> InstHead DocNameI -> String
instanceId origin no orphan ihd = concat $
[ "o:" | orphan ] ++
[ qual origin
@@ -668,8 +669,8 @@ instanceId origin no orphan ihd = concat $
-- TODO: print contexts
-ppShortDataDecl :: Bool -> Bool -> TyClDecl DocName
- -> [(HsDecl DocName,DocForDecl DocName)]
+ppShortDataDecl :: Bool -> Bool -> TyClDecl DocNameI
+ -> [(HsDecl DocNameI, DocForDecl DocName)]
-> Unicode -> Qualification -> Html
ppShortDataDecl summary dataInst dataDecl pats unicode qual
@@ -707,10 +708,10 @@ ppShortDataDecl summary dataInst dataDecl pats unicode qual
]
-ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, Fixity)] ->
+ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)] ->
[(DocName, DocForDecl DocName)] ->
- SrcSpan -> Documentation DocName -> TyClDecl DocName ->
- [(HsDecl DocName,DocForDecl DocName)] ->
+ SrcSpan -> Documentation DocName -> TyClDecl DocNameI ->
+ [(HsDecl DocNameI, DocForDecl DocName)] ->
Splice -> Unicode -> Qualification -> Html
ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
splice unicode qual
@@ -759,7 +760,7 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
-ppShortConstr :: Bool -> ConDecl DocName -> Unicode -> Qualification -> Html
+ppShortConstr :: Bool -> ConDecl DocNameI -> Unicode -> Qualification -> Html
ppShortConstr summary con unicode qual = cHead <+> cBody <+> cFoot
where
(cHead,cBody,cFoot) = ppShortConstrParts summary False con unicode qual
@@ -767,7 +768,7 @@ ppShortConstr summary con unicode qual = cHead <+> cBody <+> cFoot
-- returns three pieces: header, body, footer so that header & footer can be
-- incorporated into the declaration
-ppShortConstrParts :: Bool -> Bool -> ConDecl DocName -> Unicode -> Qualification -> (Html, Html, Html)
+ppShortConstrParts :: Bool -> Bool -> ConDecl DocNameI -> Unicode -> Qualification -> (Html, Html, Html)
ppShortConstrParts summary dataInst con unicode qual = case con of
ConDeclH98{} -> case con_details con of
PrefixCon args ->
@@ -808,7 +809,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con of
-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: Bool -> [Name] -> HsContext DocName -> Unicode
+ppConstrHdr :: Bool -> [Name] -> HsContext DocNameI -> Unicode
-> Qualification -> Html
ppConstrHdr forall_ tvs ctxt unicode qual
= (if null tvs then noHtml else ppForall)
@@ -822,7 +823,7 @@ ppConstrHdr forall_ tvs ctxt unicode qual
| otherwise = noHtml
ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> [(DocName, Fixity)]
- -> Unicode -> Qualification -> LConDecl DocName -> SubDecl
+ -> Unicode -> Qualification -> LConDecl DocNameI -> SubDecl
ppSideBySideConstr subdocs fixities unicode qual (L _ con)
= (decl, mbDoc, fieldPart)
where
@@ -852,7 +853,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
doRecordFields fields = subFields qual
(map (ppSideBySideField subdocs unicode qual) (map unLoc fields))
- doGADTCon :: Located (HsType DocName) -> Html
+ doGADTCon :: Located (HsType DocNameI) -> Html
doGADTCon ty = ppOcc <+> dcolon unicode
-- ++AZ++ make this prepend "{..}" when it is a record style GADT
<+> ppLType unicode qual HideEmptyContexts ty
@@ -880,7 +881,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification
- -> ConDeclField DocName -> SubDecl
+ -> ConDeclField DocNameI -> SubDecl
ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) =
( hsep (punctuate comma (map ((ppBinder False) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names))
<+> dcolon unicode
@@ -894,7 +895,7 @@ ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) =
mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst
-ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocName -> Html
+ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocNameI -> Html
ppShortField summary unicode qual (ConDeclField names ltype _)
= hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names))
<+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts ltype
@@ -902,7 +903,7 @@ ppShortField summary unicode qual (ConDeclField names ltype _)
-- | Print the LHS of a data\/newtype declaration.
-- Currently doesn't handle 'data instance' decls or kind signatures
-ppDataHeader :: Bool -> TyClDecl DocName -> Unicode -> Qualification -> Html
+ppDataHeader :: Bool -> TyClDecl DocNameI -> Unicode -> Qualification -> Html
ppDataHeader summary decl@(DataDecl { tcdDataDefn =
HsDataDefn { dd_ND = nd
, dd_ctxt = ctxt
@@ -964,33 +965,33 @@ maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
| otherwise = p
-ppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> Located (HsType DocName) -> Html
+ppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> Located (HsType DocNameI) -> Html
ppLType unicode qual emptyCtxts y = ppType unicode qual emptyCtxts (unLoc y)
ppLParendType unicode qual emptyCtxts y = ppParendType unicode qual emptyCtxts (unLoc y)
ppLFunLhType unicode qual emptyCtxts y = ppFunLhType unicode qual emptyCtxts (unLoc y)
-ppCtxType :: Unicode -> Qualification -> HsType DocName -> Html
+ppCtxType :: Unicode -> Qualification -> HsType DocNameI -> Html
ppCtxType unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual HideEmptyContexts
-ppType, ppParendType, ppFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> HsType DocName -> Html
+ppType, ppParendType, ppFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppType unicode qual emptyCtxts ty = ppr_mono_ty pREC_TOP ty unicode qual emptyCtxts
ppParendType unicode qual emptyCtxts ty = ppr_mono_ty pREC_CON ty unicode qual emptyCtxts
ppFunLhType unicode qual emptyCtxts ty = ppr_mono_ty pREC_FUN ty unicode qual emptyCtxts
-ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocName -> Html
+ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocNameI -> Html
ppHsTyVarBndr _ qual (UserTyVar (L _ name)) =
ppDocName qual Raw False name
ppHsTyVarBndr unicode qual (KindedTyVar name kind) =
parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+>
ppLKind unicode qual kind)
-ppLKind :: Unicode -> Qualification -> LHsKind DocName -> Html
+ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html
ppLKind unicode qual y = ppKind unicode qual (unLoc y)
-ppKind :: Unicode -> Qualification -> HsKind DocName -> Html
+ppKind :: Unicode -> Qualification -> HsKind DocNameI -> Html
ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual HideEmptyContexts
-ppPatSigType :: Unicode -> Qualification -> LHsType DocName -> Html
+ppPatSigType :: Unicode -> Qualification -> LHsType DocNameI -> Html
ppPatSigType unicode qual typ =
let emptyCtxts =
if hasNonEmptyContext typ && isFirstContextEmpty typ
@@ -1013,14 +1014,14 @@ ppPatSigType unicode qual typ =
HsFunTy _ s -> isFirstContextEmpty s
_ -> False
-ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocName] -> Html
+ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> Html
ppForAllPart unicode qual tvs = hsep (forallSymbol unicode : ppTyVars unicode qual tvs) +++ dot
-ppr_mono_lty :: Int -> LHsType DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppr_mono_lty :: Int -> LHsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
-ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppr_mono_ty :: Int -> HsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual emptyCtxts
= maybeParen ctxt_prec pREC_FUN $
ppForAllPart unicode qual tvs <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts
@@ -1089,8 +1090,7 @@ ppr_tylit :: HsTyLit -> Html
ppr_tylit (HsNumTy _ n) = toHtml (show n)
ppr_tylit (HsStrTy _ s) = toHtml (show s)
-
-ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html
+ppr_fun_ty :: Int -> LHsType DocNameI -> LHsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppr_fun_ty ctxt_prec ty1 ty2 unicode qual emptyCtxts
= let p1 = ppr_mono_lty pREC_FUN ty1 unicode qual HideEmptyContexts
p2 = ppr_mono_lty pREC_TOP ty2 unicode qual emptyCtxts