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

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

import Data.Foldable
import Data.Text (Text)
import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import GHC.Unit.Module.Warnings
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common

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

p_warnDecl :: WarnDecl GhcPs -> R ()
p_warnDecl :: WarnDecl GhcPs -> R ()
p_warnDecl (Warning XWarning GhcPs
_ [LIdP GhcPs]
functions WarningTxt
warningTxt) =
  [LocatedN RdrName] -> WarningTxt -> R ()
p_topLevelWarning [LIdP GhcPs]
functions WarningTxt
warningTxt

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

p_topLevelWarning :: [LocatedN RdrName] -> WarningTxt -> R ()
p_topLevelWarning :: [LocatedN RdrName] -> WarningTxt -> R ()
p_topLevelWarning [LocatedN RdrName]
fnames WarningTxt
wtxt = do
  let (Text
pragmaText, [Located StringLiteral]
lits) = WarningTxt -> (Text, [Located StringLiteral])
warningText WarningTxt
wtxt
  [SrcSpan] -> R () -> R ()
switchLayout (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [LocatedN RdrName]
fnames forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l e. GenLocated l e -> l
getLoc [Located StringLiteral]
lits) forall a b. (a -> b) -> a -> b
$
    Text -> R () -> R ()
pragma Text
pragmaText forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
      forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel LocatedN RdrName -> R ()
p_rdrName [LocatedN RdrName]
fnames
      R ()
breakpoint
      [Located StringLiteral] -> R ()
p_lits [Located StringLiteral]
lits

warningText :: WarningTxt -> (Text, [Located StringLiteral])
warningText :: WarningTxt -> (Text, [Located StringLiteral])
warningText = \case
  WarningTxt Located SourceText
_ [Located StringLiteral]
lits -> (Text
"WARNING", [Located StringLiteral]
lits)
  DeprecatedTxt Located SourceText
_ [Located StringLiteral]
lits -> (Text
"DEPRECATED", [Located StringLiteral]
lits)

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