{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Unit.Module.Warnings
( WarningCategory
, mkWarningCategory
, defaultWarningCategory
, validWarningCategory
, WarningCategorySet
, emptyWarningCategorySet
, completeWarningCategorySet
, nullWarningCategorySet
, elemWarningCategorySet
, insertWarningCategorySet
, deleteWarningCategorySet
, Warnings (..)
, WarningTxt (..)
, DeclWarnOccNames
, ExportWarnNames
, warningTxtCategory
, warningTxtMessage
, warningTxtSame
, pprWarningTxtForMsg
, emptyWarn
, mkIfaceDeclWarnCache
, mkIfaceExportWarnCache
, emptyIfaceWarnCache
, insertWarnDecls
, insertWarnExports
)
where
import GHC.Prelude
import GHC.Data.FastString (FastString, mkFastString, unpackFS)
import GHC.Types.SourceText
import GHC.Types.Name.Occurrence
import GHC.Types.Name.Env
import GHC.Types.Name (Name)
import GHC.Types.SrcLoc
import GHC.Types.Unique
import GHC.Types.Unique.Set
import GHC.Hs.Doc
import GHC.Utils.Outputable
import GHC.Utils.Binary
import GHC.Unicode
import Language.Haskell.Syntax.Extension
import Data.Data
import Data.List (isPrefixOf)
import GHC.Generics ( Generic )
import Control.DeepSeq
newtype WarningCategory = WarningCategory FastString
deriving (BinHandle -> IO WarningCategory
BinHandle -> WarningCategory -> IO ()
BinHandle -> WarningCategory -> IO (Bin WarningCategory)
(BinHandle -> WarningCategory -> IO ())
-> (BinHandle -> WarningCategory -> IO (Bin WarningCategory))
-> (BinHandle -> IO WarningCategory)
-> Binary WarningCategory
forall a.
(BinHandle -> a -> IO ())
-> (BinHandle -> a -> IO (Bin a))
-> (BinHandle -> IO a)
-> Binary a
$cput_ :: BinHandle -> WarningCategory -> IO ()
put_ :: BinHandle -> WarningCategory -> IO ()
$cput :: BinHandle -> WarningCategory -> IO (Bin WarningCategory)
put :: BinHandle -> WarningCategory -> IO (Bin WarningCategory)
$cget :: BinHandle -> IO WarningCategory
get :: BinHandle -> IO WarningCategory
Binary, Typeable WarningCategory
Typeable WarningCategory =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WarningCategory -> c WarningCategory)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WarningCategory)
-> (WarningCategory -> Constr)
-> (WarningCategory -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WarningCategory))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WarningCategory))
-> ((forall b. Data b => b -> b)
-> WarningCategory -> WarningCategory)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WarningCategory -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WarningCategory -> r)
-> (forall u.
(forall d. Data d => d -> u) -> WarningCategory -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> WarningCategory -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WarningCategory -> m WarningCategory)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WarningCategory -> m WarningCategory)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WarningCategory -> m WarningCategory)
-> Data WarningCategory
WarningCategory -> Constr
WarningCategory -> DataType
(forall b. Data b => b -> b) -> WarningCategory -> WarningCategory
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> WarningCategory -> u
forall u. (forall d. Data d => d -> u) -> WarningCategory -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WarningCategory -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WarningCategory -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WarningCategory -> m WarningCategory
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WarningCategory -> m WarningCategory
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WarningCategory
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WarningCategory -> c WarningCategory
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WarningCategory)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WarningCategory)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WarningCategory -> c WarningCategory
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WarningCategory -> c WarningCategory
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WarningCategory
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WarningCategory
$ctoConstr :: WarningCategory -> Constr
toConstr :: WarningCategory -> Constr
$cdataTypeOf :: WarningCategory -> DataType
dataTypeOf :: WarningCategory -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WarningCategory)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WarningCategory)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WarningCategory)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WarningCategory)
$cgmapT :: (forall b. Data b => b -> b) -> WarningCategory -> WarningCategory
gmapT :: (forall b. Data b => b -> b) -> WarningCategory -> WarningCategory
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WarningCategory -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WarningCategory -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WarningCategory -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WarningCategory -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WarningCategory -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> WarningCategory -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> WarningCategory -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> WarningCategory -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WarningCategory -> m WarningCategory
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WarningCategory -> m WarningCategory
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WarningCategory -> m WarningCategory
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WarningCategory -> m WarningCategory
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WarningCategory -> m WarningCategory
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WarningCategory -> m WarningCategory
Data, WarningCategory -> WarningCategory -> Bool
(WarningCategory -> WarningCategory -> Bool)
-> (WarningCategory -> WarningCategory -> Bool)
-> Eq WarningCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WarningCategory -> WarningCategory -> Bool
== :: WarningCategory -> WarningCategory -> Bool
$c/= :: WarningCategory -> WarningCategory -> Bool
/= :: WarningCategory -> WarningCategory -> Bool
Eq, WarningCategory -> SDoc
(WarningCategory -> SDoc) -> Outputable WarningCategory
forall a. (a -> SDoc) -> Outputable a
$cppr :: WarningCategory -> SDoc
ppr :: WarningCategory -> SDoc
Outputable, Int -> WarningCategory -> ShowS
[WarningCategory] -> ShowS
WarningCategory -> String
(Int -> WarningCategory -> ShowS)
-> (WarningCategory -> String)
-> ([WarningCategory] -> ShowS)
-> Show WarningCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WarningCategory -> ShowS
showsPrec :: Int -> WarningCategory -> ShowS
$cshow :: WarningCategory -> String
show :: WarningCategory -> String
$cshowList :: [WarningCategory] -> ShowS
showList :: [WarningCategory] -> ShowS
Show, WarningCategory -> Unique
(WarningCategory -> Unique) -> Uniquable WarningCategory
forall a. (a -> Unique) -> Uniquable a
$cgetUnique :: WarningCategory -> Unique
getUnique :: WarningCategory -> Unique
Uniquable, WarningCategory -> ()
(WarningCategory -> ()) -> NFData WarningCategory
forall a. (a -> ()) -> NFData a
$crnf :: WarningCategory -> ()
rnf :: WarningCategory -> ()
NFData)
mkWarningCategory :: FastString -> WarningCategory
mkWarningCategory :: FastString -> WarningCategory
mkWarningCategory = FastString -> WarningCategory
WarningCategory
defaultWarningCategory :: WarningCategory
defaultWarningCategory :: WarningCategory
defaultWarningCategory = FastString -> WarningCategory
mkWarningCategory (String -> FastString
mkFastString String
"deprecations")
validWarningCategory :: WarningCategory -> Bool
validWarningCategory :: WarningCategory -> Bool
validWarningCategory cat :: WarningCategory
cat@(WarningCategory FastString
c) =
WarningCategory
cat WarningCategory -> WarningCategory -> Bool
forall a. Eq a => a -> a -> Bool
== WarningCategory
defaultWarningCategory Bool -> Bool -> Bool
|| (String
"x-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
is_allowed String
s)
where
s :: String
s = FastString -> String
unpackFS FastString
c
is_allowed :: Char -> Bool
is_allowed Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
data WarningCategorySet =
FiniteWarningCategorySet (UniqSet WarningCategory)
| CofiniteWarningCategorySet (UniqSet WarningCategory)
emptyWarningCategorySet :: WarningCategorySet
emptyWarningCategorySet :: WarningCategorySet
emptyWarningCategorySet = UniqSet WarningCategory -> WarningCategorySet
FiniteWarningCategorySet UniqSet WarningCategory
forall a. UniqSet a
emptyUniqSet
completeWarningCategorySet :: WarningCategorySet
completeWarningCategorySet :: WarningCategorySet
completeWarningCategorySet = UniqSet WarningCategory -> WarningCategorySet
CofiniteWarningCategorySet UniqSet WarningCategory
forall a. UniqSet a
emptyUniqSet
nullWarningCategorySet :: WarningCategorySet -> Bool
nullWarningCategorySet :: WarningCategorySet -> Bool
nullWarningCategorySet (FiniteWarningCategorySet UniqSet WarningCategory
s) = UniqSet WarningCategory -> Bool
forall a. UniqSet a -> Bool
isEmptyUniqSet UniqSet WarningCategory
s
nullWarningCategorySet CofiniteWarningCategorySet{} = Bool
False
elemWarningCategorySet :: WarningCategory -> WarningCategorySet -> Bool
elemWarningCategorySet :: WarningCategory -> WarningCategorySet -> Bool
elemWarningCategorySet WarningCategory
c (FiniteWarningCategorySet UniqSet WarningCategory
s) = WarningCategory
c WarningCategory -> UniqSet WarningCategory -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` UniqSet WarningCategory
s
elemWarningCategorySet WarningCategory
c (CofiniteWarningCategorySet UniqSet WarningCategory
s) = Bool -> Bool
not (WarningCategory
c WarningCategory -> UniqSet WarningCategory -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` UniqSet WarningCategory
s)
insertWarningCategorySet :: WarningCategory -> WarningCategorySet -> WarningCategorySet
insertWarningCategorySet :: WarningCategory -> WarningCategorySet -> WarningCategorySet
insertWarningCategorySet WarningCategory
c (FiniteWarningCategorySet UniqSet WarningCategory
s) = UniqSet WarningCategory -> WarningCategorySet
FiniteWarningCategorySet (UniqSet WarningCategory
-> WarningCategory -> UniqSet WarningCategory
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet UniqSet WarningCategory
s WarningCategory
c)
insertWarningCategorySet WarningCategory
c (CofiniteWarningCategorySet UniqSet WarningCategory
s) = UniqSet WarningCategory -> WarningCategorySet
CofiniteWarningCategorySet (UniqSet WarningCategory
-> WarningCategory -> UniqSet WarningCategory
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
delOneFromUniqSet UniqSet WarningCategory
s WarningCategory
c)
deleteWarningCategorySet :: WarningCategory -> WarningCategorySet -> WarningCategorySet
deleteWarningCategorySet :: WarningCategory -> WarningCategorySet -> WarningCategorySet
deleteWarningCategorySet WarningCategory
c (FiniteWarningCategorySet UniqSet WarningCategory
s) = UniqSet WarningCategory -> WarningCategorySet
FiniteWarningCategorySet (UniqSet WarningCategory
-> WarningCategory -> UniqSet WarningCategory
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
delOneFromUniqSet UniqSet WarningCategory
s WarningCategory
c)
deleteWarningCategorySet WarningCategory
c (CofiniteWarningCategorySet UniqSet WarningCategory
s) = UniqSet WarningCategory -> WarningCategorySet
CofiniteWarningCategorySet (UniqSet WarningCategory
-> WarningCategory -> UniqSet WarningCategory
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet UniqSet WarningCategory
s WarningCategory
c)
data WarningTxt pass
= WarningTxt
(Maybe (Located WarningCategory))
(Located SourceText)
[Located (WithHsDocIdentifiers StringLiteral pass)]
| DeprecatedTxt
(Located SourceText)
[Located (WithHsDocIdentifiers StringLiteral pass)]
deriving (forall x. WarningTxt pass -> Rep (WarningTxt pass) x)
-> (forall x. Rep (WarningTxt pass) x -> WarningTxt pass)
-> Generic (WarningTxt pass)
forall x. Rep (WarningTxt pass) x -> WarningTxt pass
forall x. WarningTxt pass -> Rep (WarningTxt pass) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall pass x. Rep (WarningTxt pass) x -> WarningTxt pass
forall pass x. WarningTxt pass -> Rep (WarningTxt pass) x
$cfrom :: forall pass x. WarningTxt pass -> Rep (WarningTxt pass) x
from :: forall x. WarningTxt pass -> Rep (WarningTxt pass) x
$cto :: forall pass x. Rep (WarningTxt pass) x -> WarningTxt pass
to :: forall x. Rep (WarningTxt pass) x -> WarningTxt pass
Generic
warningTxtCategory :: WarningTxt pass -> WarningCategory
warningTxtCategory :: forall pass. WarningTxt pass -> WarningCategory
warningTxtCategory (WarningTxt (Just (L SrcSpan
_ WarningCategory
cat)) Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral pass)]
_) = WarningCategory
cat
warningTxtCategory WarningTxt pass
_ = WarningCategory
defaultWarningCategory
warningTxtMessage :: WarningTxt p -> [Located (WithHsDocIdentifiers StringLiteral p)]
warningTxtMessage :: forall p.
WarningTxt p -> [Located (WithHsDocIdentifiers StringLiteral p)]
warningTxtMessage (WarningTxt Maybe (Located WarningCategory)
_ Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral p)]
m) = [Located (WithHsDocIdentifiers StringLiteral p)]
m
warningTxtMessage (DeprecatedTxt Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral p)]
m) = [Located (WithHsDocIdentifiers StringLiteral p)]
m
warningTxtSame :: WarningTxt p1 -> WarningTxt p2 -> Bool
warningTxtSame :: forall p1 p2. WarningTxt p1 -> WarningTxt p2 -> Bool
warningTxtSame WarningTxt p1
w1 WarningTxt p2
w2
= WarningTxt p1 -> WarningCategory
forall pass. WarningTxt pass -> WarningCategory
warningTxtCategory WarningTxt p1
w1 WarningCategory -> WarningCategory -> Bool
forall a. Eq a => a -> a -> Bool
== WarningTxt p2 -> WarningCategory
forall pass. WarningTxt pass -> WarningCategory
warningTxtCategory WarningTxt p2
w2
Bool -> Bool -> Bool
&& WarningTxt p1 -> [StringLiteral]
forall p. WarningTxt p -> [StringLiteral]
literal_message WarningTxt p1
w1 [StringLiteral] -> [StringLiteral] -> Bool
forall a. Eq a => a -> a -> Bool
== WarningTxt p2 -> [StringLiteral]
forall p. WarningTxt p -> [StringLiteral]
literal_message WarningTxt p2
w2
Bool -> Bool -> Bool
&& Bool
same_type
where
literal_message :: WarningTxt p -> [StringLiteral]
literal_message :: forall p. WarningTxt p -> [StringLiteral]
literal_message = (GenLocated SrcSpan (WithHsDocIdentifiers StringLiteral p)
-> StringLiteral)
-> [GenLocated SrcSpan (WithHsDocIdentifiers StringLiteral p)]
-> [StringLiteral]
forall a b. (a -> b) -> [a] -> [b]
map (WithHsDocIdentifiers StringLiteral p -> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString (WithHsDocIdentifiers StringLiteral p -> StringLiteral)
-> (GenLocated SrcSpan (WithHsDocIdentifiers StringLiteral p)
-> WithHsDocIdentifiers StringLiteral p)
-> GenLocated SrcSpan (WithHsDocIdentifiers StringLiteral p)
-> StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (WithHsDocIdentifiers StringLiteral p)
-> WithHsDocIdentifiers StringLiteral p
forall l e. GenLocated l e -> e
unLoc) ([GenLocated SrcSpan (WithHsDocIdentifiers StringLiteral p)]
-> [StringLiteral])
-> (WarningTxt p
-> [GenLocated SrcSpan (WithHsDocIdentifiers StringLiteral p)])
-> WarningTxt p
-> [StringLiteral]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WarningTxt p
-> [GenLocated SrcSpan (WithHsDocIdentifiers StringLiteral p)]
forall p.
WarningTxt p -> [Located (WithHsDocIdentifiers StringLiteral p)]
warningTxtMessage
same_type :: Bool
same_type | DeprecatedTxt {} <- WarningTxt p1
w1, DeprecatedTxt {} <- WarningTxt p2
w2 = Bool
True
| WarningTxt {} <- WarningTxt p1
w1, WarningTxt {} <- WarningTxt p2
w2 = Bool
True
| Bool
otherwise = Bool
False
deriving instance Eq (IdP pass) => Eq (WarningTxt pass)
deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass)
instance Outputable (WarningTxt pass) where
ppr :: WarningTxt pass -> SDoc
ppr (WarningTxt Maybe (Located WarningCategory)
mcat Located SourceText
lsrc [Located (WithHsDocIdentifiers StringLiteral pass)]
ws)
= case Located SourceText -> SourceText
forall l e. GenLocated l e -> e
unLoc Located SourceText
lsrc of
SourceText
NoSourceText -> [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
forall pass.
[Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
pp_ws [Located (WithHsDocIdentifiers StringLiteral pass)]
ws
SourceText FastString
src -> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
src SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
ctg_doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
forall pass.
[Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
pp_ws [Located (WithHsDocIdentifiers StringLiteral pass)]
ws SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#-}"
where
ctg_doc :: SDoc
ctg_doc = SDoc
-> (Located WarningCategory -> SDoc)
-> Maybe (Located WarningCategory)
-> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty (\Located WarningCategory
ctg -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (Located WarningCategory -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located WarningCategory
ctg)) Maybe (Located WarningCategory)
mcat
ppr (DeprecatedTxt Located SourceText
lsrc [Located (WithHsDocIdentifiers StringLiteral pass)]
ds)
= case Located SourceText -> SourceText
forall l e. GenLocated l e -> e
unLoc Located SourceText
lsrc of
SourceText
NoSourceText -> [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
forall pass.
[Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
pp_ws [Located (WithHsDocIdentifiers StringLiteral pass)]
ds
SourceText FastString
src -> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
src SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
forall pass.
[Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
pp_ws [Located (WithHsDocIdentifiers StringLiteral pass)]
ds SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#-}"
pp_ws :: [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
pp_ws :: forall pass.
[Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
pp_ws [Located (WithHsDocIdentifiers StringLiteral pass)
l] = WithHsDocIdentifiers StringLiteral pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr (WithHsDocIdentifiers StringLiteral pass -> SDoc)
-> WithHsDocIdentifiers StringLiteral pass -> SDoc
forall a b. (a -> b) -> a -> b
$ Located (WithHsDocIdentifiers StringLiteral pass)
-> WithHsDocIdentifiers StringLiteral pass
forall l e. GenLocated l e -> e
unLoc Located (WithHsDocIdentifiers StringLiteral pass)
l
pp_ws [Located (WithHsDocIdentifiers StringLiteral pass)]
ws
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"["
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((Located (WithHsDocIdentifiers StringLiteral pass) -> SDoc)
-> [Located (WithHsDocIdentifiers StringLiteral pass)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (WithHsDocIdentifiers StringLiteral pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr (WithHsDocIdentifiers StringLiteral pass -> SDoc)
-> (Located (WithHsDocIdentifiers StringLiteral pass)
-> WithHsDocIdentifiers StringLiteral pass)
-> Located (WithHsDocIdentifiers StringLiteral pass)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (WithHsDocIdentifiers StringLiteral pass)
-> WithHsDocIdentifiers StringLiteral pass
forall l e. GenLocated l e -> e
unLoc) [Located (WithHsDocIdentifiers StringLiteral pass)]
ws))
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"]"
pprWarningTxtForMsg :: WarningTxt p -> SDoc
pprWarningTxtForMsg :: forall pass. WarningTxt pass -> SDoc
pprWarningTxtForMsg (WarningTxt Maybe (Located WarningCategory)
_ Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral p)]
ws)
= SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Located (WithHsDocIdentifiers StringLiteral p) -> SDoc)
-> [Located (WithHsDocIdentifiers StringLiteral p)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext (FastString -> SDoc)
-> (Located (WithHsDocIdentifiers StringLiteral p) -> FastString)
-> Located (WithHsDocIdentifiers StringLiteral p)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs (StringLiteral -> FastString)
-> (Located (WithHsDocIdentifiers StringLiteral p)
-> StringLiteral)
-> Located (WithHsDocIdentifiers StringLiteral p)
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithHsDocIdentifiers StringLiteral p -> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString (WithHsDocIdentifiers StringLiteral p -> StringLiteral)
-> (Located (WithHsDocIdentifiers StringLiteral p)
-> WithHsDocIdentifiers StringLiteral p)
-> Located (WithHsDocIdentifiers StringLiteral p)
-> StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (WithHsDocIdentifiers StringLiteral p)
-> WithHsDocIdentifiers StringLiteral p
forall l e. GenLocated l e -> e
unLoc) [Located (WithHsDocIdentifiers StringLiteral p)]
ws))
pprWarningTxtForMsg (DeprecatedTxt Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral p)]
ds)
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Deprecated:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Located (WithHsDocIdentifiers StringLiteral p) -> SDoc)
-> [Located (WithHsDocIdentifiers StringLiteral p)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext (FastString -> SDoc)
-> (Located (WithHsDocIdentifiers StringLiteral p) -> FastString)
-> Located (WithHsDocIdentifiers StringLiteral p)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs (StringLiteral -> FastString)
-> (Located (WithHsDocIdentifiers StringLiteral p)
-> StringLiteral)
-> Located (WithHsDocIdentifiers StringLiteral p)
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithHsDocIdentifiers StringLiteral p -> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString (WithHsDocIdentifiers StringLiteral p -> StringLiteral)
-> (Located (WithHsDocIdentifiers StringLiteral p)
-> WithHsDocIdentifiers StringLiteral p)
-> Located (WithHsDocIdentifiers StringLiteral p)
-> StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (WithHsDocIdentifiers StringLiteral p)
-> WithHsDocIdentifiers StringLiteral p
forall l e. GenLocated l e -> e
unLoc) [Located (WithHsDocIdentifiers StringLiteral p)]
ds))
data Warnings pass
= WarnSome (DeclWarnOccNames pass)
(ExportWarnNames pass)
| WarnAll (WarningTxt pass)
type DeclWarnOccNames pass = [(OccName, WarningTxt pass)]
type ExportWarnNames pass = [(Name, WarningTxt pass)]
deriving instance Eq (IdP pass) => Eq (Warnings pass)
emptyWarn :: Warnings p
emptyWarn :: forall p. Warnings p
emptyWarn = DeclWarnOccNames p -> ExportWarnNames p -> Warnings p
forall pass.
DeclWarnOccNames pass -> ExportWarnNames pass -> Warnings pass
WarnSome [] []
mkIfaceDeclWarnCache :: Warnings p -> OccName -> Maybe (WarningTxt p)
mkIfaceDeclWarnCache :: forall p. Warnings p -> OccName -> Maybe (WarningTxt p)
mkIfaceDeclWarnCache (WarnAll WarningTxt p
t) = \OccName
_ -> WarningTxt p -> Maybe (WarningTxt p)
forall a. a -> Maybe a
Just WarningTxt p
t
mkIfaceDeclWarnCache (WarnSome DeclWarnOccNames p
vs ExportWarnNames p
_) = OccEnv (WarningTxt p) -> OccName -> Maybe (WarningTxt p)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv (DeclWarnOccNames p -> OccEnv (WarningTxt p)
forall a. [(OccName, a)] -> OccEnv a
mkOccEnv DeclWarnOccNames p
vs)
mkIfaceExportWarnCache :: Warnings p -> Name -> Maybe (WarningTxt p)
mkIfaceExportWarnCache :: forall p. Warnings p -> Name -> Maybe (WarningTxt p)
mkIfaceExportWarnCache (WarnAll WarningTxt p
_) = Maybe (WarningTxt p) -> Name -> Maybe (WarningTxt p)
forall a b. a -> b -> a
const Maybe (WarningTxt p)
forall a. Maybe a
Nothing
mkIfaceExportWarnCache (WarnSome DeclWarnOccNames p
_ ExportWarnNames p
ds) = NameEnv (WarningTxt p) -> Name -> Maybe (WarningTxt p)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv (ExportWarnNames p -> NameEnv (WarningTxt p)
forall a. [(Name, a)] -> NameEnv a
mkNameEnv ExportWarnNames p
ds)
emptyIfaceWarnCache :: name -> Maybe (WarningTxt p)
emptyIfaceWarnCache :: forall name p. name -> Maybe (WarningTxt p)
emptyIfaceWarnCache name
_ = Maybe (WarningTxt p)
forall a. Maybe a
Nothing
insertWarnDecls :: Warnings p
-> [(OccName, WarningTxt p)]
-> Warnings p
insertWarnDecls :: forall p. Warnings p -> [(OccName, WarningTxt p)] -> Warnings p
insertWarnDecls ws :: Warnings p
ws@(WarnAll WarningTxt p
_) [(OccName, WarningTxt p)]
_ = Warnings p
ws
insertWarnDecls (WarnSome [(OccName, WarningTxt p)]
wns ExportWarnNames p
wes) [(OccName, WarningTxt p)]
wns' = [(OccName, WarningTxt p)] -> ExportWarnNames p -> Warnings p
forall pass.
DeclWarnOccNames pass -> ExportWarnNames pass -> Warnings pass
WarnSome ([(OccName, WarningTxt p)]
wns [(OccName, WarningTxt p)]
-> [(OccName, WarningTxt p)] -> [(OccName, WarningTxt p)]
forall a. [a] -> [a] -> [a]
++ [(OccName, WarningTxt p)]
wns') ExportWarnNames p
wes
insertWarnExports :: Warnings p
-> [(Name, WarningTxt p)]
-> Warnings p
insertWarnExports :: forall p. Warnings p -> [(Name, WarningTxt p)] -> Warnings p
insertWarnExports ws :: Warnings p
ws@(WarnAll WarningTxt p
_) [(Name, WarningTxt p)]
_ = Warnings p
ws
insertWarnExports (WarnSome DeclWarnOccNames p
wns [(Name, WarningTxt p)]
wes) [(Name, WarningTxt p)]
wes' = DeclWarnOccNames p -> [(Name, WarningTxt p)] -> Warnings p
forall pass.
DeclWarnOccNames pass -> ExportWarnNames pass -> Warnings pass
WarnSome DeclWarnOccNames p
wns ([(Name, WarningTxt p)]
wes [(Name, WarningTxt p)]
-> [(Name, WarningTxt p)] -> [(Name, WarningTxt p)]
forall a. [a] -> [a] -> [a]
++ [(Name, WarningTxt p)]
wes')