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