{-# 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.Name.Reader 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. 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 GhcPs warningTxt) = [LocatedN RdrName] -> WarningTxt GhcPs -> R () p_topLevelWarning [LIdP GhcPs] [LocatedN RdrName] functions WarningTxt GhcPs warningTxt p_warningTxt :: WarningTxt GhcPs -> R () p_warningTxt :: WarningTxt GhcPs -> R () p_warningTxt WarningTxt GhcPs wtxt = do let (Text pragmaText, [Located StringLiteral] lits) = WarningTxt GhcPs -> (Text, [Located 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 $ [Located StringLiteral] -> R () p_lits [Located StringLiteral] lits p_topLevelWarning :: [LocatedN RdrName] -> WarningTxt GhcPs -> R () p_topLevelWarning :: [LocatedN RdrName] -> WarningTxt GhcPs -> R () p_topLevelWarning [LocatedN RdrName] fnames WarningTxt GhcPs wtxt = do let (Text pragmaText, [Located StringLiteral] lits) = WarningTxt GhcPs -> (Text, [Located StringLiteral]) warningText WarningTxt GhcPs wtxt [SrcSpan] -> R () -> R () switchLayout ((LocatedN RdrName -> SrcSpan) -> [LocatedN RdrName] -> [SrcSpan] forall a b. (a -> b) -> [a] -> [b] 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 a b. (a -> b) -> [a] -> [b] 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 GhcPs -> (Text, [Located StringLiteral]) warningText :: WarningTxt GhcPs -> (Text, [Located StringLiteral]) warningText = \case WarningTxt Maybe (Located InWarningCategory) mcat Located SourceText _ [Located (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) -> Located (WithHsDocIdentifiers StringLiteral GhcPs) -> Located StringLiteral forall a b. (a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan 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 (Located (WithHsDocIdentifiers StringLiteral GhcPs) -> Located StringLiteral) -> [Located (WithHsDocIdentifiers StringLiteral GhcPs)] -> [Located StringLiteral] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Located (WithHsDocIdentifiers StringLiteral GhcPs)] lits) where cat :: String cat = case Located InWarningCategory -> InWarningCategory forall l e. GenLocated l e -> e unLoc (Located InWarningCategory -> InWarningCategory) -> Maybe (Located InWarningCategory) -> Maybe InWarningCategory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe (Located InWarningCategory) mcat of Just InWarningCategory {Located (HsToken "in") Located WarningCategory SourceText iwc_in :: Located (HsToken "in") iwc_st :: SourceText iwc_wc :: Located WarningCategory iwc_in :: InWarningCategory -> Located (HsToken "in") iwc_st :: InWarningCategory -> SourceText iwc_wc :: InWarningCategory -> Located 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 (Located WarningCategory -> WarningCategory forall l e. GenLocated l e -> e unLoc Located WarningCategory iwc_wc)) Maybe InWarningCategory Nothing -> String "" DeprecatedTxt Located SourceText _ [Located (WithHsDocIdentifiers StringLiteral GhcPs)] lits -> (Text "DEPRECATED", (WithHsDocIdentifiers StringLiteral GhcPs -> StringLiteral) -> Located (WithHsDocIdentifiers StringLiteral GhcPs) -> Located StringLiteral forall a b. (a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan 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 (Located (WithHsDocIdentifiers StringLiteral GhcPs) -> Located StringLiteral) -> [Located (WithHsDocIdentifiers StringLiteral GhcPs)] -> [Located StringLiteral] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Located (WithHsDocIdentifiers StringLiteral GhcPs)] 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