aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs3
-rw-r--r--haddock-api/src/Haddock/Convert.hs7
-rw-r--r--haddock-api/src/Haddock/GhcUtils.hs7
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs9
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs6
-rw-r--r--haddock-api/src/Haddock/Interface/Specialize.hs5
6 files changed, 20 insertions, 17 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 75a49036..c5a0f772 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -27,6 +27,7 @@ import Haddock.Utils hiding (out)
import GHC
import GHC.Utils.Outputable as Outputable
+import GHC.Parser.Annotation (IsUnicodeSyntax(..))
import Data.Char
import Data.List
@@ -245,7 +246,7 @@ ppCtor dflags dat subdocs con@ConDeclH98 {}
[out dflags (map (extFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]
| r <- map unLoc recs]
- funs = foldr1 (\x y -> reL $ HsFunTy noExtField HsUnrestrictedArrow x y)
+ funs = foldr1 (\x y -> reL $ HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) x y)
apps = foldl1 (\x y -> reL $ HsAppTy noExtField x y)
typeSig nm flds = operator nm ++ " :: " ++ outHsType dflags (unL $ funs flds)
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 3b73dcd1..d95337b8 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -52,6 +52,7 @@ import GHC.Utils.Outputable ( assertPanic )
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.SrcLoc
+import GHC.Parser.Annotation (IsUnicodeSyntax(..))
import Haddock.Types
import Haddock.Interface.Specialize
@@ -769,9 +770,9 @@ noKindTyVars _ _ = emptyVarSet
synifyMult :: [TyVar] -> Mult -> HsArrow GhcRn
synifyMult vs t = case t of
- One -> HsLinearArrow
- Many -> HsUnrestrictedArrow
- ty -> HsExplicitMult (synifyType WithinType vs ty)
+ One -> HsLinearArrow NormalSyntax
+ Many -> HsUnrestrictedArrow NormalSyntax
+ ty -> HsExplicitMult NormalSyntax (synifyType WithinType vs ty)
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 3abb6481..8b4bcc05 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -42,6 +42,7 @@ import GHC.Types.Var.Env ( TyVarEnv, extendVarEnv, elemVarEnv, emptyVarEnv )
import GHC.Core.TyCo.Rep ( Type(..) )
import GHC.Core.Type ( isRuntimeRepVar )
import GHC.Builtin.Types( liftedRepDataConTyCon )
+import GHC.Parser.Annotation (IsUnicodeSyntax(..))
import GHC.Data.StringBuffer ( StringBuffer )
import qualified GHC.Data.StringBuffer as S
@@ -165,13 +166,13 @@ getGADTConType (ConDeclGADT { con_forall = L _ has_forall
| otherwise
= tau_ty
--- tau_ty :: LHsType DocNameI
+-- tau_ty :: LHsType DocNameI
tau_ty = case args of
RecCon flds -> mkFunTy (noLoc (HsRecTy noExtField (unLoc flds))) res_ty
PrefixCon pos_args -> foldr mkFunTy res_ty (map hsScaledThing pos_args)
InfixCon arg1 arg2 -> (hsScaledThing arg1) `mkFunTy` ((hsScaledThing arg2) `mkFunTy` res_ty)
- mkFunTy a b = noLoc (HsFunTy noExtField HsUnrestrictedArrow a b)
+ mkFunTy a b = noLoc (HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) a b)
getGADTConType (ConDeclH98 {}) = panic "getGADTConType"
-- Should only be called on ConDeclGADT
@@ -227,7 +228,7 @@ getGADTConTypeG (ConDeclGADT { con_forall = L _ has_forall
InfixCon arg1 arg2 -> (hsScaledThing arg1) `mkFunTy` ((hsScaledThing arg2) `mkFunTy` res_ty)
-- mkFunTy :: LHsType DocNameI -> LHsType DocNameI -> LHsType DocNameI
- mkFunTy a b = noLoc (HsFunTy noExtField HsUnrestrictedArrow a b)
+ mkFunTy a b = noLoc (HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) a b)
getGADTConTypeG (ConDeclH98 {}) = panic "getGADTConTypeG"
-- Should only be called on ConDeclGADT
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 7b9674a6..dd9419eb 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -56,8 +56,7 @@ import GHC.Data.FastString ( unpackFS, bytesFS )
import GHC.Types.Basic ( StringLiteral(..), SourceText(..), PromotionFlag(..) )
import qualified GHC.Utils.Outputable as O
import GHC.HsToCore.Docs hiding (mkMaps)
-
-import GHC.Core.Multiplicity
+import GHC.Parser.Annotation (IsUnicodeSyntax(..))
-- | Use a 'TypecheckedModule' to produce an 'Interface'.
@@ -958,8 +957,8 @@ extractPatternSyn nm t tvs cons =
typ'' = noLoc (HsQualTy noExtField (noLoc []) typ')
in PatSynSig noExtField [noLoc nm] (mkEmptyImplicitBndrs typ'')
- longArrow :: (XFunTy name ~ NoExtField) => [LHsType name] -> LHsType name -> LHsType name
- longArrow inputs output = foldr (\x y -> noLoc (HsFunTy noExtField HsUnrestrictedArrow x y)) output inputs
+ longArrow :: [LHsType GhcRn] -> LHsType GhcRn -> LHsType GhcRn
+ longArrow inputs output = foldr (\x y -> noLoc (HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) x y)) output inputs
data_ty con
| ConDeclGADT{} <- con = con_res_ty con
@@ -976,7 +975,7 @@ extractRecSel _ _ _ [] = error "extractRecSel: selector not found"
extractRecSel nm t tvs (L _ con : rest) =
case getConArgs con of
RecCon (L _ fields) | ((l,L _ (ConDeclField _ _nn ty _)) : _) <- matching_fields fields ->
- L l (TypeSig noExtField [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy noExtField HsUnrestrictedArrow data_ty (getBangType ty)))))
+ L l (TypeSig noExtField [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) 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 27bad4b9..061ef8eb 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -223,9 +223,9 @@ renameMaybeInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)
renameMaybeInjectivityAnn = traverse renameInjectivityAnn
renameArrow :: HsArrow GhcRn -> RnM (HsArrow DocNameI)
-renameArrow HsUnrestrictedArrow = return HsUnrestrictedArrow
-renameArrow HsLinearArrow = return HsLinearArrow
-renameArrow (HsExplicitMult p) = HsExplicitMult <$> renameLType p
+renameArrow (HsUnrestrictedArrow u) = return (HsUnrestrictedArrow u)
+renameArrow (HsLinearArrow u) = return (HsLinearArrow u)
+renameArrow (HsExplicitMult u p) = HsExplicitMult u <$> renameLType p
renameType :: HsType GhcRn -> RnM (HsType DocNameI)
renameType t = case t of
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 5c933f25..0e9fc851 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -17,6 +17,7 @@ import GHC.Types.Name
import GHC.Data.FastString
import GHC.Builtin.Types.Prim ( funTyConName )
import GHC.Builtin.Types ( listTyConName, unrestrictedFunTyConName )
+import GHC.Parser.Annotation (IsUnicodeSyntax(..))
import Control.Monad
import Control.Monad.Trans.State
@@ -136,7 +137,7 @@ sugarTuples typ =
sugarOperators :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p)
sugarOperators (HsAppTy _ (L _ (HsAppTy _ (L _ (HsTyVar _ _ (L l name))) la)) lb)
| isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb
- | unrestrictedFunTyConName == name' = HsFunTy noExtField HsUnrestrictedArrow la lb
+ | unrestrictedFunTyConName == name' = HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) la lb
where
name' = getName name
sugarOperators typ = typ
@@ -282,7 +283,7 @@ renameType t@(HsTyLit _ _) = pure t
renameType (HsWildCardTy wc) = pure (HsWildCardTy wc)
renameHsArrow :: HsArrow GhcRn -> Rename (IdP GhcRn) (HsArrow GhcRn)
-renameHsArrow (HsExplicitMult p) = HsExplicitMult <$> renameLType p
+renameHsArrow (HsExplicitMult u p) = HsExplicitMult u <$> renameLType p
renameHsArrow mult = pure mult
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 10:30:05 +0000