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/AttachInstances.hs1
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs8
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs16
-rw-r--r--haddock-api/src/Haddock/Interface/Specialize.hs9
4 files changed, 17 insertions, 17 deletions
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index 0840bd77..d5fe878b 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -17,7 +17,6 @@ module Haddock.Interface.AttachInstances (attachInstances) where
import Haddock.Types
import Haddock.Convert
-import Haddock.GhcUtils
import Control.Applicative ((<|>))
import Control.Arrow hiding ((<+>))
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 7b9674a6..1f223282 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -34,7 +34,6 @@ import qualified Data.Map as M
import Data.Map (Map)
import Data.List
import Data.Maybe
-import Control.Applicative
import Control.Monad
import Data.Traversable
@@ -49,7 +48,6 @@ import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
import GHC.Unit.State
-import GHC.Data.Bag
import GHC.Types.Name.Reader
import GHC.Tc.Types
import GHC.Data.FastString ( unpackFS, bytesFS )
@@ -57,8 +55,6 @@ import GHC.Types.Basic ( StringLiteral(..), SourceText(..), PromotionFlag(..) )
import qualified GHC.Utils.Outputable as O
import GHC.HsToCore.Docs hiding (mkMaps)
-import GHC.Core.Multiplicity
-
-- | Use a 'TypecheckedModule' to produce an 'Interface'.
-- To do this, we need access to already processed modules in the topological
@@ -240,7 +236,7 @@ mkAliasMap state mRenamedSource =
--
-- With our mapping we know that we can display exported modules M1 and M2.
--
-unrestrictedModuleImports :: [ImportDecl name] -> M.Map ModuleName [ModuleName]
+unrestrictedModuleImports :: [ImportDecl GhcRn] -> M.Map ModuleName [ModuleName]
unrestrictedModuleImports idecls =
M.map (map (unLoc . ideclName))
$ M.filter (all isInteresting) impModMap
@@ -958,7 +954,7 @@ 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 :: [LHsType GhcRn] -> LHsType GhcRn -> LHsType GhcRn
longArrow inputs output = foldr (\x y -> noLoc (HsFunTy noExtField HsUnrestrictedArrow x y)) output inputs
data_ty con
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 27bad4b9..39a1ae17 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -474,7 +474,8 @@ renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType
renameCon :: ConDecl GhcRn -> RnM (ConDecl DocNameI)
renameCon decl@(ConDeclH98 { con_name = lname, con_ex_tvs = ltyvars
, con_mb_cxt = lcontext, con_args = details
- , con_doc = mbldoc }) = do
+ , con_doc = mbldoc
+ , con_forall = forall }) = do
lname' <- renameL lname
ltyvars' <- mapM renameLTyVarBndr ltyvars
lcontext' <- traverse renameLContext lcontext
@@ -482,21 +483,24 @@ renameCon decl@(ConDeclH98 { con_name = lname, con_ex_tvs = ltyvars
mbldoc' <- mapM renameLDocHsSyn mbldoc
return (decl { con_ext = noExtField, con_name = lname', con_ex_tvs = ltyvars'
, con_mb_cxt = lcontext'
+ , con_forall = forall -- Remove when #18311 is fixed
, con_args = details', con_doc = mbldoc' })
-renameCon decl@(ConDeclGADT { con_names = lnames, con_qvars = ltyvars
+renameCon ConDeclGADT { con_names = lnames, con_qvars = ltyvars
, con_mb_cxt = lcontext, con_args = details
- , con_res_ty = res_ty
- , con_doc = mbldoc }) = do
+ , con_res_ty = res_ty, con_forall = forall
+ , con_doc = mbldoc } = do
lnames' <- mapM renameL lnames
ltyvars' <- mapM renameLTyVarBndr ltyvars
lcontext' <- traverse renameLContext lcontext
details' <- renameDetails details
res_ty' <- renameLType res_ty
mbldoc' <- mapM renameLDocHsSyn mbldoc
- return (decl { con_g_ext = noExtField, con_names = lnames', con_qvars = ltyvars'
+ return (ConDeclGADT
+ { con_g_ext = noExtField, con_names = lnames', con_qvars = ltyvars'
, con_mb_cxt = lcontext', con_args = details'
- , con_res_ty = res_ty', con_doc = mbldoc' })
+ , con_res_ty = res_ty', con_doc = mbldoc'
+ , con_forall = forall}) -- Remove when #18311 is fixed
renameHsScaled :: HsScaled GhcRn (LHsType GhcRn)
-> RnM (HsScaled DocNameI (LHsType DocNameI))
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 5c933f25..66627c15 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -3,6 +3,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GADTs #-}
module Haddock.Interface.Specialize
( specializeInstHead
@@ -15,7 +16,6 @@ import Haddock.Types
import GHC
import GHC.Types.Name
import GHC.Data.FastString
-import GHC.Builtin.Types.Prim ( funTyConName )
import GHC.Builtin.Types ( listTyConName, unrestrictedFunTyConName )
import Control.Monad
@@ -36,7 +36,7 @@ specialize specs = go spec_map0
go :: forall x. Data x => Map Name (HsType GhcRn) -> x -> x
go spec_map = everywhereButType @Name $ mkT $ sugar . strip_kind_sig . specialize_ty_var spec_map
- strip_kind_sig :: HsType name -> HsType name
+ strip_kind_sig :: HsType GhcRn -> HsType GhcRn
strip_kind_sig (HsKindSig _ (L _ t) _) = t
strip_kind_sig typ = typ
@@ -205,6 +205,7 @@ freeVariables :: HsType GhcRn -> Set Name
freeVariables =
everythingWithState Set.empty Set.union query
where
+ query :: forall a . Data a => a -> Set Name -> (Set Name, Set Name)
query term ctx = case cast term :: Maybe (HsType GhcRn) of
Just (HsForAllTy _ tele _) ->
(Set.empty, Set.union ctx (teleNames tele))
@@ -213,6 +214,7 @@ freeVariables =
| otherwise -> (Set.singleton $ getName name, ctx)
_ -> (Set.empty, ctx)
+ teleNames :: HsForAllTelescope GhcRn -> Set Name
teleNames (HsForAllVis _ bndrs) = bndrsNames bndrs
teleNames (HsForAllInvis _ bndrs) = bndrsNames bndrs
@@ -366,7 +368,6 @@ located :: Functor f => (a -> f b) -> Located a -> f (Located b)
located f (L loc e) = L loc <$> f e
-tyVarName :: HsTyVarBndr flag name -> IdP name
+tyVarName :: HsTyVarBndr flag GhcRn -> IdP GhcRn
tyVarName (UserTyVar _ _ name) = unLoc name
tyVarName (KindedTyVar _ _ (L _ name) _) = name
-tyVarName (XTyVarBndr _ ) = error "haddock:tyVarName"
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 11:01:11 +0000