aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Interface
diff options
context:
space:
mode:
authorRichard Eisenberg <eir@cis.upenn.edu>2013-06-21 14:08:25 +0100
committerRichard Eisenberg <eir@cis.upenn.edu>2013-06-21 14:08:25 +0100
commitce3ff856c9412d5392fb7a5c37445f60f84cb2d2 (patch)
tree9a3ba795f0def258affe1a4c456edc3bfee6d0fe /src/Haddock/Interface
parent336e635f0462daadaa280e8c3dbb4f23422e341f (diff)
Updates to reflect changes in HsDecls to support closed type families.
Diffstat (limited to 'src/Haddock/Interface')
-rw-r--r--src/Haddock/Interface/AttachInstances.hs2
-rw-r--r--src/Haddock/Interface/Create.hs13
-rw-r--r--src/Haddock/Interface/Rename.hs19
3 files changed, 22 insertions, 12 deletions
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 62d08021..03d463cb 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -116,7 +116,7 @@ dropSilentArgs dfun theta = drop (dfunNSilent dfun) theta
-- | Like GHC's getInfo but doesn't cut things out depending on the
-- interative context, which we don't set sufficiently anyway.
-getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst Branched]))
+getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst]))
getAllInfo name = withSession $ \hsc_env -> do
(_msgs, r) <- liftIO $ tcRnGetInfo hsc_env name
return r
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 40016a0b..d4adbe1c 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -385,16 +385,19 @@ warnAboutFilteredDecls :: DynFlags -> Module -> [LHsDecl Name] -> ErrMsgM ()
warnAboutFilteredDecls dflags mdl decls = do
let modStr = moduleString mdl
let typeInstances =
- nub (concat [[ unLoc (tfie_tycon eqn)
- | L _ (InstD (TyFamInstD (TyFamInstDecl { tfid_eqns = eqns }))) <- decls
- , L _ eqn <- eqns ],
+ nub (concat [[ unLoc (tfie_tycon (unLoc eqn))
+ | L _ (InstD (TyFamInstD (TyFamInstDecl { tfid_eqn = eqn }))) <- decls ],
[ unLoc (dfid_tycon d)
- | L _ (InstD (DataFamInstD { dfid_inst = d })) <- decls ]])
+ | L _ (InstD (DataFamInstD { dfid_inst = d })) <- decls ],
+ [ unLoc tc
+ | L _ (TyClD (FamDecl (FamilyDecl { fdInfo = ClosedTypeFamily _
+ , fdLName = tc }))) <- decls ]])
unless (null typeInstances) $
tell [
"Warning: " ++ modStr ++ ": Instances of type and data "
- ++ "families are not yet supported. Instances of the following families "
+ ++ "families and equations of closed type families are not yet supported."
+ ++ "Instances of the following families "
++ "will be filtered out:\n " ++ (intercalate ", "
$ map (occNameString . nameOccName) typeInstances) ]
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index a2499726..f21088d8 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -379,14 +379,22 @@ renameTyClD d = case d of
renameLSig (L loc sig) = return . L loc =<< renameSig sig
renameFamilyDecl :: FamilyDecl Name -> RnM (FamilyDecl DocName)
-renameFamilyDecl (FamilyDecl { fdFlavour = flav, fdLName = lname
+renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname
, fdTyVars = ltyvars, fdKindSig = tckind }) = do
+ info' <- renameFamilyInfo info
lname' <- renameL lname
ltyvars' <- renameLTyVarBndrs ltyvars
tckind' <- renameMaybeLKind tckind
- return (FamilyDecl { fdFlavour = flav, fdLName = lname'
+ return (FamilyDecl { fdInfo = info', fdLName = lname'
, fdTyVars = ltyvars', fdKindSig = tckind' })
+renameFamilyInfo :: FamilyInfo Name -> RnM (FamilyInfo DocName)
+renameFamilyInfo DataFamily = return DataFamily
+renameFamilyInfo OpenTypeFamily = return OpenTypeFamily
+renameFamilyInfo (ClosedTypeFamily eqns)
+ = do { eqns' <- mapM (renameLThing renameTyFamInstEqn) eqns
+ ; return $ ClosedTypeFamily eqns' }
+
renameDataDefn :: HsDataDefn Name -> RnM (HsDataDefn DocName)
renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType
, dd_kindSig = k, dd_cons = cons }) = do
@@ -471,10 +479,9 @@ renameClsInstD (ClsInstDecl { cid_poly_ty =ltype, cid_tyfam_insts = lATs, cid_da
renameTyFamInstD :: TyFamInstDecl Name -> RnM (TyFamInstDecl DocName)
-renameTyFamInstD (TyFamInstDecl { tfid_eqns = eqns , tfid_group = eqn_group })
- = do { eqns' <- mapM (renameLThing renameTyFamInstEqn) eqns
- ; return (TyFamInstDecl { tfid_eqns = eqns'
- , tfid_group = eqn_group
+renameTyFamInstD (TyFamInstDecl { tfid_eqn = eqn })
+ = do { eqn' <- renameLThing renameTyFamInstEqn eqn
+ ; return (TyFamInstDecl { tfid_eqn = eqn'
, tfid_fvs = placeHolderNames }) }
renameTyFamInstEqn :: TyFamInstEqn Name -> RnM (TyFamInstEqn DocName)