git.iko.soy/ormolu
on master help sign in
Implement printer for ‘WarningD’
commit3c506ecf2ba5a7c1a94362eab434893af1ea4619 authorRupert Horlick <rupert.horlick@iohk.io> dateSat 15 Jun 2019, 18:11 (7 years ago) parentbdc8738
8 files changed+84−27
compare with master
unifiedsplit
data/examples/declaration/warning/warning-multiline-out.hs+9 data/examples/declaration/warning/warning-multiline.hs+4 data/examples/declaration/warning/warning-single-line-out.hs+4 data/examples/declaration/warning/warning-single-line.hs+5 ormolu.cabal+1 src/Ormolu/Printer/Meat/Declaration.hs+2−1 src/Ormolu/Printer/Meat/Declaration/Warning.hs+57 src/Ormolu/Printer/Meat/Module.hs+2−26
data/examples/declaration/warning/warning-multiline-out.hsnew file+9
@@ -0,0 +1,9 @@
1+{-# WARNING
2+ test
3+ , foo
4+ [ "These are bad functions"
5+ , "Really bad!"
6+ ]
7+ #-}
8+test :: IO ()
9+test = pure ()
data/examples/declaration/warning/warning-multiline.hsnew file+4
@@ -0,0 +1,4 @@
1+{-# WArNING test,
2+ foo ["These are bad functions", "Really bad!"] #-}
3+test :: IO ()
4+test = pure ()
data/examples/declaration/warning/warning-single-line-out.hsnew file+4
@@ -0,0 +1,4 @@
1+{-# WARNING test "This is a warning" #-}
2+{-# DEPRECATED test, foo "This is a deprecation" #-}
3+test :: IO ()
4+test = pure ()
data/examples/declaration/warning/warning-single-line.hsnew file+5
@@ -0,0 +1,5 @@
1+{-# WARNING test ["This is a warning" ] #-}
2+{-# Deprecated test, foo "This is a deprecation"
3+ #-}
4+test :: IO ()
5+test = pure ()
ormolu.cabal+1
@@ -72,6 +72,7 @@ library
7272 , Ormolu.Printer.Meat.Declaration.Type
7373 , Ormolu.Printer.Meat.Declaration.TypeFamily
7474 , Ormolu.Printer.Meat.Declaration.Value
75+ , Ormolu.Printer.Meat.Declaration.Warning
7576 , Ormolu.Printer.Meat.ImportExport
7677 , Ormolu.Printer.Meat.Module
7778 , Ormolu.Printer.Meat.Type
src/Ormolu/Printer/Meat/Declaration.hs+2−1
@@ -27,6 +27,7 @@ import Ormolu.Printer.Meat.Declaration.Splice
2727import Ormolu.Printer.Meat.Declaration.Type
2828import Ormolu.Printer.Meat.Declaration.TypeFamily
2929import Ormolu.Printer.Meat.Declaration.Value
30+import Ormolu.Printer.Meat.Declaration.Warning
3031import Ormolu.Printer.Meat.Type
3132import Ormolu.Utils
3233
@@ -51,7 +52,7 @@ p_hsDecl style = \case
5152 DerivD NoExt x -> p_derivDecl x
5253 DefD NoExt x -> p_defaultDecl x
5354 ForD NoExt x -> p_foreignDecl x
54− WarningD _ _ -> notImplemented "WarningD"
55+ WarningD NoExt x -> p_warnDecls x
5556 AnnD NoExt x -> p_annDecl x
5657 RuleD _ _ -> notImplemented "RuleD"
5758 SpliceD NoExt x -> p_spliceDecl x
src/Ormolu/Printer/Meat/Declaration/Warning.hsnew file+57
@@ -0,0 +1,57 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Ormolu.Printer.Meat.Declaration.Warning
5+ ( p_warnDecls
6+ , p_moduleWarning
7+ )
8+where
9+
10+import BasicTypes
11+import Data.Foldable
12+import qualified Data.List.NonEmpty as NE
13+import Data.Text (Text)
14+import GHC
15+import Ormolu.Printer.Combinators
16+import Ormolu.Printer.Meat.Common
17+import Ormolu.Utils
18+import SrcLoc (combineSrcSpans)
19+
20+p_warnDecls :: WarnDecls GhcPs -> R ()
21+p_warnDecls (Warnings NoExt _ warnings) =
22+ traverse_ (located' p_warnDecl) warnings
23+p_warnDecls XWarnDecls {} = notImplemented "XWarnDecls"
24+
25+p_warnDecl :: WarnDecl GhcPs -> R ()
26+p_warnDecl (Warning NoExt functions warningTxt) =
27+ p_topLevelWarning functions warningTxt
28+p_warnDecl XWarnDecl {} = notImplemented "XWarnDecl"
29+
30+p_moduleWarning :: WarningTxt -> R ()
31+p_moduleWarning wtxt = do
32+ let (pragmaText, lits) = warningText wtxt
33+ switchLayout (listSpan lits) $ do
34+ breakpoint
35+ inci $ pragma pragmaText (p_lits lits)
36+
37+p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()
38+p_topLevelWarning fnames wtxt = do
39+ let (pragmaText, lits) = warningText wtxt
40+ switchLayout (combineSrcSpans (listSpan fnames) (listSpan lits)) $ do
41+ pragma pragmaText $ do
42+ velt (withSep comma p_rdrName fnames)
43+ breakpoint
44+ p_lits lits
45+
46+warningText :: WarningTxt -> (Text, [Located StringLiteral])
47+warningText = \case
48+ WarningTxt _ lits -> ("WARNING", lits)
49+ DeprecatedTxt _ lits -> ("DEPRECATED", lits)
50+
51+listSpan :: [Located a] -> SrcSpan
52+listSpan xs = combineSrcSpans' (getLoc <$> NE.fromList xs)
53+
54+p_lits :: [Located StringLiteral] -> R ()
55+p_lits = \case
56+ [l] -> atom l
57+ ls -> brackets . velt $ withSep comma atom ls
src/Ormolu/Printer/Meat/Module.hs+2−26
@@ -1,4 +1,3 @@
1−{-# LANGUAGE LambdaCase #-}
21{-# LANGUAGE OverloadedStrings #-}
32{-# LANGUAGE RecordWildCards #-}
43
@@ -9,20 +8,17 @@ module Ormolu.Printer.Meat.Module
98 )
109where
1110
12−import BasicTypes hiding (InlinePragma)
1311import Control.Monad
1412import Data.Maybe (isJust)
15−import Data.Text (Text)
1613import GHC
1714import Ormolu.Imports
1815import Ormolu.Printer.Combinators
1916import Ormolu.Printer.Comments
2017import Ormolu.Printer.Meat.Common
2118import Ormolu.Printer.Meat.Declaration
19+import Ormolu.Printer.Meat.Declaration.Warning
2220import Ormolu.Printer.Meat.ImportExport
23−import Ormolu.Utils
2421import SrcLoc (combineSrcSpans)
25−import qualified Data.List.NonEmpty as NE
2622
2723p_hsModule :: ParsedSource -> R ()
2824p_hsModule loc@(L moduleSpan hsModule) = do
@@ -38,7 +34,7 @@ p_hsModule loc@(L moduleSpan hsModule) = do
3834 Nothing -> pure ()
3935 Just hsmodName' -> line $ do
4036 located hsmodName' p_hsmodName
41− forM_ hsmodDeprecMessage (located' p_warningTxt)
37+ forM_ hsmodDeprecMessage (located' p_moduleWarning)
4238 case hsmodExports of
4339 Nothing -> return ()
4440 Just hsmodExports' -> do
@@ -53,23 +49,3 @@ p_hsModule loc@(L moduleSpan hsModule) = do
5349 trailingComments <- hasMoreComments
5450 when (trailingComments && isJust hsmodName) newline
5551 spitRemainingComments
56−
57−-- | Layout the WARNING\/DEPRECATED pragmas in the module head.
58−
59−p_warningTxt :: WarningTxt -> R ()
60−p_warningTxt = \case
61− WarningTxt _ lits -> p_pragma "WARNING" lits
62− DeprecatedTxt _ lits -> p_pragma "DEPRECATED" lits
63− where
64− p_pragma :: Text -> [Located StringLiteral] -> R ()
65− p_pragma pragmaText lits = switchLayout (litsSpan lits) $ do
66− breakpoint
67− inci $ pragma pragmaText (p_lits lits)
68−
69− litsSpan :: [Located StringLiteral] -> SrcSpan
70− litsSpan lits = combineSrcSpans' (getLoc <$> NE.fromList lits)
71−
72− p_lits :: [Located StringLiteral] -> R ()
73− p_lits = \case
74− [l] -> atom l
75− ls -> brackets . velt $ withSep comma atom ls