840acd9 · ormolu · git.iko.soy

git.iko.soy/ormolu

Allow selection of a region to format

commit840acd908bb69f440a453e96e669dadec9c5ddea authorMark Karpov <markkarpov92@gmail.com> dateThu 23 Apr 2020, 18:41 (7 years ago) parent3905976

15 files changed+251−41

compare with master

unifiedsplit

CHANGELOG.md+4 app/Main.hs+13−3 default.nix+45 region-tests/expected-result-5-6.hs+11 region-tests/expected-result-5-7.hs+10 region-tests/expected-result-8-12.hs+11 region-tests/expected-result-all.hs+14 region-tests/src.hs+11 src/Ormolu.hs+8−5 src/Ormolu/Config.hs+52−6 src/Ormolu/Parser.hs+15−7 src/Ormolu/Parser/Result.hs+6−1 src/Ormolu/Printer.hs+16−13 src/Ormolu/Processing/Preprocess.hs+15−4 src/Ormolu/Utils.hs+20−2

CHANGELOG.md+4

@@ -15,6 +15,10 @@

1515* Added experimental support for simple CPP. [Issue

1616 415](https://github.com/tweag/ormolu/issues/415).

1717

18+* Added two new options `--start-line` and `--end-line` that allow us to

19+ select a region to format. [Issue

20+ 516](https://github.com/tweag/ormolu/issues/516).

21+

1822## Ormolu 0.0.4.0

1923

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

app/Main.hs+13−3

@@ -47,7 +47,7 @@ formatOne ::

4747 -- | Mode of operation

4848 Mode ->

4949 -- | Configuration

50− Config ->

50+ Config RegionIndices ->

5151 -- | File to format or stdin as 'Nothing'

5252 Maybe FilePath ->

5353 IO ()

@@ -84,7 +84,7 @@ data Opts = Opts

8484 { -- | Mode of operation

8585 optMode :: !Mode,

8686 -- | Ormolu 'Config'

87− optConfig :: !Config,

87+ optConfig :: !(Config RegionIndices),

8888 -- | Haskell source files to format or stdin (when the list is empty)

8989 optInputFiles :: ![FilePath]

9090 }

@@ -150,7 +150,7 @@ optsParser =

150150 help "Haskell source files to format or stdin (default)"

151151 ]

152152

153−configParser :: Parser Config

153+configParser :: Parser (Config RegionIndices)

154154configParser =

155155 Config

156156 <$> (fmap (fmap DynOption) . many . strOption . mconcat)

@@ -174,6 +174,16 @@ configParser =

174174 short 'c',

175175 help "Fail if formatting is not idempotent"

176176 ]

177+ <*> ( RegionIndices

178+ <$> (optional . option auto . mconcat)

179+ [ long "start-line",

180+ help "Start line of the region to format (lines start from 1)"

181+ ]

182+ <*> (optional . option auto . mconcat)

183+ [ long "end-line",

184+ help "End line of the region to format (inclusive)"

185+ ]

186+ )

177187

178188----------------------------------------------------------------------------

179189-- Helpers

default.nix+45

@@ -122,4 +122,49 @@ in {

122122 ];

123123 in listToAttrs (map (p: nameValuePair p (ormolizedPackages true).${p}) ps)

124124 );

