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 7898bb0b..84f58ab8 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -124,12 +124,12 @@ toInstalledDescription = fmap mkMeta . hmi_description . instInfo mkMeta :: Doc a -> MDoc a mkMeta x = emptyMetaDoc { _doc = x } -mkEmptySigWcType :: LHsType Name -> LHsSigWcType Name +mkEmptySigWcType :: LHsType GhcRn -> LHsSigWcType GhcRn -- 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 :: Name -> LHsQTyVars GhcRn -> LSig GhcRn -> LSig GhcRn -- 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)))) @@ -147,7 +147,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 GhcRn -> [LHsType GhcRn] lHsQTyVarsToTypes tvs = [ noLoc (HsTyVar NotPromoted (noLoc (hsLTyVarName tv))) | tv <- hsQTvExplicit tvs ] @@ -157,7 +157,7 @@ lHsQTyVarsToTypes tvs -------------------------------------------------------------------------------- -restrictTo :: [Name] -> LHsDecl Name -> LHsDecl Name +restrictTo :: [Name] -> LHsDecl GhcRn -> LHsDecl GhcRn restrictTo names (L loc decl) = L loc $ case decl of TyClD d | isDataDecl d -> TyClD (d { tcdDataDefn = restrictDataDefn names (tcdDataDefn d) }) @@ -166,7 +166,7 @@ restrictTo names (L loc decl) = L loc $ case decl of tcdATs = restrictATs names (tcdATs d) }) _ -> decl -restrictDataDefn :: [Name] -> HsDataDefn Name -> HsDataDefn Name +restrictDataDefn :: [Name] -> HsDataDefn GhcRn -> HsDataDefn GhcRn restrictDataDefn names defn@(HsDataDefn { dd_ND = new_or_data, dd_cons = cons }) | DataType <- new_or_data = defn { dd_cons = restrictCons names cons } @@ -176,7 +176,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 :: [Name] -> [LConDecl GhcRn] -> [LConDecl GhcRn] 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) = @@ -196,7 +196,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 GhcRn c' = ConDeclH98 { con_name = head (con_names c) , con_qvars = Just $ HsQTvs { hsq_implicit = mempty @@ -207,18 +207,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 GhcRn -> 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 :: [Name] -> [LSig GhcRn] -> [LSig GhcRn] restrictDecls names = mapMaybe (filterLSigNames (`elem` names)) -restrictATs :: [Name] -> [LFamilyDecl Name] -> [LFamilyDecl Name] +restrictATs :: [Name] -> [LFamilyDecl GhcRn] -> [LFamilyDecl GhcRn] restrictATs names ats = [ at | at <- ats , unL (fdLName (unL at)) `elem` names ] emptyHsQTvs :: LHsQTyVars Name |