Implement the --check-idempotency flag

app/Main.hs

@@ -137,6 +137,11 @@ configParser = Config
     , short 'p'
     , help "Do not fail if CPP pragma is present"
     ]
+  <*> (switch . mconcat)
+    [ long "check-idempotency"
+    , short 'c'
+    , help "Fail if formatting is not idempotent."
+    ]
 
 ----------------------------------------------------------------------------
 -- Helpers

nix/ormolize/ormolize.sh

@@ -13,4 +13,5 @@ mv "$1-nocpp" "$1"
 cp "$1" "$1-original"
 
 # run ormolu
-ormolu --tolerate-cpp --mode inplace "$1" || ormolu --tolerate-cpp --unsafe --mode inplace "$1"
+ormolu --tolerate-cpp --check-idempotency --mode inplace "$1" ||
+  ormolu --tolerate-cpp --unsafe --mode inplace "$1"

src/Ormolu.hs

@@ -26,10 +26,10 @@ import Ormolu.Parser
 import Ormolu.Parser.Result
 import Ormolu.Printer
 import Ormolu.Utils (showOutputable)
+import System.IO (hGetContents, stdin)
 import qualified CmdLineParser as GHC
 import qualified Data.Text as T
-import qualified GHC
-import System.IO (hGetContents, stdin)
+import qualified SrcLoc as GHC
 
 -- | Format a 'String', return formatted version as 'Text'.
 --
@@ -56,18 +56,28 @@ ormolu cfg path str = do
     traceM (concatMap showWarn ws)
     traceM (prettyPrintParseResult result0)
   let txt = printModule (cfgDebug cfg) result0
-  -- Parse the result of pretty-printing again and make sure that AST is the
-  -- same as AST of original snippet module span positions.
-  unless (cfgUnsafe cfg) $ do
+  when (not (cfgUnsafe cfg) || cfgCheckIdempotency cfg) $ do
+    let pathRendered = path ++ "<rendered>"
+    -- Parse the result of pretty-printing again and make sure that AST
+    -- is the same as AST of original snippet module span positions.
     (_, result1) <-
       parseModule'
         cfg
         OrmoluOutputParsingFailed
-        (path ++ "<rendered>")
+        pathRendered
         (T.unpack txt)
-    case diff result0 result1 of
-      Same -> return ()
-      Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss)
+    unless (cfgUnsafe cfg) $
+      case diffParseResult result0 result1 of
+        Same -> return ()
+        Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss)
+    -- Try re-formatting the formatted result to check if we get exactly
+    -- the same output.
+    when (cfgCheckIdempotency cfg) $
+      let txt2 = printModule False result1
+       in case diffText txt txt2 pathRendered of
+            Nothing -> return ()
+            Just (loc, l, r) -> liftIO $
+              throwIO (OrmoluNonIdempotentOutput loc l r)
   return txt
 
 -- | Load a file and format it. The file stays intact and the rendered

src/Ormolu/Config.hs

@@ -27,6 +27,8 @@ data Config = Config
     -- ^ Do not fail if CPP pragma is present (still doesn't handle CPP but
     -- useful for formatting of files that enable the extension without
     -- actually containing CPP macros)
+  , cfgCheckIdempotency :: !Bool
+    -- ^ Checks if re-formatting the result is idempotent.
   } deriving (Eq, Show)
 
 -- | Default 'Config'.
@@ -37,6 +39,7 @@ defaultConfig = Config
   , cfgUnsafe = False
   , cfgDebug = False
   , cfgTolerateCpp = False
+  , cfgCheckIdempotency = False
   }
 
 -- | A wrapper for dynamic options.

src/Ormolu/Diff.hs

@@ -5,17 +5,22 @@
 -- | Diffing GHC ASTs modulo span positions.
 
 module Ormolu.Diff
