ormolu 0.2.0.0 → 0.3.0.0

raw patch · 60 files changed

+980/−512 lines, 60 filesdep +Cabaldep +directoryPVP ok

version bump matches the API change (PVP)

Dependencies added: Cabal, directory

API changes (from Hackage documentation)

Files

• CHANGELOG.md +38/−2
• DESIGN.md +3/−3
• README.md +33/−26
• app/Main.hs +84/−38
• data/examples/declaration/data/gadt/multiline-where-out.hs +23/−0
• data/examples/declaration/data/gadt/multiline-where.hs +17/−0
• data/examples/declaration/value/function/arrow/proc-do-complex-out.hs +3/−0
• data/examples/declaration/value/function/arrow/proc-do-complex.hs +3/−0
• data/examples/declaration/value/function/arrow/proc-do-simple1-out.hs +1/−2
• data/examples/declaration/value/function/arrow/proc-do-simple2-out.hs +3/−2
• data/examples/declaration/value/function/arrow/proc-do-simple2.hs +2/−0
• data/examples/declaration/value/function/arrow/proc-forms2-out.hs +20/−15
• data/examples/declaration/value/function/arrow/proc-forms2.hs +5/−0
• data/examples/declaration/value/function/block-arguments-out.hs +2/−0
• data/examples/declaration/value/function/block-arguments.hs +2/−0
• data/examples/declaration/value/function/case-empty-out.hs +6/−0
• data/examples/declaration/value/function/case-empty.hs +6/−0
• data/examples/other/cpp/separation-0a-out.hs +0/−1
• data/examples/other/cpp/separation-0b-out.hs +0/−1
• data/examples/other/cpp/separation-1a-out.hs +0/−1
• data/examples/other/cpp/separation-1b-out.hs +0/−1
• data/examples/other/cpp/separation-2a-out.hs +0/−1
• data/examples/other/disabling/closing-comment-in-disabled-region-out.hs +3/−0
• data/examples/other/disabling/closing-comment-in-disabled-region.hs +3/−0
• data/examples/other/disabling/empty-disabled-region-out.hs +7/−0
• data/examples/other/disabling/empty-disabled-region.hs +7/−0
• data/examples/other/disabling/indented-fragment-out.hs +0/−7
• data/examples/other/disabling/indented-fragment.hs +0/−7
• data/examples/other/disabling/line-pragma-in-disabled-region-out.hs +7/−0
• data/examples/other/disabling/line-pragma-in-disabled-region.hs +7/−0
• data/examples/other/disabling/normalize-magic-comments-out.hs +8/−0
• data/examples/other/disabling/normalize-magic-comments.hs +8/−0
• data/examples/other/disabling/preserve-empty-lines-out.hs +11/−0
• data/examples/other/disabling/preserve-empty-lines.hs +12/−0
• data/examples/other/disabling/preserve-trailing-whitespace-out.hs +5/−0
• data/examples/other/disabling/preserve-trailing-whitespace.hs +5/−0
• data/parse-failures/disabling-preserves-error-location.hs +11/−0
• data/parse-failures/line-pragma.hs +5/−0
• ormolu.cabal +10/−5
• src/Ormolu.hs +13/−7
• src/Ormolu/Exception.hs +17/−0
• src/Ormolu/Parser.hs +27/−15
• src/Ormolu/Parser/CommentStream.hs +7/−20
• src/Ormolu/Parser/Result.hs +5/−19
• src/Ormolu/Parser/Shebang.hs +0/−27
• src/Ormolu/Printer.hs +21/−18
• src/Ormolu/Printer/Meat/Declaration/Data.hs +16/−15
• src/Ormolu/Printer/Meat/Declaration/Value.hs +77/−38
• src/Ormolu/Printer/Meat/Module.hs +1/−9
• src/Ormolu/Processing/Common.hs +62/−17
• src/Ormolu/Processing/Cpp.hs +43/−51
• src/Ormolu/Processing/Postprocess.hs +0/−31
• src/Ormolu/Processing/Preprocess.hs +126/−112
• src/Ormolu/Utils.hs +0/−13
• src/Ormolu/Utils/Extensions.hs +122/−0
• src/Ormolu/Utils/IO.hs +23/−0
• tests/Ormolu/CabalExtensionsSpec.hs +27/−0
• tests/Ormolu/Diff/TextSpec.hs +5/−5
• tests/Ormolu/Parser/ParseFailureSpec.hs +26/−0
• tests/Ormolu/PrinterSpec.hs +2/−3

@@ -1,3 +1,38 @@+## Ormolu 0.3.0.0++* Data declarations with multiline kind signatures are now formatted+  correctly. [Issue 749](https://github.com/tweag/ormolu/issues/749).++* Infix arrow command formations are formatted like usual operators.+  This fixes [Issue 748](https://github.com/tweag/ormolu/issues/748).++* `do` arrow commands are formatted more flexibly. Fixes [Issue+  753](https://github.com/tweag/ormolu/issues/753).++* Source code is always read and written using UTF8 and ignoring the native+  line ending conventions. [Issue+  717](https://github.com/tweag/ormolu/issues/717).++* Opt-in support to respect default-extensions and default-language+  from .cabal files. [Issue 517](https://github.com/tweag/ormolu/issues/517).++* Empty case expressions are now rendered with braces. [Issue+  765](https://github.com/tweag/ormolu/issues/765).++* Omit braces on repeated application of `do` blocks. [Issue+  735](https://github.com/tweag/ormolu/issues/735).++* Improved handling of disabled regions. [PR 773](+  https://github.com/tweag/ormolu/pull/773).+   * Disabled regions are now exactly preserved, in particular+     empty lines and trailing spaces. [Issue+     673](https://github.com/tweag/ormolu/issues/673).+   * Strings like `-}` can now be present in disabled regions.+     [Issue 708](https://github.com/tweag/ormolu/issues/708).+   * As a side effect, using the magic comments like in+     [Issue 601](https://github.com/tweag/ormolu/issues/601)+     is no longer supported.+ ## Ormolu 0.2.0.0  * Now standalone kind signatures are grouped with type synonyms. [Issue@@ -54,7 +89,7 @@   Previously, if an extension was disabled via the CLI, it could not be   re-enabled per file. -* `LexicalNegation` is no longer enabled by default. Also, spaces after+* `NegativeLiterals` is no longer enabled by default. Also, spaces after   negation via `-` are removed where possible. [Issue   694](https://github.com/tweag/ormolu/issues/694). @@ -64,7 +99,8 @@ * Added support for left-to-right arrow application. [Issue   737](https://github.com/tweag/ormolu/issues/737). -* Now `--mode check` fails on missing trailing blank lines.+* Now `--mode check` fails on missing trailing blank lines. [Issue+  743](https://github.com/tweag/ormolu/issues/743).  * Fixed indentation of arrow forms in do blocks. [Issue   739](https://github.com/tweag/ormolu/issues/739).

@@ -107,7 +107,7 @@ from the same upstream problems. I haven't studied the transformations it performs, but it looks like it transforms the parsed source code partially by manipulating AST and partially by manipulating raw text (e.g. to drop-trailing whitspace from each line). CPP Macros are just filtered out+trailing whitespace from each line). CPP Macros are just filtered out silently as a preprocessing step before feeding the code to `haskell-src-exts`. @@ -225,7 +225,7 @@ directives, constraining how directives can be inserted in Haskell code to avoid changing the meaning by reformatting. But this would introduce additional complexity, and the problem would-need to be solved repeteadly for every tool out there which wants+need to be solved repeatedly for every tool out there which wants to parse Haskell modules. If CPP is replaced with some language extension or mechanism to do conditional compilation, all tools will benefit from it.@@ -366,7 +366,7 @@ * An option to specify location of config file. * Options to specify parameters that come from config files on command line   instead (currently this is just dynamic options enabled by default, such-  as langauge extensions).+  as language extensions).  ### Why not contribute to/fork HIndent or Brittany? 

