module GHC.Iface.Warnings
  ( toIfaceWarnings
  , toIfaceWarningTxt
  )
where

import GHC.Prelude

import GHC.Hs

import GHC.Iface.Syntax

import GHC.Types.SourceText
import GHC.Types.SrcLoc ( unLoc )

import GHC.Unit.Module.Warnings

toIfaceWarnings :: Warnings GhcRn -> IfaceWarnings
toIfaceWarnings :: Warnings GhcRn -> IfaceWarnings
toIfaceWarnings (WarnAll WarningTxt GhcRn
txt) = IfaceWarningTxt -> IfaceWarnings
IfWarnAll (WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt WarningTxt GhcRn
txt)
toIfaceWarnings (WarnSome DeclWarnOccNames GhcRn
vs ExportWarnNames GhcRn
ds) = [(OccName, IfaceWarningTxt)]
-> [(IfExtName, IfaceWarningTxt)] -> IfaceWarnings
IfWarnSome [(OccName, IfaceWarningTxt)]
vs' [(IfExtName, IfaceWarningTxt)]
ds'
  where
    vs' :: [(OccName, IfaceWarningTxt)]
vs' = [(OccName
occ, WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt WarningTxt GhcRn
txt) | (OccName
occ, WarningTxt GhcRn
txt) <- DeclWarnOccNames GhcRn
vs]
    ds' :: [(IfExtName, IfaceWarningTxt)]
ds' = [(IfExtName
occ, WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt WarningTxt GhcRn
txt) | (IfExtName
occ, WarningTxt GhcRn
txt) <- ExportWarnNames GhcRn
ds]

toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt (WarningTxt XWarningTxt GhcRn
src Maybe (XRec GhcRn (InWarningCategory GhcRn))
mb_cat [XRec GhcRn (WithHsDocIdentifiers StringLiteral GhcRn)]
strs) = SourceText
-> Maybe WarningCategory
-> [(IfaceStringLiteral, [IfExtName])]
-> IfaceWarningTxt
IfWarningTxt XWarningTxt GhcRn
SourceText
src (GenLocated EpaLocation WarningCategory -> WarningCategory
forall l e. GenLocated l e -> e
unLoc (GenLocated EpaLocation WarningCategory -> WarningCategory)
-> (GenLocated EpaLocation (InWarningCategory GhcRn)
    -> GenLocated EpaLocation WarningCategory)
-> GenLocated EpaLocation (InWarningCategory GhcRn)
-> WarningCategory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InWarningCategory GhcRn -> XRec GhcRn WarningCategory
InWarningCategory GhcRn -> GenLocated EpaLocation WarningCategory
forall pass. InWarningCategory pass -> XRec pass WarningCategory
iwc_wc (InWarningCategory GhcRn -> GenLocated EpaLocation WarningCategory)
-> (GenLocated EpaLocation (InWarningCategory GhcRn)
    -> InWarningCategory GhcRn)
-> GenLocated EpaLocation (InWarningCategory GhcRn)
-> GenLocated EpaLocation WarningCategory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated EpaLocation (InWarningCategory GhcRn)
-> InWarningCategory GhcRn
forall l e. GenLocated l e -> e
unLoc (GenLocated EpaLocation (InWarningCategory GhcRn)
 -> WarningCategory)
-> Maybe (GenLocated EpaLocation (InWarningCategory GhcRn))
-> Maybe WarningCategory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (XRec GhcRn (InWarningCategory GhcRn))
Maybe (GenLocated EpaLocation (InWarningCategory GhcRn))
mb_cat) ((GenLocated EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)
 -> (IfaceStringLiteral, [IfExtName]))
-> [GenLocated
      EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)]
-> [(IfaceStringLiteral, [IfExtName])]
forall a b. (a -> b) -> [a] -> [b]
map (WithHsDocIdentifiers StringLiteral GhcRn
-> (IfaceStringLiteral, [IfExtName])
toIfaceStringLiteralWithNames (WithHsDocIdentifiers StringLiteral GhcRn
 -> (IfaceStringLiteral, [IfExtName]))
-> (GenLocated
      EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)
    -> WithHsDocIdentifiers StringLiteral GhcRn)
-> GenLocated
     EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)
-> (IfaceStringLiteral, [IfExtName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn
forall l e. GenLocated l e -> e
unLoc) [XRec GhcRn (WithHsDocIdentifiers StringLiteral GhcRn)]
[GenLocated EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)]
strs)
toIfaceWarningTxt (DeprecatedTxt XDeprecatedTxt GhcRn
src [XRec GhcRn (WithHsDocIdentifiers StringLiteral GhcRn)]
strs) = SourceText
-> [(IfaceStringLiteral, [IfExtName])] -> IfaceWarningTxt
IfDeprecatedTxt XDeprecatedTxt GhcRn
SourceText
src ((GenLocated EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)
 -> (IfaceStringLiteral, [IfExtName]))
-> [GenLocated
      EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)]
-> [(IfaceStringLiteral, [IfExtName])]
forall a b. (a -> b) -> [a] -> [b]
map (WithHsDocIdentifiers StringLiteral GhcRn
-> (IfaceStringLiteral, [IfExtName])
toIfaceStringLiteralWithNames (WithHsDocIdentifiers StringLiteral GhcRn
 -> (IfaceStringLiteral, [IfExtName]))
-> (GenLocated
      EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)
    -> WithHsDocIdentifiers StringLiteral GhcRn)
-> GenLocated
     EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)
-> (IfaceStringLiteral, [IfExtName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn
forall l e. GenLocated l e -> e
unLoc) [XRec GhcRn (WithHsDocIdentifiers StringLiteral GhcRn)]
[GenLocated EpaLocation (WithHsDocIdentifiers StringLiteral GhcRn)]
strs)

toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName])
toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn
-> (IfaceStringLiteral, [IfExtName])
toIfaceStringLiteralWithNames (WithHsDocIdentifiers StringLiteral
src [Located (IdP GhcRn)]
names) = (StringLiteral -> IfaceStringLiteral
toIfaceStringLiteral StringLiteral
src, (GenLocated SrcSpan IfExtName -> IfExtName)
-> [GenLocated SrcSpan IfExtName] -> [IfExtName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan IfExtName -> IfExtName
forall l e. GenLocated l e -> e
unLoc [Located (IdP GhcRn)]
[GenLocated SrcSpan IfExtName]
names)

toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral
toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral
toIfaceStringLiteral (StringLiteral SourceText
sl FastString
fs Maybe NoCommentsLocation
_) = SourceText -> FastString -> IfaceStringLiteral
IfStringLiteral SourceText
sl FastString
fs