diff options
Diffstat (limited to 'haddock-api/src/Haddock/Utils.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Utils.hs | 20 |
1 files changed, 10 insertions, 10 deletions
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index 404cfcf6..e5d589e0 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -125,12 +125,12 @@ toInstalledDescription = fmap mkMeta . hmi_description . instInfo mkMeta :: Doc a -> MDoc a mkMeta x = emptyMetaDoc { _doc = x } -mkEmptySigWcType :: LHsType Name -> LHsSigWcType Name +mkEmptySigWcType :: LHsType GHCR -> LHsSigWcType GHCR -- Dubious, because the implicit binders are empty even -- though the type might have free varaiables mkEmptySigWcType ty = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs ty) -addClassContext :: Name -> LHsQTyVars Name -> LSig Name -> LSig Name +addClassContext :: IdP GHCR -> LHsQTyVars GHCR -> LSig GHCR -> LSig GHCR -- Add the class context to a class-op signature addClassContext cls tvs0 (L pos (ClassOpSig _ lname ltype)) = L pos (TypeSig lname (mkEmptySigWcType (go (hsSigType ltype)))) @@ -148,7 +148,7 @@ addClassContext cls tvs0 (L pos (ClassOpSig _ lname ltype)) addClassContext _ _ sig = sig -- E.g. a MinimalSig is fine -lHsQTyVarsToTypes :: LHsQTyVars Name -> [LHsType Name] +lHsQTyVarsToTypes :: LHsQTyVars GHCR -> [LHsType GHCR] lHsQTyVarsToTypes tvs = [ noLoc (HsTyVar NotPromoted (noLoc (hsLTyVarName tv))) | tv <- hsQTvExplicit tvs ] @@ -158,7 +158,7 @@ lHsQTyVarsToTypes tvs -------------------------------------------------------------------------------- -restrictTo :: [Name] -> LHsDecl Name -> LHsDecl Name +restrictTo :: [IdP GHCR] -> LHsDecl GHCR -> LHsDecl GHCR restrictTo names (L loc decl) = L loc $ case decl of TyClD d | isDataDecl d -> TyClD (d { tcdDataDefn = restrictDataDefn names (tcdDataDefn d) }) @@ -167,7 +167,7 @@ restrictTo names (L loc decl) = L loc $ case decl of tcdATs = restrictATs names (tcdATs d) }) _ -> decl -restrictDataDefn :: [Name] -> HsDataDefn Name -> HsDataDefn Name +restrictDataDefn :: [IdP GHCR] -> HsDataDefn GHCR -> HsDataDefn GHCR restrictDataDefn names defn@(HsDataDefn { dd_ND = new_or_data, dd_cons = cons }) | DataType <- new_or_data = defn { dd_cons = restrictCons names cons } @@ -177,7 +177,7 @@ restrictDataDefn names defn@(HsDataDefn { dd_ND = new_or_data, dd_cons = cons }) [con] -> defn { dd_cons = [con] } _ -> error "Should not happen" -restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name] +restrictCons :: [IdP GHCR] -> [LConDecl GHCR] -> [LConDecl GHCR] restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ] where keep d | any (\n -> n `elem` names) (map unLoc $ getConNames d) = @@ -197,7 +197,7 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ] h98ConDecl c@ConDeclGADT{} = c' where (details,_res_ty,cxt,tvs) = gadtDeclDetails (con_type c) - c' :: ConDecl Name + c' :: ConDecl GHCR c' = ConDeclH98 { con_name = head (con_names c) , con_qvars = Just $ HsQTvs { hsq_implicit = mempty @@ -208,18 +208,18 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ] , con_doc = con_doc c } - field_avail :: LConDeclField Name -> Bool + field_avail :: LConDeclField GHCR -> Bool field_avail (L _ (ConDeclField fs _ _)) = all (\f -> selectorFieldOcc (unLoc f) `elem` names) fs field_types flds = [ t | ConDeclField _ t _ <- flds ] keep _ = Nothing -restrictDecls :: [Name] -> [LSig Name] -> [LSig Name] +restrictDecls :: [IdP GHCR] -> [LSig GHCR] -> [LSig GHCR] restrictDecls names = mapMaybe (filterLSigNames (`elem` names)) -restrictATs :: [Name] -> [LFamilyDecl Name] -> [LFamilyDecl Name] +restrictATs :: [IdP GHCR] -> [LFamilyDecl GHCR] -> [LFamilyDecl GHCR] restrictATs names ats = [ at | at <- ats , unL (fdLName (unL at)) `elem` names ] emptyHsQTvs :: LHsQTyVars Name |