@@ -12,6 +12,7 @@     * [Editor integration](#editor-integration)     * [GitHub actions](#github-actions)     * [Magic comments](#magic-comments)+    * [Account for .cabal files](#account-for-cabal-files)     * [Exit codes](#exit-codes) * [Limitations](#limitations) * [Running on Hackage](#running-on-hackage)@@ -46,19 +47,20 @@ $ nix-build -A ormolu ``` -Or with `cabal-install` from the Nix shell:--```console-$ nix-shell --run "cabal new-build"-```+Note that you will need to add [IOHK Hydra binary+cache][iohk-hydra-binary-cache], otherwise building may take a very long+time. -Alternatively, `stack` could be used with a `stack.yaml` file as follows.+Alternatively, `stack` could be used with a `stack.yaml` file as follows:  ```console $ cat stack.yaml-resolver: lts-16.0+resolver: lts-18.6 packages: - '.'+extra-deps:+- Cabal-3.4.0.0+- ghc-lib-parser-9.0.1.20210324  $ stack build # to build $ stack install # to install@@ -67,25 +69,16 @@ To use Ormolu directly from GitHub with Nix, this snippet may come in handy:  ```nix-# This overlay adds Ormolu straight from GitHub.-self: super:--let source = super.fetchFromGitHub {+let+  pkgs = import <nixpkgs> { };+  source = pkgs.fetchFromGitHub {       owner = "tweag";       repo = "ormolu";-      rev = "de279d80122b287374d4ed87c7b630db1f157642"; # update as necessary-      sha256 = "0qrxfk62ww6b60ha9sqcgl4nb2n5fhf66a65wszjngwkybwlzmrv"; # same-    };-    ormolu = import source { pkgs = self; };-in {-  haskell = super.haskell // {-    packages = super.haskell.packages // {-      "${ormolu.ormoluCompiler}" = super.haskell.packages.${ormolu.ormoluCompiler}.override {-        overrides = ormolu.ormoluOverlay;-      };+      rev = "c1d8a8083cf1492545b8deed342c6399fe9873ea"; # update as necessary+      # do not forget to update the hash:+      sha256 = "sha256-3XxKuWqZnFa9s3mY7OBD+uEn/fGxPmC8jdevx7exy9o=";     };-  };-}+in (import source {  }).ormoluExe # this is e.g. the executable derivation ```  ### Arch Linux@@ -159,10 +152,21 @@ This allows us to disable formatting selectively for code between these markers or disable it for the entire file. To achieve the latter, just put `{- ORMOLU_DISABLE -}` at the very top. Note that for Ormolu to work the-source code must still be parseable even when the disabled regions are-omitted. Because of that the magic comments cannot be placed arbitrarily,-but rather must enclose independent top-level definitions.+fragments where Ormolu is enabled must be parseable on their own. Because of+that the magic comments cannot be placed arbitrarily, but rather must+enclose independent top-level definitions. +### Account for .cabal files++Many cabal and stack projects use `default-extensions` to enable GHC+language extensions in all source files. With the+`--cabal-default-extensions` flag, Ormolu will take them into consideration+during formatting.++When you format input from stdin, you can pass `--stdin-input-file` which+will give Ormolu the location of the Haskell source file that should be used+as the starting point for searching for a suitable .cabal file.+ ### Exit codes  Exit code | Meaning@@ -175,6 +179,8 @@ 5         | AST of original and formatted code differs 6         | Formatting is not idempotent 7         | Unrecognized GHC options+8         | Cabal file parsing failed+9         | Missing input file path when using stdin input and accounting for .cabal files 100       | In checking mode: unformatted files 101       | Inplace and check modes do not work with stdin 102       | Other issue (with multiple input files)@@ -213,6 +219,7 @@  Copyright © 2018–present Tweag I/O +[iohk-hydra-binary-cache]: https://input-output-hk.github.io/haskell.nix/tutorials/getting-started/#setting-up-the-binary-cache [aur]: https://aur.archlinux.org/packages/ormolu [contributing]: https://github.com/tweag/ormolu/blob/master/CONTRIBUTING.md [design-cpp]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp

@@ -6,6 +6,7 @@  module Main (main) where +import Control.Exception (throwIO) import Control.Monad import Data.Bool (bool) import Data.List (intercalate, sort)@@ -19,6 +20,8 @@ import Ormolu.Parser (manualExts) import Ormolu.Terminal import Ormolu.Utils (showOutputable)+import Ormolu.Utils.Extensions (getCabalExtensionDynOptions)+import Ormolu.Utils.IO import Paths_ormolu (version) import System.Exit (ExitCode (..), exitWith) import qualified System.FilePath as FP@@ -28,7 +31,7 @@ main :: IO () main = do   Opts {..} <- execParser optsParserInfo-  let formatOne' = formatOne optMode optConfig+  let formatOne' = formatOne optCabalDefaultExtensions optMode optConfig   exitCode <- case optInputFiles of     [] -> formatOne' Nothing     ["-"] -> formatOne' Nothing@@ -51,6 +54,8 @@  -- | Format a single input. formatOne ::+  -- | Whether to respect default-extensions from .cabal files+  CabalDefaultExtensionsOpts ->   -- | Mode of operation   Mode ->   -- | Configuration@@ -58,43 +63,57 @@   -- | File to format or stdin as 'Nothing'   Maybe FilePath ->   IO ExitCode-formatOne mode config mpath = withPrettyOrmoluExceptions (cfgColorMode config) $-  case FP.normalise <$> 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-              runTerm (printTextDiff diff) (cfgColorMode config) stderr-              -- 100 is different to all the other exit code that are emitted-              -- either from an 'OrmoluException' or from 'error' and-              -- 'notImplemented'.-              return (ExitFailure 100)+formatOne CabalDefaultExtensionsOpts {..} mode config mpath =+  withPrettyOrmoluExceptions (cfgColorMode config) $+    case FP.normalise <$> mpath of+      Nothing -> do+        extraDynOptions <-+          if optUseCabalDefaultExtensions+            then case optStdinInputFile of+              Just stdinInputFile ->+                getCabalExtensionDynOptions stdinInputFile+              Nothing -> throwIO OrmoluMissingStdinInputFile+            else pure []+        r <- ormoluStdin (configPlus extraDynOptions)+        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+        extraDynOptions <-+          if optUseCabalDefaultExtensions+            then getCabalExtensionDynOptions inputFile+            else pure []+        originalInput <- readFileUtf8 inputFile+        formattedInput <- ormoluFile (configPlus extraDynOptions) 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) $+              writeFileUtf8 inputFile formattedInput+            return ExitSuccess+          Check ->+            case diffText originalInput formattedInput inputFile of+              Nothing -> return ExitSuccess+              Just diff -> do+                runTerm (printTextDiff diff) (cfgColorMode config) stderr+                -- 100 is different to all the other exit code that are emitted+                -- either from an 'OrmoluException' or from 'error' and+                -- 'notImplemented'.+                return (ExitFailure 100)+  where+    configPlus dynOpts = config {cfgDynOptions = cfgDynOptions config ++ dynOpts}  ---------------------------------------------------------------------------- -- Command line options parsing@@ -104,6 +123,8 @@     optMode :: !Mode,     -- | Ormolu 'Config'     optConfig :: !(Config RegionIndices),+    -- | Options for respecting default-extensions from .cabal files+    optCabalDefaultExtensions :: CabalDefaultExtensionsOpts,     -- | Haskell source files to format or stdin (when the list is empty)     optInputFiles :: ![FilePath]   }@@ -119,6 +140,17 @@     Check   deriving (Eq, Show) +-- | Configuration for how to account for default-extension+-- from .cabal files+data CabalDefaultExtensionsOpts = CabalDefaultExtensionsOpts+  { -- | Account for default-extensions from .cabal files+    optUseCabalDefaultExtensions :: Bool,+    -- | Optional path to a file which will be used to+    -- find a .cabal file when using input from stdin+    optStdinInputFile :: Maybe FilePath+  }+  deriving (Show)+ optsParserInfo :: ParserInfo Opts optsParserInfo =   info (helper <*> ver <*> exts <*> optsParser) . mconcat $@@ -166,9 +198,23 @@               ]         )     <*> configParser+    <*> cabalDefaultExtensionsParser     <*> (many . strArgument . mconcat)       [ metavar "FILE",         help "Haskell source files to format or stdin (the default)"+      ]++cabalDefaultExtensionsParser :: Parser CabalDefaultExtensionsOpts+cabalDefaultExtensionsParser =+  CabalDefaultExtensionsOpts+    <$> (switch . mconcat)+      [ short 'e',+        long "cabal-default-extensions",+        help "Account for default-extensions from .cabal files"+      ]+    <*> (optional . strOption . mconcat)+      [ long "stdin-input-file",+        help "Path which will be used to find the .cabal file when using input from stdin"       ]  configParser :: Parser (Config RegionIndices)

@@ -5,3 +5,26 @@     c   where   Foo :: a -> b -> c -> Foo a b c++data+  Foo ::+    Type ->+    Type ->+    Type+  where+  Foo :: Foo a b++data+  Foo a b c ::+    Type -> Type -> Type -> Type+  where+  Foo :: Foo a b c++data+  Vec ::+    Type ->+    Type ->+    Type+  where+  Nil :: Vec a Ze+  Cons :: a -> Vec a n -> Vec a (Su n)

@@ -4,3 +4,20 @@     b     c where   Foo :: a -> b -> c -> Foo a b c++data Foo :: Type+         -> Type+         -> Type where+  Foo :: Foo a b++data Foo a b c ::+  Type -> Type -> Type -> Type where+  Foo :: Foo a b c++data Vec+  :: Type+  -> Type+  -> Type+  where+    Nil  :: Vec a Ze+    Cons :: a -> Vec a n -> Vec a (Su n)

