{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}

-- | Warnings for a module
module GHC.Unit.Module.Warnings
   ( WarningCategory(..)
   , mkWarningCategory
   , defaultWarningCategory
   , validWarningCategory
   , InWarningCategory(..)
   , fromWarningCategory

   , 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.Concrete (HsToken (HsTok))
import Language.Haskell.Syntax.Extension

import Data.Data
import Data.List (isPrefixOf)
import GHC.Generics ( Generic )
import Control.DeepSeq


{-
Note [Warning categories]
~~~~~~~~~~~~~~~~~~~~~~~~~
See GHC Proposal 541 for the design of the warning categories feature:
https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0541-warning-pragmas-with-categories.rst

A WARNING pragma may be annotated with a category such as "x-partial" written
after the 'in' keyword, like this:

    {-# WARNING in "x-partial" head "This function is partial..." #-}

This is represented by the 'Maybe (Located WarningCategory)' field in
'WarningTxt'.  The parser will accept an arbitrary string as the category name,
then the renamer (in 'rnWarningTxt') will check it contains only valid
characters, so we can generate a nicer error message than a parse error.

The corresponding warnings can then be controlled with the -Wx-partial,
-Wno-x-partial, -Werror=x-partial and -Wwarn=x-partial flags.  Such a flag is
distinguished from an 'unrecognisedWarning' by the flag parser testing
'validWarningCategory'.  The 'x-' prefix means we can still usually report an
unrecognised warning where the user has made a mistake.

A DEPRECATED pragma may not have a user-defined category, and is always treated
as belonging to the special category 'deprecations'.  Similarly, a WARNING
pragma without a category belongs to the 'deprecations' category.
Thus the '-Wdeprecations' flag will enable all of the following:

    {-# WARNING in "deprecations" foo "This function is deprecated..." #-}
    {-# WARNING foo "This function is deprecated..." #-}
    {-# DEPRECATED foo "This function is deprecated..." #-}

The '-Wwarnings-deprecations' flag is supported for backwards compatibility
purposes as being equivalent to '-Wdeprecations'.

The '-Wextended-warnings' warning group collects together all warnings with
user-defined categories, so they can be enabled or disabled
collectively. Moreover they are treated as being part of other warning groups
such as '-Wdefault' (see 'warningGroupIncludesExtendedWarnings').

'DynFlags' and 'DiagOpts' each contain a set of enabled and a set of fatal
warning categories, just as they do for the finite enumeration of 'WarningFlag's
built in to GHC.  These are represented as 'WarningCategorySet's to allow for
the possibility of them being infinite.

-}

data InWarningCategory
  = InWarningCategory
    { InWarningCategory -> Located (HsToken "in")
iwc_in :: !(Located (HsToken "in")),
      InWarningCategory -> SourceText
iwc_st :: !SourceText,
      InWarningCategory -> Located WarningCategory
iwc_wc :: (Located WarningCategory)
    } deriving Typeable InWarningCategory
Typeable InWarningCategory =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> InWarningCategory
 -> c InWarningCategory)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InWarningCategory)
-> (InWarningCategory -> Constr)
-> (InWarningCategory -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InWarningCategory))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InWarningCategory))
-> ((forall b. Data b => b -> b)
    -> InWarningCategory -> InWarningCategory)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InWarningCategory -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InWarningCategory -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InWarningCategory -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InWarningCategory -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InWarningCategory -> m InWarningCategory)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InWarningCategory -> m InWarningCategory)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InWarningCategory -> m InWarningCategory)
