da0b3b8 · ormolu · git.iko.soy

app/Main.hs+5

compare with master

unifiedsplit

@@ -137,6 +137,11 @@ configParser = Config

137 , short 'p'

138 , help "Do not fail if CPP pragma is present"

139 ]

140+ <*> (switch . mconcat)

141+ [ long "check-idempotency"

142+ , short 'c'

143+ , help "Fail if formatting is not idempotent."

144+ ]

140

145

141----------------------------------------------------------------------------

146----------------------------------------------------------------------------

142-- Helpers

147-- Helpers

nix/ormolize/ormolize.sh+2−1

@@ -13,4 +13,5 @@ mv "$1-nocpp" "$1"

13cp "$1" "$1-original"

14

15# run ormolu

16+ormolu --tolerate-cpp --check-idempotency --mode inplace "$1" ||

16−ormolu --tolerate-cpp --mode inplace "$1" || ormolu --tolerate-cpp --unsafe --mode inplace "$1"

17+ ormolu --tolerate-cpp --unsafe --mode inplace "$1"

src/Ormolu.hs+19−9

@@ -26,10 +26,10 @@ import Ormolu.Parser

26import Ormolu.Parser.Result

27import Ormolu.Printer

28import Ormolu.Utils (showOutputable)

29+import System.IO (hGetContents, stdin)

29import qualified CmdLineParser as GHC

30import qualified CmdLineParser as GHC

30import qualified Data.Text as T

31import qualified Data.Text as T

31−import qualified GHC

32+import qualified SrcLoc as GHC

32−import System.IO (hGetContents, stdin)

33

34-- | Format a 'String', return formatted version as 'Text'.

35--

@@ -56,18 +56,28 @@ ormolu cfg path str = do

56 traceM (concatMap showWarn ws)

57 traceM (prettyPrintParseResult result0)

58 let txt = printModule (cfgDebug cfg) result0

59+ when (not (cfgUnsafe cfg) || cfgCheckIdempotency cfg) $ do

60+ let pathRendered = path ++ "<rendered>"

59− -- Parse the result of pretty-printing again and make sure that AST is the

61+ -- Parse the result of pretty-printing again and make sure that AST

60− -- same as AST of original snippet module span positions.

62+ -- is the same as AST of original snippet module span positions.

61− unless (cfgUnsafe cfg) $ do

62 (_, result1) <-

63 (_, result1) <-

63 parseModule'

64 parseModule'

64 cfg

65 cfg

65 OrmoluOutputParsingFailed

66 OrmoluOutputParsingFailed

66− (path ++ "<rendered>")

67+ pathRendered

67 (T.unpack txt)

68 (T.unpack txt)

69+ unless (cfgUnsafe cfg) $

68− case diff result0 result1 of

70+ case diffParseResult result0 result1 of

69− Same -> return ()

71+ Same -> return ()

70− Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss)

72+ Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss)

73+ -- Try re-formatting the formatted result to check if we get exactly

74+ -- the same output.

75+ when (cfgCheckIdempotency cfg) $

76+ let txt2 = printModule False result1

77+ in case diffText txt txt2 pathRendered of

78+ Nothing -> return ()

79+ Just (loc, l, r) -> liftIO $

80+ throwIO (OrmoluNonIdempotentOutput loc l r)

71 return txt

81 return txt

72

82

73-- | Load a file and format it. The file stays intact and the rendered

83-- | Load a file and format it. The file stays intact and the rendered

src/Ormolu/Config.hs+3

@@ -27,6 +27,8 @@ data Config = Config

27 -- ^ Do not fail if CPP pragma is present (still doesn't handle CPP but

28 -- useful for formatting of files that enable the extension without

29 -- actually containing CPP macros)

30+ , cfgCheckIdempotency :: !Bool

31+ -- ^ Checks if re-formatting the result is idempotent.

30 } deriving (Eq, Show)

32 } deriving (Eq, Show)

31

33

32-- | Default 'Config'.

34-- | Default 'Config'.

@@ -37,6 +39,7 @@ defaultConfig = Config

37 , cfgUnsafe = False

39 , cfgUnsafe = False

38 , cfgDebug = False

40 , cfgDebug = False

39 , cfgTolerateCpp = False

41 , cfgTolerateCpp = False

42+ , cfgCheckIdempotency = False

