aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs6
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs10
-rw-r--r--haddock-api/src/Haddock/Convert.hs6
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs4
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs10
-rw-r--r--haddock-api/src/Haddock/Types.hs13
7 files changed, 27 insertions, 26 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 55075e20..68896d72 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -152,7 +152,7 @@ ppClass dflags x = out dflags x{tcdSigs=[]} :
f t = HsForAllTy Implicit Nothing emptyHsQTvs (reL [context]) (reL t)
context = nlHsTyConApp (tcdName x)
- (map (reL . HsTyVar . hsTyVarName . unL) (hsQTvBndrs (tyClDeclTyVars x)))
+ (map (reL . HsTyVar . reL . hsTyVarName . unL) (hsQTvBndrs (tyClDeclTyVars x)))
ppInstance :: DynFlags -> ClsInst -> [String]
@@ -201,7 +201,7 @@ ppCtor dflags dat subdocs con
name = out dflags $ map unL $ con_names con
resType = case con_res con of
- ResTyH98 -> apps $ map (reL . HsTyVar) $
+ ResTyH98 -> apps $ map (reL . HsTyVar . reL) $
(tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvBndrs $ tyClDeclTyVars dat]
ResTyGADT _ x -> x
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 68149b41..c4468c9c 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -902,14 +902,14 @@ ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode
hsep [ppForAll expl tvs ctxt' unicode, ppr_mono_lty pREC_TOP ty unicode]
where
anonWC :: HsType DocName
- anonWC = HsWildCardTy (AnonWildCard (Undocumented underscore))
+ anonWC = HsWildCardTy (AnonWildCard (noLoc (Undocumented underscore)))
underscore = mkUnboundName (mkRdrUnqual (mkTyVarOcc "_"))
ctxt'
| Just loc <- extra = (++ [L loc anonWC]) `fmap` ctxt
| otherwise = ctxt
ppr_mono_ty _ (HsBangTy b ty) u = ppBang b <> ppLParendType u ty
-ppr_mono_ty _ (HsTyVar name) _ = ppDocName name
+ppr_mono_ty _ (HsTyVar (L _ name)) _ = ppDocName name
ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u = ppr_fun_ty ctxt_prec ty1 ty2 u
ppr_mono_ty _ (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)
ppr_mono_ty _ (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
@@ -947,7 +947,7 @@ ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode
ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ = char '_'
-ppr_mono_ty _ (HsWildCardTy (NamedWildCard name)) _ = ppDocName name
+ppr_mono_ty _ (HsWildCardTy (NamedWildCard (L _ name))) _ = ppDocName name
ppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 8996fc87..328684f3 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -835,7 +835,7 @@ ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual
ppFunLhType unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual
ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocName -> Html
-ppHsTyVarBndr _ qual (UserTyVar name ) =
+ppHsTyVarBndr _ qual (UserTyVar (L _ name)) =
ppDocName qual Raw False name
ppHsTyVarBndr unicode qual (KindedTyVar name kind) =
parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+>
@@ -877,19 +877,19 @@ ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode qual
= maybeParen ctxt_prec pREC_FUN $ ppForAllCon expl tvs ctxt' unicode qual
<+> ppr_mono_lty pREC_TOP ty unicode qual
where
- anonWC = HsWildCardTy (AnonWildCard (Undocumented underscore))
+ anonWC = HsWildCardTy (AnonWildCard (noLoc (Undocumented underscore)))
underscore = mkUnboundName (mkRdrUnqual (mkTyVarOcc "_"))
ctxt'
| Just loc <- extra = (++ [L loc anonWC]) `fmap` ctxt
| otherwise = ctxt
-- UnicodeSyntax alternatives
-ppr_mono_ty _ (HsTyVar name) True _
+ppr_mono_ty _ (HsTyVar (L _ name)) True _
| getOccString (getName name) == "*" = toHtml "★"
| getOccString (getName name) == "(->)" = toHtml "(→)"
ppr_mono_ty _ (HsBangTy b ty) u q = ppBang b +++ ppLParendType u q ty
-ppr_mono_ty _ (HsTyVar name) _ q = ppDocName q Prefix True name
+ppr_mono_ty _ (HsTyVar (L _ name)) _ q = ppDocName q Prefix True name
ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u q = ppr_fun_ty ctxt_prec ty1 ty2 u q
ppr_mono_ty _ (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)
ppr_mono_ty _ (HsKindSig ty kind) u q =
@@ -928,7 +928,7 @@ ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual
ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ = char '_'
-ppr_mono_ty _ (HsWildCardTy (NamedWildCard name)) _ q = ppDocName q Prefix True name
+ppr_mono_ty _ (HsWildCardTy (NamedWildCard (L _ name))) _ q = ppDocName q Prefix True name
ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index a61e3696..ff34d271 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -326,7 +326,7 @@ synifyTyVars ktvs = HsQTvs { hsq_kvs = map tyVarName kvs
where
(kvs, tvs) = partition isKindVar ktvs
synifyTyVar tv
- | isLiftedTypeKind kind = noLoc (UserTyVar name)
+ | isLiftedTypeKind kind = noLoc (UserTyVar (noLoc name))
| otherwise = noLoc (KindedTyVar (noLoc name) (synifyKindSig kind))
where
kind = tyVarKind tv
@@ -349,7 +349,7 @@ data SynifyTypeState
synifyType :: SynifyTypeState -> Type -> LHsType Name
-synifyType _ (TyVarTy tv) = noLoc $ HsTyVar (getName tv)
+synifyType _ (TyVarTy tv) = noLoc $ HsTyVar $ noLoc (getName tv)
synifyType _ (TyConApp tc tys)
-- Use non-prefix tuple syntax where possible, because it looks nicer.
| Just sort <- tyConTuple_maybe tc
@@ -374,7 +374,7 @@ synifyType _ (TyConApp tc tys)
-- Most TyCons:
| otherwise =
foldl (\t1 t2 -> noLoc (HsAppTy t1 t2))
- (noLoc $ HsTyVar (getName tc))
+ (noLoc $ HsTyVar $ noLoc (getName tc))
(map (synifyType WithinType) tys)
synifyType _ (AppTy t1 t2) = let
s1 = synifyType WithinType t1
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 9b8bbe50..349356d6 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -800,7 +800,7 @@ extractDecl name mdl decl
toTypeNoLoc :: Located Name -> LHsType Name
-toTypeNoLoc = noLoc . HsTyVar . unLoc
+toTypeNoLoc = noLoc . HsTyVar
extractClassDecl :: Name -> [Located Name] -> LSig Name -> LSig Name
@@ -829,7 +829,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) =
, L l n <- ns, selectorFieldOcc n == nm ]
data_ty
| ResTyGADT _ ty <- con_res con = ty
- | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar t)) tvs
+ | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar (noLoc t))) tvs
-- | Keep export items with docs.
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 131082cd..f9edb574 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -204,7 +204,7 @@ renameType t = case t of
ltype' <- renameLType ltype
return (HsForAllTy expl extra tyvars' lcontext' ltype')
- HsTyVar n -> return . HsTyVar =<< rename n
+ HsTyVar (L l n) -> return . HsTyVar . L l =<< rename n
HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype
HsAppTy a b -> do
@@ -259,9 +259,9 @@ renameLTyVarBndrs (HsQTvs { hsq_kvs = _, hsq_tvs = tvs })
-- This is rather bogus, but I'm not sure what else to do
renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
-renameLTyVarBndr (L loc (UserTyVar n))
+renameLTyVarBndr (L loc (UserTyVar (L l n)))
= do { n' <- rename n
- ; return (L loc (UserTyVar n')) }
+ ; return (L loc (UserTyVar (L l n'))) }
renameLTyVarBndr (L loc (KindedTyVar (L lv n) kind))
= do { n' <- rename n
; kind' <- renameLKind kind
@@ -273,8 +273,8 @@ renameLContext (L loc context) = do
return (L loc context')
renameWildCardInfo :: HsWildCardInfo Name -> RnM (HsWildCardInfo DocName)
-renameWildCardInfo (AnonWildCard name) = AnonWildCard <$> rename name
-renameWildCardInfo (NamedWildCard name) = NamedWildCard <$> rename name
+renameWildCardInfo (AnonWildCard (L l name)) = AnonWildCard . L l <$> rename name
+renameWildCardInfo (NamedWildCard (L l name)) = NamedWildCard . L l <$> rename name
renameInstHead :: InstHead Name -> RnM (InstHead DocName)
renameInstHead (className, k, types, rest) = do
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 33ab9592..43671de3 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -558,12 +558,13 @@ instance Monad ErrMsgGhc where
-- * Pass sensitive types
-----------------------------------------------------------------------------
-type instance PostRn DocName NameSet = PlaceHolder
-type instance PostRn DocName Fixity = PlaceHolder
-type instance PostRn DocName Bool = PlaceHolder
-type instance PostRn DocName Name = DocName
-type instance PostRn DocName [Name] = PlaceHolder
-type instance PostRn DocName DocName = DocName
+type instance PostRn DocName NameSet = PlaceHolder
+type instance PostRn DocName Fixity = PlaceHolder
+type instance PostRn DocName Bool = PlaceHolder
+type instance PostRn DocName Name = DocName
+type instance PostRn DocName (Located Name) = Located DocName
+type instance PostRn DocName [Name] = PlaceHolder
+type instance PostRn DocName DocName = DocName
type instance PostTc DocName Kind = PlaceHolder
type instance PostTc DocName Type = PlaceHolder
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 16:04:11 +0000