ormolu 0.1.3.1 → 0.1.4.0

raw patch · 41 files changed

+940/−313 lines, 41 filesdep +Diffdep +ansi-terminalPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: Diff, ansi-terminal

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• README.md +62/−31
• app/Main.hs +56/−41
• data/diff-tests/inputs/empty.hs +0/−0
• data/diff-tests/inputs/main-and-bar-v2.hs +11/−0
• data/diff-tests/inputs/main-and-bar.hs +11/−0
• data/diff-tests/inputs/main-and-baz-v2.hs +12/−0
• data/diff-tests/inputs/main-and-baz.hs +12/−0
• data/diff-tests/inputs/main-and-foo-v2.hs +7/−0
• data/diff-tests/inputs/main-and-foo.hs +7/−0
• data/diff-tests/inputs/main-foo.hs +4/−0
• data/diff-tests/inputs/main-v2.hs +4/−0
• data/diff-tests/inputs/main.hs +4/−0
• data/diff-tests/inputs/one-line.hs +1/−0
• data/diff-tests/inputs/spaced-v2.hs +16/−0
• data/diff-tests/inputs/spaced.hs +16/−0
• data/diff-tests/outputs/joined-hunk.txt +15/−0
• data/diff-tests/outputs/no-following.txt +7/−0
• data/diff-tests/outputs/no-preceding.txt +7/−0
• data/diff-tests/outputs/one-line-added.txt +3/−0
• data/diff-tests/outputs/one-line-removed.txt +3/−0
• data/diff-tests/outputs/simple-hunk.txt +10/−0
• data/diff-tests/outputs/trimming.txt +5/−0
• data/diff-tests/outputs/two-hunks.txt +16/−0
• data/examples/declaration/type/promotion-0-out.hs +9/−0
• data/examples/declaration/type/promotion-0.hs +9/−0
• data/examples/declaration/type/promotion-1-out.hs +15/−0
• data/examples/declaration/type/promotion-1.hs +9/−0
• data/examples/declaration/type/promotion-out.hs +0/−21
• data/examples/declaration/type/promotion.hs +0/−16
• data/examples/declaration/value/function/comprehension/transform-monad-out.hs +18/−0
• data/examples/declaration/value/function/comprehension/transform-monad.hs +16/−0
• ormolu.cabal +8/−2
• src/Ormolu.hs +6/−6
• src/Ormolu/Diff.hs +0/−158
• src/Ormolu/Diff/ParseResult.hs +124/−0
• src/Ormolu/Diff/Text.hs +318/−0
• src/Ormolu/Exception.hs +39/−36
• src/Ormolu/Printer/Meat/Declaration/Value.hs +1/−1
• src/Ormolu/Printer/Meat/Type.hs +1/−1
• tests/Ormolu/Diff/TextSpec.hs +65/−0

@@ -1,3 +1,16 @@+## Ormolu 0.1.4.0++* Added support for monad comprehensions. [Issue+  665](https://github.com/tweag/ormolu/issues/658).++* Fixed a bug when a space was inserted in front of promoted types even when+  it wasn't strictly necessary. [Issue+  668](https://github.com/tweag/ormolu/issues/688).++* Now the checking mode displays diffs per file when unformatted files are+  found. The rendering of the diffs is also improved. [Issue+  656](https://github.com/tweag/ormolu/issues/656).+ ## Ormolu 0.1.3.1  * Fixed a problem with multiline record updates using the record dot

