7307b6d · ormolu · git.iko.soy

git.iko.soy/ormolu

[#52] Implement WARNING/DEPRECATED in module header

commit7307b6debdd5be675cab4f103ce5537a6ff4d109 authorRupert Horlick <rupert.horlick@iohk.io> dateSat 15 Jun 2019, 11:15 (7 years ago) parentf8b9207

10 files changed+74

compare with master

unifiedsplit

data/examples/module-header/warning-pragma-list-multiline-out.hsnew file+11

@@ -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

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

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

3838 , parens

3939 , parensHash

4040 , pragmaBraces

41+ , pragma

4142 -- ** Literals

4243 , comma

4344 , space

@@ -270,6 +271,19 @@ pragmaBraces m = sitcc $ do

270271 vlayout space (newline >> txt " ")

271272 txt "#-}"

272273

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+

273287-- | Surround given entity by optional space before and a newline after, iff

274288-- current layout is multiline.

275289

src/Ormolu/Printer/Meat/Module.hs+24

@@ -1,3 +1,4 @@

1+{-# LANGUAGE LambdaCase #-}

12{-# LANGUAGE OverloadedStrings #-}

23{-# LANGUAGE PatternSynonyms #-}

34{-# LANGUAGE RecordWildCards #-}

@@ -9,8 +10,10 @@ module Ormolu.Printer.Meat.Module

910 )

1011where

1112

13+import BasicTypes hiding (InlinePragma)

1214import Control.Monad

1315import Data.Maybe (isJust)

16+import Data.Text (Text)

1417import GHC

1518import Ormolu.Imports

1619import Ormolu.Printer.Combinators

@@ -35,6 +38,7 @@ p_hsModule loc@(L moduleSpan hsModule) = do

3538 Nothing -> pure ()

3639 Just hsmodName' -> line $ do

3740 located hsmodName' p_hsmodName

41+ maybe (pure ()) (located' p_warningTxt) hsmodDeprecMessage

3842 case hsmodExports of

3943 Nothing -> return ()

4044 Just hsmodExports' -> do

@@ -59,6 +63,26 @@ p_hsModule loc@(L moduleSpan hsModule) = do

5963 when (trailingComments && isJust hsmodName) newline

6064 spitRemainingComments

6165

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+

6286-- | Determine if these declarations should be separated by a blank line.

6387

6488separatedDecls