aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Utils.hs
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2017-05-23 23:16:32 +0200
committerAlan Zimmerman <alan.zimm@gmail.com>2017-06-05 22:26:55 +0200
commit1e1f85d6513b84bac3ae13470900ac7c23e8640e (patch)
tree8a8de8b9a2507ce126aa8b9e4d7939e43e264bcc /haddock-api/src/Haddock/Utils.hs
parenta1b57146c5678b32eb5ac37021e93a81a4b73007 (diff)
Match new AST as per GHC wip/new-tree-one-param
See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow
Diffstat (limited to 'haddock-api/src/Haddock/Utils.hs')
-rw-r--r--haddock-api/src/Haddock/Utils.hs20
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