-  ( diff
-  , Diff(..)
+  ( Diff(..)
+  , diffParseResult
+  , diffText
   )
 where
 
 import BasicTypes (SourceText)
 import Data.ByteString (ByteString)
 import Data.Generics
+import Data.Text (Text)
 import GHC
 import Ormolu.Imports (sortImports)
 import Ormolu.Parser.Result
+import qualified Data.Text as T
+import qualified FastString as GHC
+import qualified SrcLoc as GHC
 
 -- | Result of comparing two 'ParseResult's.
 
@@ -31,16 +36,16 @@ instance Semigroup Diff where
 instance Monoid Diff where
   mempty = Same
 
--- | Return 'False' if two annotated ASTs are the same modulo span
--- positions.
+-- | Return 'Diff' of two 'ParseResult's.
 
-diff :: ParseResult -> ParseResult -> Diff
-diff ParseResult { prCommentStream = cstream0
-                 , prParsedSource = ps0
-                 }
-     ParseResult { prCommentStream = cstream1
-                 , prParsedSource = ps1
-                 } =
+diffParseResult :: ParseResult -> ParseResult -> Diff
+diffParseResult
+  ParseResult { prCommentStream = cstream0
+              , prParsedSource = ps0
+              }
+  ParseResult { prCommentStream = cstream1
+              , prParsedSource = ps1
+              } =
   matchIgnoringSrcSpans cstream0 cstream1 <>
   matchIgnoringSrcSpans ps0 ps1
 
@@ -96,3 +101,36 @@ matchIgnoringSrcSpans = genericQuery
         fresh = not $ any (flip isSubspanOf s) ss
         helpful = isGoodSrcSpan s
     appendSpan _ d = d
+
+-- | Diff two texts and return the location they start to differ, alongside
+-- with excerpts around that location.
+
+diffText
+  :: Text                       -- ^ Text before
+  -> Text                       -- ^ Text after
+  -> FilePath                   -- ^ Path to use to construct 'GHC.RealSrcLoc'
+  -> Maybe (GHC.RealSrcLoc, Text, Text)
+diffText left right fp =
+  case go (0, 0, 0) left right of
+    Nothing -> Nothing
+    Just (row, col, loc) -> Just (
+      GHC.mkRealSrcLoc (GHC.mkFastString fp) row col,
+      getSpan loc left,
+      getSpan loc right
+      )
+  where
+    go (row, col, loc) t1 t2  =
+      case (T.uncons t1, T.uncons t2) of
+        -- both text empty, all good
+        (Nothing, Nothing) ->
+          Nothing
+        -- first chars are the same, adjust position and recurse
+        (Just (c1, r1), Just (c2, r2)) | c1 == c2 ->
+          let (row', col', loc') = if c1 == '\n'
+                                   then (row + 1, 0, loc + 1)
+                                   else (row, col + 1, loc + 1)
+           in go (row', col', loc') r1 r2
+        -- something is different, return the position
+        _ ->
+          Just (row, col, loc)
+    getSpan loc = T.take 20 . T.drop (loc - 10)

src/Ormolu/Exception.hs

@@ -12,7 +12,9 @@ import Control.Exception
 import Ormolu.Utils (showOutputable)
 import System.Exit (ExitCode (..), exitWith)
 import System.IO
+import Data.Text (Text)
 import qualified GHC
+import qualified Outputable as GHC
 
 -- | Ormolu exception representing all cases when Ormolu can fail.
 
@@ -25,6 +27,8 @@ data OrmoluException
     -- ^ Parsing of formatted source code failed
   | OrmoluASTDiffers FilePath [GHC.SrcSpan]
     -- ^ Original and resulting ASTs differ
+  | OrmoluNonIdempotentOutput GHC.RealSrcLoc Text Text
+    -- ^ Formatted source code is not idempotent
   deriving (Eq, Show)
 
 instance Exception OrmoluException where
@@ -34,9 +38,9 @@ instance Exception OrmoluException where
       , withIndent path
       ]
     OrmoluParsingFailed s e ->
-      showParsingErr "Parsing of source code failed:" s e
+      showParsingErr "Parsing of source code failed:" s [e]
     OrmoluOutputParsingFailed s e ->
-      showParsingErr "Parsing of formatted code failed:" s e ++
+      showParsingErr "Parsing of formatted code failed:" s [e] ++
         "Please, consider reporting the bug.\n"
     OrmoluASTDiffers path ss -> unlines $
       [ "AST of input and AST of formatted code differ."
@@ -44,8 +48,12 @@ instance Exception OrmoluException where
       ++ (fmap withIndent $ case fmap (\s -> "at " ++ showOutputable s) ss of
            [] -> ["in " ++ path]
            xs -> xs) ++
-      [ "Please, consider reporting the bug."
-      ]
+      [ "Please, consider reporting the bug." ]
+    OrmoluNonIdempotentOutput loc left right ->
+      showParsingErr "Formatting is not idempotent:" loc
+        [ "before: " ++ show left , "after:  " ++ show right ]
+        ++ "Please, consider reporting the bug.\n"
+
 
 -- | Inside this wrapper 'OrmoluException' will be caught and displayed
 -- nicely using 'displayException'.
@@ -65,18 +73,18 @@ withPrettyOrmoluExceptions m = m `catch` h
           OrmoluParsingFailed _ _ -> 3
           OrmoluOutputParsingFailed _ _ -> 4
           OrmoluASTDiffers _ _ -> 5
+          OrmoluNonIdempotentOutput _ _ _ -> 6
 
 ----------------------------------------------------------------------------
 -- Helpers
 
 -- | Show a parse error.
 
-showParsingErr :: String -> GHC.SrcSpan -> String -> String
-showParsingErr msg spn err = unlines
+showParsingErr :: GHC.Outputable a => String -> a -> [String] -> String
+showParsingErr msg spn err = unlines $
   [ msg
   , withIndent (showOutputable spn)
-  , withIndent err
-  ]
+  ] ++ map withIndent err
 
 -- | Indent with 2 spaces for readability.