dde7560 · ormolu · git.iko.soy

git.iko.soy/ormolu

Allow disabling of Ormolu with special comments

Ormolu can be turned on and off via the special comments: {- ORMOLU_DISABLE -} and {- ORMOLU_ENABLE -} This allows us to disable formatting selectively for code between these markers or disable it for the entire file. To achieve the latter, just put {- ORMOLU_DISABLE -} at the very top. Note that the source code should still be parseable even without the “excluded” part. Because of that the magic comments cannot be placed arbitrary, but should rather enclose independent top-level definitions.

commitdde756029115fdd98f326d698a433904598c63c5 authorMark Karpov <markkarpov92@gmail.com> dateMon 20 Apr 2020, 17:24 (7 years ago) parent2fa7078

12 files changed+281−99

compare with master

unifiedsplit

CHANGELOG.md+3 README.md+21 data/examples/other/disabling/single-definition-out.hs+10 data/examples/other/disabling/single-definition.hs+10 data/examples/other/disabling/whole-file-out.hs+10 data/examples/other/disabling/whole-file.hs+10 ormolu.cabal+3 src/Ormolu/Parser.hs+29−87 src/Ormolu/Printer.hs+14−12 src/Ormolu/Processing/Common.hs+27 src/Ormolu/Processing/Postprocess.hs+16 src/Ormolu/Processing/Preprocess.hs+128

CHANGELOG.md+3

@@ -9,6 +9,9 @@