-> Data InWarningCategory
InWarningCategory -> Constr
InWarningCategory -> DataType
(forall b. Data b => b -> b)
-> InWarningCategory -> InWarningCategory
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) -> InWarningCategory -> u
forall u. (forall d. Data d => d -> u) -> InWarningCategory -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InWarningCategory -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InWarningCategory -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InWarningCategory -> m InWarningCategory
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InWarningCategory -> m InWarningCategory
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InWarningCategory
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InWarningCategory -> c InWarningCategory
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InWarningCategory)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InWarningCategory)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InWarningCategory -> c InWarningCategory
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InWarningCategory -> c InWarningCategory
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InWarningCategory
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InWarningCategory
$ctoConstr :: InWarningCategory -> Constr
toConstr :: InWarningCategory -> Constr
$cdataTypeOf :: InWarningCategory -> DataType
dataTypeOf :: InWarningCategory -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InWarningCategory)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InWarningCategory)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InWarningCategory)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InWarningCategory)
$cgmapT :: (forall b. Data b => b -> b)
-> InWarningCategory -> InWarningCategory
gmapT :: (forall b. Data b => b -> b)
-> InWarningCategory -> InWarningCategory
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InWarningCategory -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InWarningCategory -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InWarningCategory -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InWarningCategory -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InWarningCategory -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> InWarningCategory -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InWarningCategory -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InWarningCategory -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InWarningCategory -> m InWarningCategory
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InWarningCategory -> m InWarningCategory
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InWarningCategory -> m InWarningCategory
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InWarningCategory -> m InWarningCategory
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InWarningCategory -> m InWarningCategory
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InWarningCategory -> m InWarningCategory
Data

fromWarningCategory :: WarningCategory -> InWarningCategory
fromWarningCategory :: WarningCategory -> InWarningCategory
fromWarningCategory WarningCategory
wc = Located (HsToken "in")
-> SourceText -> Located WarningCategory -> InWarningCategory
InWarningCategory (HsToken "in" -> Located (HsToken "in")
forall e. e -> Located e
noLoc HsToken "in"
forall (tok :: Symbol). HsToken tok
HsTok) SourceText
NoSourceText (WarningCategory -> Located WarningCategory
forall e. e -> Located e
noLoc WarningCategory
wc)


-- See Note [Warning categories]
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

-- | The @deprecations@ category is used for all DEPRECATED pragmas and for
-- WARNING pragmas that do not specify a category.
defaultWarningCategory :: WarningCategory
defaultWarningCategory :: WarningCategory
defaultWarningCategory = FastString -> WarningCategory
mkWarningCategory (String -> FastString
mkFastString String
"deprecations")

-- | Is this warning category allowed to appear in user-defined WARNING pragmas?
-- It must either be the known category @deprecations@, or be a custom category
-- that begins with @x-@ and contains only valid characters (letters, numbers,
-- apostrophes and dashes).
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
'-'


-- | A finite or infinite set of warning categories.
--
-- Unlike 'WarningFlag', there are (in principle) infinitely many warning
-- categories, so we cannot necessarily enumerate all of them. However the set
-- is constructed by adding or removing categories one at a time, so we can
-- represent it as either a finite set of categories, or a cofinite set (where
-- we store the complement).
data WarningCategorySet =
    FiniteWarningCategorySet   (UniqSet WarningCategory)
      -- ^ The set of warning categories is the given finite set.
  | CofiniteWarningCategorySet (UniqSet WarningCategory)
      -- ^ The set of warning categories is infinite, so the constructor stores
      -- its (finite) complement.

-- | The empty set of warning categories.
emptyWarningCategorySet :: WarningCategorySet
emptyWarningCategorySet :: WarningCategorySet
emptyWarningCategorySet = UniqSet WarningCategory -> WarningCategorySet
FiniteWarningCategorySet UniqSet WarningCategory
forall a. UniqSet a
emptyUniqSet

-- | The set consisting of all possible warning categories.
completeWarningCategorySet :: WarningCategorySet
completeWarningCategorySet :: WarningCategorySet
completeWarningCategorySet = UniqSet WarningCategory -> WarningCategorySet
CofiniteWarningCategorySet UniqSet WarningCategory
forall a. UniqSet a
emptyUniqSet

-- | Is this set empty?
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

-- | Does this warning category belong to the set?
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)

-- | Insert an element into a warning category set.
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)

-- | Delete an element from a warning category set.
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)