@@ -60,3 +60,6 @@                   + x                   * y -- Just do the calculation               )++traverseA_ f = proc (e, (xs, s)) ->+  (| foldlA' (\() x -> do (e, (x, s)) >- f; () >- returnA) |) () xs

@@ -47,3 +47,6 @@           returnA -< (i +                       x *                       y) -- Just do the calculation++traverseA_ f = proc (e, (xs, s)) ->+  (| foldlA' (\() x -> do { (e, (x, s)) >- f; () >- returnA }) |) () xs

@@ -1,7 +1,6 @@ {-# LANGUAGE Arrows #-} -bar f = proc a -> do-  b <- f -< a+bar f = proc a -> do b <- f -< a  barbar f g = proc a -> do   b <- f -< a

@@ -1,7 +1,6 @@ {-# LANGUAGE Arrows #-} -foo f = proc a -> do-  f -< a+foo f = proc a -> do f -< a  bazbaz f g h = proc (a, b, c) -> do   x <-@@ -20,3 +19,5 @@   returnA     -<       (x, y, z)++bar f = proc x -> do { f -< x } <+> do f -< x

@@ -18,3 +18,5 @@        )      returnA -<        (x, y, z)++bar f = proc x -> do {f -< x} <+> do f -< x

@@ -15,27 +15,32 @@     ( (h f . h g)         -<           (y x) . y z-    ) |||-      ( (h g . h f)-          -<-            y z . (y x)-      )+    )+      ||| ( (h g . h f)+              -<+                y z . (y x)+          )  bar4 = proc x ->   case x of     Just f -> f -< ()     Nothing -> x -< ()-  <+> do-    g -< x+    <+> do+      g -< x  expr' = proc x ->   do     returnA -< x-  <+> do-    symbol Plus -< ()-    y <- term -< ()-    expr' -< x + y-  <+> do-    symbol Minus -< ()-    y <- term -< ()-    expr' -< x - y+    <+> do+      symbol Plus -< ()+      y <- term -< ()+      expr' -< x + y+    <+> do+      symbol Minus -< ()+      y <- term -< ()+      expr' -< x - y++bar f = proc (a, b) -> do+  (f a -< b)+    >-> (\y -> f b >- a)+    >-> (\y -> f b >- a)

@@ -34,3 +34,8 @@                 symbol Minus -< ()                 y <- term -< ()                 expr' -< x - y++bar f = proc (a, b) -> do+    (f a -< b)+      >-> (\y -> f b >- a)+      >-> (\y -> f b >- a)

@@ -32,3 +32,5 @@   do a   do b   do c++f11 = do a do b do c do d

@@ -28,3 +28,5 @@   do { a }   do { b }   do c++f11 = do a do b do c do d

@@ -0,0 +1,6 @@+absurd x = case x of {}+absurd = \case {}+absurd x = case x of {}+absurd = \case {}++foo = case () of {} 1

@@ -0,0 +1,6 @@+absurd x = case x of+absurd = \case+absurd x = case x of {}+absurd = \case {}++foo = case () of {} 1

@@ -1,7 +1,6 @@ instance Stream s => Monad (ParsecT e s m) where   return = pure   (>>=) = pBind- #if !(MIN_VERSION_base(4,13,0))   fail   = Fail.fail #endif

@@ -1,7 +1,6 @@ instance Stream s => Monad (ParsecT e s m) where   return = pure   (>>=) = pBind- #if !(MIN_VERSION_base(4,13,0))   fail   = Fail.fail #endif

@@ -4,7 +4,6 @@   ConduitT ByteString ByteString m () decompressingPipe Store = C.awaitForever C.yield decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15)- #ifdef ENABLE_BZIP2 decompressingPipe BZip2   = BZ.bunzip2 #else

@@ -4,7 +4,6 @@   ConduitT ByteString ByteString m () decompressingPipe Store = C.awaitForever C.yield decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15)- #ifdef ENABLE_BZIP2 decompressingPipe BZip2   = BZ.bunzip2 #else

@@ -1,5 +1,4 @@ ffff, ffffffff :: Natural- #ifdef HASKELL_ZIP_DEV_MODE ffff     = 200 ffffffff = 5000

@@ -0,0 +1,3 @@+{- ORMOLU_DISABLE -}+a::String+a="-}"

@@ -0,0 +1,3 @@+{- ORMOLU_DISABLE -}+a::String+a="-}"

@@ -0,0 +1,7 @@+{- ORMOLU_DISABLE -}+{- ORMOLU_ENABLE -}+foo = 0+{- ORMOLU_DISABLE -}+{- ORMOLU_ENABLE -}+bar = 1+{- ORMOLU_DISABLE -}

@@ -0,0 +1,7 @@+{- ORMOLU_DISABLE -}+{- ORMOLU_ENABLE -}+foo = 0+{- ORMOLU_DISABLE -}+{- ORMOLU_ENABLE -}+bar = 1+{- ORMOLU_DISABLE -}

@@ -1,7 +0,0 @@-foo =-  {- ORMOLU_DISABLE -}-  testCase "Foo" testFoo :-  testCase "Bar" testBar :-  testCase "Baz" testBaz :-  {- ORMOLU_ENABLE -}-  []

@@ -1,7 +0,0 @@-foo =-    {- ORMOLU_DISABLE -}-    testCase "Foo" testFoo :-    testCase "Bar" testBar :-    testCase "Baz" testBaz :-    {- ORMOLU_ENABLE -}-    []