40 }

43 }

41

44

42-- | A wrapper for dynamic options.

45-- | A wrapper for dynamic options.

src/Ormolu/Diff.hs+49−11

@@ -5,17 +5,22 @@

5-- | Diffing GHC ASTs modulo span positions.

6

7module Ormolu.Diff

8− ( diff

9− , Diff(..)

8+ ( Diff(..)

9+ , diffParseResult

10+ , diffText

10 )

11 )

11where

12where

12

13

13import BasicTypes (SourceText)

14import BasicTypes (SourceText)

14import Data.ByteString (ByteString)

15import Data.ByteString (ByteString)

15import Data.Generics

16import Data.Generics

17+import Data.Text (Text)

16import GHC

18import GHC

17import Ormolu.Imports (sortImports)

19import Ormolu.Imports (sortImports)

18import Ormolu.Parser.Result

20import Ormolu.Parser.Result

21+import qualified Data.Text as T

22+import qualified FastString as GHC

23+import qualified SrcLoc as GHC

19

24

20-- | Result of comparing two 'ParseResult's.

25-- | Result of comparing two 'ParseResult's.

21

26

@@ -31,16 +36,16 @@ instance Semigroup Diff where

31instance Monoid Diff where

36instance Monoid Diff where

32 mempty = Same

37 mempty = Same

33

38

34−-- | Return 'False' if two annotated ASTs are the same modulo span

39+-- | Return 'Diff' of two 'ParseResult's.

35−-- positions.

36

40

37−diff :: ParseResult -> ParseResult -> Diff

41+diffParseResult :: ParseResult -> ParseResult -> Diff

42+diffParseResult

38−diff ParseResult { prCommentStream = cstream0

43+ ParseResult { prCommentStream = cstream0

39− , prParsedSource = ps0

44+ , prParsedSource = ps0

40− }

45+ }

41− ParseResult { prCommentStream = cstream1

46+ ParseResult { prCommentStream = cstream1

42− , prParsedSource = ps1

47+ , prParsedSource = ps1

43− } =

48+ } =

44 matchIgnoringSrcSpans cstream0 cstream1 <>

49 matchIgnoringSrcSpans cstream0 cstream1 <>

45 matchIgnoringSrcSpans ps0 ps1

50 matchIgnoringSrcSpans ps0 ps1

46

51

@@ -96,3 +101,36 @@ matchIgnoringSrcSpans = genericQuery

96 fresh = not $ any (flip isSubspanOf s) ss

101 fresh = not $ any (flip isSubspanOf s) ss

97 helpful = isGoodSrcSpan s

102 helpful = isGoodSrcSpan s

98 appendSpan _ d = d

103 appendSpan _ d = d

104+

105+-- | Diff two texts and return the location they start to differ, alongside

106+-- with excerpts around that location.

107+

108+diffText

109+ :: Text -- ^ Text before

110+ -> Text -- ^ Text after

111+ -> FilePath -- ^ Path to use to construct 'GHC.RealSrcLoc'

112+ -> Maybe (GHC.RealSrcLoc, Text, Text)

113+diffText left right fp =

114+ case go (0, 0, 0) left right of

115+ Nothing -> Nothing

116+ Just (row, col, loc) -> Just (

117+ GHC.mkRealSrcLoc (GHC.mkFastString fp) row col,

118+ getSpan loc left,

119+ getSpan loc right

120+ )

121+ where

122+ go (row, col, loc) t1 t2 =

123+ case (T.uncons t1, T.uncons t2) of

124+ -- both text empty, all good

125+ (Nothing, Nothing) ->

126+ Nothing

127+ -- first chars are the same, adjust position and recurse

128+ (Just (c1, r1), Just (c2, r2)) | c1 == c2 ->

