Implement printer for ‘WarningD’

data/examples/declaration/warning/warning-multiline-out.hs

@@ -0,0 +1,9 @@
+{-# WARNING
+  test
+  , foo
+  [ "These are bad functions"
+  , "Really bad!"
+  ]
+  #-}
+test :: IO ()
+test = pure ()

data/examples/declaration/warning/warning-multiline.hs

@@ -0,0 +1,4 @@
+{-# WArNING test,
+  foo ["These are bad functions", "Really bad!"] #-}
+test :: IO ()
+test = pure ()

data/examples/declaration/warning/warning-single-line-out.hs

@@ -0,0 +1,4 @@
+{-# WARNING test "This is a warning" #-}
+{-# DEPRECATED test, foo "This is a deprecation" #-}
+test :: IO ()
+test = pure ()

data/examples/declaration/warning/warning-single-line.hs

@@ -0,0 +1,5 @@
+{-# WARNING test    ["This is a warning" ] #-}
+{-# Deprecated test, foo "This is a deprecation"
+  #-}
+test :: IO ()
+test = pure ()

ormolu.cabal

@@ -72,6 +72,7 @@ library
                     , Ormolu.Printer.Meat.Declaration.Type
                     , Ormolu.Printer.Meat.Declaration.TypeFamily
                     , Ormolu.Printer.Meat.Declaration.Value
+                    , Ormolu.Printer.Meat.Declaration.Warning
                     , Ormolu.Printer.Meat.ImportExport
                     , Ormolu.Printer.Meat.Module
                     , Ormolu.Printer.Meat.Type

src/Ormolu/Printer/Meat/Declaration.hs

@@ -27,6 +27,7 @@ import Ormolu.Printer.Meat.Declaration.Splice
 import Ormolu.Printer.Meat.Declaration.Type
 import Ormolu.Printer.Meat.Declaration.TypeFamily
 import Ormolu.Printer.Meat.Declaration.Value
+import Ormolu.Printer.Meat.Declaration.Warning
 import Ormolu.Printer.Meat.Type
 import Ormolu.Utils
 
@@ -51,7 +52,7 @@ p_hsDecl style = \case
   DerivD NoExt x -> p_derivDecl x
   DefD NoExt x -> p_defaultDecl x
   ForD NoExt x -> p_foreignDecl x
-  WarningD _ _ -> notImplemented "WarningD"
+  WarningD NoExt x -> p_warnDecls x
   AnnD NoExt x -> p_annDecl x
   RuleD _ _ -> notImplemented "RuleD"
   SpliceD NoExt x -> p_spliceDecl x

src/Ormolu/Printer/Meat/Declaration/Warning.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Ormolu.Printer.Meat.Declaration.Warning
+  ( p_warnDecls
+  , p_moduleWarning
+  )
+where
+
+import BasicTypes
+import Data.Foldable
+import qualified Data.List.NonEmpty as NE
+import Data.Text (Text)
+import GHC
+import Ormolu.Printer.Combinators
+import Ormolu.Printer.Meat.Common
+import Ormolu.Utils
+import SrcLoc (combineSrcSpans)
+
+p_warnDecls :: WarnDecls GhcPs -> R ()
+p_warnDecls (Warnings NoExt _ warnings) =
+  traverse_ (located' p_warnDecl) warnings
+p_warnDecls XWarnDecls {} = notImplemented "XWarnDecls"
+
+p_warnDecl :: WarnDecl GhcPs -> R ()
+p_warnDecl (Warning NoExt functions warningTxt) =
+  p_topLevelWarning functions warningTxt
+p_warnDecl XWarnDecl {} = notImplemented "XWarnDecl"
+
+p_moduleWarning :: WarningTxt -> R ()
+p_moduleWarning wtxt = do
+  let (pragmaText, lits) = warningText wtxt
+  switchLayout (listSpan lits) $ do
+    breakpoint
+    inci $ pragma pragmaText (p_lits lits)
+
+p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()
+p_topLevelWarning fnames wtxt = do
+  let (pragmaText, lits) = warningText wtxt
+  switchLayout (combineSrcSpans (listSpan fnames) (listSpan lits)) $ do
+    pragma pragmaText $ do
+      velt (withSep comma p_rdrName fnames)
+      breakpoint
+      p_lits lits
+
+warningText :: WarningTxt -> (Text, [Located StringLiteral])
+warningText = \case
+  WarningTxt _ lits -> ("WARNING", lits)
+  DeprecatedTxt _ lits -> ("DEPRECATED", lits)
+
+listSpan :: [Located a] -> SrcSpan
+listSpan xs = combineSrcSpans' (getLoc <$> NE.fromList xs)
+
+p_lits :: [Located StringLiteral] -> R ()
+p_lits = \case
+  [l] -> atom l
+  ls -> brackets . velt $ withSep comma atom ls

src/Ormolu/Printer/Meat/Module.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 
@@ -9,20 +8,17 @@ module Ormolu.Printer.Meat.Module
   )
 where
 
-import BasicTypes hiding (InlinePragma)
 import Control.Monad
 import Data.Maybe (isJust)
-import Data.Text (Text)
 import GHC
 import Ormolu.Imports
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Comments
 import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Declaration
+import Ormolu.Printer.Meat.Declaration.Warning
 import Ormolu.Printer.Meat.ImportExport
-import Ormolu.Utils
 import SrcLoc (combineSrcSpans)
-import qualified Data.List.NonEmpty as NE
 
 p_hsModule :: ParsedSource -> R ()
 p_hsModule loc@(L moduleSpan hsModule) = do
@@ -38,7 +34,7 @@ p_hsModule loc@(L moduleSpan hsModule) = do
       Nothing -> pure ()
       Just hsmodName' -> line $ do
         located hsmodName' p_hsmodName
-        forM_ hsmodDeprecMessage (located' p_warningTxt)
+        forM_ hsmodDeprecMessage (located' p_moduleWarning)
         case hsmodExports of
           Nothing -> return ()
           Just hsmodExports' -> do
@@ -53,23 +49,3 @@ p_hsModule loc@(L moduleSpan hsModule) = do
     trailingComments <- hasMoreComments
     when (trailingComments && isJust hsmodName) newline
     spitRemainingComments
-
--- | Layout the WARNING\/DEPRECATED pragmas in the module head.
-
-p_warningTxt :: WarningTxt -> R ()
-p_warningTxt = \case
-  WarningTxt _ lits -> p_pragma "WARNING" lits
-  DeprecatedTxt _ lits -> p_pragma "DEPRECATED" lits
-  where
-    p_pragma :: Text -> [Located StringLiteral] -> R ()
-    p_pragma pragmaText lits = switchLayout (litsSpan lits) $ do
-      breakpoint
-      inci $ pragma pragmaText (p_lits lits)
-
-    litsSpan :: [Located StringLiteral] -> SrcSpan
-    litsSpan lits = combineSrcSpans' (getLoc <$> NE.fromList lits)
-
-    p_lits :: [Located StringLiteral] -> R ()
-    p_lits = \case
-      [l] -> atom l
-      ls -> brackets . velt $ withSep comma atom ls