@@ -0,0 +1,7 @@+module Foo (foo) where++{- ORMOLU_DISABLE -}+foo=+{-# LINE 11 "Abc.hs" #-}+  this . line $ ((is automatically generated) Haskell<>code)+{- ORMOLU_ENABLE -}

@@ -0,0 +1,7 @@+module Foo(foo) where ++{- ORMOLU_DISABLE -}+foo=+{-# LINE 11 "Abc.hs" #-}+  this . line $ ((is automatically generated) Haskell<>code)+{- ORMOLU_ENABLE -}

@@ -0,0 +1,8 @@+{- ORMOLU_DISABLE -}+  {-  ORMOLU_DISABLE   -}+foo=bar+{- ORMOLU_ENABLE -}+{-ORMOLU_ENABLE     -}+bar = baz+{- ORMOLU_DISABLE -}+baz=foo

@@ -0,0 +1,8 @@+  {-ORMOLU_DISABLE   -}+  {-  ORMOLU_DISABLE   -}+foo=bar+{-   ORMOLU_ENABLE-}+    {-ORMOLU_ENABLE     -}+bar=baz+{-   ORMOLU_DISABLE-}+baz=foo

@@ -0,0 +1,11 @@+{- ORMOLU_DISABLE -}+bar :: Int+bar = 2+++baz :: Int+baz = 3+{- ORMOLU_ENABLE -}++foo :: Int+foo = 1

@@ -0,0 +1,12 @@+{- ORMOLU_DISABLE -}+bar :: Int+bar = 2+++baz :: Int+baz = 3+{- ORMOLU_ENABLE -}+++foo :: Int+foo = 1

@@ -0,0 +1,5 @@+foo = 2++{- ORMOLU_DISABLE -}+bar = 3  +{- ORMOLU_ENABLE -}

@@ -0,0 +1,5 @@+foo = 2  ++{- ORMOLU_DISABLE -}+bar = 3  +{- ORMOLU_ENABLE -}

@@ -0,0 +1,11 @@+module Main (main) where++{- ORMOLU_DISABLE -}+foo Int+foo Int+foo 5 EU>>>>++{- ORMOLU_ENABLE -}++main :: IO ()+main = return <<<

@@ -0,0 +1,5 @@+module Foo (foo,bar,baz) where+bar = foo+{-# LINE 113 "Abc.hs" #-}+foo = (some <$> ( automatically $ generated ))))))))) invalid Haskell code+baz = bar

@@ -1,10 +1,10 @@ cabal-version:      2.4 name:               ormolu-version:            0.2.0.0+version:            0.3.0.0 license:            BSD-3-Clause license-file:       LICENSE.md maintainer:         Mark Karpov <mark.karpov@tweag.io>-tested-with:        ghc ==8.8.4 ghc ==8.10.4 ghc ==9.0.1+tested-with:        ghc ==8.8.4 ghc ==8.10.7 ghc ==9.0.1 homepage:           https://github.com/tweag/ormolu bug-reports:        https://github.com/tweag/ormolu/issues synopsis:           A formatter for Haskell source code@@ -43,7 +43,6 @@         Ormolu.Parser.CommentStream         Ormolu.Parser.Pragma         Ormolu.Parser.Result-        Ormolu.Parser.Shebang         Ormolu.Printer         Ormolu.Printer.Combinators         Ormolu.Printer.Comments@@ -72,10 +71,11 @@         Ormolu.Printer.SpanStream         Ormolu.Processing.Common         Ormolu.Processing.Cpp-        Ormolu.Processing.Postprocess         Ormolu.Processing.Preprocess         Ormolu.Terminal         Ormolu.Utils+        Ormolu.Utils.Extensions+        Ormolu.Utils.IO      hs-source-dirs:   src     other-modules:    GHC.DynFlags@@ -91,7 +91,10 @@         ghc-lib-parser >=9.0 && <9.1,         mtl >=2.0 && <3.0,         syb >=0.7 && <0.8,-        text >=0.2 && <1.3+        text >=0.2 && <1.3,+        filepath >=1.2 && <1.5,+        directory ^>=1.3,+        Cabal ^>=3.4      if flag(dev)         ghc-options:@@ -135,8 +138,10 @@     build-tool-depends: hspec-discover:hspec-discover >=2.0 && <3.0     hs-source-dirs:     tests     other-modules:+        Ormolu.CabalExtensionsSpec         Ormolu.Diff.TextSpec         Ormolu.Parser.OptionsSpec+        Ormolu.Parser.ParseFailureSpec         Ormolu.Parser.PragmaSpec         Ormolu.PrinterSpec 

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}  -- | A formatter for Haskell source code. module Ormolu@@ -31,6 +32,7 @@ import Ormolu.Parser.Result import Ormolu.Printer import Ormolu.Utils (showOutputable)+import Ormolu.Utils.IO  -- | Format a 'String', return formatted version as 'Text'. --@@ -59,7 +61,6 @@   when (cfgDebug cfg) $ do     traceM "warnings:\n"     traceM (concatMap showWarn warnings)-    traceM (prettyPrintParseResult result0)   -- We're forcing 'txt' here because otherwise errors (such as messages   -- about not-yet-supported functionality) will be thrown later when we try   -- to parse the rendered code back, inside of GHC monad wrapper which will@@ -74,10 +75,15 @@         OrmoluOutputParsingFailed         path         (T.unpack txt)-    unless (cfgUnsafe cfg) $-      case diffParseResult result0 result1 of-        Same -> return ()-        Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss)+    unless (cfgUnsafe cfg) $ do+      when (length result0 /= length result1) $+        liftIO $ throwIO (OrmoluASTDiffers path [])+      forM_ (result0 `zip` result1) $ \case+        (ParsedSnippet s, ParsedSnippet s') -> case diffParseResult s s' of+          Same -> return ()+          Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss)+        (RawSnippet {}, RawSnippet {}) -> pure ()+        _ -> liftIO $ throwIO (OrmoluASTDiffers path [])     -- Try re-formatting the formatted result to check if we get exactly     -- the same output.     when (cfgCheckIdempotence cfg) $@@ -103,7 +109,7 @@   -- | Resulting rendition   m Text ormoluFile cfg path =-  liftIO (readFile path) >>= ormolu cfg path+  readFileUtf8 path >>= ormolu cfg path . T.unpack  -- | Read input from stdin and format it. --@@ -132,7 +138,7 @@   FilePath ->   -- | Actual input for the parser   String ->-  m ([GHC.Warn], ParseResult)+  m ([GHC.Warn], [SourceSnippet]) parseModule' cfg mkException path str = do   (warnings, r) <- parseModule cfg path str   case r of

@@ -32,6 +32,11 @@     OrmoluNonIdempotentOutput TextDiff   | -- | Some GHC options were not recognized     OrmoluUnrecognizedOpts (NonEmpty String)+  | -- | Cabal file parsing failed+    OrmoluCabalFileParsingFailed FilePath+  | -- | Missing input file path when using stdin input and+    -- accounting for .cabal files+    OrmoluMissingStdinInputFile   deriving (Eq, Show)  instance Exception OrmoluException@@ -80,6 +85,16 @@     put "  "     (putS . unwords . NE.toList) opts     newline+  OrmoluCabalFileParsingFailed cabalFile -> do+    put "Parsing this .cabal file failed:"+    newline+    put $ "  " <> T.pack cabalFile+    newline+  OrmoluMissingStdinInputFile -> do+    put "The --stdin-input-file option is necessary when using input"+    newline+    put "from stdin and accounting for .cabal files"+    newline  -- | Inside this wrapper 'OrmoluException' will be caught and displayed -- nicely.@@ -102,3 +117,5 @@           OrmoluASTDiffers {} -> 5           OrmoluNonIdempotentOutput {} -> 6           OrmoluUnrecognizedOpts {} -> 7+          OrmoluCabalFileParsingFailed {} -> 8+          OrmoluMissingStdinInputFile {} -> 9

@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -10,11 +11,11 @@ where  import Control.Exception-import Control.Monad.IO.Class+import Control.Monad.Except+import Data.Functor import qualified Data.List as L import qualified Data.List.NonEmpty as NE import Data.Ord (Down (Down))-import qualified Data.Text as T import GHC.Data.Bag (bagToList) import qualified GHC.Data.FastString as GHC import qualified GHC.Data.StringBuffer as GHC@@ -35,8 +36,9 @@ import Ormolu.Parser.Anns import Ormolu.Parser.CommentStream import Ormolu.Parser.Result-import Ormolu.Processing.Preprocess (preprocess)-import Ormolu.Utils (incSpanLine, removeIndentation)+import Ormolu.Processing.Common+import Ormolu.Processing.Preprocess+import Ormolu.Utils (incSpanLine)  -- | Parse a complete module from string. parseModule ::@@ -49,12 +51,9 @@   String ->   m     ( [GHC.Warn],-      Either (SrcSpan, String) ParseResult+      Either (SrcSpan, String) [SourceSnippet]     )-parseModule Config {..} path rawInput = liftIO $ do-  let (literalPrefix, indentedInput, literalSuffix, extraComments) =-        preprocess path rawInput cfgRegion-      (input, indent) = removeIndentation indentedInput+parseModule config@Config {..} path rawInput = liftIO $ do   -- It's important that 'setDefaultExts' is done before   -- 'parsePragmasIntoDynFlags', because otherwise we might enable an   -- extension that was explicitly disabled in the file.@@ -72,6 +71,22 @@                 (mkSrcLoc (GHC.mkFastString path) 1 1)                 (mkSrcLoc (GHC.mkFastString path) 1 1)          in throwIO (OrmoluParsingFailed loc err)+  snippets <- runExceptT . forM (preprocess cfgRegion rawInput) $ \case+    Right region ->+      fmap ParsedSnippet . ExceptT $+        parseModuleSnippet (config $> region) dynFlags path rawInput+    Left raw -> pure $ RawSnippet raw+  pure (warnings, snippets)++parseModuleSnippet ::+  MonadIO m =>+  Config RegionDeltas ->+  DynFlags ->+  FilePath ->+  String ->+  m (Either (SrcSpan, String) ParseResult)+parseModuleSnippet Config {..} dynFlags path rawInput = liftIO $ do+  let (input, indent) = removeIndentation . linesInRegion cfgRegion $ rawInput   let useRecordDot =         "record-dot-preprocessor" == pgm_F dynFlags           || any@@ -98,23 +113,20 @@             -- later stages; but we fail in those cases.             Just err -> Left err             Nothing ->-              let (stackHeader, shebangs, pragmas, comments) =-                    mkCommentStream input extraComments pstate+              let (stackHeader, pragmas, comments) =+                    mkCommentStream input pstate                in Right                     ParseResult                       { prParsedSource = hsModule,                         prAnns = mkAnns pstate,                         prStackHeader = stackHeader,-                        prShebangs = shebangs,                         prPragmas = pragmas,                         prCommentStream = comments,                         prUseRecordDot = useRecordDot,                         prExtensions = GHC.extensionFlags dynFlags,-                        prLiteralPrefix = T.pack literalPrefix,-                        prLiteralSuffix = T.pack literalSuffix,                         prIndent = indent                       }-  return (warnings, r)+  return r  -- | Enable all language extensions that we think should be enabled by -- default for ease of use.

@@ -27,8 +27,6 @@ import qualified GHC.Parser.Lexer as GHC import GHC.Types.SrcLoc import Ormolu.Parser.Pragma-import Ormolu.Parser.Shebang-import Ormolu.Processing.Common import Ormolu.Utils (onTheSameLine, showOutputable)  ----------------------------------------------------------------------------@@ -39,25 +37,20 @@ newtype CommentStream = CommentStream [RealLocated Comment]   deriving (Eq, Data, Semigroup, Monoid) --- | Create 'CommentStream' from 'GHC.PState'. The pragmas and shebangs are--- removed from the 'CommentStream'. Shebangs are only extracted from the--- comments that come from the first argument.+-- | Create 'CommentStream' from 'GHC.PState'. The pragmas are+-- removed from the 'CommentStream'. mkCommentStream ::   -- | Original input   String ->-  -- | Extra comments to include-  [RealLocated String] ->   -- | Parser state to use for comment extraction   GHC.PState ->-  -- | Stack header, shebangs, pragmas, and comment stream+  -- | Stack header, pragmas, and comment stream   ( Maybe (RealLocated Comment),-    [Shebang],     [([RealLocated Comment], Pragma)],     CommentStream   )-mkCommentStream input extraComments pstate =+mkCommentStream input pstate =   ( mstackHeader,-    shebangs,     pragmas,     CommentStream comments   )@@ -66,12 +59,10 @@     (rawComments1, mstackHeader) = extractStackHeader rawComments0     rawComments0 =       L.sortOn (realSrcSpanStart . getRealSrcSpan) $-        otherExtraComments-          ++ mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate)+        mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate)           ++ concatMap             (mapMaybe (liftMaybe . fmap unAnnotationComment) . snd)             (GHC.annotations_comments pstate)-    (shebangs, otherExtraComments) = extractShebangs extraComments  -- | Pretty-print a 'CommentStream'. showCommentStream :: CommentStream -> String@@ -110,15 +101,11 @@             Nothing -> s :| []             Just (x :| xs) ->               let getIndent y =-                    if all isSpace y || y == endDisabling+                    if all isSpace y                       then startIndent                       else length (takeWhile isSpace y)                   n = minimum (startIndent : fmap getIndent xs)-                  removeIndent y =-                    if y == endDisabling-                      then y-                      else drop n y-               in x :| (removeIndent <$> xs)+               in x :| (drop n <$> xs)           else s :| []     (atomsBefore, ls') =       case dropWhile ((< commentLine) . fst) ls of

@@ -2,8 +2,8 @@  -- | A type for result of parsing. module Ormolu.Parser.Result-  ( ParseResult (..),-    prettyPrintParseResult,+  ( SourceSnippet (..),+    ParseResult (..),   ) where @@ -15,8 +15,10 @@ import Ormolu.Parser.Anns import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma (Pragma)-import Ormolu.Parser.Shebang (Shebang) +-- | Either a 'ParseResult', or a raw snippet.+data SourceSnippet = RawSnippet Text | ParsedSnippet ParseResult+ -- | A collection of data that represents a parsed module in Ormolu. data ParseResult = ParseResult   { -- | 'ParsedSource' from GHC@@ -25,8 +27,6 @@     prAnns :: Anns,     -- | Stack header     prStackHeader :: Maybe (RealLocated Comment),-    -- | Shebangs found in the input-    prShebangs :: [Shebang],     -- | Pragmas and the associated comments     prPragmas :: [([RealLocated Comment], Pragma)],     -- | Comment stream@@ -35,20 +35,6 @@     prUseRecordDot :: Bool,     -- | Enabled extensions     prExtensions :: EnumSet Extension,-    -- | Literal prefix-    prLiteralPrefix :: Text,-    -- | Literal suffix-    prLiteralSuffix :: Text,     -- | Indentation level, can be non-zero in case of region formatting     prIndent :: Int   }---- | Pretty-print a 'ParseResult'.-prettyPrintParseResult :: ParseResult -> String-prettyPrintParseResult ParseResult {..} =-  unlines-    [ "parse result:",-      "  comment stream:",-      showCommentStream prCommentStream-      -- XXX extend as needed-    ]

@@ -1,27 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}---- | A module for dealing with shebangs.-module Ormolu.Parser.Shebang-  ( Shebang (..),-    extractShebangs,-    isShebang,-  )-where--import Data.Data (Data)-import qualified Data.List as L-import GHC.Types.SrcLoc---- | A wrapper for a shebang.-newtype Shebang = Shebang (RealLocated String)-  deriving (Eq, Data)---- | Extract shebangs from the beginning of a comment stream.-extractShebangs :: [RealLocated String] -> ([Shebang], [RealLocated String])-extractShebangs comments = (Shebang <$> shebangs, rest)-  where-    (shebangs, rest) = span (isShebang . unLoc) comments---- | Return 'True' if given 'String' is a shebang.-isShebang :: String -> Bool-isShebang str = "#!" `L.isPrefixOf` str

@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  -- | Pretty-printer for Haskell AST.@@ -7,32 +9,33 @@ where  import Data.Text (Text)+import qualified Data.Text as T import Ormolu.Parser.Result import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Module import Ormolu.Printer.SpanStream-import Ormolu.Processing.Postprocess (postprocess)+import Ormolu.Processing.Common  -- | Render a module. printModule ::   -- | Result of parsing-  ParseResult ->+  [SourceSnippet] ->   -- | Resulting rendition   Text-printModule ParseResult {..} =-  prLiteralPrefix <> region <> prLiteralSuffix+printModule = T.concat . fmap printSnippet   where-    region =-      postprocess prIndent $-        runR-          ( p_hsModule-              prStackHeader-              prShebangs-              prPragmas-              prParsedSource-          )-          (mkSpanStream prParsedSource)-          prCommentStream-          prAnns-          prUseRecordDot-          prExtensions+    printSnippet = \case+      ParsedSnippet ParseResult {..} ->+        reindent prIndent $+          runR+            ( p_hsModule+                prStackHeader+                prPragmas+                prParsedSource+            )+            (mkSpanStream prParsedSource)+            prCommentStream+            prAnns+            prUseRecordDot+            prExtensions+      RawSnippet r -> r

@@ -53,26 +53,27 @@       p_sourceText type_       txt " #-}"   let constructorSpans = getLoc name : fmap lhsTypeArgSrcSpan tpats-  switchLayout constructorSpans $ do+      sigSpans = maybeToList . fmap getLoc $ dd_kindSig+      declHeaderSpans = constructorSpans ++ sigSpans+  switchLayout declHeaderSpans $ do     breakpoint-    inci $-      p_infixDefHelper-        (isInfix fixity)-        True-        (p_rdrName name)-        (p_lhsTypeArg <$> tpats)-  case dd_kindSig of-    Nothing -> return ()-    Just k -> do-      space-      txt "::"-      space-      located k p_hsType+    inci $ do+      switchLayout constructorSpans $+        p_infixDefHelper+          (isInfix fixity)+          True+          (p_rdrName name)+          (p_lhsTypeArg <$> tpats)+      forM_ dd_kindSig $ \k -> do+        space+        txt "::"+        breakpoint+        inci $ located k p_hsType   let gadt = isJust dd_kindSig || any (isGadt . unLoc) dd_cons   unless (null dd_cons) $     if gadt       then inci $ do-        switchLayout constructorSpans $ do+        switchLayout declHeaderSpans $ do           breakpoint           txt "where"         breakpoint

@@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-}@@ -107,11 +108,13 @@   -- | Match group   MatchGroup GhcPs (Located body) ->   R ()-p_matchGroup' placer render style MG {..} = do+p_matchGroup' placer render style mg@MG {..} = do   let ob = case style of-        Case -> id-        LambdaCase -> id+        Case -> bracesIfEmpty+        LambdaCase -> bracesIfEmpty         _ -> dontUseBraces+        where+          bracesIfEmpty = if isEmptyMatchGroup mg then useBraces else id   -- Since we are forcing braces on 'sepSemi' based on 'ob', we have to   -- restore the brace state inside the sepsemi.   ub <- bool dontUseBraces useBraces <$> canUseBraces@@ -335,14 +338,9 @@     unless (null cmds) $ do       breakpoint       inci (sequence_ (intersperse breakpoint (located' p_hsCmdTop <$> cmds)))-  HsCmdArrForm NoExtField form Infix _ [left, right] -> do-    located left p_hsCmdTop-    case unLoc left of-      HsCmdTop NoExtField (L _ HsCmdPar {}) -> space-      _ -> breakpoint-    located form p_hsExpr-    placeHanging (cmdTopPlacement (unLoc right)) $-      located right p_hsCmdTop+  HsCmdArrForm NoExtField form Infix _ [left, right] ->+    let opTree = OpBranch (cmdOpTree left) form (cmdOpTree right)+     in p_cmdOpTree (reassociateOpTree getOpName opTree)   HsCmdArrForm NoExtField _ Infix _ _ -> notImplemented "HsCmdArrForm"   HsCmdApp NoExtField cmd expr -> do     located cmd (p_hsCmd' s)@@ -360,9 +358,7 @@     p_let p_hsCmd localBinds c   HsCmdDo NoExtField es -> do     txt "do"-    newline-    inci . located es $-      sitcc . sep newline (sitcc . withSpacing (p_stmt' cmdPlacement (p_hsCmd' S)))+    p_stmts cmdPlacement (p_hsCmd' S) es  p_hsCmdTop :: HsCmdTop GhcPs -> R () p_hsCmdTop (HsCmdTop NoExtField cmd) = located cmd p_hsCmd@@ -465,6 +461,22 @@     space     sitcc $ sepSemi (withSpacing (p_stmt' placer render)) recS_stmts +p_stmts ::+  Data body =>+  -- | Placer+  (body -> Placement) ->+  -- | Render+  (body -> R ()) ->+  -- | Statements to render+  Located [Located (Stmt GhcPs (Located body))] ->+  R ()+p_stmts placer render es = do+  breakpoint+  ub <- layoutToBraces <$> getLayout+  inci . located es $+    sepSemi+      (ub . withSpacing (p_stmt' placer render))+ gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]] gatherStmt (L _ (ParStmt NoExtField block _ _)) =   foldr ((<>) . gatherStmtBlock) [] block@@ -612,7 +624,7 @@           located func (p_hsExpr' s)           breakpoint           sep breakpoint (located' p_hsExpr) initp-        placeHanging placement $+        placeHanging placement . dontUseBraces $           located lastp p_hsExpr   HsAppType NoExtField e a -> do     located e p_hsExpr@@ -687,12 +699,7 @@     let doBody moduleName header = do           forM_ moduleName $ \m -> atom m *> txt "."           txt header-          breakpoint-          ub <- layoutToBraces <$> getLayout-          inci $-            sepSemi-              (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))-              (unLoc es)+          p_stmts exprPlacement (p_hsExpr' S) es         compBody = brackets N . located es $ \xs -> do           let p_parBody =                 sep@@ -1297,28 +1304,14 @@   R () p_exprOpTree s (OpNode x) = located x (p_hsExpr' s) p_exprOpTree s (OpBranch x op y) = do-  -- If the beginning of the first argument and the second argument are on-  -- the same line, and the second argument has a hanging form, use hanging-  -- placement.-  let placement =-        if isOneLineSpan-          (mkSrcSpan (srcSpanStart (opTreeLoc x)) (srcSpanStart (opTreeLoc y)))-          then case y of-            OpNode (L _ n) -> exprPlacement n-            _ -> Normal-          else Normal+  let placement = opBranchPlacement exprPlacement x y       -- Distinguish holes used in infix notation.       -- eg. '1 _foo 2' and '1 `_foo` 2'       opWrapper = case unLoc op of         HsUnboundVar NoExtField _ -> backticks         _ -> id-  layout <- getLayout-  let ub = case layout of-        SingleLine -> useBraces-        MultiLine -> case placement of-          Hanging -> useBraces-          Normal -> dontUseBraces-      opNameStr = (fmap getOpNameStr . getOpName . unLoc) op+  ub <- opBranchBraceStyle placement+  let opNameStr = (fmap getOpNameStr . getOpName . unLoc) op       gotDollar = opNameStr == Just "$"       gotColon = opNameStr == Just ":"       gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)@@ -1366,6 +1359,52 @@           p_op           space           p_y++pattern CmdTopCmd :: HsCmd GhcPs -> LHsCmdTop GhcPs+pattern CmdTopCmd cmd <- (L _ (HsCmdTop NoExtField (L _ cmd)))++cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)+cmdOpTree = \case+  CmdTopCmd (HsCmdArrForm NoExtField op Infix _ [x, y]) ->+    OpBranch (cmdOpTree x) op (cmdOpTree y)+  n -> OpNode n++p_cmdOpTree :: OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) -> R ()+p_cmdOpTree = \case+  OpNode n -> located n p_hsCmdTop+  OpBranch x op y -> do+    let placement = opBranchPlacement cmdTopPlacement x y+    ub <- opBranchBraceStyle placement+    ub $ p_cmdOpTree x+    placeHanging placement $ do+      located op p_hsExpr+      space+      p_cmdOpTree y++opBranchPlacement ::+  -- | Placement of nodes+  (ty -> Placement) ->+  -- | Left branch+  OpTree (Located ty) op ->+  -- | Right branch+  OpTree (Located ty) op ->+  Placement+opBranchPlacement f x y+  -- If the beginning of the first argument and the second argument are on+  -- the same line, and the second argument has a hanging form, use hanging+  -- placement.+  | isOneLineSpan (mkSrcSpan (srcSpanStart (opTreeLoc x)) (srcSpanStart (opTreeLoc y))),+    OpNode (L _ n) <- y =+    f n+  | otherwise = Normal++opBranchBraceStyle :: Placement -> R (R () -> R ())+opBranchBraceStyle placement =+  getLayout <&> \case+    SingleLine -> useBraces+    MultiLine -> case placement of+      Hanging -> useBraces+      Normal -> dontUseBraces  -- | Return 'True' if given expression is a record-dot operator expression. isRecordDot ::

@@ -9,13 +9,11 @@ where  import Control.Monad-import qualified Data.Text as T import GHC.Hs import GHC.Types.SrcLoc import Ormolu.Imports (normalizeImports) import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma-import Ormolu.Parser.Shebang import Ormolu.Printer.Combinators import Ormolu.Printer.Comments import Ormolu.Printer.Meat.Common@@ -28,21 +26,15 @@ p_hsModule ::   -- | Stack header   Maybe (RealLocated Comment) ->-  -- | Shebangs-  [Shebang] ->   -- | Pragmas and the associated comments   [([RealLocated Comment], Pragma)] ->   -- | AST to print   HsModule ->   R ()-p_hsModule mstackHeader shebangs pragmas HsModule {..} = do+p_hsModule mstackHeader pragmas HsModule {..} = do   let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage       exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports   switchLayout (deprecSpan <> exportSpans) $ do-    forM_ shebangs $ \(Shebang x) ->-      realLocated x $ \shebang -> do-        txt (T.pack shebang)-        newline     forM_ mstackHeader $ \(L spn comment) -> do       spitCommentNow spn comment       newline

@@ -1,27 +1,72 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}  -- | Common definitions for pre- and post- processing. module Ormolu.Processing.Common-  ( OrmoluState (..),-    startDisabling,-    endDisabling,+  ( removeIndentation,+    reindent,+    linesInRegion,+    regionInbetween,+    intSetToRegions,   ) where -import Data.String (IsString (..))+import Data.Char (isSpace)+import Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet+import Data.Text (Text)+import qualified Data.Text as T+import Ormolu.Config --- | Ormolu state.-data OrmoluState-  = -- | Enabled-    OrmoluEnabled-  | -- | Disabled-    OrmoluDisabled-  deriving (Eq, Show)+-- | Remove indentation from a given 'String'. Return the input with+-- indentation removed and the detected indentation level.+removeIndentation :: String -> (String, Int)+removeIndentation (lines -> xs) = (unlines (drop n <$> xs), n)+  where+    n = minimum (getIndent <$> xs)+    getIndent y =+      if all isSpace y+        then 0+        else length (takeWhile isSpace y) --- | Marker for the beginning of the region where Ormolu should be disabled.-startDisabling :: IsString s => s-startDisabling = "{- ORMOLU_DISABLE_START"+-- | Add indentation to a 'Text'.+reindent :: Int -> Text -> Text+reindent i = T.unlines . fmap (T.replicate i " " <>) . T.lines --- | Marker for the end of the region where Ormolu should be disabled.-endDisabling :: IsString s => s-endDisabling = "ORMOLU_DISABLE_END -}"+-- | All lines in the region specified by 'RegionDeltas'.+linesInRegion :: RegionDeltas -> String -> String+linesInRegion RegionDeltas {..} (lines -> ls) = unlines middle+  where+    (_, nonPrefix) = splitAt regionPrefixLength ls+    middle = take (length nonPrefix - regionSuffixLength) nonPrefix++-- | Get the region after the end of the first and till the end of+-- the second region.+regionInbetween ::+  -- | Total number of lines+  Int ->+  RegionDeltas ->+  RegionDeltas ->+  RegionDeltas+regionInbetween total r r' =+  RegionDeltas+    { regionPrefixLength = total - regionSuffixLength r,+      regionSuffixLength = total - regionPrefixLength r'+    }++-- | Convert a set of line indices into disjoint 'RegionDelta's+intSetToRegions ::+  -- | Total number of lines+  Int ->+  IntSet ->+  [RegionDeltas]+intSetToRegions total (IntSet.toAscList -> indices) =+  regionIndicesToDeltas total <$> go Nothing indices+  where+    go Nothing [] = []+    go (Just (a, b)) [] = [RegionIndices (Just a) (Just b)]+    go Nothing (i : is) = go (Just (i, i)) is+    go (Just (a, b)) (i : is)+      | b + 1 == i = go (Just (a, i)) is+      | otherwise = RegionIndices (Just a) (Just b) : go (Just (i, i)) is

@@ -2,69 +2,61 @@  -- | Support for CPP. module Ormolu.Processing.Cpp-  ( State (..),-    processLine,-    unmaskLine,+  ( cppLines,   ) where -import Control.Monad import Data.Char (isSpace)+import Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet import qualified Data.List as L import Data.Maybe (isJust)-import Data.String-import Data.Text (Text)-import qualified Data.Text as T  -- | State of the CPP processor. data State   = -- | Outside of CPP directives     Outside-  | -- | In a conditional expression-    InConditional-  | -- | In a continuation (after @\\@)+  | -- | In a conditional expression, with a positive nesting count+    InConditional Int+  | -- | In a continuation (after @\\@), but not in a conditional expression     InContinuation   deriving (Eq, Show) --- | Automatically mask the line when needed and update the 'State'.-processLine :: String -> State -> (String, State)-processLine line state-  | for "define " = (masked, state')-  | for "include " = (masked, state')-  | for "undef " = (masked, state')-  | for "ifdef " = (masked, InConditional)-  | for "ifndef " = (masked, InConditional)-  | for "if " = (masked, InConditional)-  | for "else" = (masked, InConditional)-  | for "elif" = (masked, InConditional)-  | for "endif" = (masked, state')-  | otherwise =-    case state of-      Outside -> (line, Outside)-      InConditional -> (masked, InConditional)-      InContinuation -> (masked, state')+-- | Return an 'IntSet' containing all lines which are affected by CPP.+cppLines :: String -> IntSet+cppLines input = IntSet.fromAscList $ go Outside (lines input `zip` [1 ..])   where-    for directive = isJust $ do-      s <- dropWhile isSpace <$> L.stripPrefix "#" line-      void (L.stripPrefix directive s)-    masked = maskLine line-    state' =-      if "\\" `L.isSuffixOf` line-        then InContinuation-        else Outside---- | Mask the given line.-maskLine :: String -> String-maskLine x = maskPrefix ++ x---- | If the given line is masked, unmask it. Otherwise return the line--- unchanged.-unmaskLine :: Text -> Text-unmaskLine x =-  case T.stripPrefix maskPrefix (T.stripStart x) of-    Nothing -> x-    Just x' -> x'---- | Mask prefix for CPP.-maskPrefix :: IsString s => s-maskPrefix = "-- ORMOLU_CPP_MASK"+    go _ [] = []+    go state ((line, i) : ls)+      | any for ["define ", "include ", "undef "] =+        i : go contState ls+      | any for ["ifdef ", "ifndef ", "if "] =+        let state' = case state of+              InConditional nc -> InConditional (nc + 1)+              _ -> InConditional 1+         in i : go state' ls+      | for "endif" =+        let state' = case state of+              InConditional nc | nc > 1 -> InConditional (nc - 1)+              _ -> Outside+         in i : go state' ls+      | otherwise =+        let is = case state of+              Outside -> []+              _ -> [i]+            state' = case state of+              InContinuation -> contState+              _ -> state+         in is <> go state' ls+      where+        for directive = isJust $ do+          s <- dropWhile isSpace <$> L.stripPrefix "#" line+          L.stripPrefix directive s+        contState =+          if "\\" `L.isSuffixOf` line && not inConditional+            then InContinuation+            else Outside+          where+            inConditional = case state of+              InConditional {} -> True+              _ -> False

@@ -1,31 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}---- | Postprocessing for the results of printing.-module Ormolu.Processing.Postprocess-  ( postprocess,-  )-where--import Data.Text (Text)-import qualified Data.Text as T-import Ormolu.Processing.Common-import qualified Ormolu.Processing.Cpp as Cpp---- | Postprocess output of the formatter.-postprocess ::-  -- | Desired indentation level-  Int ->-  -- | Input to process-  Text ->-  Text-postprocess indent =-  T.unlines-    . fmap indentLine-    . fmap Cpp.unmaskLine-    . filter (not . magicComment)-    . T.lines-  where-    magicComment (T.stripStart -> x) =-      x == startDisabling || x == endDisabling-    indentLine x = T.replicate indent " " <> x

@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  -- | Preprocessing for input source code.@@ -9,139 +10,152 @@ where  import Control.Monad+import Data.Bifunctor (bimap) import Data.Char (isSpace)+import Data.Function ((&))+import Data.IntMap (IntMap)+import qualified Data.IntMap.Strict as IntMap+import Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet import qualified Data.List as L-import Data.Maybe (isJust, maybeToList)-import GHC.Data.FastString-import GHC.Types.SrcLoc+import Data.Maybe (isJust)+import Data.Text (Text)+import qualified Data.Text as T import Ormolu.Config (RegionDeltas (..))-import Ormolu.Parser.Shebang (isShebang) import Ormolu.Processing.Common-import qualified Ormolu.Processing.Cpp as Cpp+import Ormolu.Processing.Cpp --- | Transform given input possibly returning comments extracted from it.--- This handles LINE pragmas, CPP, shebangs, and the magic comments for--- enabling\/disabling of Ormolu.-preprocess ::-  -- | File name, just to use in the spans-  FilePath ->-  -- | Input to process-  String ->-  -- | Region deltas-  RegionDeltas ->-  -- | Literal prefix, pre-processed input, literal suffix, extra comments-  (String, String, String, [RealLocated String])-preprocess path input RegionDeltas {..} =-  go 1 OrmoluEnabled Cpp.Outside id id regionLines+-- | Preprocess the specified region of the input into raw snippets+-- and subregions to be formatted.+preprocess :: RegionDeltas -> String -> [Either Text RegionDeltas]+preprocess region rawInput = rawSnippetsAndRegionsToFormat   where-    (prefixLines, otherLines) = splitAt regionPrefixLength (lines input)-    (regionLines, suffixLines) =-      let regionLength = length otherLines - regionSuffixLength-       in splitAt regionLength otherLines-    go !n ormoluState cppState inputSoFar csSoFar = \case-      [] ->-        let input' = unlines (inputSoFar [])-         in ( unlines prefixLines,-              case ormoluState of-                OrmoluEnabled -> input'-                OrmoluDisabled -> input' ++ endDisabling,-              unlines suffixLines,-              csSoFar []-            )-      (x : xs) ->-        let (x', ormoluState', cppState', cs) =-              processLine path n ormoluState cppState x-         in go-              (n + 1)-              ormoluState'-              cppState'-              (inputSoFar . (x' :))-              (csSoFar . (maybeToList cs ++))-              xs+    (linesNotToFormat', replacementLines) = linesNotToFormat region rawInput+    regionsToFormat =+      intSetToRegions rawLineLength $+        IntSet.fromAscList [1 .. rawLineLength] IntSet.\\ linesNotToFormat'+    regionsNotToFormat = intSetToRegions rawLineLength linesNotToFormat'+    -- We want to interleave the regionsToFormat and regionsNotToFormat.+    -- If the first non-formattable region starts at the first line, it is+    -- the first interleaved region, otherwise, we start with the first+    -- region to format.+    interleave' = case regionsNotToFormat of+      r : _ | regionPrefixLength r == 0 -> interleave+      _ -> flip interleave+    rawSnippets = T.pack . flip linesInRegion updatedInput <$> regionsNotToFormat+      where+        updatedInput = unlines . fmap updateLine . zip [1 ..] . lines $ rawInput+        updateLine (i, line) = IntMap.findWithDefault line i replacementLines+    rawSnippetsAndRegionsToFormat =+      interleave' (Left <$> rawSnippets) (Right <$> regionsToFormat)+        >>= patchSeparatingBlankLines+        & dropWhile isBlankRawSnippet+        & L.dropWhileEnd isBlankRawSnippet+    -- For every formattable region, we want to ensure that it is separated by+    -- a blank line from preceding/succeeding raw snippets if it starts/ends+    -- with a blank line.+    -- Empty formattable regions are replaced by a blank line instead.+    -- Extraneous raw snippets at the start/end are dropped afterwards.+    patchSeparatingBlankLines = \case+      Right r@RegionDeltas {..} ->+        if all isSpace (linesInRegion r rawInput)+          then [blankRawSnippet]+          else+            [blankRawSnippet | isBlankLine regionPrefixLength] <> [Right r]+              <> [blankRawSnippet | isBlankLine (rawLineLength - regionSuffixLength - 1)]+      Left r -> [Left r]+      where+        blankRawSnippet = Left "\n"+        isBlankLine i = isJust . mfilter (all isSpace) $ rawLines !!? i+    isBlankRawSnippet = \case+      Left r | T.all isSpace r -> True+      _ -> False --- | Transform a given line possibly returning a comment extracted from it.-processLine ::-  -- | File name, just to use in the spans-  FilePath ->-  -- | Line number of this line-  Int ->-  -- | Whether Ormolu is currently enabled-  OrmoluState ->-  -- | CPP state-  Cpp.State ->-  -- | The actual line-  String ->-  -- | Adjusted line and possibly a comment extracted from it-  (String, OrmoluState, Cpp.State, Maybe (RealLocated String))-processLine path n ormoluState Cpp.Outside line-  | "{-# LINE" `L.isPrefixOf` line =-    let (pragma, res) = getPragma line-        size = length pragma-        ss = mkRealSrcSpan (mkRealSrcLoc' 1) (mkRealSrcLoc' (size + 1))-     in (res, ormoluState, Cpp.Outside, Just (L ss pragma))-  | isOrmoluEnable line =-    case ormoluState of-      OrmoluEnabled ->-        (enableMarker, OrmoluEnabled, Cpp.Outside, Nothing)-      OrmoluDisabled ->-        (endDisabling ++ enableMarker, OrmoluEnabled, Cpp.Outside, Nothing)-  | isOrmoluDisable line =-    case ormoluState of-      OrmoluEnabled ->-        (disableMarker ++ startDisabling, OrmoluDisabled, Cpp.Outside, Nothing)-      OrmoluDisabled ->-        (disableMarker, OrmoluDisabled, Cpp.Outside, Nothing)-  | isShebang line =-    let ss = mkRealSrcSpan (mkRealSrcLoc' 1) (mkRealSrcLoc' (length line))-     in ("", ormoluState, Cpp.Outside, Just (L ss line))-  | otherwise =-    let (line', cppState') = Cpp.processLine line Cpp.Outside-     in (line', ormoluState, cppState', Nothing)+    rawLines = lines rawInput+    rawLineLength = length rawLines++    interleave [] bs = bs+    interleave (a : as) bs = a : interleave bs as++    xs !!? i = if i >= 0 && i < length xs then Just $ xs !! i else Nothing++-- | All lines we are not supposed to format, and a set of replacements+-- for specific lines.+linesNotToFormat :: RegionDeltas -> String -> (IntSet, IntMap String)+linesNotToFormat region@RegionDeltas {..} input =+  (unconsidered <> magicDisabled <> otherDisabled, lineUpdates)   where-    mkRealSrcLoc' = mkRealSrcLoc (mkFastString path) n-processLine _ _ ormoluState cppState line =-  let (line', cppState') = Cpp.processLine line cppState-   in (line', ormoluState, cppState', Nothing)+    unconsidered =+      IntSet.fromAscList $+        [1 .. regionPrefixLength] <> [totalLines - regionSuffixLength + 1 .. totalLines]+    totalLines = length (lines input)+    regionLines = linesInRegion region input+    (magicDisabled, lineUpdates) = magicDisabledLines regionLines+    otherDisabled = (cppLines <> shebangLines <> linePragmaLines) regionLines --- | Take a line pragma and output its replacement (where line pragma is--- replaced with spaces) and the contents of the pragma itself.-getPragma ::-  -- | Pragma line to analyze-  String ->-  -- | Contents of the pragma and its replacement line-  (String, String)-getPragma [] = error "Ormolu.Preprocess.getPragma: input must not be empty"-getPragma s@(x : xs)-  | "#-}" `L.isPrefixOf` s = ("#-}", "   " ++ drop 3 s)-  | otherwise =-    let (prag, remline) = getPragma xs-     in (x : prag, ' ' : remline)+-- | Ormolu state.+data OrmoluState+  = -- | Enabled+    OrmoluEnabled+  | -- | Disabled+    OrmoluDisabled+  deriving (Eq, Show) --- | Canonical enable marker.-enableMarker :: String-enableMarker = "{- ORMOLU_ENABLE -}"+-- | All lines which are disabled by Ormolu's magic comments,+-- as well as normalizing replacements.+magicDisabledLines :: String -> (IntSet, IntMap String)+magicDisabledLines input =+  bimap IntSet.fromAscList IntMap.fromAscList . mconcat $+    go OrmoluEnabled (lines input `zip` [1 ..])+  where+    go _ [] = []+    go state ((line, i) : ls)+      | isMagicComment ormoluDisable line,+        state == OrmoluEnabled =+        ([i], [(i, magicComment ormoluDisable)]) : go OrmoluDisabled ls+      | isMagicComment ormoluEnable line,+        state == OrmoluDisabled =+        ([i], [(i, magicComment ormoluEnable)]) : go OrmoluEnabled ls+      | otherwise = iIfDisabled : go state ls+      where+        iIfDisabled = case state of+          OrmoluDisabled -> ([i], [])+          OrmoluEnabled -> ([], []) --- | Canonical disable marker.-disableMarker :: String-disableMarker = "{- ORMOLU_DISABLE -}"+-- | All lines which satisfy a predicate.+linesFiltered :: (String -> Bool) -> String -> IntSet+linesFiltered p =+  IntSet.fromAscList . fmap snd . filter (p . fst) . (`zip` [1 ..]) . lines --- | Return 'True' if the given string is an enabling marker.-isOrmoluEnable :: String -> Bool-isOrmoluEnable = magicComment "ORMOLU_ENABLE"+-- | Lines which contain a shebang.+shebangLines :: String -> IntSet+shebangLines = linesFiltered ("#!" `L.isPrefixOf`) --- | Return 'True' if the given string is a disabling marker.-isOrmoluDisable :: String -> Bool-isOrmoluDisable = magicComment "ORMOLU_DISABLE"+-- | Lines which contain a LINE pragma.+linePragmaLines :: String -> IntSet+linePragmaLines = linesFiltered ("{-# LINE" `L.isPrefixOf`) +-- | Inner text of a magic enabling marker.+ormoluEnable :: String+ormoluEnable = "ORMOLU_ENABLE"++-- | Inner text of a magic disabling marker.+ormoluDisable :: String+ormoluDisable = "ORMOLU_DISABLE"++-- | Creates a magic comment with the given inner text.+magicComment :: String -> String+magicComment t = "{- " <> t <> " -}"+ -- | Construct a function for whitespace-insensitive matching of string.-magicComment ::+isMagicComment ::   -- | What to expect   String ->   -- | String to test   String ->   -- | Whether or not the two strings watch   Bool-magicComment expected s0 = isJust $ do+isMagicComment expected s0 = isJust $ do   let trim = dropWhile isSpace   s1 <- trim <$> L.stripPrefix "{-" (trim s0)   s2 <- trim <$> L.stripPrefix expected s1

@@ -15,11 +15,9 @@     separatedByBlank,     separatedByBlankNE,     onTheSameLine,-    removeIndentation,   ) where -import Data.Char (isSpace) import Data.List (dropWhileEnd) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE@@ -135,14 +133,3 @@ onTheSameLine :: SrcSpan -> SrcSpan -> Bool onTheSameLine a b =   isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))---- | Remove indentation from a given 'String'. Return the input with--- indentation removed and the detected indentation level.-removeIndentation :: String -> (String, Int)-removeIndentation (lines -> xs) = (unlines (drop n <$> xs), n)-  where-    n = minimum (getIndent <$> xs)-    getIndent y =-      if all isSpace y-        then 0-        else length (takeWhile isSpace y)

