diff options
Diffstat (limited to 'haddock-api')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 3 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 3 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 5 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 6 | ||||
-rw-r--r-- | haddock-api/src/Haddock/GhcUtils.hs | 3 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 3 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 22 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Types.hs | 14 |
8 files changed, 38 insertions, 21 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 221580cc..d508cc6d 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -18,8 +18,7 @@ module Haddock.Backends.Hoogle ( ppHoogle ) where -import GHC.Types.Basic ( OverlapFlag(..), OverlapMode(..), - PromotionFlag(..), TopLevelFlag(..) ) +import GHC.Types.Basic ( OverlapFlag(..), OverlapMode(..), TopLevelFlag(..) ) import GHC.Types.SourceText import GHC.Core.InstEnv (ClsInst(..)) import Documentation.Haddock.Markup diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 420bd3f0..38efeba8 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -24,7 +24,6 @@ import Haddock.GhcUtils import GHC.Utils.Ppr hiding (Doc, quote) import qualified GHC.Utils.Ppr as Pretty -import GHC.Types.Basic ( PromotionFlag(..), isPromoted ) import GHC hiding (fromMaybeContext ) import GHC.Types.Name.Occurrence import GHC.Types.Name ( nameOccName ) @@ -1155,7 +1154,7 @@ ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode) -ppr_tylit :: HsTyLit -> Bool -> LaTeX +ppr_tylit :: HsTyLit DocNameI -> Bool -> LaTeX ppr_tylit (HsNumTy _ n) _ = integer n ppr_tylit (HsStrTy _ s) _ = text (show s) ppr_tylit (HsCharTy _ c) _ = text (show c) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index d385b42a..8cf6e7af 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -35,7 +35,6 @@ import Data.Maybe import Text.XHtml hiding ( name, title, p, quote ) import GHC.Core.Type ( Specificity(..) ) -import GHC.Types.Basic (PromotionFlag(..), isPromoted) import GHC hiding (LexicalFixity(..), fromMaybeContext) import GHC.Exts import GHC.Types.Name @@ -609,7 +608,7 @@ ppClassDecl summary links instances fixities loc d subdocs ] -- Minimal complete definition - minimalBit = case [ s | MinimalSig _ _ (L _ s) <- sigs ] of + minimalBit = case [ s | MinimalSig _ (L _ s) <- sigs ] of -- Miminal complete definition = every shown method And xs : _ | sort [getName n | L _ (Var (L _ n)) <- xs] == sort [getName n | ClassOpSig _ _ ns _ <- sigs, L _ n <- ns] @@ -1300,7 +1299,7 @@ ppr_mono_ty (HsDocTy _ ty _) unicode qual emptyCtxts ppr_mono_ty (HsWildCardTy _) _ _ _ = char '_' ppr_mono_ty (HsTyLit _ n) _ _ _ = ppr_tylit n -ppr_tylit :: HsTyLit -> Html +ppr_tylit :: HsTyLit DocNameI -> Html ppr_tylit (HsNumTy _ n) = toHtml (show n) ppr_tylit (HsStrTy _ s) = toHtml (show s) ppr_tylit (HsCharTy _ c) = toHtml (show c) diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index ceefedf3..f8b41851 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -20,7 +20,7 @@ module Haddock.Convert ( ) where import GHC.Data.Bag ( emptyBag ) -import GHC.Types.Basic ( TupleSort(..), PromotionFlag(..), DefMethSpec(..), TopLevelFlag(..) ) +import GHC.Types.Basic ( TupleSort(..), DefMethSpec(..), TopLevelFlag(..) ) import GHC.Types.SourceText (SourceText(..)) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Core.Class @@ -131,7 +131,7 @@ tyThingToLHsDecl prr t = case t of , tcdFDs = map (\ (l,r) -> noLocA (FunDep noAnn (map (noLocA . getName) l) (map (noLocA . getName) r)) ) $ snd $ classTvsFds cl - , tcdSigs = noLocA (MinimalSig noAnn NoSourceText . noLocA . fmap noLocA $ classMinimalDef cl) : + , tcdSigs = noLocA (MinimalSig (noAnn, NoSourceText) . noLocA . fmap noLocA $ classMinimalDef cl) : [ noLocA tcdSig | clsOp <- classOpItems cl , tcdSig <- synifyTcIdSig vs clsOp ] @@ -823,7 +823,7 @@ synifyPatSynType ps = (\vs -> implicitForAll ts vs [] prov_theta (synifyType WithinType)) (mkVisFunTys arg_tys res_ty) -synifyTyLit :: TyLit -> HsTyLit +synifyTyLit :: TyLit -> HsTyLit GhcRn synifyTyLit (NumTyLit n) = HsNumTy NoSourceText n synifyTyLit (StrTyLit s) = HsStrTy NoSourceText s synifyTyLit (CharTyLit c) = HsCharTy NoSourceText c diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 7c1dc73b..893bf010 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -37,7 +37,6 @@ import GHC.Types.Name import GHC.Unit.Module import GHC import GHC.Driver.Session -import GHC.Types.Basic import GHC.Types.SrcLoc ( advanceSrcLoc ) import GHC.Types.Var ( Specificity, VarBndr(..), TyVarBinder , tyVarKind, updateTyVarKind, isInvisibleArgFlag ) @@ -76,7 +75,7 @@ filterSigNames p (FixSig _ (FixitySig _ ns ty)) = case filter (p . unLoc) ns of [] -> Nothing filtered -> Just (FixSig noAnn (FixitySig noExtField filtered ty)) -filterSigNames _ orig@(MinimalSig _ _ _) = Just orig +filterSigNames _ orig@(MinimalSig _ _) = Just orig filterSigNames p (TypeSig _ ns ty) = case filter (p . unLoc) ns of [] -> Nothing diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 09eb2ad5..ee93324e 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -64,7 +64,6 @@ import GHC.Tc.Types hiding (IfM) import GHC.Tc.Utils.Monad (finalSafeMode) import GHC.Types.Avail hiding (avail) import qualified GHC.Types.Avail as Avail -import GHC.Types.Basic (PromotionFlag (..)) import GHC.Types.Name (getOccString, getSrcSpan, isDataConName, isValName, nameIsLocalOrFrom, nameOccName, emptyOccEnv) import GHC.Types.Name.Env (lookupNameEnv) import GHC.Types.Name.Reader (GlobalRdrEnv, greMangledName, lookupGlobalRdrEnv) @@ -755,7 +754,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames L loc (TyClD _ ClassDecl {..}) -> do mdef <- minimalDef t - let sig = maybeToList $ fmap (noLocA . MinimalSig noAnn NoSourceText . noLocA . fmap noLocA) mdef + let sig = maybeToList $ fmap (noLocA . MinimalSig (noAnn, NoSourceText) . noLocA . fmap noLocA) mdef availExportDecl avail (L loc $ TyClD noExtField ClassDecl { tcdSigs = sig ++ tcdSigs, .. }) docs_ diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index d2f11733..b3d31940 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -308,7 +308,7 @@ renameType t = case t of doc' <- renameLDocHsSyn doc return (HsDocTy noAnn ty' doc') - HsTyLit _ x -> return (HsTyLit noAnn x) + HsTyLit _ x -> return (HsTyLit noAnn (renameTyLit x)) HsRecTy _ a -> HsRecTy noAnn <$> mapM renameConDeclFieldField a XHsType a -> pure (XHsType a) @@ -318,6 +318,12 @@ renameType t = case t of HsSpliceTy (HsUntypedSpliceNested _) _ -> error "renameType: not an top level type splice" HsWildCardTy _ -> pure (HsWildCardTy noAnn) +renameTyLit :: HsTyLit GhcRn -> HsTyLit DocNameI +renameTyLit t = case t of + HsNumTy _ v -> HsNumTy noExtField v + HsStrTy _ v -> HsStrTy noExtField v + HsCharTy _ v -> HsCharTy noExtField v + renameSigType :: HsSigType GhcRn -> RnM (HsSigType DocNameI) renameSigType (HsSig { sig_bndrs = bndrs, sig_body = body }) = do @@ -576,9 +582,9 @@ renameSig sig = case sig of FixSig _ (FixitySig _ lnames fixity) -> do lnames' <- mapM renameL lnames return $ FixSig noExtField (FixitySig noExtField lnames' fixity) - MinimalSig _ src (L l s) -> do + MinimalSig _ (L l s) -> do s' <- traverse (traverse lookupRnNoWarn) s - return $ MinimalSig noExtField src (L l s') + return $ MinimalSig noExtField (L l s') -- we have filtered out all other kinds of signatures in Interface.Create _ -> error "expected TypeSig" @@ -587,11 +593,17 @@ renameForD :: ForeignDecl GhcRn -> RnM (ForeignDecl DocNameI) renameForD (ForeignImport _ lname ltype x) = do lname' <- renameL lname ltype' <- renameLSigType ltype - return (ForeignImport noExtField lname' ltype' x) + return (ForeignImport noExtField lname' ltype' (renameForI x)) renameForD (ForeignExport _ lname ltype x) = do lname' <- renameL lname ltype' <- renameLSigType ltype - return (ForeignExport noExtField lname' ltype' x) + return (ForeignExport noExtField lname' ltype' (renameForE x)) + +renameForI :: ForeignImport GhcRn -> ForeignImport DocNameI +renameForI (CImport _ cconv safety mHeader spec) = CImport noExtField cconv safety mHeader spec + +renameForE :: ForeignExport GhcRn -> ForeignExport DocNameI +renameForE (CExport _ spec) = CExport noExtField spec renameInstD :: InstDecl GhcRn -> RnM (InstDecl DocNameI) diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index dc15dfe0..35f2e200 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -44,9 +44,7 @@ import Control.Monad.Writer.Strict (Writer, WriterT, MonadWriter(..), lift, runW import Data.Typeable (Typeable) import Data.Map (Map) import Data.Data (Data) -import Data.Void (Void) import Documentation.Haddock.Types -import GHC.Types.Basic (PromotionFlag(..)) import GHC.Types.Fixity (Fixity(..)) import GHC.Types.Var (Specificity) @@ -761,6 +759,11 @@ type instance XTyLit DocNameI = EpAnn [AddEpAnn] type instance XWildCardTy DocNameI = EpAnn [AddEpAnn] type instance XXType DocNameI = HsCoreTy +type instance XNumTy DocNameI = NoExtField +type instance XStrTy DocNameI = NoExtField +type instance XCharTy DocNameI = NoExtField +type instance XXTyLit DocNameI = DataConCantHappen + type instance XHsForAllVis DocNameI = NoExtField type instance XHsForAllInvis DocNameI = NoExtField type instance XXHsForAllTelescope DocNameI = DataConCantHappen @@ -781,6 +784,13 @@ type instance XMinimalSig DocNameI = NoExtField type instance XForeignExport DocNameI = NoExtField type instance XForeignImport DocNameI = NoExtField + +type instance XCImport DocNameI = NoExtField +type instance XCExport DocNameI = NoExtField + +type instance XXForeignImport DocNameI = DataConCantHappen +type instance XXForeignExport DocNameI = DataConCantHappen + type instance XConDeclGADT DocNameI = NoExtField type instance XConDeclH98 DocNameI = NoExtField type instance XXConDecl DocNameI = DataConCantHappen |