aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs16
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs46
2 files changed, 34 insertions, 28 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 27456998..52a983a8 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -61,7 +61,7 @@ import TcRnTypes
import FastString (concatFS)
import BasicTypes ( StringLiteral(..), SourceText(..) )
import qualified Outputable as O
-import HsDecls ( getConDetails )
+import HsDecls ( getConArgs )
-- | Use a 'TypecheckedModule' to produce an 'Interface'.
@@ -455,7 +455,7 @@ subordinates instMap decl = case decl of
constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, M.empty)
| c <- cons, cname <- getConNames c ]
fields = [ (selectorFieldOcc n, maybeToList $ fmap unL doc, M.empty)
- | RecCon flds <- map getConDetails cons
+ | RecCon flds <- map getConArgs cons
, L _ (ConDeclField ns _ doc) <- (unLoc flds)
, L _ n <- ns ]
derivs = [ (instName, [unL doc], M.empty)
@@ -1028,7 +1028,7 @@ extractDecl name decl
let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = d }))
<- insts
-- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (feqn_rhs d)
- , RecCon rec <- map (getConDetails . unLoc) (dd_cons (feqn_rhs d))
+ , RecCon rec <- map (getConArgs . unLoc) (dd_cons (feqn_rhs d))
, ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
, L _ n <- ns
, selectorFieldOcc n == name
@@ -1050,14 +1050,14 @@ extractPatternSyn nm t tvs cons =
extract :: ConDecl GhcRn -> Sig GhcRn
extract con =
let args =
- case getConDetails con of
+ case getConArgs con of
PrefixCon args' -> args'
RecCon (L _ fields) -> cd_fld_type . unLoc <$> fields
InfixCon arg1 arg2 -> [arg1, arg2]
typ = longArrow args (data_ty con)
typ' =
case con of
- ConDeclH98 { con_cxt = Just cxt } -> noLoc (HsQualTy cxt typ)
+ ConDeclH98 { con_mb_cxt = Just cxt } -> noLoc (HsQualTy cxt typ)
_ -> typ
typ'' = noLoc (HsQualTy (noLoc []) typ')
in PatSynSig [noLoc nm] (mkEmptyImplicitBndrs typ'')
@@ -1066,7 +1066,7 @@ extractPatternSyn nm t tvs cons =
longArrow inputs output = foldr (\x y -> noLoc (HsFunTy x y)) output inputs
data_ty con
- | ConDeclGADT{} <- con = hsib_body $ con_type con
+ | ConDeclGADT{} <- con = con_res_ty con
| otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
extractRecSel :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn]
@@ -1074,7 +1074,7 @@ extractRecSel :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn]
extractRecSel _ _ _ [] = error "extractRecSel: selector not found"
extractRecSel nm t tvs (L _ con : rest) =
- case getConDetails con of
+ case getConArgs con of
RecCon (L _ fields) | ((l,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
L l (TypeSig [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy data_ty (getBangType ty)))))
_ -> extractRecSel nm t tvs rest
@@ -1084,7 +1084,7 @@ extractRecSel nm t tvs (L _ con : rest) =
, L l n <- ns, selectorFieldOcc n == nm ]
data_ty
-- ResTyGADT _ ty <- con_res con = ty
- | ConDeclGADT{} <- con = hsib_body $ con_type con
+ | ConDeclGADT{} <- con = con_res_ty con
| otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
-- | Keep export items with docs.
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 7023a908..fadd0553 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -428,35 +428,41 @@ renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType
, dd_derivs = noLoc [] })
renameCon :: ConDecl GhcRn -> RnM (ConDecl DocNameI)
-renameCon decl@(ConDeclH98 { con_name = lname, con_qvars = ltyvars
- , con_cxt = lcontext, con_details = details
+renameCon decl@(ConDeclH98 { con_name = lname, con_ex_tvs = ltyvars
+ , con_mb_cxt = lcontext, con_args = details
, con_doc = mbldoc }) = do
lname' <- renameL lname
- ltyvars' <- traverse renameLHsQTyVars ltyvars
+ ltyvars' <- mapM renameLTyVarBndr ltyvars
lcontext' <- traverse renameLContext lcontext
details' <- renameDetails details
mbldoc' <- mapM renameLDocHsSyn mbldoc
- return (decl { con_name = lname', con_qvars = ltyvars', con_cxt = lcontext'
- , con_details = details', con_doc = mbldoc' })
+ return (decl { con_name = lname', con_ex_tvs = ltyvars'
+ , con_mb_cxt = lcontext'
+ , con_args = details', con_doc = mbldoc' })
- where
- renameDetails (RecCon (L l fields)) = do
- fields' <- mapM renameConDeclFieldField fields
- return (RecCon (L l fields'))
- renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
- renameDetails (InfixCon a b) = do
- a' <- renameLType a
- b' <- renameLType b
- return (InfixCon a' b')
-
-renameCon decl@(ConDeclGADT { con_names = lnames
- , con_type = lty
+renameCon decl@(ConDeclGADT { con_names = lnames, con_qvars = ltyvars
+ , con_mb_cxt = lcontext, con_args = details
+ , con_res_ty = res_ty
, con_doc = mbldoc }) = do
lnames' <- mapM renameL lnames
- lty' <- renameLSigType lty
+ ltyvars' <- renameLHsQTyVars ltyvars
+ lcontext' <- traverse renameLContext lcontext
+ details' <- renameDetails details
+ res_ty' <- renameLType res_ty
mbldoc' <- mapM renameLDocHsSyn mbldoc
- return (decl { con_names = lnames'
- , con_type = lty', con_doc = mbldoc' })
+ return (decl { con_names = lnames', con_qvars = ltyvars'
+ , con_mb_cxt = lcontext', con_args = details'
+ , con_res_ty = res_ty', con_doc = mbldoc' })
+
+renameDetails :: HsConDeclDetails GhcRn -> RnM (HsConDeclDetails DocNameI)
+renameDetails (RecCon (L l fields)) = do
+ fields' <- mapM renameConDeclFieldField fields
+ return (RecCon (L l fields'))
+renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
+renameDetails (InfixCon a b) = do
+ a' <- renameLType a
+ b' <- renameLType b
+ return (InfixCon a' b')
renameConDeclFieldField :: LConDeclField GhcRn -> RnM (LConDeclField DocNameI)
renameConDeclFieldField (L l (ConDeclField names t doc)) = do