@@ -0,0 +1,122 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++module Ormolu.Utils.Extensions+  ( Extension (..),+    getExtensionsFromCabalFile,+    findCabalFile,+    getCabalExtensionDynOptions,+  )+where++import Control.Exception+import Control.Monad.IO.Class+import qualified Data.ByteString as B+import Data.List (find)+import Data.Map.Lazy (Map)+import qualified Data.Map.Lazy as M+import Data.Maybe (maybeToList)+import qualified Distribution.ModuleName as ModuleName+import Distribution.PackageDescription+import Distribution.PackageDescription.Parsec+import Language.Haskell.Extension+import Ormolu.Config+import Ormolu.Exception+import System.Directory+import System.FilePath+import System.IO.Error (isDoesNotExistError)++-- | Get a map from Haskell source file paths (without any extensions)+-- to its default language extensions+getExtensionsFromCabalFile ::+  MonadIO m =>+  -- | Path to cabal file+  FilePath ->+  m (Map FilePath [DynOption])+getExtensionsFromCabalFile cabalFile = liftIO $ do+  GenericPackageDescription {..} <-+    parseGenericPackageDescriptionMaybe <$> B.readFile cabalFile >>= \case+      Just gpd -> pure gpd+      Nothing -> throwIO $ OrmoluCabalFileParsingFailed cabalFile+  let lib = maybeToList condLibrary+      sublibs = snd <$> condSubLibraries+  pure . M.unions . concat $+    [ buildMap extractFromLibrary <$> lib ++ sublibs,+      buildMap extractFromExecutable . snd <$> condExecutables,+      buildMap extractFromTestSuite . snd <$> condTestSuites,+      buildMap extractFromBenchmark . snd <$> condBenchmarks+    ]+  where+    buildMap f a = let (files, exts) = f (condTreeData a) in M.fromList $ (,exts) <$> files++    extractFromBuildInfo extraModules BuildInfo {..} = (,exts) $ do+      m <- extraModules ++ (ModuleName.toFilePath <$> otherModules)+      (takeDirectory cabalFile </>) . (</> dropExtensions m) <$> hsSourceDirs+      where+        exts = maybe [] langExt defaultLanguage ++ fmap extToDynOption defaultExtensions+        langExt =+          pure . DynOption . \case+            Haskell98 -> "-XHaskell98"+            Haskell2010 -> "-XHaskell2010"+            UnknownLanguage lan -> "-X" ++ lan+        extToDynOption =+          DynOption . \case+            EnableExtension e -> "-X" ++ show e+            DisableExtension e -> "-XNo" ++ show e+            UnknownExtension e -> "-X" ++ e++    extractFromLibrary Library {..} =+      extractFromBuildInfo (ModuleName.toFilePath <$> exposedModules) libBuildInfo+    extractFromExecutable Executable {..} =+      extractFromBuildInfo [modulePath] buildInfo+    extractFromTestSuite TestSuite {..} =+      extractFromBuildInfo mainPath testBuildInfo+      where+        mainPath = case testInterface of+          TestSuiteExeV10 _ p -> [p]+          TestSuiteLibV09 _ p -> [ModuleName.toFilePath p]+          TestSuiteUnsupported {} -> []+    extractFromBenchmark Benchmark {..} =+      extractFromBuildInfo mainPath benchmarkBuildInfo+      where+        mainPath = case benchmarkInterface of+          BenchmarkExeV10 _ p -> [p]+          BenchmarkUnsupported {} -> []++-- | Find the path to an appropriate .cabal file for a Haskell+-- source file, if available+findCabalFile ::+  MonadIO m =>+  -- | Absolute path to a Haskell source file in a project with a .cabal file+  FilePath ->+  m (Maybe FilePath)+findCabalFile p = liftIO $ do+  let parentDir = takeDirectory p+  ps <-+    listDirectory parentDir `catch` \case+      (isDoesNotExistError -> True) -> pure []+      e -> throwIO e+  case find ((== ".cabal") . takeExtension) ps of+    Just cabalFile -> pure . Just $ parentDir </> cabalFile+    Nothing ->+      if isDrive parentDir+        then pure Nothing+        else findCabalFile parentDir++-- | Get the default language extensions of a Haskell source file.+-- The .cabal file can be provided explicitly or auto-detected.+getCabalExtensionDynOptions ::+  MonadIO m =>+  -- | Haskell source file+  FilePath ->+  m [DynOption]+getCabalExtensionDynOptions sourceFile' = liftIO $ do+  sourceFile <- makeAbsolute sourceFile'+  mCabalFile <- findCabalFile sourceFile+  case mCabalFile of+    Just cabalFile -> do+      extsByFile <- getExtensionsFromCabalFile cabalFile+      pure $ M.findWithDefault [] (dropExtensions sourceFile) extsByFile+    Nothing -> pure []

