diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2014-09-05 18:13:24 -0500 | 
|---|---|---|
| committer | Austin Seipp <aseipp@pobox.com> | 2014-09-05 18:13:24 -0500 | 
| commit | aacaa91951b16f22e3ad54412974b81c32230a8c (patch) | |
| tree | d00b833e52a6ca0e66fbdfdc131695b9cea90ecc /src/Haddock | |
| parent | eee52f697233f99e23c1d8183511229fb93e3f3e (diff) | |
Follow changes to TypeAnnot in GHC HEAD
Signed-off-by: Austin Seipp <aseipp@pobox.com>
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Convert.hs | 10 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 27 | 
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 | 
