aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2014-09-05 18:13:24 -0500
committerAustin Seipp <aseipp@pobox.com>2014-09-05 18:13:24 -0500
commitaacaa91951b16f22e3ad54412974b81c32230a8c (patch)
treed00b833e52a6ca0e66fbdfdc131695b9cea90ecc
parenteee52f697233f99e23c1d8183511229fb93e3f3e (diff)
Follow changes to TypeAnnot in GHC HEAD
Signed-off-by: Austin Seipp <aseipp@pobox.com>
-rw-r--r--src/Haddock/Convert.hs10
-rw-r--r--src/Haddock/Interface/Rename.hs27
2 files changed, 26 insertions, 11 deletions
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index dfb0f14f..48306392 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -81,7 +81,7 @@ tyThingToLHsDecl t = noLoc $ case t of
, tcdATs = atFamDecls
, tcdATDefs = [] --ignore associated type defaults
, tcdDocs = [] --we don't have any docs at this point
- , tcdFVs = placeHolderNames }
+ , tcdFVs = placeHolderNamesTc }
| otherwise
-> TyClD (synifyTyCon Nothing tc)
@@ -118,7 +118,7 @@ synifyAxiom ax@(CoAxiom { co_ax_tc = tc })
| isOpenSynFamilyTyCon tc
, Just branch <- coAxiomSingleBranch_maybe ax
= InstD (TyFamInstD (TyFamInstDecl { tfid_eqn = noLoc $ synifyAxBranch tc branch
- , tfid_fvs = placeHolderNames }))
+ , tfid_fvs = placeHolderNamesTc }))
| Just ax' <- isClosedSynFamilyTyCon_maybe tc
, getUnique ax' == getUnique ax -- without the getUniques, type error
@@ -148,7 +148,7 @@ synifyTyCon coax tc
-- we have their kind accurately:
, dd_cons = [] -- No constructors
, dd_derivs = Nothing }
- , tcdFVs = placeHolderNames }
+ , tcdFVs = placeHolderNamesTc }
| isSynFamilyTyCon tc
= case synTyConRhs_maybe tc of
@@ -177,7 +177,7 @@ synifyTyCon coax tc
SynDecl { tcdLName = synifyName tc
, tcdTyVars = synifyTyVars (tyConTyVars tc)
, tcdRhs = synifyType WithinType ty
- , tcdFVs = placeHolderNames }
+ , tcdFVs = placeHolderNamesTc }
_ -> error "synifyTyCon: impossible synTyCon"
| otherwise =
-- (closed) newtype and data
@@ -217,7 +217,7 @@ synifyTyCon coax tc
, dd_cons = cons
, dd_derivs = alg_deriv }
in DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdDataDefn = defn
- , tcdFVs = placeHolderNames }
+ , tcdFVs = placeHolderNamesTc }
-- User beware: it is your responsibility to pass True (use_gadt_syntax)
-- for any constructor that would be misrepresented by omitting its
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index a804f4a1..dd2bd73f 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeFamilies #-}
----------------------------------------------------------------------------
-- |
-- Module : Haddock.Interface.Rename
@@ -20,6 +21,8 @@ import Haddock.Types
import Bag (emptyBag)
import GHC hiding (NoLink)
import Name
+import NameSet
+import Coercion
import Control.Applicative
import Control.Monad hiding (mapM)
@@ -177,6 +180,7 @@ renameLKind = renameLType
renameMaybeLKind :: Maybe (LHsKind Name) -> RnM (Maybe (LHsKind DocName))
renameMaybeLKind = traverse renameLKind
+
renameType :: HsType Name -> RnM (HsType DocName)
renameType t = case t of
HsForAllTy expl tyvars lcontext ltype -> do
@@ -303,17 +307,17 @@ renameTyClD d = case d of
decl' <- renameFamilyDecl decl
return (FamDecl { tcdFam = decl' })
- SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdRhs = rhs, tcdFVs = fvs } -> do
+ SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdRhs = rhs, tcdFVs = _fvs } -> do
lname' <- renameL lname
tyvars' <- renameLTyVarBndrs tyvars
rhs' <- renameLType rhs
- return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdRhs = rhs', tcdFVs = fvs })
+ return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdRhs = rhs', tcdFVs = placeHolderNames })
- DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdDataDefn = defn, tcdFVs = fvs } -> do
+ DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdDataDefn = defn, tcdFVs = _fvs } -> do
lname' <- renameL lname
tyvars' <- renameLTyVarBndrs tyvars
defn' <- renameDataDefn defn
- return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdFVs = fvs })
+ return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdFVs = placeHolderNames })
ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars
, tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do
@@ -466,7 +470,7 @@ renameLTyFamInstEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = pats_w_bndrs,
; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)
; rhs' <- renameLType rhs
; return (L loc (TyFamEqn { tfe_tycon = tc'
- , tfe_pats = pats_w_bndrs { hswb_cts = pats' }
+ , tfe_pats = HsWB pats' PlaceHolder PlaceHolder
, tfe_rhs = rhs' })) }
renameLTyFamDefltEqn :: LTyFamDefltEqn Name -> RnM (LTyFamDefltEqn DocName)
@@ -483,7 +487,9 @@ renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats_w_bndrs,
= do { tc' <- renameL tc
; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)
; defn' <- renameDataDefn defn
- ; return (DataFamInstDecl { dfid_tycon = tc', dfid_pats = pats_w_bndrs { hswb_cts = pats' }
+ ; return (DataFamInstDecl { dfid_tycon = tc'
+ , dfid_pats
+ = HsWB pats' PlaceHolder PlaceHolder
, dfid_defn = defn', dfid_fvs = placeHolderNames }) }
renameExportItem :: ExportItem Name -> RnM (ExportItem DocName)
@@ -518,3 +524,12 @@ renameSub (n,doc) = do
n' <- rename n
doc' <- renameDocForDecl doc
return (n', doc')
+
+type instance PostRn DocName NameSet = PlaceHolder
+type instance PostRn DocName Fixity = PlaceHolder
+type instance PostRn DocName Bool = PlaceHolder
+type instance PostRn DocName [Name] = PlaceHolder
+
+type instance PostTc DocName Kind = PlaceHolder
+type instance PostTc DocName Type = PlaceHolder
+type instance PostTc DocName Coercion = PlaceHolder