125+ regionTests = pkgs.stdenv.mkDerivation {

126+ name = "ormolu-region-tests";

127+ src = ./region-tests;

128+ buildInputs = [

129+ haskellPackages.ormolu

130+ pkgs.diffutils

131+ ];

132+ doCheck = true;

133+ buildPhase = ''

134+ cp src.hs result-all-implicit.hs

135+ ormolu --check-idempotency --mode inplace result-all-implicit.hs

136+ cp src.hs result-all-explicit.hs

137+ ormolu --check-idempotency --mode inplace --start-line 1 --end-line 12 result-all-explicit.hs

138+ cp src.hs result-only-start.hs

139+ ormolu --check-idempotency --mode inplace --start-line 1 result-only-start.hs

140+ cp src.hs result-only-end.hs

141+ ormolu --check-idempotency --mode inplace --end-line 12 result-only-end.hs

142+ cp src.hs result-5-6.hs

143+ ormolu --check-idempotency --mode inplace --start-line 5 --end-line 6 result-5-6.hs

144+ cp src.hs result-5-7.hs

145+ ormolu --check-idempotency --mode inplace --start-line 5 --end-line 7 result-5-7.hs

146+ cp src.hs result-8-12.hs

147+ ormolu --check-idempotency --mode inplace --start-line 8 --end-line 12 result-8-12.hs

148+ '';

149+ checkPhase = ''

150+ echo result-all-implicit.hs

151+ diff --color=always expected-result-all.hs result-all-implicit.hs

152+ echo result-all-explicit.hs

153+ diff --color=always expected-result-all.hs result-all-explicit.hs

154+ echo result-only-start.hs

155+ diff --color=always expected-result-all.hs result-only-start.hs

156+ echo result-only-end.hs

157+ diff --color=always expected-result-all.hs result-only-end.hs

158+ echo result-5-6.hs

159+ diff --color=always expected-result-5-6.hs result-5-6.hs

160+ echo result-5-7.hs

161+ diff --color=always expected-result-5-7.hs result-5-7.hs

162+ echo result-8-12.hs

163+ diff --color=always expected-result-8-12.hs result-8-12.hs

164+ '';

165+ installPhase = ''

166+ mkdir "$out"

167+ find . -name '*.hs' -exec cp --parents {} $out \;

168+ '';

169+ };

125170}

region-tests/expected-result-5-6.hsnew file+11

@@ -0,0 +1,11 @@