129+ let (row', col', loc') = if c1 == '\n'

130+ then (row + 1, 0, loc + 1)

131+ else (row, col + 1, loc + 1)

132+ in go (row', col', loc') r1 r2

133+ -- something is different, return the position

134+ _ ->

135+ Just (row, col, loc)

136+ getSpan loc = T.take 20 . T.drop (loc - 10)

src/Ormolu/Exception.hs+16−8

@@ -12,7 +12,9 @@ import Control.Exception

12import Ormolu.Utils (showOutputable)

13import System.Exit (ExitCode (..), exitWith)

14import System.IO

15+import Data.Text (Text)

15import qualified GHC

16import qualified GHC

17+import qualified Outputable as GHC

16

18

17-- | Ormolu exception representing all cases when Ormolu can fail.

19-- | Ormolu exception representing all cases when Ormolu can fail.

18

20

@@ -25,6 +27,8 @@ data OrmoluException

25 -- ^ Parsing of formatted source code failed

27 -- ^ Parsing of formatted source code failed

26 | OrmoluASTDiffers FilePath [GHC.SrcSpan]

28 | OrmoluASTDiffers FilePath [GHC.SrcSpan]

27 -- ^ Original and resulting ASTs differ

29 -- ^ Original and resulting ASTs differ

30+ | OrmoluNonIdempotentOutput GHC.RealSrcLoc Text Text

31+ -- ^ Formatted source code is not idempotent

28 deriving (Eq, Show)

32 deriving (Eq, Show)

29

33

30instance Exception OrmoluException where

34instance Exception OrmoluException where

@@ -34,9 +38,9 @@ instance Exception OrmoluException where

34 , withIndent path

38 , withIndent path

35 ]

39 ]

36 OrmoluParsingFailed s e ->

40 OrmoluParsingFailed s e ->

37− showParsingErr "Parsing of source code failed:" s e

41+ showParsingErr "Parsing of source code failed:" s [e]

38 OrmoluOutputParsingFailed s e ->

42 OrmoluOutputParsingFailed s e ->

39− showParsingErr "Parsing of formatted code failed:" s e ++

43+ showParsingErr "Parsing of formatted code failed:" s [e] ++

40 "Please, consider reporting the bug.\n"

44 "Please, consider reporting the bug.\n"

41 OrmoluASTDiffers path ss -> unlines $

45 OrmoluASTDiffers path ss -> unlines $

42 [ "AST of input and AST of formatted code differ."

46 [ "AST of input and AST of formatted code differ."

@@ -44,8 +48,12 @@ instance Exception OrmoluException where

44 ++ (fmap withIndent $ case fmap (\s -> "at " ++ showOutputable s) ss of

48 ++ (fmap withIndent $ case fmap (\s -> "at " ++ showOutputable s) ss of

45 [] -> ["in " ++ path]

49 [] -> ["in " ++ path]

46 xs -> xs) ++

50 xs -> xs) ++

47− [ "Please, consider reporting the bug."

51+ [ "Please, consider reporting the bug." ]

48− ]

52+ OrmoluNonIdempotentOutput loc left right ->

53+ showParsingErr "Formatting is not idempotent:" loc

54+ [ "before: " ++ show left , "after: " ++ show right ]

55+ ++ "Please, consider reporting the bug.\n"

56+

49

57

50-- | Inside this wrapper 'OrmoluException' will be caught and displayed

58-- | Inside this wrapper 'OrmoluException' will be caught and displayed

51-- nicely using 'displayException'.

59-- nicely using 'displayException'.

@@ -65,18 +73,18 @@ withPrettyOrmoluExceptions m = m `catch` h

65 OrmoluParsingFailed _ _ -> 3

73 OrmoluParsingFailed _ _ -> 3

66 OrmoluOutputParsingFailed _ _ -> 4

74 OrmoluOutputParsingFailed _ _ -> 4

67 OrmoluASTDiffers _ _ -> 5

75 OrmoluASTDiffers _ _ -> 5

76+ OrmoluNonIdempotentOutput _ _ _ -> 6

68

77

69----------------------------------------------------------------------------

78----------------------------------------------------------------------------

70-- Helpers

79-- Helpers

71

80

72-- | Show a parse error.

81-- | Show a parse error.

73

82

74−showParsingErr :: String -> GHC.SrcSpan -> String -> String

83+showParsingErr :: GHC.Outputable a => String -> a -> [String] -> String

75−showParsingErr msg spn err = unlines

84+showParsingErr msg spn err = unlines $

76 [ msg

85 [ msg

77 , withIndent (showOutputable spn)

86 , withIndent (showOutputable spn)

78− , withIndent err

87+ ] ++ map withIndent err

79− ]

80

88

81-- | Indent with 2 spaces for readability.

89-- | Indent with 2 spaces for readability.

82

90