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

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

import BasicTypes
import Data.Foldable
import Data.Text (Text)
import GHC
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 NoExt _ warnings :: [LWarnDecl GhcPs]
warnings) =
  (LWarnDecl GhcPs -> R ()) -> [LWarnDecl GhcPs] -> R ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((WarnDecl GhcPs -> R ()) -> LWarnDecl GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' WarnDecl GhcPs -> R ()
p_warnDecl) [LWarnDecl GhcPs]
warnings
p_warnDecls XWarnDecls {} = String -> R ()
forall a. String -> a
notImplemented "XWarnDecls"

p_warnDecl :: WarnDecl GhcPs -> R ()
p_warnDecl :: WarnDecl GhcPs -> R ()
p_warnDecl (Warning NoExt functions :: [Located (IdP GhcPs)]
functions warningTxt :: WarningTxt
warningTxt) =
  [Located RdrName] -> WarningTxt -> R ()
p_topLevelWarning [Located (IdP GhcPs)]
[Located RdrName]
functions WarningTxt
warningTxt
p_warnDecl XWarnDecl {} = String -> R ()
forall a. String -> a
notImplemented "XWarnDecl"

p_moduleWarning :: WarningTxt -> R ()
p_moduleWarning :: WarningTxt -> R ()
p_moduleWarning wtxt :: WarningTxt
wtxt = do
  let (pragmaText :: Text
pragmaText, lits :: [Located StringLiteral]
lits) = WarningTxt -> (Text, [Located StringLiteral])
warningText WarningTxt
wtxt
  [SrcSpan] -> R () -> R ()
switchLayout (Located StringLiteral -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located StringLiteral -> SrcSpan)
-> [Located StringLiteral] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located StringLiteral]
lits)
    (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
$ Text -> R () -> R ()
pragma Text
pragmaText (R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ [Located StringLiteral] -> R ()
p_lits [Located StringLiteral]
lits)

p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()
p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()
p_topLevelWarning fnames :: [Located RdrName]
fnames wtxt :: WarningTxt
wtxt = do
  let (pragmaText :: Text
pragmaText, lits :: [Located StringLiteral]
lits) = WarningTxt -> (Text, [Located StringLiteral])
warningText WarningTxt
wtxt
  [SrcSpan] -> R () -> R ()
switchLayout ((Located RdrName -> SrcSpan) -> [Located RdrName] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc [Located RdrName]
fnames [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ (Located StringLiteral -> SrcSpan)
-> [Located StringLiteral] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located StringLiteral -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc [Located 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
      R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (Located RdrName -> R ()) -> [Located RdrName] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) Located RdrName -> R ()
p_rdrName [Located 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 _ lits :: [Located StringLiteral]
lits -> ("WARNING", [Located StringLiteral]
lits)
  DeprecatedTxt _ lits :: [Located StringLiteral]
lits -> ("DEPRECATED", [Located StringLiteral]
lits)

p_lits :: [Located StringLiteral] -> R ()
p_lits :: [Located StringLiteral] -> R ()
p_lits = \case
  [l :: Located StringLiteral
l] -> Located StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom Located StringLiteral
l
  ls :: [Located StringLiteral]
ls -> BracketStyle -> R () -> R ()
brackets BracketStyle
N (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (Located StringLiteral -> R ())
-> [Located StringLiteral]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) Located StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom [Located StringLiteral]
ls