{-# 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.Decls import GHC.Hs.Extension import GHC.Types.Basic import GHC.Types.Name.Reader import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common p_warnDecls :: WarnDecls GhcPs -> R () p_warnDecls :: WarnDecls GhcPs -> R () p_warnDecls (Warnings XWarnings GhcPs NoExtField SourceText _ [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. (a -> R ()) -> Located 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 NoExtField [Located (IdP GhcPs)] functions WarningTxt warningTxt) = [Located RdrName] -> WarningTxt -> R () p_topLevelWarning [Located (IdP GhcPs)] [Located RdrName] 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 (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 $ [Located StringLiteral] -> R () p_lits [Located StringLiteral] lits p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R () p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R () p_topLevelWarning [Located RdrName] fnames WarningTxt wtxt = do let (Text pragmaText, [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 l e. GenLocated l e -> l 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 l e. GenLocated l e -> l 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 () -> (Located RdrName -> R ()) -> [Located RdrName] -> R () forall a. R () -> (a -> R ()) -> [a] -> R () sep R () commaDel 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 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] -> Located StringLiteral -> R () forall a. Outputable a => a -> R () atom Located StringLiteral l [Located StringLiteral] ls -> BracketStyle -> R () -> R () brackets BracketStyle N (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 () commaDel Located StringLiteral -> R () forall a. Outputable a => a -> R () atom [Located StringLiteral] ls