aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/GhcUtils.hs
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2021-02-22 20:04:24 +0000
committerAlan Zimmerman <alan.zimm@gmail.com>2021-02-22 20:04:24 +0000
commit8241d9e700e043b86b609c334494c4632848389f (patch)
tree58cc739b2a3f9aa70c344a8c98994bd6c8b03172 /haddock-api/src/Haddock/GhcUtils.hs
parentd1b7f181b60ba3ac191183f1512e66793d28ac08 (diff)
Context becomes a Maybe in the GHC AST
This prevents noLoc's appearing in the ParsedSource. Match the change in GHC.
Diffstat (limited to 'haddock-api/src/Haddock/GhcUtils.hs')
-rw-r--r--haddock-api/src/Haddock/GhcUtils.hs16
1 files changed, 11 insertions, 5 deletions
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 546e2941..6e21e094 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -24,7 +24,7 @@ module Haddock.GhcUtils where
import Control.Arrow
import Data.Char ( isSpace )
-import Data.Maybe ( mapMaybe )
+import Data.Maybe ( mapMaybe, fromMaybe )
import Haddock.Types( DocName, DocNameI )
@@ -172,7 +172,7 @@ getGADTConType (ConDeclGADT { con_bndrs = L _ outer_bndrs
, sig_body = theta_ty })
where
theta_ty | Just theta <- mcxt
- = noLoc (HsQualTy { hst_xqual = noExtField, hst_ctxt = theta, hst_body = tau_ty })
+ = noLoc (HsQualTy { hst_xqual = noExtField, hst_ctxt = Just theta, hst_body = tau_ty })
| otherwise
= tau_ty
@@ -226,10 +226,12 @@ addClassContext cls tvs0 (L pos (ClassOpSig _ _ lname ltype))
, hst_ctxt = add_ctxt ctxt, hst_body = ty })
go_ty (L loc ty)
= L loc (HsQualTy { hst_xqual = noExtField
- , hst_ctxt = add_ctxt (L loc []), hst_body = L loc ty })
+ , hst_ctxt = add_ctxt Nothing, hst_body = L loc ty })
extra_pred = nlHsTyConApp Prefix cls (lHsQTyVarsToTypes tvs0)
- add_ctxt (L loc preds) = L loc (extra_pred : preds)
+
+ add_ctxt Nothing = Just $ noLoc [extra_pred]
+ add_ctxt (Just (L loc preds)) = Just $ L loc (extra_pred : preds)
addClassContext _ _ sig = sig -- E.g. a MinimalSig is fine
@@ -355,7 +357,9 @@ reparenTypePrec = go
go p (HsQualTy x ctxt ty)
= let p' [_] = PREC_CTX
p' _ = PREC_TOP -- parens will get added anyways later...
- ctxt' = mapXRec @a (\xs -> map (goL (p' xs)) xs) ctxt
+ ctxt' = case ctxt of
+ Nothing -> Nothing
+ Just c -> Just $ mapXRec @a (\xs -> map (goL (p' xs)) xs) c
in paren p PREC_CTX $ HsQualTy x ctxt' (goL PREC_TOP ty)
go p (HsFunTy x w ty1 ty2)
= paren p PREC_FUN $ HsFunTy x w (goL PREC_FUN ty1) (goL PREC_TOP ty2)
@@ -758,3 +762,5 @@ defaultRuntimeRepVars = go emptyVarEnv
go _ ty@(LitTy {}) = ty
go _ ty@(CoercionTy {}) = ty
+fromMaybeContext :: Maybe (LHsContext DocNameI) -> HsContext DocNameI
+fromMaybeContext mctxt = unLoc $ fromMaybe (noLoc []) mctxt