Match new AST as per GHC wip/new-tree-one-param

See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow

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