aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2017-11-21 15:50:12 -0500
committerBen Gamari <ben@smart-cactus.org>2017-11-21 15:50:12 -0500
commita1cc07a1c7272e09b67eaf0193722ad3451e5dc2 (patch)
tree47235d3eba7b214f084b8ac46f1a6be21bd5dd02 /haddock-api/src/Haddock/Interface
parent04fd3e021cfe04eaaa470be4ae8408a417821864 (diff)
Revert "Clean up use of PlaceHolder, to match TTG"
This reverts commit 134a7bb054ea730b13c8629a76232d73e3ace049.
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.hs45
-rw-r--r--haddock-api/src/Haddock/Interface/Specialize.hs6
3 files changed, 33 insertions, 34 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 048126cf..357cd780 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -1057,18 +1057,18 @@ extractPatternSyn nm t tvs cons =
typ = longArrow args (data_ty con)
typ' =
case con of
- ConDeclH98 { con_cxt = Just cxt } -> noLoc (HsQualTy noExt cxt typ)
+ ConDeclH98 { con_cxt = Just cxt } -> noLoc (HsQualTy PlaceHolder cxt typ)
_ -> typ
- typ'' = noLoc (HsQualTy noExt (noLoc []) typ')
+ typ'' = noLoc (HsQualTy PlaceHolder (noLoc []) typ')
in PatSynSig [noLoc nm] (mkEmptyImplicitBndrs typ'')
longArrow :: [LHsType (GhcPass name)] -> LHsType (GhcPass name) -> LHsType (GhcPass name)
- longArrow inputs output = foldr (\x y -> noLoc (HsFunTy noExt x y)) output inputs
+ longArrow inputs output = foldr (\x y -> noLoc (HsFunTy PlaceHolder x y)) output inputs
data_ty con
| ConDeclGADT{} <- con = hsib_body $ con_type con
- | otherwise = foldl' (\x y -> noLoc (HsAppTy noExt x y))
- (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs
+ | otherwise = foldl' (\x y -> noLoc (HsAppTy PlaceHolder x y))
+ (noLoc (HsTyVar PlaceHolder NotPromoted (noLoc t))) tvs
extractRecSel :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn]
-> LSig GhcRn
@@ -1077,7 +1077,7 @@ extractRecSel _ _ _ [] = error "extractRecSel: selector not found"
extractRecSel nm t tvs (L _ con : rest) =
case getConDetails con of
RecCon (L _ fields) | ((l,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
- L l (TypeSig [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy noExt data_ty (getBangType ty)))))
+ L l (TypeSig [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy PlaceHolder data_ty (getBangType ty)))))
_ -> extractRecSel nm t tvs rest
where
matching_fields :: [LConDeclField GhcRn] -> [(SrcSpan, LConDeclField GhcRn)]
@@ -1086,8 +1086,8 @@ extractRecSel nm t tvs (L _ con : rest) =
data_ty
-- ResTyGADT _ ty <- con_res con = ty
| ConDeclGADT{} <- con = hsib_body $ con_type con
- | otherwise = foldl' (\x y -> noLoc (HsAppTy noExt x y))
- (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs
+ | otherwise = foldl' (\x y -> noLoc (HsAppTy PlaceHolder x y))
+ (noLoc (HsTyVar PlaceHolder NotPromoted (noLoc t))) tvs
-- | Keep export items with docs.
pruneExportItems :: [ExportItem GhcRn] -> [ExportItem GhcRn]
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index fc2d5723..c7e4f6f8 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -21,7 +21,6 @@ import Haddock.Types
import Bag (emptyBag)
import GHC hiding (NoLink)
import Name
-import PlaceHolder
import Control.Applicative
import Control.Monad hiding (mapM)
@@ -213,55 +212,55 @@ renameType t = case t of
HsForAllTy { hst_bndrs = tyvars, hst_body = ltype } -> do
tyvars' <- mapM renameLTyVarBndr tyvars
ltype' <- renameLType ltype
- return (HsForAllTy { hst_xforall = noExt, hst_bndrs = tyvars', hst_body = ltype' })
+ return (HsForAllTy { hst_xforall = PlaceHolder, hst_bndrs = tyvars', hst_body = ltype' })
HsQualTy { hst_ctxt = lcontext , hst_body = ltype } -> do
lcontext' <- renameLContext lcontext
ltype' <- renameLType ltype
- return (HsQualTy { hst_xqual = noExt, hst_ctxt = lcontext', hst_body = ltype' })
+ return (HsQualTy { hst_xqual = PlaceHolder, hst_ctxt = lcontext', hst_body = ltype' })
- HsTyVar _ ip (L l n) -> return . HsTyVar noExt ip . L l =<< rename n
- HsBangTy _ b ltype -> return . HsBangTy noExt b =<< renameLType ltype
+ HsTyVar _ ip (L l n) -> return . HsTyVar PlaceHolder ip . L l =<< rename n
+ HsBangTy _ b ltype -> return . HsBangTy PlaceHolder b =<< renameLType ltype
HsAppTy _ a b -> do
a' <- renameLType a
b' <- renameLType b
- return (HsAppTy noExt a' b')
+ return (HsAppTy PlaceHolder a' b')
HsFunTy _ a b -> do
a' <- renameLType a
b' <- renameLType b
- return (HsFunTy noExt a' b')
+ return (HsFunTy PlaceHolder a' b')
- HsListTy _ ty -> return . (HsListTy noExt) =<< renameLType ty
- HsPArrTy _ ty -> return . (HsPArrTy noExt) =<< renameLType ty
- HsIParamTy _ n ty -> liftM (HsIParamTy noExt n) (renameLType ty)
- HsEqTy _ ty1 ty2 -> liftM2 (HsEqTy noExt) (renameLType ty1) (renameLType ty2)
+ HsListTy _ ty -> return . (HsListTy PlaceHolder) =<< renameLType ty
+ HsPArrTy _ ty -> return . (HsPArrTy PlaceHolder) =<< renameLType ty
+ HsIParamTy _ n ty -> liftM (HsIParamTy PlaceHolder n) (renameLType ty)
+ HsEqTy _ ty1 ty2 -> liftM2 (HsEqTy PlaceHolder) (renameLType ty1) (renameLType ty2)
- HsTupleTy _ b ts -> return . HsTupleTy noExt b =<< mapM renameLType ts
- HsSumTy _ ts -> HsSumTy noExt <$> mapM renameLType ts
+ HsTupleTy _ b ts -> return . HsTupleTy PlaceHolder b =<< mapM renameLType ts
+ HsSumTy _ ts -> HsSumTy PlaceHolder <$> mapM renameLType ts
HsOpTy _ a (L loc op) b -> do
op' <- rename op
a' <- renameLType a
b' <- renameLType b
- return (HsOpTy noExt a' (L loc op') b')
+ return (HsOpTy PlaceHolder a' (L loc op') b')
- HsParTy _ ty -> return . (HsParTy noExt) =<< renameLType ty
+ HsParTy _ ty -> return . (HsParTy PlaceHolder) =<< renameLType ty
HsKindSig _ ty k -> do
ty' <- renameLType ty
k' <- renameLKind k
- return (HsKindSig noExt ty' k')
+ return (HsKindSig PlaceHolder ty' k')
HsDocTy _ ty doc -> do
ty' <- renameLType ty
doc' <- renameLDocHsSyn doc
- return (HsDocTy noExt ty' doc')
+ return (HsDocTy PlaceHolder ty' doc')
- HsTyLit _ x -> return (HsTyLit noExt x)
+ HsTyLit _ x -> return (HsTyLit PlaceHolder x)
- HsRecTy _ a -> HsRecTy noExt <$> mapM renameConDeclFieldField a
+ HsRecTy _ a -> HsRecTy PlaceHolder <$> mapM renameConDeclFieldField a
(XHsType (NHsCoreTy a)) -> pure (XHsType (NHsCoreTy a))
HsExplicitListTy x i b -> HsExplicitListTy x i <$> mapM renameLType b
HsExplicitTupleTy x b -> HsExplicitTupleTy x <$> mapM renameLType b
@@ -359,7 +358,7 @@ renameTyClD d = case d of
lname' <- renameL lname
tyvars' <- renameLHsQTyVars tyvars
defn' <- renameDataDefn defn
- return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdFixity = fixity, tcdDataDefn = defn', tcdDataCusk = placeHolder, tcdFVs = placeHolderNames })
+ return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdFixity = fixity, tcdDataDefn = defn', tcdDataCusk = PlaceHolder, tcdFVs = placeHolderNames })
ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars, tcdFixity = fixity
, tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do
@@ -598,8 +597,8 @@ renameImplicit :: (in_thing -> RnM out_thing)
renameImplicit rn_thing (HsIB { hsib_body = thing })
= do { thing' <- rn_thing thing
; return (HsIB { hsib_body = thing'
- , hsib_vars = placeHolder
- , hsib_closed = placeHolder }) }
+ , hsib_vars = PlaceHolder
+ , hsib_closed = PlaceHolder }) }
renameWc :: (in_thing -> RnM out_thing)
-> HsWildCardBndrs GhcRn in_thing
@@ -607,7 +606,7 @@ renameWc :: (in_thing -> RnM out_thing)
renameWc rn_thing (HsWC { hswc_body = thing })
= do { thing' <- rn_thing thing
; return (HsWC { hswc_body = thing'
- , hswc_wcs = placeHolder }) }
+ , hswc_wcs = PlaceHolder }) }
renameDocInstance :: DocInstance GhcRn -> RnM (DocInstance DocNameI)
renameDocInstance (inst, idoc, L l n) = do
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 8d9ec58e..f0cf08a1 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -111,7 +111,7 @@ sugar = sugarOperators . sugarTuples . sugarLists
sugarLists :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p)
sugarLists (HsAppTy _ (L _ (HsTyVar _ _ (L _ name))) ltyp)
- | isBuiltInSyntax name' && strName == "[]" = HsListTy noExt ltyp
+ | isBuiltInSyntax name' && strName == "[]" = HsListTy PlaceHolder ltyp
where
name' = getName name
strName = occNameString . nameOccName $ name'
@@ -125,7 +125,7 @@ sugarTuples typ =
aux apps (HsAppTy _ (L _ ftyp) atyp) = aux (atyp:apps) ftyp
aux apps (HsParTy _ (L _ typ')) = aux apps typ'
aux apps (HsTyVar _ _ (L _ name))
- | isBuiltInSyntax name' && suitable = HsTupleTy noExt HsBoxedTuple apps
+ | isBuiltInSyntax name' && suitable = HsTupleTy PlaceHolder HsBoxedTuple apps
where
name' = getName name
strName = occNameString . nameOccName $ name'
@@ -138,7 +138,7 @@ sugarTuples typ =
sugarOperators :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p)
sugarOperators (HsAppTy _ (L _ (HsAppTy _ (L _ (HsTyVar _ _ (L l name))) la)) lb)
| isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb
- | isBuiltInSyntax name' && getOccString name == "(->)" = HsFunTy noExt la lb
+ | isBuiltInSyntax name' && getOccString name == "(->)" = HsFunTy PlaceHolder la lb
where
name' = getName name
sugarOperators typ = typ