aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock
diff options
context:
space:
mode:
authorZubin Duggal <zubin@cmi.ac.in>2020-06-26 15:29:18 +0530
committerZubin Duggal <zubin@cmi.ac.in>2020-07-23 18:46:40 +0530
commit7e6628febc482b4ad451f49ad416722375d1b170 (patch)
tree26321ac202d0f9600ba1bab45f41499ee9eef418 /haddock-api/src/Haddock
parent7e1ae9b519e16bd93fafcc653e38524fa17b38b9 (diff)
Update for modular ping pong
Diffstat (limited to 'haddock-api/src/Haddock')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs1
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs5
-rw-r--r--haddock-api/src/Haddock/Convert.hs2
-rw-r--r--haddock-api/src/Haddock/GhcUtils.hs62
-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
-rw-r--r--haddock-api/src/Haddock/Types.hs8
-rw-r--r--haddock-api/src/Haddock/Utils.hs3
11 files changed, 52 insertions, 65 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 75a49036..d280ed23 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -69,7 +69,7 @@ ppModule dflags iface =
---------------------------------------------------------------------
-- Utility functions
-dropHsDocTy :: HsType a -> HsType a
+dropHsDocTy :: HsType (GhcPass p) -> HsType (GhcPass p)
dropHsDocTy = f
where
g (L src x) = L src (f x)
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index badb1914..c439be8f 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -41,7 +41,6 @@ import Control.Monad
import Data.Maybe
import Data.List
import Prelude hiding ((<>))
-import GHC.Core.Multiplicity
import Haddock.Doc (combineDocumentation)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 6e210b61..20e099ee 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -41,7 +41,6 @@ import GHC.Exts
import GHC.Types.Name
import GHC.Data.BooleanFormula
import GHC.Types.Name.Reader ( rdrNameOcc )
-import GHC.Core.Multiplicity
-- | Pretty print a declaration
ppDecl :: Bool -- ^ print summary info only
@@ -1143,18 +1142,16 @@ ppLKind unicode qual y = ppKind unicode qual (unLoc y)
ppKind :: Unicode -> Qualification -> HsKind DocNameI -> Html
ppKind unicode qual ki = ppr_mono_ty (reparenTypePrec PREC_TOP ki) unicode qual HideEmptyContexts
-patSigContext :: LHsType name -> HideEmptyContexts
+patSigContext :: LHsType DocNameI -> HideEmptyContexts
patSigContext typ | hasNonEmptyContext typ && isFirstContextEmpty typ = ShowEmptyToplevelContexts
| otherwise = HideEmptyContexts
where
- hasNonEmptyContext :: LHsType name -> Bool
hasNonEmptyContext t =
case unLoc t of
HsForAllTy _ _ s -> hasNonEmptyContext s
HsQualTy _ cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True
HsFunTy _ _ _ s -> hasNonEmptyContext s
_ -> False
- isFirstContextEmpty :: LHsType name -> Bool
isFirstContextEmpty t =
case unLoc t of
HsForAllTy _ _ s -> isFirstContextEmpty s
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 3b73dcd1..d8f7206f 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -35,7 +35,6 @@ import GHC.Types.Name
import GHC.Types.Name.Set ( emptyNameSet )
import GHC.Types.Name.Reader ( mkVarUnqual )
import GHC.Core.PatSyn
-import GHC.Types.SrcLoc ( Located, noLoc, unLoc, GenLocated(..), srcLocSpan )
import GHC.Tc.Utils.TcType
import GHC.Core.TyCon
import GHC.Core.Type
@@ -57,7 +56,6 @@ import Haddock.Types
import Haddock.Interface.Specialize
import Haddock.GhcUtils ( orderedFVs, defaultRuntimeRepVars )
-import GHC.Core.Multiplicity
import Data.Maybe ( catMaybes, mapMaybe, maybeToList )
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 3abb6481..6fae5f58 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -1,5 +1,8 @@
{-# LANGUAGE BangPatterns, StandaloneDeriving, FlexibleInstances, ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK hide #-}
@@ -23,17 +26,14 @@ import Data.Char ( isSpace )
import Haddock.Types( DocName, DocNameI )
-import GHC.Utils.Exception
import GHC.Utils.FV as FV
import GHC.Utils.Outputable ( Outputable, panic, showPpr )
import GHC.Types.Name
-import GHC.Types.Name.Set
import GHC.Unit.Module
import GHC.Driver.Types
import GHC
import GHC.Core.Class
import GHC.Driver.Session
-import GHC.Core.Multiplicity
import GHC.Types.SrcLoc ( advanceSrcLoc )
import GHC.Types.Var ( Specificity, VarBndr(..), TyVarBinder
, tyVarKind, updateTyVarKind, isInvisibleArgFlag )
@@ -50,6 +50,8 @@ import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
+import GHC.HsToCore.Docs
+
moduleString :: Module -> String
moduleString = moduleNameString . moduleName
@@ -89,25 +91,12 @@ ifTrueJust :: Bool -> name -> Maybe name
ifTrueJust True = Just
ifTrueJust False = const Nothing
-sigName :: LSig name -> [IdP name]
+sigName :: LSig GhcRn -> [IdP GhcRn]
sigName (L _ sig) = sigNameNoLoc sig
-sigNameNoLoc :: Sig name -> [IdP name]
-sigNameNoLoc (TypeSig _ ns _) = map unLoc ns
-sigNameNoLoc (ClassOpSig _ _ ns _) = map unLoc ns
-sigNameNoLoc (PatSynSig _ ns _) = map unLoc ns
-sigNameNoLoc (SpecSig _ n _ _) = [unLoc n]
-sigNameNoLoc (InlineSig _ n _) = [unLoc n]
-sigNameNoLoc (FixSig _ (FixitySig _ ns _)) = map unLoc ns
-sigNameNoLoc _ = []
-
-- | Was this signature given by the user?
-isUserLSig :: LSig name -> Bool
-isUserLSig (L _ (TypeSig {})) = True
-isUserLSig (L _ (ClassOpSig {})) = True
-isUserLSig (L _ (PatSynSig {})) = True
-isUserLSig _ = False
-
+isUserLSig :: forall p. UnXRec p => LSig p -> Bool
+isUserLSig = isUserSig . unXRec @p
isClassD :: HsDecl a -> Bool
isClassD (TyClD _ d) = isClassDecl d
@@ -258,18 +247,18 @@ data Precedence
--
-- We cannot add parens that may be required by fixities because we do not have
-- any fixity information to work with in the first place :(.
-reparenTypePrec :: (XParTy a ~ NoExtField) => Precedence -> HsType a -> HsType a
+reparenTypePrec :: forall a. (XParTy a ~ NoExtField, MapXRec a, UnXRec a, WrapXRec a) => Precedence -> HsType a -> HsType a
reparenTypePrec = go
where
-- Shorter name for 'reparenType'
- go :: (XParTy a ~ NoExtField) => Precedence -> HsType a -> HsType a
+ go :: Precedence -> HsType a -> HsType a
go _ (HsBangTy x b ty) = HsBangTy x b (reparenLType ty)
go _ (HsTupleTy x con tys) = HsTupleTy x con (map reparenLType tys)
go _ (HsSumTy x tys) = HsSumTy x (map reparenLType tys)
go _ (HsKindSig x ty kind) = HsKindSig x (reparenLType ty) (reparenLType kind)
go _ (HsListTy x ty) = HsListTy x (reparenLType ty)
- go _ (HsRecTy x flds) = HsRecTy x (map (fmap reparenConDeclField) flds)
+ go _ (HsRecTy x flds) = HsRecTy x (map (mapXRec @a reparenConDeclField) flds)
go p (HsDocTy x ty d) = HsDocTy x (goL p ty) d
go _ (HsExplicitListTy x p tys) = HsExplicitListTy x p (map reparenLType tys)
go _ (HsExplicitTupleTy x tys) = HsExplicitTupleTy x (map reparenLType tys)
@@ -278,7 +267,7 @@ reparenTypePrec = go
go p (HsForAllTy x tele ty)
= paren p PREC_CTX $ HsForAllTy x (reparenHsForAllTelescope tele) (reparenLType ty)
go p (HsQualTy x ctxt ty)
- = paren p PREC_FUN $ HsQualTy x (fmap (map reparenLType) ctxt) (reparenLType ty)
+ = paren p PREC_FUN $ HsQualTy x (mapXRec @a (map reparenLType) ctxt) (reparenLType ty)
go p (HsFunTy x w ty1 ty2)
= paren p PREC_FUN $ HsFunTy x w (goL PREC_FUN ty1) (goL PREC_TOP ty2)
go p (HsAppTy x fun_ty arg_ty)
@@ -287,7 +276,7 @@ reparenTypePrec = go
= paren p PREC_CON $ HsAppKindTy x (goL PREC_FUN fun_ty) (goL PREC_CON arg_ki)
go p (HsOpTy x ty1 op ty2)
= paren p PREC_FUN $ HsOpTy x (goL PREC_OP ty1) op (goL PREC_OP ty2)
- go p (HsParTy _ t) = unLoc $ goL p t -- pretend the paren doesn't exist - it will be added back if needed
+ go p (HsParTy _ t) = unXRec @a $ goL p t -- pretend the paren doesn't exist - it will be added back if needed
go _ t@HsTyVar{} = t
go _ t@HsStarTy{} = t
go _ t@HsSpliceTy{} = t
@@ -296,43 +285,42 @@ reparenTypePrec = go
go _ t@XHsType{} = t
-- Located variant of 'go'
- goL :: (XParTy a ~ NoExtField) => Precedence -> LHsType a -> LHsType a
- goL ctxt_prec = fmap (go ctxt_prec)
+ goL :: Precedence -> LHsType a -> LHsType a
+ goL ctxt_prec = mapXRec @a (go ctxt_prec)
-- Optionally wrap a type in parens
- paren :: (XParTy a ~ NoExtField)
- => Precedence -- Precedence of context
+ paren :: Precedence -- Precedence of context
-> Precedence -- Precedence of top-level operator
-> HsType a -> HsType a -- Wrap in parens if (ctxt >= op)
- paren ctxt_prec op_prec | ctxt_prec >= op_prec = HsParTy noExtField . noLoc
+ paren ctxt_prec op_prec | ctxt_prec >= op_prec = HsParTy noExtField . wrapXRec @a
| otherwise = id
-- | Add parenthesis around the types in a 'HsType' (see 'reparenTypePrec')
-reparenType :: (XParTy a ~ NoExtField) => HsType a -> HsType a
+reparenType :: (XParTy a ~ NoExtField, MapXRec a, UnXRec a, WrapXRec a) => HsType a -> HsType a
reparenType = reparenTypePrec PREC_TOP
-- | Add parenthesis around the types in a 'LHsType' (see 'reparenTypePrec')
-reparenLType :: (XParTy a ~ NoExtField) => LHsType a -> LHsType a
-reparenLType = fmap reparenType
+reparenLType :: forall a. (XParTy a ~ NoExtField, MapXRec a, UnXRec a, WrapXRec a) => LHsType a -> LHsType a
+reparenLType = mapXRec @a reparenType
-- | Add parentheses around the types in an 'HsForAllTelescope' (see 'reparenTypePrec')
-reparenHsForAllTelescope :: (XParTy a ~ NoExtField)
+reparenHsForAllTelescope :: forall a. (XParTy a ~ NoExtField, MapXRec a, UnXRec a, WrapXRec a)
=> HsForAllTelescope a -> HsForAllTelescope a
reparenHsForAllTelescope (HsForAllVis x bndrs) =
- HsForAllVis x (map (fmap reparenTyVar) bndrs)
+ HsForAllVis x (map (mapXRec @a reparenTyVar) bndrs)
reparenHsForAllTelescope (HsForAllInvis x bndrs) =
- HsForAllInvis x (map (fmap reparenTyVar) bndrs)
+ HsForAllInvis x (map (mapXRec @a reparenTyVar) bndrs)
reparenHsForAllTelescope v@XHsForAllTelescope{} = v
-- | Add parenthesis around the types in a 'HsTyVarBndr' (see 'reparenTypePrec')
-reparenTyVar :: (XParTy a ~ NoExtField) => HsTyVarBndr flag a -> HsTyVarBndr flag a
+reparenTyVar :: (XParTy a ~ NoExtField, MapXRec a, UnXRec a, WrapXRec a) => HsTyVarBndr flag a -> HsTyVarBndr flag a
reparenTyVar (UserTyVar x flag n) = UserTyVar x flag n
reparenTyVar (KindedTyVar x flag n kind) = KindedTyVar x flag n (reparenLType kind)
reparenTyVar v@XTyVarBndr{} = v
-- | Add parenthesis around the types in a 'ConDeclField' (see 'reparenTypePrec')
-reparenConDeclField :: (XParTy a ~ NoExtField) => ConDeclField a -> ConDeclField a
+reparenConDeclField :: (XParTy a ~ NoExtField, MapXRec a, UnXRec a, WrapXRec a) => ConDeclField a -> ConDeclField a
reparenConDeclField (ConDeclField x n t d) = ConDeclField x n (reparenLType t) d
reparenConDeclField c@XConDeclField{} = c
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"
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 21c7d19b..89fd6658 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -669,7 +669,13 @@ instance MonadIO ErrMsgGhc where
-- * Pass sensitive types
-----------------------------------------------------------------------------
-type instance XRec DocNameI f = Located (f DocNameI)
+type instance XRec DocNameI a = Located a
+instance UnXRec DocNameI where
+ unXRec = unLoc
+instance MapXRec DocNameI where
+ mapXRec = fmap
+instance WrapXRec DocNameI where
+ wrapXRec = noLoc
type instance XForAllTy DocNameI = NoExtField
type instance XQualTy DocNameI = NoExtField
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 8346a477..33fbd000 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Utils
@@ -90,8 +91,6 @@ import qualified System.Posix.Internals
import GHC.Utils.Monad ( MonadIO(..) )
-import GHC.Core.Multiplicity
-
--------------------------------------------------------------------------------
-- * Logging