dde7560 · ormolu · git.iko.soy

git.iko.soy/ormolu

on master help sign in

Allow disabling of Ormolu with special comments

dde7560Mark Karpov7 years ago

CHANGELOG.md+3

compare with master

unifiedsplit

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

9* Comments on pragmas are now preserved. [Issue

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

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

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

14+

12## Ormolu 0.0.4.0

15## Ormolu 0.0.4.0

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

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

README.md+21

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

91$ ormolu --mode inplace Module.hs

92```

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+

94## Current limitations

115## Current limitations

116

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

117* 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

109 , Ormolu.Printer.Meat.Type

110 , Ormolu.Printer.Operators

111 , Ormolu.Printer.SpanStream

112+ , Ormolu.Processing.Common

113+ , Ormolu.Processing.Postprocess

114+ , Ormolu.Processing.Preprocess

112 , Ormolu.Utils

115 , Ormolu.Utils

113 other-modules: GHC

116 other-modules: GHC

114 , GHC.DynFlags

117 , GHC.DynFlags

src/Ormolu/Parser.hs+29−87

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

14import Control.Exception

15import Control.Monad

16import Control.Monad.IO.Class

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

17+import qualified Data.List as L

18import qualified Data.List.NonEmpty as NE

19−import Data.Maybe (catMaybes)

20import Data.Ord (Down (Down))

19import Data.Ord (Down (Down))

21import DynFlags as GHC

20import DynFlags as GHC

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

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

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

32import Ormolu.Parser.Anns

31import Ormolu.Parser.Anns

33import Ormolu.Parser.CommentStream

32import Ormolu.Parser.CommentStream

34import Ormolu.Parser.Result

33import Ormolu.Parser.Result

35−import Ormolu.Parser.Shebang

34+import Ormolu.Processing.Preprocess (preprocess)

36import qualified Panic as GHC

35import qualified Panic as GHC

37import qualified Parser as GHC

36import qualified Parser as GHC

38import qualified StringBuffer as GHC

37import qualified StringBuffer as GHC

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

51 Either (SrcSpan, String) ParseResult

50 Either (SrcSpan, String) ParseResult

52 )

51 )

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

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

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

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

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

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

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

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

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

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

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

78 (pluginModNames dynFlags)

77 (pluginModNames dynFlags)

79 pStateErrors = \pstate ->

78 pStateErrors = \pstate ->

80 let errs = bagToList $ GHC.getErrorMessages pstate dynFlags

79 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

82 [] -> Nothing

81 [] -> Nothing

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

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

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

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

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

110 }

109 }

111 return (warnings, r)

110 return (warnings, r)

112

111

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+

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

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

114-- by user.

121-- by user.

115manualExts :: [Extension]

122manualExts :: [Extension]

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

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

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

137 ]

144 ]

138

145

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

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

141−

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

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

143runParser ::

147runParser ::

144 -- | Computation to run

148 -- | Computation to run

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

157 buffer = GHC.stringToStringBuffer input

161 buffer = GHC.stringToStringBuffer input

158 parseState = GHC.mkPState flags buffer location

162 parseState = GHC.mkPState flags buffer location

159

163

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

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

161−-- This handles LINE pragmas and shebangs.

165+newtype SeverityOrd = SeverityOrd Severity

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

196

166

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

167+instance Eq SeverityOrd where

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

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

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)

210

169

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

170+instance Ord SeverityOrd where

212−-- default for ease of use.

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

213−setDefaultExts :: DynFlags -> DynFlags

172+ compare (f s1) (f s2)

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

173+ where

215− where

174+ f :: Severity -> Int

216− autoExts = allExts \\ manualExts

175+ f SevOutput = 1

217− allExts = [minBound .. maxBound]

176+ f SevFatal = 2

177+ f SevInteractive = 3

178+ f SevDump = 4

179+ f SevInfo = 5

180+ f SevWarning = 6

181+ f SevError = 7

218

182

219----------------------------------------------------------------------------

183----------------------------------------------------------------------------

220−-- More helpers (taken from HLint)

184+-- Helpers taken from HLint

221

185

222parsePragmasIntoDynFlags ::

186parsePragmasIntoDynFlags ::

223 -- | Pre-set 'DynFlags'

187 -- | Pre-set 'DynFlags'

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

246 reportErr

210 reportErr

247 (GHC.handleSourceError reportErr act)

211 (GHC.handleSourceError reportErr act)

248 reportErr e = return $ Left (show e)

212 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

11import Ormolu.Printer.Combinators

12import Ormolu.Printer.Meat.Module

13import Ormolu.Printer.SpanStream

14+import Ormolu.Processing.Postprocess (postprocess)

15-- | Render a module.

16-- | Render a module.

16printModule ::

17printModule ::

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

19 -- | Resulting rendition

20 -- | Resulting rendition

20 Text

21 Text

21printModule ParseResult {..} =

22printModule ParseResult {..} =

23+ postprocess $

22− runR

24+ runR

23− ( p_hsModule

25+ ( p_hsModule

24− prStackHeader

26+ prStackHeader

25− prShebangs

27+ prShebangs

26− prPragmas

28+ prPragmas

27− prImportQualifiedPost

29+ prImportQualifiedPost

28− prParsedSource

30+ prParsedSource

29− )

31+ )

30− (mkSpanStream prParsedSource)

32+ (mkSpanStream prParsedSource)

31− prCommentStream

33+ prCommentStream

32− prAnns

34+ prAnns

33− prUseRecordDot

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)