diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2017-10-17 15:00:02 +0200 |
|---|---|---|
| committer | Alan Zimmerman <alan.zimm@gmail.com> | 2017-11-07 08:28:03 +0200 |
| commit | 01eeeb048acd2dd05ff6471ae148a97cf0720547 (patch) | |
| tree | 3598e6d0f16fee0640d96b4cf12426155608acae /haddock-api/src/Haddock/Utils.hs | |
| parent | 1789c77a6ed1580dc10a4391dc8c398e902f03b1 (diff) | |
Match changes for Trees that Grow in GHC
Diffstat (limited to 'haddock-api/src/Haddock/Utils.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Utils.hs | 15 |
1 files changed, 9 insertions, 6 deletions
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index 84f58ab8..815aad47 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -63,7 +63,7 @@ import Haddock.GhcUtils import GHC import Name import NameSet ( emptyNameSet ) -import HsTypes (selectorFieldOcc) +import HsTypes (extFieldOcc) import Control.Monad ( liftM ) import Data.Char ( isAlpha, isAlphaNum, isAscii, ord, chr ) @@ -136,11 +136,14 @@ addClassContext cls tvs0 (L pos (ClassOpSig _ lname ltype)) -- The mkEmptySigWcType is suspicious where go (L loc (HsForAllTy { hst_bndrs = tvs, hst_body = ty })) - = L loc (HsForAllTy { hst_bndrs = tvs, hst_body = go ty }) + = L loc (HsForAllTy { hst_xforall = PlaceHolder + , hst_bndrs = tvs, hst_body = go ty }) go (L loc (HsQualTy { hst_ctxt = ctxt, hst_body = ty })) - = L loc (HsQualTy { hst_ctxt = add_ctxt ctxt, hst_body = ty }) + = L loc (HsQualTy { hst_xqual = PlaceHolder + , hst_ctxt = add_ctxt ctxt, hst_body = ty }) go (L loc ty) - = L loc (HsQualTy { hst_ctxt = add_ctxt (L loc []), hst_body = L loc ty }) + = L loc (HsQualTy { hst_xqual = PlaceHolder + , hst_ctxt = add_ctxt (L loc []), hst_body = L loc ty }) extra_pred = nlHsTyConApp cls (lHsQTyVarsToTypes tvs0) add_ctxt (L loc preds) = L loc (extra_pred : preds) @@ -149,7 +152,7 @@ addClassContext _ _ sig = sig -- E.g. a MinimalSig is fine lHsQTyVarsToTypes :: LHsQTyVars GhcRn -> [LHsType GhcRn] lHsQTyVarsToTypes tvs - = [ noLoc (HsTyVar NotPromoted (noLoc (hsLTyVarName tv))) + = [ noLoc (HsTyVar PlaceHolder NotPromoted (noLoc (hsLTyVarName tv))) | tv <- hsQTvExplicit tvs ] -------------------------------------------------------------------------------- @@ -209,7 +212,7 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ] field_avail :: LConDeclField GhcRn -> Bool field_avail (L _ (ConDeclField fs _ _)) - = all (\f -> selectorFieldOcc (unLoc f) `elem` names) fs + = all (\f -> extFieldOcc (unLoc f) `elem` names) fs field_types flds = [ t | ConDeclField _ t _ <- flds ] keep _ = Nothing |