@@ -0,0 +1,23 @@+-- | Write 'Text' to files using UTF8 and ignoring native+-- line ending conventions.+module Ormolu.Utils.IO+  ( writeFileUtf8,+    readFileUtf8,+  )+where++import Control.Exception (throwIO)+import Control.Monad.IO.Class+import qualified Data.ByteString as B+import Data.Text (Text)+import qualified Data.Text.Encoding as TE++-- | Write a 'Text' to a file using UTF8 and ignoring native+-- line ending conventions.+writeFileUtf8 :: MonadIO m => FilePath -> Text -> m ()+writeFileUtf8 p = liftIO . B.writeFile p . TE.encodeUtf8++-- | Read an entire file strictly into a 'Text' using UTF8 and+-- ignoring native line ending conventions.+readFileUtf8 :: MonadIO m => FilePath -> m Text+readFileUtf8 p = liftIO $ either throwIO pure . TE.decodeUtf8' =<< B.readFile p

@@ -0,0 +1,27 @@+module Ormolu.CabalExtensionsSpec (spec) where++import qualified Data.Map as M+import Ormolu.Config+import Ormolu.Utils.Extensions+import Test.Hspec++spec :: Spec+spec = describe "Handle extensions from .cabal files" $ do+  it "extract extensions from .cabal files" $ do+    extsByFile <- getExtensionsFromCabalFile "ormolu.cabal"+    extsByFile `shouldNotSatisfy` M.null+    M.elems extsByFile `shouldSatisfy` all (== [DynOption "-XHaskell2010"])+    extsByFile+      `shouldSatisfy` members+        [ "./src/Ormolu",+          "./app/Main",+          "./tests/Spec"+        ]+  it "find the .cabal file" $ do+    let findsOrmoluCabal start expectedCabalFile = do+          cabalFile <- findCabalFile start+          cabalFile `shouldBe` Just expectedCabalFile+    findsOrmoluCabal "src/Ormolu/Config.hs" "./ormolu.cabal"+    findsOrmoluCabal "a/b/c/d/e" "./ormolu.cabal"+  where+    members as m = all (`M.member` m) as