@@ -6,6 +6,17 @@ [![Stackage LTS](http://stackage.org/package/ormolu/badge/lts)](http://stackage.org/lts/package/ormolu) [![Build status](https://badge.buildkite.com/8e3b0951f3652b77e1c422b361904136a539b0522029156354.svg?branch=master)](https://buildkite.com/tweag-1/ormolu) +* [Building and installation](#building-and-installation)+    * [Arch Linux](#arch-linux)+* [Usage](#usage)+    * [Editor integration](#editor-integration)+    * [Magic comments](#magic-comments)+    * [Exit codes](#exit-codes)+* [Limitations](#limitations)+* [Running on Hackage](#running-on-hackage)+* [Contributing](#contributing)+* [License](#license)+ Ormolu is a formatter for Haskell source code. The project was created with the following goals in mind: @@ -13,21 +24,20 @@   [`haskell-src-exts`][haskell-src-exts]. * Let some whitespace be programmable. The layout of the input influences   the layout choices in the output. This means that the choices between-  single-line/multi-line layouts in each particular situation are made by-  the user, not by an algorithm. This makes the implementation simpler and-  leaves some control to the user while still guaranteeing that the-  formatted code is stylistically consistent.+  single-line/multi-line layouts in certain situations are made by the user,+  not by an algorithm. This makes the implementation simpler and leaves some+  control to the user while still guaranteeing that the formatted code is+  stylistically consistent. * Writing code in such a way so it's easy to modify and maintain. * Implementing one “true” formatting style which admits no configuration.-* That formatting style aims to result in minimal diffs while still-  remaining very close to “conventional” Haskell formatting people use.+* The formatting style aims to result in minimal diffs. * Choose a style compatible with modern dialects of Haskell. As new Haskell   extensions enter broad use, we may change the style to accommodate them. * Idempotence: formatting already formatted code doesn't change it.-* Be well-tested and robust to the point that it can be used in large-  projects without exposing unfortunate, disappointing bugs here and there.+* Be well-tested and robust so that the formatter can be used in large+  projects. -## Building+## Building and installation  The easiest way to build the project is with Nix: @@ -63,7 +73,7 @@       owner = "tweag";       repo = "ormolu";       rev = "de279d80122b287374d4ed87c7b630db1f157642"; # update as necessary-      sha256 = "0qrxfk62ww6b60ha9sqcgl4nb2n5fhf66a65wszjngwkybwlzmrv"; # as well+      sha256 = "0qrxfk62ww6b60ha9sqcgl4nb2n5fhf66a65wszjngwkybwlzmrv"; # same     };     ormolu = import source { pkgs = self; }; in {@@ -77,6 +87,14 @@ } ``` +### Arch Linux++To install Ormolu on Arch Linux, one can use [the package on AUR][aur]:++```console+yay -S ormolu+```+ ## Usage  The following will print the formatted output to the standard output.@@ -98,8 +116,22 @@ $ ormolu --mode inplace $(find . -name '*.hs') ``` -## Magic comments+To check if files are are already formatted (useful on CI): +```console+$ ormolu --mode check $(find . -name '*.hs')+```++### Editor integration++We know of the following editor integrations:++* [Emacs][emacs-package]+* [VS Code][vs-code-plugin]+* Vim: [neoformat][neoformat], [vim-ormolu][vim-ormolu]++### Magic comments+ Ormolu understands two magic comments:  ```haskell@@ -119,16 +151,31 @@ omitted. Because of that the magic comments cannot be placed arbitrarily, but rather must enclose independent top-level definitions. -## Current limitations+### Exit codes +Exit code | Meaning+----------|-----------------------------------------------+0         | Success+1         | General problem+2         | CPP used (deprecated)+3         | Parsing of original input failed+4         | Parsing of formatted code failed+5         | AST of original and formatted code differs+6         | Formatting is not idempotent+7         | Unrecognized GHC options+100       | In checking mode: unformatted files+101       | Inplace and check modes do not work with stdin+102       | Other issue (with multiple input files)++## Limitations+ * CPP support is experimental. CPP is virtually impossible to handle   correctly, so we process them as a sort of unchangeable snippets. This   works only in simple cases when CPP conditionals surround top-level-  declarations. See the [CPP][design-cpp] section in the design notes for-  a discussion of the dangers.+  declarations. See the [CPP][design-cpp] section in the design notes for a+  discussion of the dangers. * Input modules should be parsable by Haddock, which is a bit stricter   criterion than just being valid Haskell modules.-* Various minor idempotence issues, most of them are related to comments.  ## Running on Hackage @@ -143,22 +190,6 @@ also contain formatted `.hs` files for inspection and original inputs with `.hs-original` extension (those are with CPP dropped, exactly what is fed into Ormolu).--## Editor integration--We know of the following editor integrations:--* [Emacs][emacs-package]-* [VS Code][vs-code-plugin]-* vim: [neoformat][neoformat], [vim-ormolu][vim-ormolu]--## Arch Linux--To install Ormolu on Arch Linux, one can use [the package on AUR][aur]:--```console-yay -S ormolu-```  ## Contributing 

@@ -6,16 +6,16 @@  module Main (main) where -import Control.Exception (SomeException, displayException, try) import Control.Monad import Data.Bool (bool)-import Data.Either (lefts) import Data.List (intercalate, sort)+import Data.Maybe (mapMaybe) import qualified Data.Text.IO as TIO import Data.Version (showVersion) import Development.GitRev import Options.Applicative import Ormolu+import Ormolu.Diff.Text (diffText, printTextDiff) import Ormolu.Parser (manualExts) import Ormolu.Utils (showOutputable) import Paths_ormolu (version)@@ -24,21 +24,28 @@  -- | Entry point of the program. main :: IO ()-main = withPrettyOrmoluExceptions $ do+main = do   Opts {..} <- execParser optsParserInfo   let formatOne' = formatOne optMode optConfig-  case optInputFiles of+  exitCode <- case optInputFiles of     [] -> formatOne' Nothing     ["-"] -> formatOne' Nothing     [x] -> formatOne' (Just x)     xs -> do-      -- It is possible to get IOException, error's and 'OrmoluException's-      -- from 'formatOne', so we just catch everything.-      errs <--        lefts <$> mapM (try @SomeException . formatOne' . Just) (sort xs)-      unless (null errs) $ do-        mapM_ (hPutStrLn stderr . displayException) errs-        exitWith (ExitFailure 102)+      let selectFailure = \case+            ExitSuccess -> Nothing+            ExitFailure n -> Just n+      errorCodes <-+        mapMaybe selectFailure <$> mapM (formatOne' . Just) (sort xs)+      return $+        if null errorCodes+          then ExitSuccess+          else+            ExitFailure $+              if all (== 100) errorCodes+                then 100+                else 102+  exitWith exitCode  -- | Format a single input. formatOne ::@@ -48,36 +55,44 @@   Config RegionIndices ->   -- | File to format or stdin as 'Nothing'   Maybe FilePath ->-  IO ()-formatOne mode config = \case-  Nothing -> do-    r <- ormoluStdin config-    case mode of-      Stdout -> TIO.putStr r-      _ -> do-        hPutStrLn-          stderr-          "This feature is not supported when input comes from stdin."-        -- 101 is different from all the other exit codes we already use.-        exitWith (ExitFailure 101)-  Just inputFile -> do-    originalInput <- TIO.readFile inputFile-    formattedInput <- ormoluFile config inputFile-    case mode of-      Stdout ->-        TIO.putStr formattedInput-      InPlace -> do-        -- Only write when the contents have changed, in order to avoid-        -- updating the modified timestamp if the file was already correctly-        -- formatted.-        when (formattedInput /= originalInput) $-          TIO.writeFile inputFile formattedInput-      Check -> do-        when (formattedInput /= originalInput) $-          -- 100 is different to all the other exit code that are emitted-          -- either from an 'OrmoluException' or from 'error' and-          -- 'notImplemented'.-          exitWith (ExitFailure 100)+  IO ExitCode+formatOne mode config mpath = withPrettyOrmoluExceptions $+  case mpath of+    Nothing -> do+      r <- ormoluStdin config+      case mode of+        Stdout -> do+          TIO.putStr r+          return ExitSuccess+        _ -> do+          hPutStrLn+            stderr+            "This feature is not supported when input comes from stdin."+          -- 101 is different from all the other exit codes we already use.+          return (ExitFailure 101)+    Just inputFile -> do+      originalInput <- TIO.readFile inputFile+      formattedInput <- ormoluFile config inputFile+      case mode of+        Stdout -> do+          TIO.putStr formattedInput+          return ExitSuccess+        InPlace -> do+          -- Only write when the contents have changed, in order to avoid+          -- updating the modified timestamp if the file was already correctly+          -- formatted.+          when (formattedInput /= originalInput) $+            TIO.writeFile inputFile formattedInput+          return ExitSuccess+        Check ->+          case diffText originalInput formattedInput inputFile of+            Nothing -> return ExitSuccess+            Just diff -> do+              printTextDiff stderr diff+              -- 100 is different to all the other exit code that are emitted+              -- either from an 'OrmoluException' or from 'error' and+              -- 'notImplemented'.+              return (ExitFailure 100)  ---------------------------------------------------------------------------- -- Command line options parsing.

@@ -0,0 +1,11 @@+module Main (main) where++main :: IO ()+main = pure ()++foo :: Int+foo =+  5++bar :: Int+bar = 7

@@ -0,0 +1,11 @@+module Main (main) where++main :: IO ()+main = return ()++foo :: Int+foo =+  5++bar :: Int+bar = 6

@@ -0,0 +1,12 @@+module Main (main) where++main :: IO ()+main = pure ()++foo :: Int+foo =+  5+   + 5++bar :: Int+bar = 7

@@ -0,0 +1,12 @@+module Main (main) where++main :: IO ()+main = return ()++foo :: Int+foo =+  5+   + 5++bar :: Int+bar = 6

@@ -0,0 +1,7 @@+module Main (main) where++main :: IO ()+main = pure ()++foo :: Int+foo = 5

@@ -0,0 +1,7 @@+module Main (main) where++main :: IO ()+main = return ()++foo :: Int+foo = 5

@@ -0,0 +1,4 @@+module Main (foo) where++main :: IO ()+main = return ()

@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = pure ()

@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = return ()

@@ -0,0 +1,1 @@+module Main (main) where

@@ -0,0 +1,16 @@+module Main (main) where++++++main :: IO ()+main = pure ()+++++++foo :: Int+foo = 5

@@ -0,0 +1,16 @@+module Main (main) where++++++main :: IO ()+main = return ()+++++++foo :: Int+foo = 5

@@ -0,0 +1,15 @@+TEST+@@ -1,11 +1,11 @@+  module Main (main) where++  main :: IO ()+- main = return ()++ main = pure ()++  foo :: Int+  foo =+    5++  bar :: Int+- bar = 6++ bar = 7

@@ -0,0 +1,7 @@+TEST+@@ -1,4 +1,4 @@+  module Main (main) where++  main :: IO ()+- main = return ()++ main = pure ()

@@ -0,0 +1,7 @@+TEST+@@ -1,4 +1,4 @@+- module Main (foo) where++ module Main (main) where++  main :: IO ()+  main = return ()

@@ -0,0 +1,3 @@+TEST+@@ -1,0 +1,1 @@++ module Main (main) where

@@ -0,0 +1,3 @@+TEST+@@ -1,1 +1,0 @@+- module Main (main) where

@@ -0,0 +1,10 @@+TEST+@@ -1,7 +1,7 @@+  module Main (main) where++  main :: IO ()+- main = return ()++ main = pure ()++  foo :: Int+  foo = 5

@@ -0,0 +1,5 @@+TEST+@@ -7,2 +7,2 @@+  main :: IO ()+- main = return ()++ main = pure ()

@@ -0,0 +1,16 @@+TEST+@@ -1,7 +1,7 @@+  module Main (main) where++  main :: IO ()+- main = return ()++ main = pure ()++  foo :: Int+  foo =+@@ -9,4 +9,4 @@+     + 5++  bar :: Int+- bar = 6++ bar = 7

@@ -0,0 +1,9 @@+type Foo = Cluster '[ 'NodeCore, 'NodeRelay', 'NodeEdge]++type Query = Query '[] '[] DB '[ 'NotNull 'PGint4] (RowPG RawElementData)++data T = T' | T'T++type S0 = ' T'++type S1 = ' T'T

@@ -0,0 +1,9 @@+type Foo = Cluster '[ 'NodeCore, 'NodeRelay', 'NodeEdge ]++type Query = Query '[] '[] DB '[ 'NotNull 'PGint4] (RowPG RawElementData)++data T = T' | T'T++type S0 = ' T'++type S1 = ' T'T

@@ -0,0 +1,15 @@+type S2 = Proxy ('[ '[], '[]])++type S4 = Proxy ('( 'Just, ' T'T))++type S5 = Proxy ('[ 'Just, 'TT'T])++type S6 = Proxy ('( '(), '()))++type S7 = Proxy ('( 'a, 'b))++type S8 = Proxy ('[Int, Bool])++type E = TypeError ('Text "Some text")++type G = '[ '( 'Just, 'Bool)]

@@ -0,0 +1,9 @@+type S2 = Proxy ( '[ '[], '[] ])+type S4 = Proxy ( '( 'Just, ' T'T))+type S5 = Proxy ( '[ 'Just, ' TT'T])+type S6 = Proxy ( '( '(), '() ))+type S7 = Proxy ( '( 'a, 'b ))+type S8 = Proxy ( '[ Int, Bool ])++type E = TypeError ('Text "Some text")+type G = '[ '( 'Just, 'Bool) ]

@@ -1,21 +0,0 @@-type Foo = Cluster '[ 'NodeCore, 'NodeRelay', 'NodeEdge]--type Query = Query '[] '[] DB '[ 'NotNull 'PGint4] (RowPG RawElementData)--data T = T' | T'T--type S0 = ' T'--type S1 = ' T'T--type S2 = Proxy ('[ '[], '[]])--type S4 = Proxy ('( 'Just, ' T'T))--type S5 = Proxy ('[ 'Just, 'TT'T])--type S6 = Proxy ('( '(), '()))--type S7 = Proxy ('( 'a, 'b))--type S8 = Proxy ('[Int, Bool])

@@ -1,16 +0,0 @@-type Foo = Cluster '[ 'NodeCore, 'NodeRelay', 'NodeEdge ]--type Query = Query '[] '[] DB '[ 'NotNull 'PGint4] (RowPG RawElementData)--data T = T' | T'T--type S0 = ' T'--type S1 = ' T'T--type S2 = Proxy ( '[ '[], '[] ])-type S4 = Proxy ( '( 'Just, ' T'T))-type S5 = Proxy ( '[ 'Just, ' TT'T])-type S6 = Proxy ( '( '(), '() ))-type S7 = Proxy ( '( 'a, 'b ))-type S8 = Proxy ( '[ Int, Bool ])

@@ -0,0 +1,18 @@+{-# LANGUAGE MonadComprehensions #-}+{-# LANGUAGE TransformListComp #-}++quux' xs ys =+  [ ( x,+      y+    )+    | x <- xs,+      y <- ys,+      then group by+        -- First comment+        ( x+            + y+        )+      using+        -- Second comment+        groupWith -- Third comment+  ]

@@ -0,0 +1,16 @@+{-# LANGUAGE MonadComprehensions #-}+{-# LANGUAGE TransformListComp #-}++quux' xs ys = [+  (x,+    y) |+  x <- xs,+  y <- ys,+  then+  group+  by -- First comment+    (x+      + y)+  using -- Second comment+    groupWith -- Third comment+  ]

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            ormolu-version:         0.1.3.1+version:         0.1.4.0 license:         BSD3 license-file:    LICENSE.md maintainer:      Mark Karpov <mark.karpov@tweag.io>@@ -48,6 +48,8 @@     data/examples/import/*.hs     data/examples/module-header/*.hs     data/examples/other/*.hs+    data/diff-tests/inputs/*.hs+    data/diff-tests/outputs/*.txt  extra-doc-files:     CONTRIBUTING.md@@ -68,7 +70,8 @@     exposed-modules:         Ormolu         Ormolu.Config-        Ormolu.Diff+        Ormolu.Diff.ParseResult+        Ormolu.Diff.Text         Ormolu.Exception         Ormolu.Imports         Ormolu.Parser@@ -116,6 +119,8 @@      default-language: Haskell2010     build-depends:+        Diff >=0.4 && <1.0,+        ansi-terminal >=0.10 && <1.0,         base >=4.12 && <5.0,         bytestring >=0.2 && <0.11,         containers >=0.5 && <0.7,@@ -163,6 +168,7 @@     build-tools:      hspec-discover >=2.0 && <3.0     hs-source-dirs:   tests     other-modules:+        Ormolu.Diff.TextSpec         Ormolu.Parser.PragmaSpec         Ormolu.PrinterSpec 

@@ -22,7 +22,8 @@ import qualified Data.Text as T import Debug.Trace import Ormolu.Config-import Ormolu.Diff+import Ormolu.Diff.ParseResult+import Ormolu.Diff.Text import Ormolu.Exception import Ormolu.Parser import Ormolu.Parser.Result@@ -64,14 +65,13 @@   -- lead to error messages presenting the exceptions as GHC bugs.   let !txt = printModule result0   when (not (cfgUnsafe cfg) || cfgCheckIdempotence 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-        pathRendered+        path         (T.unpack txt)     unless (cfgUnsafe cfg) $       case diffParseResult result0 result1 of@@ -81,11 +81,11 @@     -- the same output.     when (cfgCheckIdempotence cfg) $       let txt2 = printModule result1-       in case diffText txt txt2 pathRendered of+       in case diffText txt txt2 path of             Nothing -> return ()-            Just (loc, l, r) ->+            Just diff ->               liftIO $-                throwIO (OrmoluNonIdempotentOutput loc l r)+                throwIO (OrmoluNonIdempotentOutput diff)   return txt  -- | Load a file and format it. The file stays intact and the rendered

@@ -1,158 +0,0 @@-{-# LANGUAGE RankNTypes #-}---- | Diffing GHC ASTs modulo span positions.-module Ormolu.Diff-  ( Diff (..),-    diffParseResult,-    diffText,-  )-where--import Data.ByteString (ByteString)-import Data.Generics-import Data.Text (Text)-import qualified Data.Text as T-import qualified FastString as GHC-import GHC-import Ormolu.Imports (normalizeImports)-import Ormolu.Parser.CommentStream-import Ormolu.Parser.Result-import Ormolu.Utils---- | Result of comparing two 'ParseResult's.-data Diff-  = -- | Two parse results are the same-    Same-  | -- | Two parse results differ-    Different [SrcSpan]--instance Semigroup Diff where-  Same <> a = a-  a <> Same = a-  Different xs <> Different ys = Different (xs ++ ys)--instance Monoid Diff where-  mempty = Same---- | Return 'Diff' of two 'ParseResult's.-diffParseResult :: ParseResult -> ParseResult -> Diff-diffParseResult-  ParseResult-    { prCommentStream = cstream0,-      prParsedSource = hs0-    }-  ParseResult-    { prCommentStream = cstream1,-      prParsedSource = hs1-    } =-    matchIgnoringSrcSpans cstream0 cstream1-      <> matchIgnoringSrcSpans-        hs0 {hsmodImports = normalizeImports (hsmodImports hs0)}-        hs1 {hsmodImports = normalizeImports (hsmodImports hs1)}---- | Compare two values for equality disregarding differences in 'SrcSpan's--- and the ordering of import lists.-matchIgnoringSrcSpans :: Data a => a -> a -> Diff-matchIgnoringSrcSpans = genericQuery-  where-    genericQuery :: GenericQ (GenericQ Diff)-    genericQuery x y-      -- 'ByteString' implements 'Data' instance manually and does not-      -- implement 'toConstr', so we have to deal with it in a special way.-      | Just x' <- cast x,-        Just y' <- cast y =-        if x' == (y' :: ByteString)-          then Same-          else Different []-      | typeOf x == typeOf y,-        toConstr x == toConstr y =-        mconcat $-          gzipWithQ-            ( genericQuery-                `extQ` srcSpanEq-                `extQ` commentEq-                `extQ` sourceTextEq-                `extQ` hsDocStringEq-                `extQ` importDeclQualifiedStyleEq-                `ext2Q` forLocated-            )-            x-            y-      | otherwise = Different []-    srcSpanEq :: SrcSpan -> GenericQ Diff-    srcSpanEq _ _ = Same-    commentEq :: Comment -> GenericQ Diff-    commentEq (Comment _ x) d =-      case cast d :: Maybe Comment of-        Nothing -> Different []-        Just (Comment _ y) ->-          if x == y-            then Same-            else Different []-    sourceTextEq :: SourceText -> GenericQ Diff-    sourceTextEq _ _ = Same-    importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ Diff-    importDeclQualifiedStyleEq d0 d1' =-      case (d0, cast d1' :: Maybe ImportDeclQualifiedStyle) of-        (x, Just x') | x == x' -> Same-        (QualifiedPre, Just QualifiedPost) -> Same-        (QualifiedPost, Just QualifiedPre) -> Same-        _ -> Different []-    hsDocStringEq :: HsDocString -> GenericQ Diff-    hsDocStringEq str0 str1' =-      case cast str1' :: Maybe HsDocString of-        Nothing -> Different []-        Just str1 ->-          if splitDocString str0 == splitDocString str1-            then Same-            else Different []-    forLocated ::-      (Data e0, Data e1) =>-      GenLocated e0 e1 ->-      GenericQ Diff-    forLocated x@(L mspn _) y =-      maybe id appendSpan (cast mspn) (genericQuery x y)-    appendSpan :: SrcSpan -> Diff -> Diff-    appendSpan s (Different ss) | fresh && helpful = Different (s : ss)-      where-        fresh = not $ any (`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 before-  Text ->-  -- | Text after-  Text ->-  -- | Path to use to construct 'GHC.RealSrcLoc'-  FilePath ->-  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)

@@ -0,0 +1,124 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}++-- | This module allows us to diff two 'ParseResult's.+module Ormolu.Diff.ParseResult+  ( ParseResultDiff (..),+    diffParseResult,+  )+where++import Data.ByteString (ByteString)+import Data.Generics+import GHC+import Ormolu.Imports (normalizeImports)+import Ormolu.Parser.CommentStream+import Ormolu.Parser.Result+import Ormolu.Utils++-- | Result of comparing two 'ParseResult's.+data ParseResultDiff+  = -- | Two parse results are the same+    Same+  | -- | Two parse results differ+    Different [SrcSpan]++instance Semigroup ParseResultDiff where+  Same <> a = a+  a <> Same = a+  Different xs <> Different ys = Different (xs ++ ys)++instance Monoid ParseResultDiff where+  mempty = Same++-- | Return 'Diff' of two 'ParseResult's.+diffParseResult ::+  ParseResult ->+  ParseResult ->+  ParseResultDiff+diffParseResult+  ParseResult+    { prCommentStream = cstream0,+      prParsedSource = hs0+    }+  ParseResult+    { prCommentStream = cstream1,+      prParsedSource = hs1+    } =+    matchIgnoringSrcSpans cstream0 cstream1+      <> matchIgnoringSrcSpans+        hs0 {hsmodImports = normalizeImports (hsmodImports hs0)}+        hs1 {hsmodImports = normalizeImports (hsmodImports hs1)}++-- | Compare two values for equality disregarding differences in 'SrcSpan's+-- and the ordering of import lists.+matchIgnoringSrcSpans :: Data a => a -> a -> ParseResultDiff+matchIgnoringSrcSpans = genericQuery+  where+    genericQuery :: GenericQ (GenericQ ParseResultDiff)+    genericQuery x y+      -- 'ByteString' implements 'Data' instance manually and does not+      -- implement 'toConstr', so we have to deal with it in a special way.+      | Just x' <- cast x,+        Just y' <- cast y =+        if x' == (y' :: ByteString)+          then Same+          else Different []+      | typeOf x == typeOf y,+        toConstr x == toConstr y =+        mconcat $+          gzipWithQ+            ( genericQuery+                `extQ` srcSpanEq+                `extQ` commentEq+                `extQ` sourceTextEq+                `extQ` hsDocStringEq+                `extQ` importDeclQualifiedStyleEq+                `ext2Q` forLocated+            )+            x+            y+      | otherwise = Different []+    srcSpanEq :: SrcSpan -> GenericQ ParseResultDiff+    srcSpanEq _ _ = Same+    commentEq :: Comment -> GenericQ ParseResultDiff+    commentEq (Comment _ x) d =+      case cast d :: Maybe Comment of+        Nothing -> Different []+        Just (Comment _ y) ->+          if x == y+            then Same+            else Different []+    sourceTextEq :: SourceText -> GenericQ ParseResultDiff+    sourceTextEq _ _ = Same+    importDeclQualifiedStyleEq ::+      ImportDeclQualifiedStyle ->+      GenericQ ParseResultDiff+    importDeclQualifiedStyleEq d0 d1' =+      case (d0, cast d1' :: Maybe ImportDeclQualifiedStyle) of+        (x, Just x') | x == x' -> Same+        (QualifiedPre, Just QualifiedPost) -> Same+        (QualifiedPost, Just QualifiedPre) -> Same+        _ -> Different []+    hsDocStringEq :: HsDocString -> GenericQ ParseResultDiff+    hsDocStringEq str0 str1' =+      case cast str1' :: Maybe HsDocString of+        Nothing -> Different []+        Just str1 ->+          if splitDocString str0 == splitDocString str1+            then Same+            else Different []+    forLocated ::+      (Data e0, Data e1) =>+      GenLocated e0 e1 ->+      GenericQ ParseResultDiff+    forLocated x@(L mspn _) y =+      maybe id appendSpan (cast mspn) (genericQuery x y)+    appendSpan :: SrcSpan -> ParseResultDiff -> ParseResultDiff+    appendSpan s (Different ss) | fresh && helpful = Different (s : ss)+      where+        fresh = not $ any (`isSubspanOf` s) ss+        helpful = isGoodSrcSpan s+    appendSpan _ d = d

@@ -0,0 +1,318 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}++-- | This module allows us to diff two 'Text' values.+module Ormolu.Diff.Text+  ( TextDiff,+    diffText,+    printTextDiff,+  )+where++import Control.Monad+import qualified Data.Algorithm.Diff as D+import Data.Maybe (listToMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import System.Console.ANSI+import System.IO++----------------------------------------------------------------------------+-- Types++-- | Result of diffing two 'Text's.+data TextDiff = TextDiff FilePath DiffList+  deriving (Eq)++instance Show TextDiff where+  show (TextDiff path _) = "TextDiff " ++ show path ++ " _"++-- | List of lines tagged by 'D.Both', 'D.First', or 'D.Second'.+type DiffList = [D.Diff [Text]]++-- | Similar to 'DiffList', but with line numbers assigned.+type DiffList' = [D.Diff [(Int, Int, Text)]]++-- | Diff hunk.+data Hunk = Hunk+  { hunkFirstStartLine :: Int,+    hunkFirstLength :: Int,+    hunkSecondStartLine :: Int,+    hunkSecondLength :: Int,+    hunkDiff :: DiffList+  }++----------------------------------------------------------------------------+-- API++-- | Diff two texts and produce a 'TextDiff'.+diffText ::+  -- | Text before+  Text ->+  -- | Text after+  Text ->+  -- | Path to use+  FilePath ->+  -- | The resulting diff or 'Nothing' if the inputs are identical+  Maybe TextDiff+diffText a b path =+  if all isBoth xs+    then Nothing+    else Just (TextDiff path xs)+  where+    xs = D.getGroupedDiff (T.lines a) (T.lines b)+    isBoth = \case+      D.Both _ _ -> True+      D.First _ -> False+      D.Second _ -> False++-- | Print the given 'TextDiff' to 'Handle'. This function tries to mimic+-- the style of @git diff@.+printTextDiff :: Handle -> TextDiff -> IO ()+printTextDiff h (TextDiff path xs) = do+  supports <- hSupportsANSI h+  let bold m =+        if supports+          then do+            hSetSGR h [SetConsoleIntensity BoldIntensity]+            m+            hSetSGR h [Reset]+          else m+      cyan m =+        if supports+          then do+            hSetSGR h [SetColor Foreground Dull Cyan]+            m+            hSetSGR h [Reset]+          else m+      green m =+        if supports+          then do+            hSetSGR h [SetColor Foreground Dull Green]+            m+            hSetSGR h [Reset]+          else m+      red m =+        if supports+          then do+            hSetSGR h [SetColor Foreground Dull Red]+            m+            hSetSGR h [Reset]+          else m+      put = T.hPutStr h+      newline = hPutStr h "\n"+  (bold . put . T.pack) path+  newline+  forM_ (toHunks (assignLines xs)) $ \Hunk {..} -> do+    cyan $ do+      put "@@ -"+      put (T.pack $ show hunkFirstStartLine)+      put ","+      put (T.pack $ show hunkFirstLength)+      put " +"+      put (T.pack $ show hunkSecondStartLine)+      put ","+      put (T.pack $ show hunkSecondLength)+      put " @@"+    newline+    forM_ hunkDiff $ \case+      D.Both ys _ ->+        forM_ ys $ \y -> do+          unless (T.null y) $+            put "  "+          put y+          newline+      D.First ys ->+        forM_ ys $ \y -> red $ do+          put "-"+          unless (T.null y) $+            put " "+          put y+          newline+      D.Second ys ->+        forM_ ys $ \y -> green $ do+          put "+"+          unless (T.null y) $+            put " "+          put y+          newline+  hFlush h++----------------------------------------------------------------------------+-- Helpers++-- | Assign lines to a 'DiffList'.+assignLines :: DiffList -> DiffList'+assignLines = go 1 1 id+  where+    go _ _ acc [] = acc []+    go !firstLine !secondLine acc (x : xs) =+      case x of+        D.Both a b ->+          let firstInc = length a+              secondInc = length b+              a' =+                zipWith3+                  (,,)+                  (iterate (+ 1) firstLine)+                  (iterate (+ 1) secondLine)+                  a+           in go+                (firstLine + firstInc)+                (secondLine + secondInc)+                (acc . ((D.Both a' a') :))+                xs+        D.First a ->+          let firstInc = length a+              a' =+                zipWith3+                  (,,)+                  (iterate (+ 1) firstLine)+                  (repeat secondLine)+                  a+           in go+                (firstLine + firstInc)+                secondLine+                (acc . ((D.First a') :))+                xs+        D.Second b ->+          let secondInc = length b+              b' =+                zipWith3+                  (,,)+                  (repeat firstLine)+                  (iterate (+ 1) secondLine)+                  b+           in go+                firstLine+                (secondLine + secondInc)+                (acc . ((D.Second b') :))+                xs++-- | Form 'Hunk's from a 'DiffList''.+toHunks :: DiffList' -> [Hunk]+toHunks = go 0 False id id []+  where+    -- How many lines of context (that is, lines present in both texts) to+    -- show per hunk.+    margin = 3+    go ::+      Int ->+      Bool ->+      ([Hunk] -> [Hunk]) ->+      (DiffList' -> DiffList') ->+      [(Int, Int, Text)] ->+      DiffList' ->+      [Hunk]+    go !n gotChanges hunksAcc currentAcc bothHistory = \case+      [] ->+        if gotChanges+          then+            let p = reverse (take margin bothHistory)+                currentAcc' = addBothAfter p currentAcc+             in case formHunk (currentAcc' []) of+                  Nothing -> hunksAcc []+                  Just hunk -> hunksAcc [hunk]+          else hunksAcc []+      (x : xs) ->+        case x of+          D.Both a _ ->+            let currentAcc' = addBothAfter p currentAcc+                p = reverse (drop (n' - margin) bothHistory')+                hunksAcc' =+                  case formHunk (currentAcc' []) of+                    Nothing -> hunksAcc+                    Just hunk -> hunksAcc . (hunk :)+                bothHistory' = reverse a ++ bothHistory+                lena = length a+                n' = n + lena+             in if gotChanges && n' > margin * 2+                  then go 0 False hunksAcc' id bothHistory' xs+                  else go n' gotChanges hunksAcc currentAcc bothHistory' xs+          piece ->+            if gotChanges+              then+                let p = reverse bothHistory+                    currentAcc' = currentAcc . addBothBefore p (piece :)+                 in go 0 True hunksAcc currentAcc' [] xs+              else+                let p = reverse (take margin bothHistory)+                    currentAcc' = addBothBefore p (piece :)+                 in go 0 True hunksAcc currentAcc' [] xs+    addBothBefore [] acc = acc+    addBothBefore p acc = (D.Both p p :) . acc+    addBothAfter [] acc = acc+    addBothAfter p acc = acc . (D.Both p p :)++-- | Form a 'Hunk'.+formHunk :: DiffList' -> Maybe Hunk+formHunk xsRaw = do+  let xs = trimEmpty xsRaw+  hunkFirstStartLine <- listToMaybe xs >>= firstStartLine+  let hunkFirstLength = firstLength xs+  hunkSecondStartLine <- listToMaybe xs >>= secondStartLine+  let hunkSecondLength = secondLength xs+      hunkDiff = mapDiff (fmap third) xs+  return Hunk {..}++-- | Trim empty “both” lines from beginning and end of a 'DiffList''.+trimEmpty :: DiffList' -> DiffList'+trimEmpty = go True id+  where+    go isFirst acc = \case+      [] -> acc []+      [D.Both x _] ->+        let x' = reverse $ dropWhile (T.null . third) (reverse x)+         in go False (acc . (D.Both x' x' :)) []+      (D.Both x _ : xs) ->+        let x' = dropWhile (T.null . third) x+         in if isFirst+              then go False (acc . (D.Both x' x' :)) xs+              else go False (acc . (D.Both x x :)) xs+      (x : xs) ->+        go False (acc . (x :)) xs++firstStartLine :: D.Diff [(Int, Int, a)] -> Maybe Int+firstStartLine = \case+  D.Both ((x, _, _) : _) _ -> Just x+  D.First ((x, _, _) : _) -> Just x+  D.Second ((x, _, _) : _) -> Just x+  _ -> Nothing++firstLength :: [D.Diff [(Int, Int, a)]] -> Int+firstLength = go 0+  where+    go n [] = n+    go !n (x : xs) = case x of+      D.Both as _ -> go (n + length as) xs+      D.First as -> go (n + length as) xs+      D.Second _ -> go n xs++secondStartLine :: D.Diff [(Int, Int, a)] -> Maybe Int+secondStartLine = \case+  D.Both ((_, x, _) : _) _ -> Just x+  D.First ((_, x, _) : _) -> Just x+  D.Second ((_, x, _) : _) -> Just x+  _ -> Nothing++secondLength :: [D.Diff [(Int, Int, a)]] -> Int+secondLength = go 0+  where+    go n [] = n+    go !n (x : xs) = case x of+      D.Both as _ -> go (n + length as) xs+      D.First _ -> go n xs+      D.Second as -> go (n + length as) xs++mapDiff :: (a -> b) -> [D.Diff a] -> [D.Diff b]+mapDiff f = fmap $ \case+  D.Both a b -> D.Both (f a) (f b)+  D.First a -> D.First (f a)+  D.Second b -> D.Second (f b)++third :: (Int, Int, Text) -> Text+third (_, _, x) = x

@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TupleSections #-}  -- | 'OrmoluException' type and surrounding definitions. module Ormolu.Exception@@ -10,11 +11,11 @@ import Control.Exception import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE-import Data.Text (Text) import qualified GHC+import Ormolu.Diff.Text (TextDiff, printTextDiff) import Ormolu.Utils (showOutputable) import qualified Outputable as GHC-import System.Exit (ExitCode (..), exitWith)+import System.Exit (ExitCode (..)) import System.IO  -- | Ormolu exception representing all cases when Ormolu can fail.@@ -26,53 +27,55 @@   | -- | Original and resulting ASTs differ     OrmoluASTDiffers FilePath [GHC.SrcSpan]   | -- | Formatted source code is not idempotent-    OrmoluNonIdempotentOutput GHC.RealSrcLoc Text Text+    OrmoluNonIdempotentOutput TextDiff   | -- | Some GHC options were not recognized     OrmoluUnrecognizedOpts (NonEmpty String)   deriving (Eq, Show) -instance Exception OrmoluException where-  displayException = \case-    OrmoluParsingFailed s e ->+instance Exception OrmoluException++-- |+printOrmoluException :: Handle -> OrmoluException -> IO ()+printOrmoluException h = \case+  OrmoluParsingFailed s e ->+    hPutStrLn h $       showParsingErr "The GHC parser (in Haddock mode) failed:" s [e]-    OrmoluOutputParsingFailed s e ->+  OrmoluOutputParsingFailed s e ->+    hPutStrLn h $       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."-        ]-          ++ fmap-            withIndent-            ( case fmap (\s -> "at " ++ showOutputable s) ss of-                [] -> ["in " ++ path]-                xs -> xs-            )-          ++ ["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"-    OrmoluUnrecognizedOpts opts ->-      unlines-        [ "The following GHC options were not recognized:",-          (withIndent . unwords . NE.toList) opts-        ]+  OrmoluASTDiffers path ss ->+    hPutStrLn h . unlines $+      [ "AST of input and AST of formatted code differ."+      ]+        ++ fmap+          withIndent+          ( case fmap (\s -> "at " ++ showOutputable s) ss of+              [] -> ["in " ++ path]+              xs -> xs+          )+        ++ ["Please, consider reporting the bug."]+  OrmoluNonIdempotentOutput diff -> do+    hPutStrLn h "Formatting is not idempotent:\n"+    printTextDiff h diff+    hPutStrLn h "\nPlease, consider reporting the bug.\n"+  OrmoluUnrecognizedOpts opts ->+    hPutStrLn h . unlines $+      [ "The following GHC options were not recognized:",+        (withIndent . unwords . NE.toList) opts+      ]  -- | Inside this wrapper 'OrmoluException' will be caught and displayed--- nicely using 'displayException'.+-- nicely. withPrettyOrmoluExceptions ::-  -- | Action that may throw the exception-  IO a ->-  IO a+  -- | Action that may throw an exception+  IO ExitCode ->+  IO ExitCode withPrettyOrmoluExceptions m = m `catch` h   where-    h :: OrmoluException -> IO a     h e = do-      hPutStrLn stderr (displayException e)-      exitWith . ExitFailure $+      printOrmoluException stderr e+      return . ExitFailure $         case e of           -- Error code 1 is for 'error' or 'notImplemented'           -- 2 used to be for erroring out on CPP

@@ -702,7 +702,7 @@       DoExpr -> doBody "do"       MDoExpr -> doBody "mdo"       ListComp -> compBody-      MonadComp -> notImplemented "MonadComp"+      MonadComp -> compBody       ArrowExpr -> notImplemented "ArrowExpr"       GhciStmtCtxt -> notImplemented "GhciStmtCtxt"       PatGuard _ -> notImplemented "PatGuard"

@@ -52,7 +52,6 @@   HsTyVar NoExtField p n -> do     case p of       IsPromoted -> do-        space         txt "'"         case showOutputable (unLoc n) of           _ : '\'' : _ -> space@@ -170,6 +169,7 @@   XHsType (NHsCoreTy t) -> atom t   where     isPromoted = \case+      HsAppTy _ (L _ f) _ -> isPromoted f       HsTyVar _ IsPromoted _ -> True       HsExplicitTupleTy {} -> True       HsExplicitListTy {} -> True

@@ -0,0 +1,65 @@+{-# LANGUAGE TemplateHaskell #-}++module Ormolu.Diff.TextSpec (spec) where++import Data.Text (Text)+import qualified Data.Text.IO as T+import Ormolu.Diff.Text+import Path+import Path.IO+import qualified System.FilePath as FP+import System.IO (Handle, hClose)+import Test.Hspec++spec :: Spec+spec =+  describe "printTextDiff" $ do+    stdTest "one-line-added" "empty" "one-line"+    stdTest "one-line-removed" "one-line" "empty"+    stdTest "no-preceding" "main-foo" "main"+    stdTest "no-following" "main" "main-v2"+    stdTest "simple-hunk" "main-and-foo" "main-and-foo-v2"+    stdTest "joined-hunk" "main-and-bar" "main-and-bar-v2"+    stdTest "two-hunks" "main-and-baz" "main-and-baz-v2"+    stdTest "trimming" "spaced" "spaced-v2"++-- | Test diff printig.+stdTest ::+  -- | Name of the test case+  String ->+  -- | Location of input A+  FilePath ->+  -- | Location of input B+  FilePath ->+  Spec+stdTest name pathA pathB = it name $ do+  inputA <-+    parseRelFile (FP.addExtension pathA "hs")+      >>= T.readFile . toFilePath . (diffInputsDir </>)+  inputB <-+    parseRelFile (FP.addExtension pathB "hs")+      >>= T.readFile . toFilePath . (diffInputsDir </>)+  let expectedDiffPath = FP.addExtension name "txt"+  expectedDiffText <-+    parseRelFile expectedDiffPath+      >>= T.readFile . toFilePath . (diffOutputsDir </>)+  let Just actualDiff = diffText inputA inputB "TEST"+  actualDiffText <- printToText (\h -> printTextDiff h actualDiff)+  actualDiffText `shouldBe` expectedDiffText++-- | Print to a 'Text' value.+printToText :: (Handle -> IO ()) -> IO Text+printToText action =+  withSystemTempFile "ormolu-diff-test" $ \path h -> do+    action h+    hClose h+    T.readFile (toFilePath path)++diffTestsDir :: Path Rel Dir+diffTestsDir = $(mkRelDir "data/diff-tests")++diffInputsDir :: Path Rel Dir+diffInputsDir = diffTestsDir </> $(mkRelDir "inputs")++diffOutputsDir :: Path Rel Dir+diffOutputsDir = diffTestsDir </> $(mkRelDir "outputs")