{-# 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) = (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. HasSrcSpan 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 XWarning GhcPs _ [LIdP GhcPs] functions WarningTxt warningTxt) = [LocatedN RdrName] -> WarningTxt -> R () p_topLevelWarning [LIdP GhcPs] [LocatedN 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 :: [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 ((LocatedN RdrName -> SrcSpan) -> [LocatedN RdrName] -> [SrcSpan] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap LocatedN RdrName -> SrcSpan forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan getLocA [LocatedN 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 () -> (LocatedN RdrName -> R ()) -> [LocatedN RdrName] -> R () 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] -> 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