99* Comments on pragmas are now preserved. [Issue

1010 216](https://github.com/tweag/ormolu/issues/216).

1111

12+* Ormolu can now be enabled and disabled via special comments. [Issue

13+ 435](https://github.com/tweag/ormolu/issues/435).

14+

1215## Ormolu 0.0.4.0

1316

1417* When given several files to format, Ormolu does not stop on the first

README.md+21

@@ -91,6 +91,27 @@ formatted output.

9191$ ormolu --mode inplace Module.hs

9292```

9393

94+## Magic comments

95+

96+Ormolu understands two magic comments:

97+

98+```haskell

99+{- ORMOLU_DISABLE -}

100+```

101+

102+and

103+

104+```haskell

105+{- ORMOLU_ENABLE -}

106+```

107+

108+This allows us to disable formatting selectively for code between these

109+markers or disable it for the entire file. To achieve the latter, just put

110+`{- ORMOLU_DISABLE -}` at the very top. Note that the source code should

111+still be parseable even without the “excluded” part. Because of that the

112+magic comments cannot be placed arbitrary, but should rather enclose

113+independent top-level definitions.

114+

94115## Current limitations

95116

96117* Does not handle CPP (wontfix, see [the design document][design]).

data/examples/other/disabling/single-definition-out.hsnew file+10

@@ -0,0 +1,10 @@

1+module Foo (foo, bar) where

3+{- ORMOLU_DISABLE -}

4+foo :: Int -> Int

5+foo = (+5)

6+{- ORMOLU_ENABLE -}

8+bar :: Bool -> Bool

9+bar True = True

10+bar False = True

data/examples/other/disabling/single-definition.hsnew file+10

@@ -0,0 +1,10 @@

1+module Foo (foo,bar) where

3+{- ORMOLU_DISABLE -}

4+foo :: Int -> Int

5+foo = (+5)

6+{- ORMOLU_ENABLE -}

8+bar :: Bool -> Bool

9+bar True = True

10+bar False = True

data/examples/other/disabling/whole-file-out.hsnew file+10

@@ -0,0 +1,10 @@

1+{- ORMOLU_DISABLE -}

3+module Foo (foo,bar) where

5+foo :: Int -> Int

6+foo = (+5)

8+bar :: Bool -> Bool

9+bar True = True

10+bar False = True

data/examples/other/disabling/whole-file.hsnew file+10

@@ -0,0 +1,10 @@

1+{- ORMOLU_DISABLE -}

3+module Foo (foo,bar) where

5+foo :: Int -> Int

6+foo = (+5)

8+bar :: Bool -> Bool

9+bar True = True

10+bar False = True

ormolu.cabal+3

@@ -109,6 +109,9 @@ library

109109 , Ormolu.Printer.Meat.Type

110110 , Ormolu.Printer.Operators

111111 , Ormolu.Printer.SpanStream

112+ , Ormolu.Processing.Common

113+ , Ormolu.Processing.Postprocess

114+ , Ormolu.Processing.Preprocess

112115 , Ormolu.Utils

113116 other-modules: GHC

114117 , GHC.DynFlags

src/Ormolu/Parser.hs+29−87

@@ -14,9 +14,8 @@ import qualified CmdLineParser as GHC

1414import Control.Exception

1515import Control.Monad

1616import Control.Monad.IO.Class

17−import Data.List ((\\), foldl', isPrefixOf, sortOn)

17+import qualified Data.List as L

1818import qualified Data.List.NonEmpty as NE

19−import Data.Maybe (catMaybes)

2019import Data.Ord (Down (Down))

2120import DynFlags as GHC

2221import ErrUtils (Severity (..), errMsgSeverity, errMsgSpan)

@@ -32,7 +31,7 @@ import Ormolu.Exception

3231import Ormolu.Parser.Anns

3332import Ormolu.Parser.CommentStream

3433import Ormolu.Parser.Result

35−import Ormolu.Parser.Shebang

34+import Ormolu.Processing.Preprocess (preprocess)

3635import qualified Panic as GHC

3736import qualified Parser as GHC

3837import qualified StringBuffer as GHC

@@ -51,7 +50,7 @@ parseModule ::

5150 Either (SrcSpan, String) ParseResult

5251 )

5352parseModule Config {..} path input' = liftIO $ do

54− let (input, extraComments) = extractCommentsFromLines path input'

53+ let (input, extraComments) = preprocess path input'

5554 -- It's important that 'setDefaultExts' is done before

5655 -- 'parsePragmasIntoDynFlags', because otherwise we might enable an

5756 -- extension that was explicitly disabled in the file.

@@ -78,7 +77,7 @@ parseModule Config {..} path input' = liftIO $ do

7877 (pluginModNames dynFlags)

7978 pStateErrors = \pstate ->

8079 let errs = bagToList $ GHC.getErrorMessages pstate dynFlags

81− in case sortOn (Down . SeverityOrd . errMsgSeverity) errs of

80+ in case L.sortOn (Down . SeverityOrd . errMsgSeverity) errs of

8281 [] -> Nothing

8382 err : _ -> Just (errMsgSpan err, show err) -- Show instance returns a short error message

8483 r = case runParser GHC.parseModule dynFlags path input of

@@ -110,6 +109,14 @@ parseModule Config {..} path input' = liftIO $ do

110109 }

111110 return (warnings, r)

112111

112+-- | Enable all language extensions that we think should be enabled by

113+-- default for ease of use.

114+setDefaultExts :: DynFlags -> DynFlags

115+setDefaultExts flags = L.foldl' xopt_set flags autoExts

116+ where

117+ autoExts = allExts L.\\ manualExts

118+ allExts = [minBound .. maxBound]

119+

113120-- | Extensions that are not enabled automatically and should be activated

114121-- by user.

115122manualExts :: [Extension]

@@ -136,9 +143,6 @@ manualExts =

136143 -- decision of enabling this style is left to the user

137144 ]

138145

139−----------------------------------------------------------------------------

140−-- Helpers (taken from ghc-exactprint)

141−

142146-- | Run a 'GHC.P' computation.

143147runParser ::

144148 -- | Computation to run

@@ -157,67 +161,27 @@ runParser parser flags filename input = GHC.unP parser parseState

157161 buffer = GHC.stringToStringBuffer input

158162 parseState = GHC.mkPState flags buffer location

159163

160−-- | Transform given input possibly returning comments extracted from it.

161−-- This handles LINE pragmas and shebangs.

162−extractCommentsFromLines ::

163− -- | File name, just to use in the spans

164− FilePath ->

165− -- | Contents of that file

166− String ->

167− -- | Adjusted input with comments extracted from it

168− (String, [Located String])

169−extractCommentsFromLines path =

170− unlines' . unzip . zipWith (extractCommentFromLine path) [1 ..] . lines

171− where

172− unlines' (a, b) = (unlines a, catMaybes b)

173−

174−-- | Transform a given line possibly returning a comment extracted from it.

175−extractCommentFromLine ::

176− -- | File name, just to use in the spans

177− FilePath ->

178− -- | Line number of this line

179− Int ->

180− -- | The actual line

181− String ->

182− -- | Adjusted line and possibly a comment extracted from it

183− (String, Maybe (Located String))

184−extractCommentFromLine path line s

185− | "{-# LINE" `isPrefixOf` s =

186− let (pragma, res) = getPragma s

187− size = length pragma

188− ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1))

189− in (res, Just $ L ss pragma)

190− | isShebang s =

191− let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length s))

192− in ("", Just $ L ss s)

193− | otherwise = (s, Nothing)

194− where

195− mkSrcLoc' = mkSrcLoc (GHC.mkFastString path) line

164+-- | Wrap GHC's 'Severity' to add 'Ord' instance.

165+newtype SeverityOrd = SeverityOrd Severity

196166

197−-- | Take a line pragma and output its replacement (where line pragma is

198−-- replaced with spaces) and the contents of the pragma itself.

199−getPragma ::

200− -- | Pragma line to analyze

201− String ->

202− -- | Contents of the pragma and its replacement line

203− (String, String)

204−getPragma [] = error "Ormolu.Parser.getPragma: input must not be empty"

205−getPragma s@(x : xs)

206− | "#-}" `isPrefixOf` s = ("#-}", " " ++ drop 3 s)

207− | otherwise =

208− let (prag, remline) = getPragma xs

209− in (x : prag, ' ' : remline)

167+instance Eq SeverityOrd where

168+ s1 == s2 = compare s1 s2 == EQ

210169

211−-- | Enable all language extensions that we think should be enabled by

212−-- default for ease of use.

213−setDefaultExts :: DynFlags -> DynFlags

214−setDefaultExts flags = foldl' GHC.xopt_set flags autoExts

215− where

216− autoExts = allExts \\ manualExts

217− allExts = [minBound .. maxBound]

170+instance Ord SeverityOrd where

171+ compare (SeverityOrd s1) (SeverityOrd s2) =

172+ compare (f s1) (f s2)

173+ where

174+ f :: Severity -> Int

175+ f SevOutput = 1

176+ f SevFatal = 2

177+ f SevInteractive = 3

178+ f SevDump = 4

179+ f SevInfo = 5

180+ f SevWarning = 6

181+ f SevError = 7

218182

219183----------------------------------------------------------------------------

220−-- More helpers (taken from HLint)

184+-- Helpers taken from HLint

221185

222186parsePragmasIntoDynFlags ::

223187 -- | Pre-set 'DynFlags'

@@ -246,25 +210,3 @@ parsePragmasIntoDynFlags flags extraOpts filepath str =

246210 reportErr

247211 (GHC.handleSourceError reportErr act)

248212 reportErr e = return $ Left (show e)

249−

250−----------------------------------------------------------------------------

251−-- Even more helpers

252−

253−-- Wrap GHC's ErrUtils.Severity to add Ord instance

254−newtype SeverityOrd = SeverityOrd Severity

255−

256−instance Eq SeverityOrd where

257− s1 == s2 = compare s1 s2 == EQ

258−

259−instance Ord SeverityOrd where

260− compare (SeverityOrd s1) (SeverityOrd s2) =

261− compare (f s1) (f s2)

262− where

263− f :: Severity -> Int

264− f SevOutput = 1

265− f SevFatal = 2

266− f SevInteractive = 3

267− f SevDump = 4

268− f SevInfo = 5

269− f SevWarning = 6

270− f SevError = 7

src/Ormolu/Printer.hs+14−12

@@ -11,6 +11,7 @@ import Ormolu.Parser.Result

1111import Ormolu.Printer.Combinators

1212import Ormolu.Printer.Meat.Module

1313import Ormolu.Printer.SpanStream

14+import Ormolu.Processing.Postprocess (postprocess)

1415

1516-- | Render a module.

1617printModule ::

@@ -19,15 +20,16 @@ printModule ::

1920 -- | Resulting rendition

2021 Text

2122printModule ParseResult {..} =

22− runR

23− ( p_hsModule

24− prStackHeader

25− prShebangs

26− prPragmas

27− prImportQualifiedPost

28− prParsedSource

29− )

30− (mkSpanStream prParsedSource)

31− prCommentStream

32− prAnns

33− prUseRecordDot

23+ postprocess $

24+ runR

25+ ( p_hsModule

26+ prStackHeader

27+ prShebangs

28+ prPragmas

29+ prImportQualifiedPost

30+ prParsedSource

31+ )

32+ (mkSpanStream prParsedSource)

33+ prCommentStream

34+ prAnns

35+ prUseRecordDot

src/Ormolu/Processing/Common.hsnew file+27

@@ -0,0 +1,27 @@

1+{-# LANGUAGE OverloadedStrings #-}

3+-- | Common definitions for pre- and post- processing.

4+module Ormolu.Processing.Common

5+ ( OrmoluState (..),

6+ startDisabling,

7+ endDisabling,

8+ )

9+where

10+

11+import Data.String (IsString (..))

12+

13+-- | Ormolu state.

14+data OrmoluState

15+ = -- | Enabled

16+ OrmoluEnabled

17+ | -- | Disabled

18+ OrmoluDisabled

19+ deriving (Eq, Show)

20+

21+-- | Marker for the beginning of the region where Ormolu should be disabled.

22+startDisabling :: IsString s => s

23+startDisabling = "{- ORMOLU_DISABLING_START"

24+

25+-- | Marker for the end of the region where Ormolu should be disabled.

26+endDisabling :: IsString s => s

27+endDisabling = "ORMOLU_DISABLE_END -}"

src/Ormolu/Processing/Postprocess.hsnew file+16

@@ -0,0 +1,16 @@

1+-- | Postprocessing for the results of printing.

2+module Ormolu.Processing.Postprocess

3+ ( postprocess,

4+ )

5+where

7+import Data.Text (Text)

8+import qualified Data.Text as T

9+import Ormolu.Processing.Common

10+

11+-- | Postprocess output of the formatter.

12+postprocess :: Text -> Text

13+postprocess = T.unlines . filter (not . magicComment) . T.lines

14+ where

15+ magicComment x =

16+ x == startDisabling || x == endDisabling

src/Ormolu/Processing/Preprocess.hsnew file+128

@@ -0,0 +1,128 @@

1+{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE LambdaCase #-}

4+-- | Preprocessing for input source code.

5+module Ormolu.Processing.Preprocess

6+ ( preprocess,

7+ )

8+where

10+import Control.Monad

11+import Data.Char (isSpace)

12+import qualified Data.List as L

13+import Data.Maybe (isJust)

14+import Data.Maybe (maybeToList)

15+import FastString

16+import Ormolu.Parser.Shebang (isShebang)

17+import Ormolu.Processing.Common

18+import SrcLoc

19+

20+-- | Transform given input possibly returning comments extracted from it.

21+-- This handles LINE pragmas, shebangs, and the magic comments for

22+-- enabling\/disabling of Ormolu.

23+preprocess ::

24+ -- | File name, just to use in the spans

25+ FilePath ->

26+ -- | Input to process

27+ String ->

28+ -- | Adjusted input with comments extracted from it

29+ (String, [Located String])

30+preprocess path input = go 1 OrmoluEnabled id id (lines input)

31+ where

32+ go !n ormoluState inputSoFar csSoFar = \case

33+ [] ->

34+ let input' = unlines (inputSoFar [])

35+ in ( case ormoluState of

36+ OrmoluEnabled -> input'

37+ OrmoluDisabled -> input' ++ endDisabling,

38+ csSoFar []

39+ )

40+ (x : xs) ->

41+ let (x', ormoluState', cs) = processLine path n ormoluState x

42+ in go

43+ (n + 1)

44+ ormoluState'

45+ (inputSoFar . (x' :))

46+ (csSoFar . (maybeToList cs ++))

47+ xs

48+

49+-- | Transform a given line possibly returning a comment extracted from it.

50+processLine ::

51+ -- | File name, just to use in the spans

52+ FilePath ->

53+ -- | Line number of this line

54+ Int ->

55+ -- | Whether Ormolu is currently enabled

56+ OrmoluState ->

57+ -- | The actual line

58+ String ->

59+ -- | Adjusted line and possibly a comment extracted from it

60+ (String, OrmoluState, Maybe (Located String))

61+processLine path n ormoluState line

62+ | "{-# LINE" `L.isPrefixOf` line =

63+ let (pragma, res) = getPragma line

64+ size = length pragma

65+ ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1))

66+ in (res, ormoluState, Just (L ss pragma))

67+ | isOrmoluEnable line =

68+ case ormoluState of

69+ OrmoluEnabled ->

70+ (enableMarker, OrmoluEnabled, Nothing)

71+ OrmoluDisabled ->

72+ (endDisabling ++ enableMarker, OrmoluEnabled, Nothing)

73+ | isOrmoluDisable line =

74+ case ormoluState of

75+ OrmoluEnabled ->

76+ (disableMarker ++ startDisabling, OrmoluDisabled, Nothing)

77+ OrmoluDisabled ->

78+ (disableMarker, OrmoluDisabled, Nothing)

79+ | isShebang line =

80+ let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length line))

81+ in ("", ormoluState, Just (L ss line))

82+ | otherwise = (line, ormoluState, Nothing)

83+ where

84+ mkSrcLoc' = mkSrcLoc (mkFastString path) n

85+

86+-- | Take a line pragma and output its replacement (where line pragma is

87+-- replaced with spaces) and the contents of the pragma itself.

88+getPragma ::

89+ -- | Pragma line to analyze

90+ String ->

91+ -- | Contents of the pragma and its replacement line

92+ (String, String)

93+getPragma [] = error "Ormolu.Preprocess.getPragma: input must not be empty"

94+getPragma s@(x : xs)

95+ | "#-}" `L.isPrefixOf` s = ("#-}", " " ++ drop 3 s)

96+ | otherwise =

97+ let (prag, remline) = getPragma xs

98+ in (x : prag, ' ' : remline)

99+

100+-- | Canonical enable marker.

101+enableMarker :: String

102+enableMarker = "{- ORMOLU_ENABLE -}"

103+

104+-- | Canonical disable marker.

105+disableMarker :: String

106+disableMarker = "{- ORMOLU_DISABLE -}"

107+

108+-- | Return 'True' if the given string is an enabling marker.

109+isOrmoluEnable :: String -> Bool

110+isOrmoluEnable = magicComment "ORMOLU_ENABLE"

111+

112+-- | Return 'True' if the given string is a disabling marker.

113+isOrmoluDisable :: String -> Bool

114+isOrmoluDisable = magicComment "ORMOLU_DISABLE"

115+

116+-- | Construct a function for whitespace-insensitive matching of string.

117+magicComment ::

118+ -- | What to expect

119+ String ->

120+ -- | String to test

121+ String ->

122+ -- | Whether or not the two strings watch

123+ Bool

124+magicComment expected s0 = isJust $ do

125+ s1 <- dropWhile isSpace <$> L.stripPrefix "{-" s0

126+ s2 <- dropWhile isSpace <$> L.stripPrefix expected s1

127+ s3 <- L.stripPrefix "-}" s2

128+ guard (all isSpace s3)