From 4b0adcedc3ca0d5e367da6eb3c671289bf1215a7 Mon Sep 17 00:00:00 2001 From: Richard Eisenberg Date: Wed, 24 Feb 2016 13:21:44 -0500 Subject: Follow-on changes to support RuntimeRep (cherry picked from commit ab954263a793d8ced734459d6194a5d89214b66c) --- haddock-api/src/Haddock/Convert.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 02e4356a..3ad5c164 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -37,7 +37,7 @@ import TyCoRep import TysPrim ( alphaTyVars, unliftedTypeKindTyConName ) import TysWiredIn ( listTyConName, starKindTyConName ) import PrelNames ( hasKey, eqTyConKey, ipClassKey - , tYPETyConKey, liftedDataConKey, unliftedDataConKey ) + , tYPETyConKey, ptrRepLiftedDataConKey, ptrRepUnliftedDataConKey ) import Unique ( getUnique ) import Util ( filterByList, filterOut ) import Var @@ -181,12 +181,11 @@ synifyTyCon _coax tc , fdLName = synifyName tc , fdTyVars = synifyTyVars (tyConTyVars tc) , fdResultSig = - synifyFamilyResultSig resultVar tyConResKind + synifyFamilyResultSig resultVar (tyConResKind tc) , fdInjectivityAnn = synifyInjectivityAnn resultVar (tyConTyVars tc) (familyTyConInjectivityInfo tc) } - tyConResKind = piResultTys (tyConKind tc) (mkTyVarTys (tyConTyVars tc)) synifyTyCon coax tc | Just ty <- synTyConRhs_maybe tc @@ -365,11 +364,11 @@ synifyType _ (TyConApp tc tys) -- Use */# instead of TYPE 'Lifted/TYPE 'Unlifted (#473) | tc `hasKey` tYPETyConKey , [TyConApp lev []] <- tys - , lev `hasKey` liftedDataConKey + , lev `hasKey` ptrRepLiftedDataConKey = noLoc (HsTyVar (noLoc starKindTyConName)) | tc `hasKey` tYPETyConKey , [TyConApp lev []] <- tys - , lev `hasKey` unliftedDataConKey + , lev `hasKey` ptrRepUnliftedDataConKey = noLoc (HsTyVar (noLoc unliftedTypeKindTyConName)) -- Use non-prefix tuple syntax where possible, because it looks nicer. | Just sort <- tyConTuple_maybe tc -- cgit v1.2.3 From a0ddf910f08e1e1848bb36db202c18c42f15cc07 Mon Sep 17 00:00:00 2001 From: Richard Eisenberg Date: Mon, 14 Mar 2016 23:47:23 -0400 Subject: Changes due to fix for GHC#11648. (cherry picked from commit bb994de1ab0c76d1aaf1e39c54158db2526d31f1) --- haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 2 +- haddock-api/src/Haddock/Backends/LaTeX.hs | 2 +- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 4 ++-- haddock-api/src/Haddock/Convert.hs | 9 ++++++--- haddock-api/src/Haddock/Interface/Rename.hs | 4 ++-- haddock-api/src/Haddock/Utils.hs | 7 +++++-- 6 files changed, 17 insertions(+), 11 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index e8baae88..be17cb8b 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -117,7 +117,7 @@ decls (group, _, _, _) = concatMap ($ group) ] where typ (GHC.L _ t) = case t of - GHC.DataDecl name _ _ _ -> pure . decl $ name + GHC.DataDecl { tcdLName = name } -> pure . decl $ name GHC.SynDecl name _ _ _ -> pure . decl $ name GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index b7be7ffb..81a23a1b 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -641,7 +641,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) = ppOcc = case occ of [one] -> ppBinder one _ -> cat (punctuate comma (map ppBinder occ)) - tyVars = tyvarNames (fromMaybe (HsQTvs PlaceHolder []) (con_qvars con)) + tyVars = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con)) context = unLoc (fromMaybe (noLoc []) (con_cxt con)) -- don't use "con_doc con", in case it's reconstructed from a .hi file, diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 2f802aef..b354658d 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -776,7 +776,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con of [one] -> ppBinderInfix summary one _ -> hsep (punctuate comma (map (ppBinderInfix summary) occ)) - ltvs = fromMaybe (HsQTvs PlaceHolder []) (con_qvars con) + ltvs = fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con) tyVars = tyvarNames ltvs lcontext = fromMaybe (noLoc []) (con_cxt con) context = unLoc lcontext @@ -846,7 +846,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) [one] -> ppBinderInfix False one _ -> hsep (punctuate comma (map (ppBinderInfix False) occ)) - tyVars = tyvarNames (fromMaybe (HsQTvs PlaceHolder []) (con_qvars con)) + tyVars = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con)) context = unLoc (fromMaybe (noLoc []) (con_cxt con)) forall_ = False -- don't use "con_doc con", in case it's reconstructed from a .hi file, diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 3ad5c164..283803a3 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -27,6 +27,7 @@ import DataCon import FamInstEnv import HsSyn import Name +import NameSet ( emptyNameSet ) import RdrName ( mkVarUnqual ) import PatSyn import SrcLoc ( Located, noLoc, unLoc ) @@ -145,7 +146,7 @@ synifyTyCon _coax tc in HsQTvs { hsq_implicit = [] -- No kind polymorphism , hsq_explicit = zipWith mk_hs_tv (fst (splitFunTys (tyConKind tc))) alphaTyVars --a, b, c... which are unfortunately all kind * - } + , hsq_dependent = emptyNameSet } , tcdDataDefn = HsDataDefn { dd_ND = DataType -- arbitrary lie, they are neither -- algebraic data nor newtype: @@ -155,6 +156,7 @@ synifyTyCon _coax tc -- we have their kind accurately: , dd_cons = [] -- No constructors , dd_derivs = Nothing } + , tcdDataCusk = False , tcdFVs = placeHolderNamesTc } synifyTyCon _coax tc @@ -234,7 +236,7 @@ synifyTyCon coax tc in case lefts consRaw of [] -> return $ DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdDataDefn = defn - , tcdFVs = placeHolderNamesTc } + , tcdDataCusk = False, tcdFVs = placeHolderNamesTc } dataConErrs -> Left $ unlines dataConErrs synifyInjectivityAnn :: Maybe Name -> [TyVar] -> Injectivity @@ -323,7 +325,8 @@ synifyCtx = noLoc . map (synifyType WithinType) synifyTyVars :: [TyVar] -> LHsQTyVars Name synifyTyVars ktvs = HsQTvs { hsq_implicit = [] - , hsq_explicit = map synifyTyVar ktvs } + , hsq_explicit = map synifyTyVar ktvs + , hsq_dependent = emptyNameSet } synifyTyVar :: TyVar -> LHsTyVarBndr Name synifyTyVar tv diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 0f97ee3b..3054e2f9 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -270,7 +270,7 @@ renameType t = case t of renameLHsQTyVars :: LHsQTyVars Name -> RnM (LHsQTyVars DocName) renameLHsQTyVars (HsQTvs { hsq_implicit = _, hsq_explicit = tvs }) = do { tvs' <- mapM renameLTyVarBndr tvs - ; return (HsQTvs { hsq_implicit = error "haddock:renameLHsQTyVars", hsq_explicit = tvs' }) } + ; return (HsQTvs { hsq_implicit = error "haddock:renameLHsQTyVars", hsq_explicit = tvs', hsq_dependent = error "haddock:renameLHsQTyVars" }) } -- This is rather bogus, but I'm not sure what else to do renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName) @@ -350,7 +350,7 @@ renameTyClD d = case d of lname' <- renameL lname tyvars' <- renameLHsQTyVars tyvars defn' <- renameDataDefn defn - return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdFVs = placeHolderNames }) + return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdDataCusk = PlaceHolder, tcdFVs = placeHolderNames }) ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index 325dd710..58a7ef90 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -64,6 +64,7 @@ import Haddock.GhcUtils import GHC import Name +import NameSet ( emptyNameSet ) import HsTypes (selectorFieldOcc) import Control.Monad ( liftM ) @@ -201,7 +202,8 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ] c' = ConDeclH98 { con_name = head (con_names c) , con_qvars = Just $ HsQTvs { hsq_implicit = mempty - , hsq_explicit = tvs } + , hsq_explicit = tvs + , hsq_dependent = emptyNameSet } , con_cxt = Just cxt , con_details = details , con_doc = con_doc c @@ -226,7 +228,8 @@ emptyHsQTvs :: LHsQTyVars Name -- does not necessarily have all the rigt kind variables. It is used -- in Haddock just for printing, so it doesn't matter emptyHsQTvs = HsQTvs { hsq_implicit = error "haddock:emptyHsQTvs" - , hsq_explicit = [] } + , hsq_explicit = [] + , hsq_dependent = error "haddock:emptyHsQTvs" } -------------------------------------------------------------------------------- -- cgit v1.2.3 From 1308be34399d1819e39f6ad1ea41928681110a4a Mon Sep 17 00:00:00 2001 From: Rik Steenkamp Date: Sat, 2 Apr 2016 21:13:34 +0100 Subject: Fix printing of pattern synonym types Removes the call to `patSynType :: PatSyn -> Type` in `Convert.hs` as this function will be removed from GHC. Instead, we use the function `patSynSig` and build the `HsDecl` manually. This also fixes the printing of the two contexts and the quantified type variables in a pattern synonym type. Reviewers: goldfire, bgamari, mpickering Differential Revision: https://phabricator.haskell.org/D2048 (cherry picked from commit 3ddcbd6b8e6884bd95028381176eb33bee6896fb) --- haddock-api/src/Haddock/Convert.hs | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 283803a3..660be723 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -36,7 +36,7 @@ import TyCon import Type import TyCoRep import TysPrim ( alphaTyVars, unliftedTypeKindTyConName ) -import TysWiredIn ( listTyConName, starKindTyConName ) +import TysWiredIn ( listTyConName, starKindTyConName, unitTy ) import PrelNames ( hasKey, eqTyConKey, ipClassKey , tYPETyConKey, ptrRepLiftedDataConKey, ptrRepUnliftedDataConKey ) import Unique ( getUnique ) @@ -102,8 +102,7 @@ tyThingToLHsDecl t = case t of (synifySigWcType ImplicitizeForAll (dataConUserType dc))) AConLike (PatSynCon ps) -> - allOK . SigD $ PatSynSig (synifyName ps) (synifySigType WithinType - (patSynType ps)) + allOK . SigD $ PatSynSig (synifyName ps) (synifyPatSynSigType ps) where withErrs e x = return (e, x) allOK x = return (mempty, x) @@ -361,6 +360,10 @@ synifySigWcType :: SynifyTypeState -> Type -> LHsSigWcType Name -- Ditto (see synifySigType) synifySigWcType s ty = mkEmptyImplicitBndrs (mkEmptyWildCardBndrs (synifyType s ty)) +synifyPatSynSigType :: PatSyn -> LHsSigType Name +-- Ditto (see synifySigType) +synifyPatSynSigType ps = mkEmptyImplicitBndrs (synifyPatSynType ps) + synifyType :: SynifyTypeState -> Type -> LHsType Name synifyType _ (TyVarTy tv) = noLoc $ HsTyVar $ noLoc (getName tv) synifyType _ (TyConApp tc tys) @@ -422,6 +425,22 @@ synifyType _ (LitTy t) = noLoc $ HsTyLit $ synifyTyLit t synifyType s (CastTy t _) = synifyType s t synifyType _ (CoercionTy {}) = error "synifyType:Coercion" +synifyPatSynType :: PatSyn -> LHsType Name +synifyPatSynType ps = let + (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, res_ty) = patSynSig ps + req_theta' | null req_theta && not (null prov_theta && null ex_tvs) = [unitTy] + -- HACK: a HsQualTy with theta = [unitTy] will be printed as "() =>", + -- i.e., an explicit empty context, which is what we need. This is not + -- possible by taking theta = [], as that will print no context at all + | otherwise = req_theta + sForAll [] s = s + sForAll tvs s = HsForAllTy { hst_bndrs = map synifyTyVar tvs + , hst_body = noLoc s } + sQual theta s = HsQualTy { hst_ctxt = synifyCtx theta + , hst_body = noLoc s } + sTau = unLoc $ synifyType WithinType $ mkFunTys arg_tys res_ty + in noLoc $ sForAll univ_tvs $ sQual req_theta' $ sForAll ex_tvs $ sQual prov_theta sTau + synifyTyLit :: TyLit -> HsTyLit synifyTyLit (NumTyLit n) = HsNumTy mempty n synifyTyLit (StrTyLit s) = HsStrTy mempty s -- cgit v1.2.3 From 035f2f18448d6f81a16d80e8b2ae8025616f8d41 Mon Sep 17 00:00:00 2001 From: RyanGlScott Date: Thu, 11 Feb 2016 15:42:42 -0500 Subject: Collapse type/data family instances by default (cherry picked from commit 2da130a8db8f995c119b544fad807533236cf088) --- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 15 ++++++++++----- haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 18 +++++++++++++----- 2 files changed, 23 insertions(+), 10 deletions(-) (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 b354658d..660a8475 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -607,20 +607,25 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) = , [subInstDetails iid ats sigs] ) where - iid = instanceId origin no orphan ihd sigs = ppInstanceSigs links splice unicode qual clsiSigs ats = ppInstanceAssocTys links splice unicode qual clsiAssocTys TypeInst rhs -> - (ptype, mdoc, []) + ( subInstHead iid ptype + , mdoc + , [subFamInstDetails iid prhs] + ) where - ptype = keyword "type" <+> typ <+> prhs + ptype = keyword "type" <+> typ prhs = maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs DataInst dd -> - (pdata, mdoc, []) + ( subInstHead iid pdata + , mdoc + , [subFamInstDetails iid pdecl]) where - pdata = keyword "data" <+> typ <+> pdecl + pdata = keyword "data" <+> typ pdecl = ppShortDataDecl False True dd unicode qual where + iid = instanceId origin no orphan ihd typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index 26aeaff8..19de935c 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -31,7 +31,8 @@ module Haddock.Backends.Xhtml.Layout ( subConstructors, subEquations, subFields, - subInstances, subOrphanInstances, subInstHead, subInstDetails, + subInstances, subOrphanInstances, + subInstHead, subInstDetails, subFamInstDetails, subMethods, subMinimal, @@ -179,7 +180,6 @@ subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBloc subConstructors :: Qualification -> [SubDecl] -> Html subConstructors qual = divSubDecls "constructors" "Constructors" . subTable qual - subFields :: Qualification -> [SubDecl] -> Html subFields qual = divSubDecls "fields" "Fields" . subDlist qual @@ -226,10 +226,18 @@ subInstDetails :: String -- ^ Instance unique id (for anchor generation) -> [Html] -- ^ Method contents (pretty-printed signatures) -> Html subInstDetails iid ats mets = - section << (subAssociatedTypes ats <+> subMethods mets) - where - section = thediv ! collapseSection (instAnchorId iid) False "inst-details" + subInstSection iid << (subAssociatedTypes ats <+> subMethods mets) + +subFamInstDetails :: String -- ^ Instance unique id (for anchor generation) + -> Html -- ^ Type or data family instance + -> Html +subFamInstDetails iid fi = + subInstSection iid << declElem fi +subInstSection :: String -- ^ Instance unique id (for anchor generation) + -> Html + -> Html +subInstSection iid = thediv ! collapseSection (instAnchorId iid) False "inst-details" instAnchorId :: String -> String instAnchorId iid = makeAnchorId $ "i:" ++ iid -- cgit v1.2.3 From 82f5ef8484fb91230a83d26c971a7082547e32b8 Mon Sep 17 00:00:00 2001 From: RyanGlScott Date: Thu, 11 Feb 2016 20:17:09 -0500 Subject: Ensure expanded family instances render correctly (cherry picked from commit 1338b5d7c32939de6bbc31af0049477e4f847103) --- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 5 +++-- haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) (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 660a8475..fab6bf8d 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -616,14 +616,15 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) = ) where ptype = keyword "type" <+> typ - prhs = maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs + prhs = ptype <+> maybe noHtml + (\t -> equals <+> ppType unicode qual t) rhs DataInst dd -> ( subInstHead iid pdata , mdoc , [subFamInstDetails iid pdecl]) where pdata = keyword "data" <+> typ - pdecl = ppShortDataDecl False True dd unicode qual + pdecl = pdata <+> ppShortDataDecl False True dd unicode qual where iid = instanceId origin no orphan ihd typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index 19de935c..41457f72 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -232,7 +232,7 @@ subFamInstDetails :: String -- ^ Instance unique id (for anchor generation) -> Html -- ^ Type or data family instance -> Html subFamInstDetails iid fi = - subInstSection iid << declElem fi + subInstSection iid << thediv ! [theclass "src"] << fi subInstSection :: String -- ^ Instance unique id (for anchor generation) -> Html -- cgit v1.2.3 From 03b02a0faa5381d3a614e3f39b36923b0e988051 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 4 Mar 2016 21:04:02 +0000 Subject: Remove unused functions (cherry picked from commit b89d1c2456bdb2d4208d94ded56155f7088a37d0) --- haddock-api/src/Haddock/GhcUtils.hs | 32 -------------------------------- haddock-api/src/Haddock/Types.hs | 5 ----- 2 files changed, 37 deletions(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 4e5e008b..3933f8e7 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -35,13 +35,6 @@ import Class moduleString :: Module -> String moduleString = moduleNameString . moduleName -lookupLoadedHomeModuleGRE :: GhcMonad m => ModuleName -> m (Maybe GlobalRdrEnv) -lookupLoadedHomeModuleGRE mod_name = withSession $ \hsc_env -> - case lookupUFM (hsc_HPT hsc_env) mod_name of - Just mod_info -> return (mi_globals (hm_iface mod_info)) - _not_a_home_module -> return Nothing - - isNameSym :: Name -> Bool isNameSym = isSymOcc . nameOccName @@ -123,26 +116,11 @@ isUserLSig (L _(TypeSig {})) = True isUserLSig (L _(ClassOpSig {})) = True isUserLSig _ = False -isTyClD :: HsDecl a -> Bool -isTyClD (TyClD _) = True -isTyClD _ = False - isClassD :: HsDecl a -> Bool isClassD (TyClD d) = isClassDecl d isClassD _ = False - -isDocD :: HsDecl a -> Bool -isDocD (DocD _) = True -isDocD _ = False - - -isInstD :: HsDecl a -> Bool -isInstD (InstD _) = True -isInstD _ = False - - isValD :: HsDecl a -> Bool isValD (ValD _) = True isValD _ = False @@ -156,11 +134,6 @@ declATs _ = [] pretty :: Outputable a => DynFlags -> a -> String pretty = showPpr - -trace_ppr :: Outputable a => DynFlags -> a -> b -> b -trace_ppr dflags x y = trace (pretty dflags x) y - - ------------------------------------------------------------------------------- -- * Located ------------------------------------------------------------------------------- @@ -173,11 +146,6 @@ unL (L _ x) = x reL :: a -> Located a reL = L undefined - -before :: Located a -> Located a -> Bool -before = (<) `on` getLoc - - ------------------------------------------------------------------------------- -- * NamedThing instances ------------------------------------------------------------------------------- diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 3a4df70c..eacf4473 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -268,11 +268,6 @@ noDocForDecl :: DocForDecl name noDocForDecl = (Documentation Nothing Nothing, Map.empty) -unrenameDocForDecl :: DocForDecl DocName -> DocForDecl Name -unrenameDocForDecl (doc, fnArgsDoc) = - (fmap getName doc, (fmap . fmap) getName fnArgsDoc) - - ----------------------------------------------------------------------------- -- * Cross-referencing ----------------------------------------------------------------------------- -- cgit v1.2.3 From 88bacd21107ef9b8d8d83d5d281a06c8ef4f2271 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Tue, 10 May 2016 17:06:19 +0200 Subject: Create: Mark a comment as TODO --- haddock-api/src/Haddock/Interface/Create.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'haddock-api/src/Haddock') diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 6466acfb..007038cb 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -533,7 +533,7 @@ mkExportItems let declNames = getMainDeclBinder (unL decl) in case () of _ - -- temp hack: we filter out separately exported ATs, since we haven't decided how + -- TODO: temp hack: we filter out separately exported ATs, since we haven't decided how -- to handle them yet. We should really give an warning message also, and filter the -- name out in mkVisibleNames... | t `elem` declATs (unL decl) -> return [] -- cgit v1.2.3