{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Ormolu.Printer.Meat.Declaration.Warning
  ( p_warnDecls,
    p_warningTxt,
  )
where

import Data.Foldable
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Hs
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import GHC.Unit.Module.Warnings
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common
import Ormolu.Utils

p_warnDecls :: WarnDecls GhcPs -> R ()
p_warnDecls :: WarnDecls GhcPs -> R ()
p_warnDecls (Warnings XWarnings GhcPs
_ [LWarnDecl GhcPs]
warnings) =
  (GenLocated SrcSpanAnnA (WarnDecl GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (WarnDecl GhcPs)] -> R ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((WarnDecl GhcPs -> R ())
-> GenLocated SrcSpanAnnA (WarnDecl GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' WarnDecl GhcPs -> R ()
p_warnDecl) [LWarnDecl GhcPs]
[GenLocated SrcSpanAnnA (WarnDecl GhcPs)]
warnings

p_warnDecl :: WarnDecl GhcPs -> R ()
p_warnDecl :: WarnDecl GhcPs -> R ()
p_warnDecl (Warning (NamespaceSpecifier
namespace, [AddEpAnn]
_) [LIdP GhcPs]
fnames WarningTxt GhcPs
wtxt) = do
  let (Text
pragmaText, [LocatedE StringLiteral]
lits) = WarningTxt GhcPs -> (Text, [LocatedE StringLiteral])
warningText WarningTxt GhcPs
wtxt
  [SrcSpan] -> R () -> R ()
switchLayout ((GenLocated SrcSpanAnnN RdrName -> SrcSpan)
-> [GenLocated SrcSpanAnnN RdrName] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
fnames [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ (LocatedE StringLiteral -> SrcSpan)
-> [LocatedE StringLiteral] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocatedE StringLiteral -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA [LocatedE StringLiteral]
lits) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
    Text -> R () -> R ()
pragma Text
pragmaText (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      NamespaceSpecifier -> R ()
p_namespaceSpec NamespaceSpecifier
namespace
      R ()
-> (GenLocated SrcSpanAnnN RdrName -> R ())
-> [GenLocated SrcSpanAnnN RdrName]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
fnames
      R ()
breakpoint
      [LocatedE StringLiteral] -> R ()
p_lits [LocatedE StringLiteral]
lits

p_warningTxt :: WarningTxt GhcPs -> R ()
p_warningTxt :: WarningTxt GhcPs -> R ()
p_warningTxt WarningTxt GhcPs
wtxt = do
  let (Text
pragmaText, [LocatedE StringLiteral]
lits) = WarningTxt GhcPs -> (Text, [LocatedE StringLiteral])
warningText WarningTxt GhcPs
wtxt
  R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Text -> R () -> R ()
pragma Text
pragmaText (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ [LocatedE StringLiteral] -> R ()
p_lits [LocatedE StringLiteral]
lits

warningText :: WarningTxt GhcPs -> (Text, [LocatedE StringLiteral])
warningText :: WarningTxt GhcPs -> (Text, [LocatedE StringLiteral])
warningText = \case
  WarningTxt Maybe (LocatedE InWarningCategory)
mcat SourceText
_ [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
lits -> (Text
"WARNING" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
cat, (WithHsDocIdentifiers StringLiteral GhcPs -> StringLiteral)
-> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
-> LocatedE StringLiteral
forall a b.
(a -> b) -> GenLocated EpaLocation a -> GenLocated EpaLocation b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers StringLiteral GhcPs -> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString (LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
 -> LocatedE StringLiteral)
-> [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
-> [LocatedE StringLiteral]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
lits)
    where
      cat :: String
cat = case LocatedE InWarningCategory -> InWarningCategory
forall l e. GenLocated l e -> e
unLoc (LocatedE InWarningCategory -> InWarningCategory)
-> Maybe (LocatedE InWarningCategory) -> Maybe InWarningCategory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LocatedE InWarningCategory)
mcat of
        Just InWarningCategory {LocatedE WarningCategory
SourceText
EpToken "in"
iwc_in :: EpToken "in"
iwc_st :: SourceText
iwc_wc :: LocatedE WarningCategory
iwc_in :: InWarningCategory -> EpToken "in"
iwc_st :: InWarningCategory -> SourceText
iwc_wc :: InWarningCategory -> LocatedE WarningCategory
..} ->
          String
" in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show (forall o. Outputable o => o -> String
showOutputable @WarningCategory (LocatedE WarningCategory -> WarningCategory
forall l e. GenLocated l e -> e
unLoc LocatedE WarningCategory
iwc_wc))
        Maybe InWarningCategory
Nothing -> String
""
  DeprecatedTxt SourceText
_ [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
lits -> (Text
"DEPRECATED", (WithHsDocIdentifiers StringLiteral GhcPs -> StringLiteral)
-> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
-> LocatedE StringLiteral
forall a b.
(a -> b) -> GenLocated EpaLocation a -> GenLocated EpaLocation b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers StringLiteral GhcPs -> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString (LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
 -> LocatedE StringLiteral)
-> [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
-> [LocatedE StringLiteral]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
lits)

p_lits :: [LocatedE StringLiteral] -> R ()
p_lits :: [LocatedE StringLiteral] -> R ()
p_lits = \case
  [LocatedE StringLiteral
l] -> LocatedE StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom LocatedE StringLiteral
l
  [LocatedE StringLiteral]
ls -> BracketStyle -> R () -> R ()
brackets BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (LocatedE StringLiteral -> R ())
-> [LocatedE StringLiteral]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel LocatedE StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom [LocatedE StringLiteral]
ls