-- | Warning Text
--
-- reason/explanation from a WARNING or DEPRECATED pragma
data WarningTxt pass
   = WarningTxt
      (Maybe (Located InWarningCategory))
        -- ^ Warning category attached to this WARNING pragma, if any;
        -- see Note [Warning categories]
      (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

-- | To which warning category does this WARNING or DEPRECATED pragma belong?
-- See Note [Warning categories].
warningTxtCategory :: WarningTxt pass -> WarningCategory
warningTxtCategory :: forall pass. WarningTxt pass -> WarningCategory
warningTxtCategory (WarningTxt (Just (L SrcSpan
_ (InWarningCategory Located (HsToken "in")
_  SourceText
_ (L SrcSpan
_ WarningCategory
cat)))) Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral pass)]
_) = WarningCategory
cat
warningTxtCategory WarningTxt pass
_ = WarningCategory
defaultWarningCategory

-- | The message that the WarningTxt was specified to output
warningTxtMessage :: WarningTxt p -> [Located (WithHsDocIdentifiers StringLiteral p)]
warningTxtMessage :: forall p.
WarningTxt p -> [Located (WithHsDocIdentifiers StringLiteral p)]
warningTxtMessage (WarningTxt Maybe (Located InWarningCategory)
_ 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

-- | True if the 2 WarningTxts have the same category and messages
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 InWarningCategory

deriving instance (Eq (HsToken "in"), Eq (IdP pass)) => Eq (WarningTxt pass)
deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass)

instance Outputable InWarningCategory where
  ppr :: InWarningCategory -> SDoc
ppr (InWarningCategory Located (HsToken "in")
_ SourceText
_ Located WarningCategory
wt) = 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
wt)


instance Outputable (WarningTxt pass) where
    ppr :: WarningTxt pass -> SDoc
ppr (WarningTxt Maybe (Located InWarningCategory)
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 InWarningCategory -> SDoc)
-> Maybe (Located InWarningCategory)
-> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty (\Located InWarningCategory
ctg -> Located InWarningCategory -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located InWarningCategory
ctg) Maybe (Located InWarningCategory)
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 InWarningCategory)
_ 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))


-- | Warning information from a module
data Warnings pass
  = WarnSome (DeclWarnOccNames pass) -- ^ Names deprecated (may be empty)
             (ExportWarnNames pass)  -- ^ Exports deprecated (may be empty)
  | WarnAll (WarningTxt pass)        -- ^ Whole module deprecated

     -- For the module-specific names only an OccName is needed because
     --    (1) a deprecation always applies to a binding
     --        defined in the module in which the deprecation appears.
     --    (2) deprecations are only reported outside the defining module.
     --        this is important because, otherwise, if we saw something like
     --
     --        {-# DEPRECATED f "" #-}
     --        f = ...
     --        h = f
     --        g = let f = undefined in f
     --
     --        we'd need more information than an OccName to know to say something
     --        about the use of f in h but not the use of the locally bound f in g
     --
     --        however, because we only report about deprecations from the outside,
     --        and a module can only export one value called f,
     --        an OccName suffices.
     --
     --        this is in contrast with fixity declarations, where we need to map
     --        a Name to its fixity declaration.
     --
     -- For export deprecations we need to know where the symbol comes from, since
     -- we need to be able to check if the deprecated export that was imported is
     -- the same thing as imported by another import, which would not trigger
     -- a deprecation message.

-- | Deprecated declarations
type DeclWarnOccNames pass = [(OccName, WarningTxt pass)]

-- | Names that are deprecated as exports
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 [] []

-- | Constructs the cache for the 'mi_decl_warn_fn' field of a 'ModIface'
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)

-- | Constructs the cache for the 'mi_export_warn_fn' field of a 'ModIface'
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 -- We do not want a double report of the module deprecation
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                -- ^ Existing warnings
                -> [(OccName, WarningTxt p)] -- ^ New declaration deprecations
                -> Warnings p                -- ^ Updated warnings
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             -- ^ Existing warnings
                  -> [(Name, WarningTxt p)] -- ^ New export deprecations
                  -> Warnings p             -- ^ Updated warnings
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')