@@ -3,9 +3,9 @@ module Ormolu.Diff.TextSpec (spec) where  import Data.Text (Text)-import qualified Data.Text.IO as T import Ormolu.Diff.Text import Ormolu.Terminal+import Ormolu.Utils.IO import Path import Path.IO import qualified System.FilePath as FP@@ -37,14 +37,14 @@ stdTest name pathA pathB = it name $ do   inputA <-     parseRelFile (FP.addExtension pathA "hs")-      >>= T.readFile . toFilePath . (diffInputsDir </>)+      >>= readFileUtf8 . toFilePath . (diffInputsDir </>)   inputB <-     parseRelFile (FP.addExtension pathB "hs")-      >>= T.readFile . toFilePath . (diffInputsDir </>)+      >>= readFileUtf8 . toFilePath . (diffInputsDir </>)   let expectedDiffPath = FP.addExtension name "txt"   expectedDiffText <-     parseRelFile expectedDiffPath-      >>= T.readFile . toFilePath . (diffOutputsDir </>)+      >>= readFileUtf8 . toFilePath . (diffOutputsDir </>)   let Just actualDiff = diffText inputA inputB "TEST"   actualDiffText <- printDiff actualDiff   actualDiffText `shouldBe` expectedDiffText@@ -55,7 +55,7 @@   withSystemTempFile "ormolu-diff-test" $ \path h -> do     runTerm (printTextDiff diff) Never h     hClose h-    T.readFile (toFilePath path)+    readFileUtf8 (toFilePath path)  diffTestsDir :: Path Rel Dir diffTestsDir = $(mkRelDir "data/diff-tests")

