1{-# LANGUAGE LambdaCase #-} 2{-# LANGUAGE OverloadedStrings #-} 3 4module Ormolu.Printer.Meat.Declaration.Warning 5 ( p_warnDecls, 6 p_moduleWarning, 7 ) 8where 9 10import BasicTypes 11import Data.Foldable 12import Data.Text (Text) 13import GHC 14import Ormolu.Printer.Combinators 15import Ormolu.Printer.Meat.Common 16 17p_warnDecls :: WarnDecls GhcPs -> R () 18p_warnDecls (Warnings NoExtField _ warnings) = 19 traverse_ (located' p_warnDecl) warnings 20p_warnDecls (XWarnDecls x) = noExtCon x 21 22p_warnDecl :: WarnDecl GhcPs -> R () 23p_warnDecl (Warning NoExtField functions warningTxt) = 24 p_topLevelWarning functions warningTxt 25p_warnDecl (XWarnDecl x) = noExtCon x 26 27p_moduleWarning :: WarningTxt -> R () 28p_moduleWarning wtxt = do 29 let (pragmaText, lits) = warningText wtxt 30 inci $ pragma pragmaText $ inci $ p_lits lits 31 32p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R () 33p_topLevelWarning fnames wtxt = do 34 let (pragmaText, lits) = warningText wtxt 35 switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $ 36 pragma pragmaText . inci $ do 37 sep commaDel p_rdrName fnames 38 breakpoint 39 p_lits lits 40 41warningText :: WarningTxt -> (Text, [Located StringLiteral]) 42warningText = \case 43 WarningTxt _ lits -> ("WARNING", lits) 44 DeprecatedTxt _ lits -> ("DEPRECATED", lits) 45 46p_lits :: [Located StringLiteral] -> R () 47p_lits = \case 48 [l] -> atom l 49 ls -> brackets N $ sep commaDel atom ls 50