1+{-# LANGUAGE LambdaCase #-}

3+module Main (main) where

5+foo :: Int

6+foo = 5

8+bar :: Int -> Int

9+bar = \case

10+ 0 -> foo

11+ x -> x - foo

region-tests/expected-result-5-7.hsnew file+10

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

1+{-# LANGUAGE LambdaCase #-}

3+module Main (main) where

5+foo :: Int

6+foo = 5

7+bar :: Int -> Int

8+bar = \case

9+ 0 -> foo

10+ x -> x - foo

region-tests/expected-result-8-12.hsnew file+11

@@ -0,0 +1,11 @@

1+{-# LANGUAGE LambdaCase #-}

3+module Main (main) where

5+foo :: Int

6+foo = 5

8+bar :: Int -> Int

9+bar = \case

10+ 0 -> foo

11+ x -> x - foo

region-tests/expected-result-all.hsnew file+14

@@ -0,0 +1,14 @@

1+{-# LANGUAGE LambdaCase #-}

3+module Main

4+ ( main,

5+ )

6+where

8+foo :: Int

9+foo = 5

10+

11+bar :: Int -> Int

12+bar = \case

13+ 0 -> foo

14+ x -> x - foo

region-tests/src.hsnew file+11

@@ -0,0 +1,11 @@

1+{-# LANGUAGE LambdaCase #-}

3+module Main (main) where

5+foo :: Int

6+foo = 5

8+bar :: Int -> Int

9+bar = \case

10+ 0 -> foo

11+ x -> x - foo

src/Ormolu.hs+8−5

@@ -6,6 +6,7 @@ module Ormolu

66 ormoluFile,

77 ormoluStdin,

88 Config (..),

9+ RegionIndices (..),

910 defaultConfig,

1011 DynOption (..),

1112 OrmoluException (..),

@@ -42,13 +43,15 @@ import qualified SrcLoc as GHC

4243ormolu ::

4344 MonadIO m =>

4445 -- | Ormolu configuration

45− Config ->

46+ Config RegionIndices ->

4647 -- | Location of source file

4748 FilePath ->

4849 -- | Input to format

4950 String ->

5051 m Text

51−ormolu cfg path str = do

52+ormolu cfgWithIndices path str = do

53+ let totalLines = length (lines str)

54+ cfg = regionIndicesToDeltas totalLines <$> cfgWithIndices

5255 (warnings, result0) <-

5356 parseModule' cfg OrmoluParsingFailed path str

5457 when (cfgDebug cfg) $ do

@@ -93,7 +96,7 @@ ormolu cfg path str = do

9396ormoluFile ::

9497 MonadIO m =>

9598 -- | Ormolu configuration

96− Config ->

99+ Config RegionIndices ->

97100 -- | Location of source file

98101 FilePath ->

99102 -- | Resulting rendition

@@ -108,7 +111,7 @@ ormoluFile cfg path =

108111ormoluStdin ::

109112 MonadIO m =>

110113 -- | Ormolu configuration

111− Config ->

114+ Config RegionIndices ->

112115 -- | Resulting rendition

113116 m Text

114117ormoluStdin cfg =

@@ -121,7 +124,7 @@ ormoluStdin cfg =

121124parseModule' ::

122125 MonadIO m =>

123126 -- | Ormolu configuration

124− Config ->

127+ Config RegionDeltas ->

125128 -- | How to obtain 'OrmoluException' to throw when parsing fails

126129 (GHC.SrcSpan -> String -> OrmoluException) ->

127130 -- | File name to use in errors

src/Ormolu/Config.hs+52−6

@@ -1,7 +1,13 @@

1+{-# LANGUAGE DeriveFunctor #-}

2+{-# LANGUAGE RecordWildCards #-}

14-- | Configuration options used by the tool.

25module Ormolu.Config

36 ( Config (..),

7+ RegionIndices (..),

8+ RegionDeltas (..),

49 defaultConfig,

10+ regionIndicesToDeltas,

511 DynOption (..),

612 dynOptionToLocatedStr,

713 )

@@ -10,26 +16,66 @@ where

1016import qualified SrcLoc as GHC

1117

1218-- | Ormolu configuration.

13−data Config = Config

19+data Config region = Config

1420 { -- | Dynamic options to pass to GHC parser

1521 cfgDynOptions :: ![DynOption],

1622 -- | Do formatting faster but without automatic detection of defects

1723 cfgUnsafe :: !Bool,

1824 -- | Output information useful for debugging

1925 cfgDebug :: !Bool,

20− -- | Checks if re-formatting the result is idempotent.

21− cfgCheckIdempotency :: !Bool

26+ -- | Checks if re-formatting the result is idempotent

27+ cfgCheckIdempotency :: !Bool,

28+ -- | Region selection

29+ cfgRegion :: !region

30+ }

31+ deriving (Eq, Show, Functor)

32+

33+-- | Region selection as the combination of start and end line numbers.

34+data RegionIndices = RegionIndices

35+ { -- | Start line of the region to format

36+ regionStartLine :: !(Maybe Int),

37+ -- | End line of the region to format

38+ regionEndLine :: !(Maybe Int)

39+ }

40+ deriving (Eq, Show)

41+

42+-- | Region selection as the length of the literal prefix and the literal

43+-- suffix.

44+data RegionDeltas = RegionDeltas

45+ { -- | Prefix length in number of lines

46+ regionPrefixLength :: !Int,

47+ -- | Suffix length in number of lines

48+ regionSuffixLength :: !Int

2249 }

2350 deriving (Eq, Show)

2451

25−-- | Default 'Config'.

26−defaultConfig :: Config

52+-- | Default @'Config' 'RegionIndices'@.

53+defaultConfig :: Config RegionIndices

2754defaultConfig =

2855 Config

2956 { cfgDynOptions = [],

3057 cfgUnsafe = False,

3158 cfgDebug = False,

32− cfgCheckIdempotency = False

59+ cfgCheckIdempotency = False,

60+ cfgRegion =

61+ RegionIndices

62+ { regionStartLine = Nothing,

63+ regionEndLine = Nothing

64+ }

65+ }

66+

67+-- | Convert 'RegionIndices' into 'RegionDeltas'.

68+regionIndicesToDeltas ::

69+ -- | Total number of lines in the input

70+ Int ->

71+ -- | Region indices

72+ RegionIndices ->

73+ -- | Region deltas

74+ RegionDeltas

75+regionIndicesToDeltas total RegionIndices {..} =

76+ RegionDeltas

77+ { regionPrefixLength = maybe 0 (subtract 1) regionStartLine,

78+ regionSuffixLength = maybe 0 (total -) regionEndLine

3379 }

3480

3581-- | A wrapper for dynamic options.

src/Ormolu/Parser.hs+15−7

@@ -16,6 +16,7 @@ import Control.Monad.IO.Class

1616import qualified Data.List as L

1717import qualified Data.List.NonEmpty as NE

1818import Data.Ord (Down (Down))

19+import qualified Data.Text as T

1920import DynFlags as GHC

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

2122import qualified FastString as GHC

@@ -31,6 +32,7 @@ import Ormolu.Parser.Anns

3132import Ormolu.Parser.CommentStream

3233import Ormolu.Parser.Result

3334import Ormolu.Processing.Preprocess (preprocess)

35+import Ormolu.Utils (incSpanLine)

3436import qualified Panic as GHC

3537import qualified Parser as GHC

3638import qualified StringBuffer as GHC

@@ -39,7 +41,7 @@ import qualified StringBuffer as GHC

3941parseModule ::

4042 MonadIO m =>

4143 -- | Ormolu configuration

42− Config ->

44+ Config RegionDeltas ->

4345 -- | File name (only for source location annotations)

4446 FilePath ->

4547 -- | Input for parser

@@ -48,8 +50,9 @@ parseModule ::

4850 ( [GHC.Warn],

4951 Either (SrcSpan, String) ParseResult

5052 )

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

52− let (input, extraComments) = preprocess path input'

53+parseModule Config {..} path rawInput = liftIO $ do

54+ let (literalPrefix, input, literalSuffix, extraComments) =

55+ preprocess path rawInput cfgRegion

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

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

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

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

5962 (setDefaultExts baseDynFlags)

6063 extraOpts = dynOptionToLocatedStr <$> cfgDynOptions

6164 (warnings, dynFlags) <-

62− parsePragmasIntoDynFlags baseFlags extraOpts path input' >>= \case

65+ parsePragmasIntoDynFlags baseFlags extraOpts path rawInput >>= \case

6366 Right res -> pure res

6467 Left err ->

6568 let loc =

@@ -74,14 +77,17 @@ parseModule Config {..} path input' = liftIO $ do

7477 (pluginModNames dynFlags)

7578 pStateErrors = \pstate ->

7679 let errs = bagToList $ GHC.getErrorMessages pstate dynFlags

80+ fixupErrSpan = incSpanLine (regionPrefixLength cfgRegion)

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

7882 [] -> Nothing

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

83+ err : _ ->

84+ -- Show instance returns a short error message

85+ Just (fixupErrSpan (errMsgSpan err), show err)

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

8187 GHC.PFailed pstate ->

8288 case pStateErrors pstate of

8389 Just err -> Left err

84− Nothing -> error "invariant violation: PFailed does not have an error"

90+ Nothing -> error "PFailed does not have an error"

8591 GHC.POk pstate pmod ->

8692 case pStateErrors pstate of

8793 -- Some parse errors (pattern/arrow syntax in expr context)

@@ -102,7 +108,9 @@ parseModule Config {..} path input' = liftIO $ do

102108 prCommentStream = comments,

103109 prUseRecordDot = useRecordDot,

104110 prImportQualifiedPost =

105− GHC.xopt ImportQualifiedPost dynFlags

111+ GHC.xopt ImportQualifiedPost dynFlags,

112+ prLiteralPrefix = T.pack literalPrefix,

113+ prLiteralSuffix = T.pack literalSuffix

106114 }

107115 return (warnings, r)

108116

src/Ormolu/Parser/Result.hs+6−1

@@ -7,6 +7,7 @@ module Ormolu.Parser.Result

77 )

88where

10+import Data.Text (Text)

1011import GHC

1112import Ormolu.Parser.Anns

1213import Ormolu.Parser.CommentStream

@@ -30,7 +31,11 @@ data ParseResult = ParseResult

3031 -- | Whether or not record dot syntax is enabled

3132 prUseRecordDot :: Bool,

3233 -- | Whether or not ImportQualifiedPost is enabled

33− prImportQualifiedPost :: Bool

34+ prImportQualifiedPost :: Bool,

35+ -- | Literal prefix

36+ prLiteralPrefix :: Text,

37+ -- | Literal suffix

38+ prLiteralSuffix :: Text

3439 }

3540

3641-- | Pretty-print a 'ParseResult'.

src/Ormolu/Printer.hs+16−13

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

2020 -- | Resulting rendition

2121 Text

2222printModule ParseResult {..} =

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

23+ prLiteralPrefix <> region <> prLiteralSuffix

24+ where

25+ region =

26+ postprocess $

27+ runR

28+ ( p_hsModule

29+ prStackHeader

30+ prShebangs

31+ prPragmas

32+ prImportQualifiedPost

33+ prParsedSource

34+ )

35+ (mkSpanStream prParsedSource)

36+ prCommentStream

37+ prAnns

38+ prUseRecordDot

src/Ormolu/Processing/Preprocess.hs+15−4

@@ -1,5 +1,6 @@

11{-# LANGUAGE BangPatterns #-}

22{-# LANGUAGE LambdaCase #-}

3+{-# LANGUAGE RecordWildCards #-}

45-- | Preprocessing for input source code.

56module Ormolu.Processing.Preprocess

@@ -13,6 +14,7 @@ import qualified Data.List as L

1314import Data.Maybe (isJust)

1415import Data.Maybe (maybeToList)

1516import FastString

17+import Ormolu.Config (RegionDeltas (..))

1618import Ormolu.Parser.Shebang (isShebang)

1719import Ormolu.Processing.Common

1820import qualified Ormolu.Processing.Cpp as Cpp

@@ -26,16 +28,25 @@ preprocess ::

2628 FilePath ->

2729 -- | Input to process

2830 String ->

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

30− (String, [Located String])

31−preprocess path input = go 1 OrmoluEnabled Cpp.Outside id id (lines input)

31+ -- | Region deltas

32+ RegionDeltas ->

33+ -- | Literal prefix, pre-processed input, literal suffix, extra comments

34+ (String, String, String, [Located String])

35+preprocess path input RegionDeltas {..} =

36+ go 1 OrmoluEnabled Cpp.Outside id id regionLines

3237 where

38+ (prefixLines, otherLines) = splitAt regionPrefixLength (lines input)

39+ (regionLines, suffixLines) =

40+ let regionLength = length otherLines - regionSuffixLength

41+ in splitAt regionLength otherLines

3342 go !n ormoluState cppState inputSoFar csSoFar = \case

3443 [] ->

3544 let input' = unlines (inputSoFar [])

36− in ( case ormoluState of

45+ in ( unlines prefixLines,

46+ case ormoluState of

3747 OrmoluEnabled -> input'

3848 OrmoluDisabled -> input' ++ endDisabling,

49+ unlines suffixLines,

3950 csSoFar []

4051 )

4152 (x : xs) ->

src/Ormolu/Utils.hs+20−2

@@ -12,6 +12,7 @@ module Ormolu.Utils

1212 splitDocString,

1313 typeArgToType,

1414 unSrcSpan,

15+ incSpanLine,

1516 separatedByBlank,

1617 separatedByBlankNE,

1718 )

@@ -100,15 +101,32 @@ splitDocString docStr =

100101 then dropSpace <$> xs

101102 else xs

102103

104+-- | Get 'LHsType' out of 'LHsTypeArg'.

103105typeArgToType :: LHsTypeArg p -> LHsType p

104106typeArgToType = \case

105107 HsValArg tm -> tm

106108 HsTypeArg _ ty -> ty

107109 HsArgPar _ -> notImplemented "HsArgPar"

108110

111+-- | Get 'RealSrcSpan' out of 'SrcSpan' if the span is “helpful”.

109112unSrcSpan :: SrcSpan -> Maybe RealSrcSpan

110−unSrcSpan (RealSrcSpan r) = Just r

111−unSrcSpan (UnhelpfulSpan _) = Nothing

113+unSrcSpan = \case

114+ RealSrcSpan r -> Just r

115+ UnhelpfulSpan _ -> Nothing

116+

117+-- | Increment line number in a 'SrcSpan'.

118+incSpanLine :: Int -> SrcSpan -> SrcSpan

119+incSpanLine i = \case

120+ RealSrcSpan s ->

121+ let start = realSrcSpanStart s

122+ end = realSrcSpanEnd s

123+ incLine x =

124+ let file = srcLocFile x

125+ line = srcLocLine x

126+ col = srcLocCol x

127+ in mkRealSrcLoc file (line + i) col

128+ in RealSrcSpan (mkRealSrcSpan (incLine start) (incLine end))

129+ UnhelpfulSpan x -> UnhelpfulSpan x

112130

113131-- | Do two declarations have a blank between them?

114132separatedByBlank :: (a -> SrcSpan) -> a -> a -> Bool