git.iko.soy/ormolu
on master help sign in
[#52] Implement WARNING/DEPRECATED in module header
7307b6dRupert Horlick
data/examples/module-header/warning-pragma-list-multiline-out.hsnew file+11
compare with master
unifiedsplit
@@ -0,0 +1,11 @@
1+module Test
2+ {-# DEPRECATED
3+ [ "This module is deprecated."
4+ , "Please use OtherModule instead."
5+ ]
6+ #-}
7+ ( foo
8+ , bar
9+ , baz
10+ )
11+where
data/examples/module-header/warning-pragma-list-multiline.hsnew file+8
@@ -0,0 +1,8 @@
1+module Test {-# DEPRECATED ["This module is deprecated.",
2+ "Please use OtherModule instead."
3+ ]#-}
4+ ( foo
5+ , bar
6+ , baz
7+ )
8+where
data/examples/module-header/warning-pragma-multiline-out.hsnew file+8
@@ -0,0 +1,8 @@
1+module Test {-# DEPRECATED "This module is unstable" #-}
2+ ( foo
3+ , bar
4+ , baz
5+ )
6+where
7+
8+import Blah
data/examples/module-header/warning-pragma-multiline.hsnew file+4
@@ -0,0 +1,4 @@
1+module Test {-# DEPRECATED "This module is unstable" #-}
2+ (foo, bar, baz) where
3+
4+import Blah
data/examples/module-header/warning-pragma-out.hsnew file+1
@@ -0,0 +1 @@
1+module Test {-# WARNING "This module is very internal" #-} where
data/examples/module-header/warning-pragma-singleton-list-out.hsnew file+1
@@ -0,0 +1 @@
1+module Test {-# WARNING "There's only one line here." #-} where
data/examples/module-header/warning-pragma-singleton-list.hsnew file+1
@@ -0,0 +1 @@
1+module Test {-# WArnING ["There's only one line here."] #-} where
data/examples/module-header/warning-pragma.hsnew file+2
@@ -0,0 +1,2 @@
1+module Test {-# WARNING "This module is very internal"
2+ #-} where
src/Ormolu/Printer/Combinators.hs+14
@@ -38,6 +38,7 @@ module Ormolu.Printer.Combinators
38 , parens
38 , parens
39 , parensHash
39 , parensHash
40 , pragmaBraces
40 , pragmaBraces
41+ , pragma
41 -- ** Literals
42 -- ** Literals
42 , comma
43 , comma
43 , space
44 , space
@@ -270,6 +271,19 @@ pragmaBraces m = sitcc $ do
270 vlayout space (newline >> txt " ")
271 vlayout space (newline >> txt " ")
271 txt "#-}"
272 txt "#-}"
272
273
274+-- | This surrounds the body in a pragma, which includes the 'pragmaBraces' and
275+--- the keyword for the pragma. It also takes a 'SrcSpan', which should be the
276+--- combined span of the body. This means multiline layouts are only triggered
277+--- when the body spans multiple lines, not just when the braces or pragma
278+--- keyword do.
279+
280+pragma :: SrcSpan -> Text -> R () -> R ()
281+pragma srcSpan pragmaText body = switchLayout srcSpan . pragmaBraces $ do
282+ txt pragmaText
283+ breakpoint
284+ inci body
285+
286+
273-- | Surround given entity by optional space before and a newline after, iff
287-- | Surround given entity by optional space before and a newline after, iff
274-- current layout is multiline.
288-- current layout is multiline.
275
289
src/Ormolu/Printer/Meat/Module.hs+24
@@ -1,3 +1,4 @@
1+{-# LANGUAGE LambdaCase #-}
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE PatternSynonyms #-}
3{-# LANGUAGE PatternSynonyms #-}
3{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE RecordWildCards #-}
@@ -9,8 +10,10 @@ module Ormolu.Printer.Meat.Module
9 )
10 )
10where
11where
11
12
13+import BasicTypes hiding (InlinePragma)
12import Control.Monad
14import Control.Monad
13import Data.Maybe (isJust)
15import Data.Maybe (isJust)
16+import Data.Text (Text)
14import GHC
17import GHC
15import Ormolu.Imports
18import Ormolu.Imports
16import Ormolu.Printer.Combinators
19import Ormolu.Printer.Combinators
@@ -35,6 +38,7 @@ p_hsModule loc@(L moduleSpan hsModule) = do
35 Nothing -> pure ()
38 Nothing -> pure ()
36 Just hsmodName' -> line $ do
39 Just hsmodName' -> line $ do
37 located hsmodName' p_hsmodName
40 located hsmodName' p_hsmodName
41+ maybe (pure ()) (located' p_warningTxt) hsmodDeprecMessage
38 case hsmodExports of
42 case hsmodExports of
39 Nothing -> return ()
43 Nothing -> return ()
40 Just hsmodExports' -> do
44 Just hsmodExports' -> do
@@ -59,6 +63,26 @@ p_hsModule loc@(L moduleSpan hsModule) = do
59 when (trailingComments && isJust hsmodName) newline
63 when (trailingComments && isJust hsmodName) newline
60 spitRemainingComments
64 spitRemainingComments
61
65
66+-- | Layout the WARNING/DEPRECATED pragmas in the module head
67+
68+p_warningTxt :: WarningTxt -> R ()
69+p_warningTxt = \case
70+ WarningTxt _ lits -> p_pragma "WARNING" lits
71+ DeprecatedTxt _ lits -> p_pragma "DEPRECATED" lits
72+ where
73+ p_pragma :: Text -> [Located StringLiteral] -> R ()
74+ p_pragma pragmaText lits = switchLayout (litsSpan lits) $ do
75+ breakpoint
76+ inci $ pragma (litsSpan lits) pragmaText (p_lits lits)
77+
78+ litsSpan :: [Located StringLiteral] -> SrcSpan
79+ litsSpan lits = combineSrcSpans (getLoc $ head lits) (getLoc $ last lits)
80+
81+ p_lits :: [Located StringLiteral] -> R ()
82+ p_lits = \case
83+ [l] -> atom l
84+ ls -> brackets . velt $ withSep comma atom ls
85+
62-- | Determine if these declarations should be separated by a blank line.
86-- | Determine if these declarations should be separated by a blank line.
63
87
64separatedDecls
88separatedDecls