aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs6
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs11
-rw-r--r--haddock-api/src/Haddock/Interface/Specialize.hs4
3 files changed, 11 insertions, 10 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 2d79bb97..2782f711 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -1142,7 +1142,7 @@ extractPatternSyn nm t tvs cons =
InfixCon arg1 arg2 -> map hsScaledThing [arg1, arg2]
ConDeclGADT { con_g_args = con_args' } -> case con_args' of
PrefixConGADT args' -> map hsScaledThing args'
- RecConGADT (L _ fields) -> cd_fld_type . unLoc <$> fields
+ RecConGADT (L _ fields) _ -> cd_fld_type . unLoc <$> fields
typ = longArrow args (data_ty con)
typ' =
case con of
@@ -1152,7 +1152,7 @@ extractPatternSyn nm t tvs cons =
in PatSynSig noAnn [noLocA nm] (mkEmptySigType typ'')
longArrow :: [LHsType GhcRn] -> LHsType GhcRn -> LHsType GhcRn
- longArrow inputs output = foldr (\x y -> noLocA (HsFunTy noAnn (HsUnrestrictedArrow NormalSyntax) x y)) output inputs
+ longArrow inputs output = foldr (\x y -> noLocA (HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) x y)) output inputs
data_ty con
| ConDeclGADT{} <- con = con_res_ty con
@@ -1169,7 +1169,7 @@ extractRecSel _ _ _ [] = Left "extractRecSel: selector not found"
extractRecSel nm t tvs (L _ con : rest) =
case getRecConArgs_maybe con of
Just (L _ fields) | ((l,L _ (ConDeclField _ _nn ty _)) : _) <- matching_fields fields ->
- pure (L (noAnnSrcSpan l) (TypeSig noAnn [noLocA nm] (mkEmptyWildCardBndrs $ mkEmptySigType (noLocA (HsFunTy noAnn (HsUnrestrictedArrow NormalSyntax) data_ty (getBangType ty))))))
+ pure (L (noAnnSrcSpan l) (TypeSig noAnn [noLocA nm] (mkEmptyWildCardBndrs $ mkEmptySigType (noLocA (HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) data_ty (getBangType ty))))))
_ -> extractRecSel nm t tvs rest
where
matching_fields :: [LConDeclField GhcRn] -> [(SrcSpan, LConDeclField GhcRn)]
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 693a22ef..98b3a6e6 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -245,9 +245,10 @@ renameMaybeInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)
renameMaybeInjectivityAnn = traverse renameInjectivityAnn
renameArrow :: HsArrow GhcRn -> RnM (HsArrow DocNameI)
-renameArrow (HsUnrestrictedArrow u) = return (HsUnrestrictedArrow u)
-renameArrow (HsLinearArrow u a) = return (HsLinearArrow u a)
-renameArrow (HsExplicitMult u a p) = HsExplicitMult u a <$> renameLType p
+renameArrow (HsUnrestrictedArrow arr) = return (HsUnrestrictedArrow arr)
+renameArrow (HsLinearArrow (HsPct1 pct1 arr)) = return (HsLinearArrow (HsPct1 pct1 arr))
+renameArrow (HsLinearArrow (HsLolly arr)) = return (HsLinearArrow (HsLolly arr))
+renameArrow (HsExplicitMult pct p arr) = (\p' -> HsExplicitMult pct p' arr) <$> renameLType p
renameType :: HsType GhcRn -> RnM (HsType DocNameI)
renameType t = case t of
@@ -548,9 +549,9 @@ renameH98Details (InfixCon a b) = do
renameGADTDetails :: HsConDeclGADTDetails GhcRn
-> RnM (HsConDeclGADTDetails DocNameI)
-renameGADTDetails (RecConGADT (L l fields)) = do
+renameGADTDetails (RecConGADT (L l fields) arr) = do
fields' <- mapM renameConDeclFieldField fields
- return (RecConGADT (L (locA l) fields'))
+ return (RecConGADT (L (locA l) fields') arr)
renameGADTDetails (PrefixConGADT ps) = PrefixConGADT <$> mapM renameHsScaled ps
renameConDeclFieldField :: LConDeclField GhcRn -> RnM (LConDeclField DocNameI)
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 657da7ae..399e5d0d 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -134,7 +134,7 @@ sugarTuples typ =
sugarOperators :: HsType GhcRn -> HsType GhcRn
sugarOperators (HsAppTy _ (L _ (HsAppTy _ (L _ (HsTyVar _ _ (L l name))) la)) lb)
| isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb
- | unrestrictedFunTyConName == name' = HsFunTy noAnn (HsUnrestrictedArrow NormalSyntax) la lb
+ | unrestrictedFunTyConName == name' = HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) la lb
where
name' = getName name
sugarOperators typ = typ
@@ -311,7 +311,7 @@ renameType t@(HsTyLit _ _) = pure t
renameType (HsWildCardTy wc) = pure (HsWildCardTy wc)
renameHsArrow :: HsArrow GhcRn -> Rename (IdP GhcRn) (HsArrow GhcRn)
-renameHsArrow (HsExplicitMult u a p) = HsExplicitMult u a <$> renameLType p
+renameHsArrow (HsExplicitMult pct p arr) = (\p' -> HsExplicitMult pct p' arr) <$> renameLType p
renameHsArrow mult = pure mult