@@ -0,0 +1,26 @@+{-# LANGUAGE LambdaCase #-}++module Ormolu.Parser.ParseFailureSpec (spec) where++import Ormolu+import Ormolu.Utils (showOutputable)+import System.FilePath+import Test.Hspec++spec :: Spec+spec = do+  "disabling-preserves-error-location.hs" `failsAt` "12:1"+  "line-pragma.hs" `failsAt` "4:47"++failsAt :: String -> String -> Spec+failsAt filename location =+  let filePath = baseDir </> filename+   in it (filename ++ " fails at " ++ location) $+        ormoluFile defaultConfig filePath+          `shouldThrow` \case+            OrmoluParsingFailed srcSpan _ ->+              showOutputable srcSpan == filePath ++ ":" ++ location+            _ -> False++baseDir :: FilePath+baseDir = "data" </> "parse-failures"

@@ -4,12 +4,11 @@  import Control.Exception import Control.Monad-import Control.Monad.IO.Class import Data.List (isSuffixOf) import Data.Text (Text) import qualified Data.Text as T-import qualified Data.Text.IO as T import Ormolu+import Ormolu.Utils.IO import Path import Path.IO import qualified System.FilePath as F@@ -33,7 +32,7 @@   -- 3. Check the output against expected output. Thus all tests should   -- include two files: input and expected output.   -- T.writeFile (fromRelFile expectedOutputPath) formatted0-  expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath+  expected <- readFileUtf8 $ fromRelFile expectedOutputPath   shouldMatch False formatted0 expected   -- 4. Check that running the formatter on the output produces the same   -- output again (the transformation is idempotent).