{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
module GHC.Unit.Module.Warnings
( Warnings (..)
, WarningTxt (..)
, pprWarningTxtForMsg
, mkIfaceWarnCache
, emptyIfaceWarnCache
, plusWarns
)
where
import GHC.Prelude
import GHC.Types.SourceText
import GHC.Types.Name.Occurrence
import GHC.Types.SrcLoc
import GHC.Hs.Doc
import GHC.Hs.Extension
import GHC.Utils.Outputable
import GHC.Utils.Binary
import Language.Haskell.Syntax.Extension
import Data.Data
import GHC.Generics ( Generic )
data WarningTxt pass
= WarningTxt
(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
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 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 String
src -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
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)]
ws SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#-}"
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 String
src -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
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
"#-}"
instance Binary (WarningTxt GhcRn) where
put_ :: BinHandle -> WarningTxt GhcRn -> IO ()
put_ BinHandle
bh (WarningTxt Located SourceText
s [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
w) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (SourceText -> IO ()) -> SourceText -> IO ()
forall a b. (a -> b) -> a -> b
$ Located SourceText -> SourceText
forall l e. GenLocated l e -> e
unLoc Located SourceText
s
BinHandle -> [WithHsDocIdentifiers StringLiteral GhcRn] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ([WithHsDocIdentifiers StringLiteral GhcRn] -> IO ())
-> [WithHsDocIdentifiers StringLiteral GhcRn] -> IO ()
forall a b. (a -> b) -> a -> b
$ Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn
forall l e. GenLocated l e -> e
unLoc (Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn)
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
-> [WithHsDocIdentifiers StringLiteral GhcRn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
w
put_ BinHandle
bh (DeprecatedTxt Located SourceText
s [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
d) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (SourceText -> IO ()) -> SourceText -> IO ()
forall a b. (a -> b) -> a -> b
$ Located SourceText -> SourceText
forall l e. GenLocated l e -> e
unLoc Located SourceText
s
BinHandle -> [WithHsDocIdentifiers StringLiteral GhcRn] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ([WithHsDocIdentifiers StringLiteral GhcRn] -> IO ())
-> [WithHsDocIdentifiers StringLiteral GhcRn] -> IO ()
forall a b. (a -> b) -> a -> b
$ Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn
forall l e. GenLocated l e -> e
unLoc (Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn)
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
-> [WithHsDocIdentifiers StringLiteral GhcRn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
d
get :: BinHandle -> IO (WarningTxt GhcRn)
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> do Located SourceText
s <- SourceText -> Located SourceText
forall e. e -> Located e
noLoc (SourceText -> Located SourceText)
-> IO SourceText -> IO (Located SourceText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[Located (WithHsDocIdentifiers StringLiteral GhcRn)]
w <- (WithHsDocIdentifiers StringLiteral GhcRn
-> Located (WithHsDocIdentifiers StringLiteral GhcRn))
-> [WithHsDocIdentifiers StringLiteral GhcRn]
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers StringLiteral GhcRn
-> Located (WithHsDocIdentifiers StringLiteral GhcRn)
forall e. e -> Located e
noLoc ([WithHsDocIdentifiers StringLiteral GhcRn]
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)])
-> IO [WithHsDocIdentifiers StringLiteral GhcRn]
-> IO [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [WithHsDocIdentifiers StringLiteral GhcRn]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
WarningTxt GhcRn -> IO (WarningTxt GhcRn)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located SourceText
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
-> WarningTxt GhcRn
forall pass.
Located SourceText
-> [Located (WithHsDocIdentifiers StringLiteral pass)]
-> WarningTxt pass
WarningTxt Located SourceText
s [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
w)
Word8
_ -> do Located SourceText
s <- SourceText -> Located SourceText
forall e. e -> Located e
noLoc (SourceText -> Located SourceText)
-> IO SourceText -> IO (Located SourceText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[Located (WithHsDocIdentifiers StringLiteral GhcRn)]
d <- (WithHsDocIdentifiers StringLiteral GhcRn
-> Located (WithHsDocIdentifiers StringLiteral GhcRn))
-> [WithHsDocIdentifiers StringLiteral GhcRn]
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers StringLiteral GhcRn
-> Located (WithHsDocIdentifiers StringLiteral GhcRn)
forall e. e -> Located e
noLoc ([WithHsDocIdentifiers StringLiteral GhcRn]
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)])
-> IO [WithHsDocIdentifiers StringLiteral GhcRn]
-> IO [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [WithHsDocIdentifiers StringLiteral GhcRn]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
WarningTxt GhcRn -> IO (WarningTxt GhcRn)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located SourceText
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
-> WarningTxt GhcRn
forall pass.
Located SourceText
-> [Located (WithHsDocIdentifiers StringLiteral pass)]
-> WarningTxt pass
DeprecatedTxt Located SourceText
s [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
d)
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 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
= NoWarnings
| WarnAll (WarningTxt pass)
| WarnSome [(OccName,WarningTxt pass)]
deriving instance Eq (IdP pass) => Eq (Warnings pass)
instance Binary (Warnings GhcRn) where
put_ :: BinHandle -> Warnings GhcRn -> IO ()
put_ BinHandle
bh Warnings GhcRn
NoWarnings = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh (WarnAll WarningTxt GhcRn
t) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> WarningTxt GhcRn -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WarningTxt GhcRn
t
put_ BinHandle
bh (WarnSome [(OccName, WarningTxt GhcRn)]
ts) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> [(OccName, WarningTxt GhcRn)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(OccName, WarningTxt GhcRn)]
ts
get :: BinHandle -> IO (Warnings GhcRn)
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> Warnings GhcRn -> IO (Warnings GhcRn)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Warnings GhcRn
forall pass. Warnings pass
NoWarnings
Word8
1 -> do WarningTxt GhcRn
aa <- BinHandle -> IO (WarningTxt GhcRn)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Warnings GhcRn -> IO (Warnings GhcRn)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WarningTxt GhcRn -> Warnings GhcRn
forall pass. WarningTxt pass -> Warnings pass
WarnAll WarningTxt GhcRn
aa)
Word8
_ -> do [(OccName, WarningTxt GhcRn)]
aa <- BinHandle -> IO [(OccName, WarningTxt GhcRn)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Warnings GhcRn -> IO (Warnings GhcRn)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(OccName, WarningTxt GhcRn)] -> Warnings GhcRn
forall pass. [(OccName, WarningTxt pass)] -> Warnings pass
WarnSome [(OccName, WarningTxt GhcRn)]
aa)
mkIfaceWarnCache :: Warnings p -> OccName -> Maybe (WarningTxt p)
mkIfaceWarnCache :: forall p. Warnings p -> OccName -> Maybe (WarningTxt p)
mkIfaceWarnCache Warnings p
NoWarnings = \OccName
_ -> Maybe (WarningTxt p)
forall a. Maybe a
Nothing
mkIfaceWarnCache (WarnAll WarningTxt p
t) = \OccName
_ -> WarningTxt p -> Maybe (WarningTxt p)
forall a. a -> Maybe a
Just WarningTxt p
t
mkIfaceWarnCache (WarnSome [(OccName, WarningTxt p)]
pairs) = OccEnv (WarningTxt p) -> OccName -> Maybe (WarningTxt p)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv ([(OccName, WarningTxt p)] -> OccEnv (WarningTxt p)
forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [(OccName, WarningTxt p)]
pairs)
emptyIfaceWarnCache :: OccName -> Maybe (WarningTxt p)
emptyIfaceWarnCache :: forall p. OccName -> Maybe (WarningTxt p)
emptyIfaceWarnCache OccName
_ = Maybe (WarningTxt p)
forall a. Maybe a
Nothing
plusWarns :: Warnings p -> Warnings p -> Warnings p
plusWarns :: forall p. Warnings p -> Warnings p -> Warnings p
plusWarns Warnings p
d Warnings p
NoWarnings = Warnings p
d
plusWarns Warnings p
NoWarnings Warnings p
d = Warnings p
d
plusWarns Warnings p
_ (WarnAll WarningTxt p
t) = WarningTxt p -> Warnings p
forall pass. WarningTxt pass -> Warnings pass
WarnAll WarningTxt p
t
plusWarns (WarnAll WarningTxt p
t) Warnings p
_ = WarningTxt p -> Warnings p
forall pass. WarningTxt pass -> Warnings pass
WarnAll WarningTxt p
t
plusWarns (WarnSome [(OccName, WarningTxt p)]
v1) (WarnSome [(OccName, WarningTxt p)]
v2) = [(OccName, WarningTxt p)] -> Warnings p
forall pass. [(OccName, WarningTxt pass)] -> Warnings pass
WarnSome ([(OccName, WarningTxt p)]
v1 [(OccName, WarningTxt p)]
-> [(OccName, WarningTxt p)] -> [(OccName, WarningTxt p)]
forall a. [a] -> [a] -> [a]
++ [(OccName, WarningTxt p)]
v2)