aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface/Create.hs
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2017-11-21 15:52:15 -0500
committerBen Gamari <ben@smart-cactus.org>2017-11-21 16:36:06 -0500
commitae0d140334fff57f2737dbd7c5804b4868d9c3ab (patch)
tree3f1ef4707ddf7fb79737643a9b4175a89e302247 /haddock-api/src/Haddock/Interface/Create.hs
parentbe45ddae4e2f7d971f2166d9a8fe45402ddcb3c1 (diff)
Revert "Match changes for Trees that Grow in GHC"
This reverts commit 01eeeb048acd2dd05ff6471ae148a97cf0720547.
Diffstat (limited to 'haddock-api/src/Haddock/Interface/Create.hs')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs30
1 files changed, 14 insertions, 16 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index c6a67af0..27456998 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -454,12 +454,12 @@ subordinates instMap decl = case decl of
cons = map unL $ (dd_cons dd)
constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, M.empty)
| c <- cons, cname <- getConNames c ]
- fields = [ (extFieldOcc n, maybeToList $ fmap unL doc, M.empty)
+ fields = [ (selectorFieldOcc n, maybeToList $ fmap unL doc, M.empty)
| RecCon flds <- map getConDetails cons
, L _ (ConDeclField ns _ doc) <- (unLoc flds)
, L _ n <- ns ]
derivs = [ (instName, [unL doc], M.empty)
- | HsIB { hsib_body = L l (HsDocTy _ _ doc) }
+ | HsIB { hsib_body = L l (HsDocTy _ doc) }
<- concatMap (unLoc . deriv_clause_tys . unLoc) $
unLoc $ dd_derivs dd
, Just instName <- [M.lookup l instMap] ]
@@ -478,9 +478,9 @@ typeDocs d =
where
go n (HsForAllTy { hst_body = ty }) = go n (unLoc ty)
go n (HsQualTy { hst_body = ty }) = go n (unLoc ty)
- go n (HsFunTy _ (L _ (HsDocTy _ _ (L _ x))) (L _ ty)) = M.insert n x $ go (n+1) ty
- go n (HsFunTy _ _ ty) = go (n+1) (unLoc ty)
- go n (HsDocTy _ _ (L _ doc)) = M.singleton n doc
+ go n (HsFunTy (L _ (HsDocTy _ (L _ x))) (L _ ty)) = M.insert n x $ go (n+1) ty
+ go n (HsFunTy _ ty) = go (n+1) (unLoc ty)
+ go n (HsDocTy _ (L _ doc)) = M.singleton n doc
go _ _ = M.empty
@@ -1031,7 +1031,7 @@ extractDecl name decl
, RecCon rec <- map (getConDetails . unLoc) (dd_cons (feqn_rhs d))
, ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
, L _ n <- ns
- , extFieldOcc n == name
+ , selectorFieldOcc n == name
]
in case matches of
[d0] -> extractDecl name (noLoc . InstD $ DataFamInstD d0)
@@ -1057,18 +1057,17 @@ extractPatternSyn nm t tvs cons =
typ = longArrow args (data_ty con)
typ' =
case con of
- ConDeclH98 { con_cxt = Just cxt } -> noLoc (HsQualTy PlaceHolder cxt typ)
+ ConDeclH98 { con_cxt = Just cxt } -> noLoc (HsQualTy cxt typ)
_ -> typ
- typ'' = noLoc (HsQualTy PlaceHolder (noLoc []) typ')
+ typ'' = noLoc (HsQualTy (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 PlaceHolder x y)) output inputs
+ longArrow :: [LHsType name] -> LHsType name -> LHsType name
+ longArrow inputs output = foldr (\x y -> noLoc (HsFunTy x y)) output inputs
data_ty con
| ConDeclGADT{} <- con = hsib_body $ con_type con
- | otherwise = foldl' (\x y -> noLoc (HsAppTy PlaceHolder x y))
- (noLoc (HsTyVar PlaceHolder NotPromoted (noLoc t))) tvs
+ | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
extractRecSel :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn]
-> LSig GhcRn
@@ -1077,17 +1076,16 @@ 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 PlaceHolder data_ty (getBangType ty)))))
+ L l (TypeSig [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy data_ty (getBangType ty)))))
_ -> extractRecSel nm t tvs rest
where
matching_fields :: [LConDeclField GhcRn] -> [(SrcSpan, LConDeclField GhcRn)]
matching_fields flds = [ (l,f) | f@(L _ (ConDeclField ns _ _)) <- flds
- , L l n <- ns, extFieldOcc n == nm ]
+ , L l n <- ns, selectorFieldOcc n == nm ]
data_ty
-- ResTyGADT _ ty <- con_res con = ty
| ConDeclGADT{} <- con = hsib_body $ con_type con
- | otherwise = foldl' (\x y -> noLoc (HsAppTy PlaceHolder x y))
- (noLoc (HsTyVar PlaceHolder NotPromoted (noLoc t))) tvs
+ | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
-- | Keep export items with docs.
pruneExportItems :: [ExportItem GhcRn] -> [ExportItem GhcRn]