fourmolu 0.11.0.0 → 0.12.0.0

raw patch · 98 files changed

+1473/−681 lines, 98 filesdep +deepseqdep +scientificdep −dlistdep ~Cabal-syntaxdep ~ghc-lib-parserPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, scientific

Dependencies removed: dlist

Dependency ranges changed: Cabal-syntax, ghc-lib-parser

API changes (from Hackage documentation)

Files

• CHANGELOG.md +45/−0
• README.md +9/−69
• app/Main.hs +13/−9
• data/examples/declaration/data/gadt/unicode-four-out.hs +4/−0
• data/examples/declaration/data/gadt/unicode-out.hs +4/−0
• data/examples/declaration/data/gadt/unicode.hs +4/−0
• data/examples/declaration/data/type-data-four-out.hs +8/−0
• data/examples/declaration/data/type-data-out.hs +8/−0
• data/examples/declaration/data/type-data.hs +7/−0
• data/examples/declaration/data/unnamed-field-comment-0-four-out.hs +2/−2
• data/examples/declaration/data/unnamed-field-comment-0-out.hs +2/−2
• data/examples/declaration/data/unnamed-field-comment-1-four-out.hs +1/−1
• data/examples/declaration/data/unnamed-field-comment-1-out.hs +1/−1
• data/examples/declaration/data/unnamed-field-comment-2-four-out.hs +11/−0
• data/examples/declaration/data/unnamed-field-comment-2-out.hs +11/−0
• data/examples/declaration/data/unnamed-field-comment-2.hs +9/−0
• data/examples/declaration/data/unnamed-field-comment-3-four-out.hs +5/−0
• data/examples/declaration/data/unnamed-field-comment-3-out.hs +5/−0
• data/examples/declaration/data/unnamed-field-comment-3.hs +1/−0
• data/examples/declaration/type-families/closed-type-family/promotion-four-out.hs +2/−0
• data/examples/declaration/type-families/closed-type-family/promotion-out.hs +2/−0
• data/examples/declaration/type-families/closed-type-family/promotion.hs +2/−0
• data/examples/declaration/type/promotion-1-four-out.hs +2/−0
• data/examples/declaration/type/promotion-1-out.hs +2/−0
• data/examples/declaration/type/promotion-1.hs +2/−0
• data/examples/declaration/value/function/overloaded-labels-four-out.hs +32/−0
• data/examples/declaration/value/function/overloaded-labels-out.hs +33/−0
• data/examples/declaration/value/function/overloaded-labels.hs +30/−0
• data/fourmolu/column-limit/input.hs +82/−0
• data/fourmolu/column-limit/output-limit=100.hs +108/−0
• data/fourmolu/column-limit/output-limit=80.hs +135/−0
• data/fourmolu/column-limit/output-limit=none.hs +96/−0
• data/fourmolu/single-constraint-parens/input.hs +5/−0
• data/fourmolu/single-constraint-parens/output-ConstraintAlways.hs +5/−0
• data/fourmolu/single-constraint-parens/output-ConstraintAuto.hs +5/−0
• data/fourmolu/single-constraint-parens/output-ConstraintNever.hs +5/−0
• fourmolu.cabal +21/−19
• fourmolu.yaml +2/−0
• src/GHC/DynFlags.hs +1/−4
• src/Ormolu.hs +8/−9
• src/Ormolu/Config.hs +8/−8
• src/Ormolu/Config/Gen.hs +135/−1
• src/Ormolu/Diff/ParseResult.hs +48/−55
• src/Ormolu/Diff/Text.hs +21/−20
• src/Ormolu/Exception.hs +27/−22
• src/Ormolu/Fixity.hs +11/−16
• src/Ormolu/Fixity/Internal.hs +10/−14
• src/Ormolu/Fixity/Parser.hs +4/−5
• src/Ormolu/Fixity/Printer.hs +6/−6
• src/Ormolu/Imports.hs +29/−21
• src/Ormolu/Parser.hs +46/−28
• src/Ormolu/Parser/CommentStream.hs +7/−11
• src/Ormolu/Parser/Pragma.hs +3/−3
• src/Ormolu/Parser/Result.hs +1/−3
• src/Ormolu/Printer.hs +1/−2
• src/Ormolu/Printer/Combinators.hs +33/−7
• src/Ormolu/Printer/Comments.hs +1/−2
• src/Ormolu/Printer/Internal.hs +3/−5
• src/Ormolu/Printer/Meat/Common.hs +5/−6
• src/Ormolu/Printer/Meat/Declaration.hs +9/−10
• src/Ormolu/Printer/Meat/Declaration/Annotation.hs +1/−1
• src/Ormolu/Printer/Meat/Declaration/Data.hs +47/−26
• src/Ormolu/Printer/Meat/Declaration/Default.hs +0/−1
• src/Ormolu/Printer/Meat/Declaration/Foreign.hs +6/−5
• src/Ormolu/Printer/Meat/Declaration/Instance.hs +0/−1
• src/Ormolu/Printer/Meat/Declaration/OpTree.hs +0/−1
• src/Ormolu/Printer/Meat/Declaration/Rule.hs +3/−3
• src/Ormolu/Printer/Meat/Declaration/Signature.hs +4/−5
• src/Ormolu/Printer/Meat/Declaration/Splice.hs +3/−5
• src/Ormolu/Printer/Meat/Declaration/Value.hs +28/−43
• src/Ormolu/Printer/Meat/Declaration/Value.hs-boot +3/−6
• src/Ormolu/Printer/Meat/Declaration/Warning.hs +1/−1
• src/Ormolu/Printer/Meat/ImportExport.hs +6/−8
• src/Ormolu/Printer/Meat/Module.hs +5/−5
• src/Ormolu/Printer/Meat/Pragma.hs +3/−3
• src/Ormolu/Printer/Meat/Type.hs +24/−33
• src/Ormolu/Printer/Operators.hs +2/−3
• src/Ormolu/Printer/SpanStream.hs +10/−12
• src/Ormolu/Processing/Common.hs +2/−2
• src/Ormolu/Processing/Cpp.hs +2/−2
• src/Ormolu/Processing/Preprocess.hs +4/−5
• src/Ormolu/Terminal.hs +74/−74
• src/Ormolu/Terminal/QualifiedDo.hs +7/−0
• src/Ormolu/Utils.hs +5/−7
• src/Ormolu/Utils/Cabal.hs +10/−9
• src/Ormolu/Utils/Fixity.hs +2/−2
• src/Ormolu/Utils/IO.hs +2/−2
• tests/Ormolu/CabalInfoSpec.hs +4/−4
• tests/Ormolu/Config/OptionsSpec.hs +6/−0
• tests/Ormolu/Config/PrinterOptsSpec.hs +54/−21
• tests/Ormolu/Diff/TextSpec.hs +2/−14
• tests/Ormolu/Fixity/ParserSpec.hs +2/−2
• tests/Ormolu/Fixity/PrinterSpec.hs +3/−3
• tests/Ormolu/HackageInfoSpec.hs +2/−3
• tests/Ormolu/OpTreeSpec.hs +2/−2
• tests/Ormolu/Parser/OptionsSpec.hs +1/−1
• tests/Ormolu/Parser/PragmaSpec.hs +1/−1
• tests/Ormolu/PrinterSpec.hs +4/−4

@@ -1,3 +1,48 @@+## Fourmolu 0.12.0.0++* Add `single-constraint-parens` option for controlling parenthesis around constraints in type+  signatures. See [issue 288](https://github.com/fourmolu/fourmolu/pull/304)++* Add `column-limit` option to try to insert line breaks when lines exceed a certain length.+  May break idempotence in some particularly painful cases.+  See [issue 71](https://github.com/fourmolu/fourmolu/pull/305)++* Add a new CLI flag `--print-defaults` which makes fourmolu print default options to stdout.+  This can be used to generate default config which can be further tweaked by user `fourmolu --print-defaults > fourmolu.yaml`.+  See [issue 307](https://github.com/fourmolu/fourmolu/pull/308)++### Upstream changes:++#### Ormolu 0.6.0.1++* Fix false positives in AST diffing related to `UnicodeSyntax`. [PR+  1009](https://github.com/tweag/ormolu/pull/1009).++#### Ormolu 0.6.0.0++* Haddocks attached to arguments of a data constructor are now formatted in+  the pipe style (rather than the caret style), consistent with everything+  else. As a consequence, now Ormolu's output will be deemed invalid by the+  Haddock shipped with GHC <9.0. [Issue+  844](https://github.com/tweag/ormolu/issues/844) and [issue+  828](https://github.com/tweag/ormolu/issues/828).++* Insert space before char literals in ticked promoted constructs when+  necessary. [Issue 1000](https://github.com/tweag/ormolu/issues/1000).++* Switched to `ghc-lib-parser-9.6`:+  * Extended `OverloadedLabels`: `#Foo`, `#3`, `#"Hello there"`.++    Also, it is now disabled by default, as it causes e.g. `a#b` to be parsed+    differently.+  * New extension: `TypeData`, enabled by default.+  * Parse errors now include error codes, cf. https://errors.haskell.org.++* Updated to `Cabal-syntax-3.10`.++* Now whenever Ormolu fails to parse a `.cabal` file it also explains why.+  [PR 999](https://github.com/tweag/ormolu/pull/999).+ ## Fourmolu 0.11.0.0  * Added the `no-space` value for the `in-style` option. See [issue

@@ -8,6 +8,7 @@ * [Installation](#installation) * [Building from source](#building-from-source) * [Usage](#usage)+    * [Fourmolu Live](#fourmolu-live)     * [Editor integration](#editor-integration)     * [Language extensions, dependencies, and fixities](#language-extensions-dependencies-and-fixities)     * [Magic comments](#magic-comments)@@ -18,7 +19,7 @@ * [Contributing](#contributing) * [License](#license) -Fourmolu is a formatter for Haskell source code. It is a fork of [Ormolu](https://github.com/tweag/ormolu), with the intention to continue to merge upstream improvements.+Fourmolu is a formatter for Haskell source code. It is a fork of [Ormolu](https://github.com/tweag/ormolu), with upstream improvements continually merged.  We share all bar one of Ormolu's goals: @@ -41,72 +42,7 @@  ## Configuration -### Available options--Defaults are in bold.--| Configuration option     | Valid options                                         | Description-|--------------------------|-------------------------------------------------------|--------------| `indentation`            | any non-negative integer (**`4`**)                    | How many spaces to use as an indent-| `function-arrows`        | **`trailing`**, `leading`, `leading-args`             | Where to place arrows in type signatures-| `comma-style`            | **`leading`**, `trailing`                             | Where to place commas in lists, tuples, etc.-| `import-export-style`    | `leading`, `trailing`, **`diff-friendly`**            | How to format multiline import/export lists (`diff-friendly` lists have trailing commas but keep the opening parenthesis on the same line as `import`)-| `indent-wheres`          | `true`, **`false`**                                   | Use an extra level of indentation _vs_ only half-indent the `where` keyword-| `record-brace-space`     | `true`, **`false`**                                   | `rec {x = 1}` _vs_ `rec{x = 1}`-| `newlines-between-decls` | any integer (**`1`**)                                 | Number of newlines between top-level declarations-| `haddock-style`          | `single-line`, **`multi-line`**, `multi-line-compact` | Use `-- \|`, `{- \|`, or `{-\|` for multiline haddocks (single-line haddocks always use `--`)-| `haddock-style-module`   | same as `haddock-style`                               | `haddock-style`, but specifically for the module docstring (not specifying anything = use the same setting as `haddock-style`) |-| `let-style`              | `inline`, `newline`, **`auto`**, `mixed`              | How to style `let` blocks (`auto` uses `newline` if there's a newline in the input and `inline` otherwise, and `mixed` uses `inline` only when the `let` has exactly one binding)-| `in-style`               | `left-align`, **`right-align`**, `no-space`           | How to align the `in` keyword with respect to `let` (`left-align` produces <code>in &nbsp;...</code>, `right-align` produces <code>&nbsp;in ...</code>, `no-space` produces <code>in ...</code>)-| `unicode`                | `always`, `detect`, **`never`**                       | Output Unicode syntax. With `detect` we output Unicode syntax exactly when the extension is seen to be enabled. When using `always`, make sure to have the `UnicodeSyntax` extension enabled, or Fourmolu will throw errors.-| `respectful`             | **`true`**, `false`                                   | Be less aggressive in reformatting input, e.g. keep empty lines in import list-| `fixities`               | list of strings (**`[]`**)                            | See the "Language extensions, dependencies, and fixities" section below--For examples of each of these options, see the [test files](https://github.com/fourmolu/fourmolu/tree/main/data/fourmolu/).--### Specifying configuration--Configuration options may be specified in either a `fourmolu.yaml` file or via command-line options. Fourmolu looks for a `fourmolu.yaml` file in all parents of the current directory, followed by [the XDG config directory](https://hackage.haskell.org/package/directory/docs/System-Directory.html#v:XdgConfig).--A complete configuration file, corresponding to Fourmolu's default options, looks like:--```yaml-indentation: 4-function-arrows: trailing-comma-style: leading-import-export-style: diff-friendly-indent-wheres: false-record-brace-space: false-newlines-between-decls: 1-haddock-style: multi-line-haddock-style-module:-let-style: auto-in-style: right-align-respectful: true-fixities: []-unicode: never-```--The configuration that most closely matches Ormolu's styling is:--```yaml-indentation: 2-function-arrows: trailing-comma-style: trailing-import-export-style: trailing-indent-wheres: true-record-brace-space: true-newlines-between-decls: 1-haddock-style: single-line-haddock-style-module:-let-style: inline-in-style: right-align-respectful: false-fixities: []-unicode: never-```--Command-line options override options in a configuration file. Run `fourmolu --help` to see all options.+See https://fourmolu.github.io/config/  ## Installation @@ -154,7 +90,7 @@ $ git ls-files -z '*.hs' | xargs -0 fourmolu --mode inplace ``` -To check if files are are already formatted (useful on CI):+To check if files are already formatted (useful on CI):  ```console $ fourmolu --mode check src@@ -168,6 +104,10 @@ https://www.git-scm.com/docs/git-config#Documentation/git-config.txt-coreautocrlf) to `false`. +### Web app++See https://fourmolu.github.io/ to try Fourmolu in your browser. This is re-deployed on every new commit to `main`, so will use the latest version of Fourmolu, potentially including unreleased changes.+ ### Editor integration  Fourmolu can be integrated with your editor via the [Haskell Language Server](https://haskell-language-server.readthedocs.io/en/latest/index.html). Just set `haskell.formattingProvider` to `fourmolu` ([instructions](https://haskell-language-server.readthedocs.io/en/latest/configuration.html#language-specific-server-options)).@@ -274,7 +214,7 @@   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.+* Various minor idempotence issues, most of them are related to comments or column limits. * Fourmolu is in a fairly early stage of development. The implementation should be as stable as Ormolu, as it only makes minimal changes, and is extensively tested. But the default configuration style may change in some minor ways in the near future, as we make more options available. It will always be possible to replicate the old default behaviour with a suitable `fourmolu.yaml`.  ## Contributing

@@ -1,12 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeApplications #-}  module Main (main) where @@ -14,12 +11,12 @@ import Control.Monad import Data.Bool (bool) import Data.List (intercalate, isSuffixOf, sort)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe, mapMaybe, maybeToList)-import qualified Data.Set as Set-import qualified Data.Text.IO as TIO+import Data.Set qualified as Set+import Data.Text.IO qualified as TIO import Data.Version (showVersion)-import qualified Data.Yaml as Yaml+import Data.Yaml qualified as Yaml import Language.Haskell.TH.Env (envQ) import Options.Applicative import Ormolu@@ -34,7 +31,7 @@ import Paths_fourmolu (version) import System.Directory import System.Exit (ExitCode (..), exitWith)-import qualified System.FilePath as FP+import System.FilePath qualified as FP import System.IO (hPutStrLn, stderr)  -- | Entry point of the program.@@ -282,7 +279,7 @@  optsParserInfo :: ParserInfo Opts optsParserInfo =-  info (helper <*> ver <*> exts <*> optsParser) . mconcat $+  info (helper <*> ver <*> exts <*> printDefaults <*> optsParser) . mconcat $     [fullDesc]   where     ver :: Parser (a -> a)@@ -307,6 +304,13 @@           help "Display extensions that need to be enabled manually"         ]     displayExts = unlines $ sort (showOutputable <$> manualExts)++    printDefaults :: Parser (a -> a)+    printDefaults =+      infoOption defaultPrinterOptsYaml . mconcat $+        [ long "print-defaults",+          help "Print default configuration options that can be used in fourmolu.yaml"+        ]  optsParser :: Parser Opts optsParser =

@@ -0,0 +1,4 @@+{-# LANGUAGE UnicodeSyntax #-}++data Foo :: Type -> Type where+    Foo :: a -> Foo a

@@ -0,0 +1,4 @@+{-# LANGUAGE UnicodeSyntax #-}++data Foo :: Type -> Type where+  Foo :: a -> Foo a

@@ -0,0 +1,4 @@+{-# LANGUAGE UnicodeSyntax #-}++data Foo ∷ Type → Type where+  Foo ∷ a → Foo a

@@ -0,0 +1,8 @@+type data Universe = Character | Number | Boolean++type data Maybe a+    = Just a+    | Nothing++type data P :: Type -> Type -> Type where+    MkP :: (a ~ Natural, b ~~ Char) => P a b

@@ -0,0 +1,8 @@+type data Universe = Character | Number | Boolean++type data Maybe a+  = Just a+  | Nothing++type data P :: Type -> Type -> Type where+  MkP :: (a ~ Natural, b ~~ Char) => P a b

@@ -0,0 +1,7 @@+type data Universe = Character | Number | Boolean++type data Maybe a = Just a+                  | Nothing++type data P :: Type -> Type -> Type where+  MkP :: (a ~ Natural, b ~~ Char) => P a b

@@ -1,7 +1,7 @@ data Foo     = -- | Bar       Bar+        -- | Field 1         Field1-        -- ^ Field 1+        -- | Field 2         Field2-        -- ^ Field 2

@@ -1,7 +1,7 @@ data Foo   = -- | Bar     Bar+      -- | Field 1       Field1-      -- ^ Field 1+      -- | Field 2       Field2-      -- ^ Field 2

@@ -1,5 +1,5 @@ data X     = B+        -- | y         !Int-        -- ^ y         C

@@ -1,5 +1,5 @@ data X   = B+      -- | y       !Int-      -- ^ y       C

@@ -0,0 +1,11 @@+-- | Describes what sort of dictionary to generate for type class instances+data Evidence+    = -- | An existing named instance+      NamedInstance (Qualified Ident)+    | -- | Computed instances+      WarnInstance+        -- | Warn type class with a user-defined warning message+        SourceType+    | -- | The IsSymbol type class for a given Symbol literal+      IsSymbolInstance PSString+    deriving (Show, Eq)

@@ -0,0 +1,11 @@+-- | Describes what sort of dictionary to generate for type class instances+data Evidence+  = -- | An existing named instance+    NamedInstance (Qualified Ident)+  | -- | Computed instances+    WarnInstance+      -- | Warn type class with a user-defined warning message+      SourceType+  | -- | The IsSymbol type class for a given Symbol literal+    IsSymbolInstance PSString+  deriving (Show, Eq)

@@ -0,0 +1,9 @@+-- | Describes what sort of dictionary to generate for type class instances+data Evidence+  -- | An existing named instance+  = NamedInstance (Qualified Ident)++  -- | Computed instances+  | WarnInstance SourceType -- ^ Warn type class with a user-defined warning message+  | IsSymbolInstance PSString -- ^ The IsSymbol type class for a given Symbol literal+  deriving (Show, Eq)

@@ -0,0 +1,5 @@+data A+    = A+        -- | a number+        Int+        Bool

@@ -0,0 +1,5 @@+data A+  = A+      -- | a number+      Int+      Bool

@@ -0,0 +1,1 @@+data A = A {- | a number -} Int Bool

@@ -0,0 +1,2 @@+type family Foo a where+    Foo '( 'x', a) = a

@@ -0,0 +1,2 @@+type family Foo a where+  Foo '( 'x', a) = a

@@ -0,0 +1,2 @@+type family Foo a where+  Foo '( 'x', a) = a

@@ -9,3 +9,5 @@ type G = '[ '( 'Just, 'Bool)]  type X = () '`PromotedInfix` ()++type A = '[ 'a']

@@ -15,3 +15,5 @@ type G = '[ '( 'Just, 'Bool)]  type X = () '`PromotedInfix` ()++type A = '[ 'a']

@@ -9,3 +9,5 @@ type G = '[ '( 'Just, 'Bool) ]  type X = () '`PromotedInfix` ()++type A = '[ 'a' ]

@@ -2,3 +2,35 @@  foo = #field bar = (#this) (#that)+baz = #Foo #"Hello world!" #"\"" #3 #"\n"++-- from https://gitlab.haskell.org/ghc/ghc/-/blob/ghc-9.6.1-alpha3/testsuite/tests/overloadedrecflds/should_run/T11671_run.hs+-- unnecessary once https://github.com/tweag/ormolu/issues/821 lands+main =+    traverse_+        putStrLn+        [ #a+        , #number17+        , #do+        , #type+        , #Foo+        , #3+        , #"199.4"+        , #17a23b+        , #f'a'+        , #'a'+        , #'+        , #''notTHSplice+        , #"..."+        , #привет+        , #こんにちは+        , #"3"+        , #":"+        , #"Foo"+        , #"The quick brown fox"+        , #"\""+        , (++) #hello #world+        , (++) #"hello" #"world"+        , #"hello" # 1 -- equivalent to `(fromLabel @"hello") # 1`+        , f "hello" #2 -- equivalent to `f ("hello"# :: Addr#) 2`+        ]

@@ -3,3 +3,36 @@ foo = #field  bar = (#this) (#that)++baz = #Foo #"Hello world!" #"\"" #3 #"\n"++-- from https://gitlab.haskell.org/ghc/ghc/-/blob/ghc-9.6.1-alpha3/testsuite/tests/overloadedrecflds/should_run/T11671_run.hs+-- unnecessary once https://github.com/tweag/ormolu/issues/821 lands+main =+  traverse_+    putStrLn+    [ #a,+      #number17,+      #do,+      #type,+      #Foo,+      #3,+      #"199.4",+      #17a23b,+      #f'a',+      #'a',+      #',+      #''notTHSplice,+      #"...",+      #привет,+      #こんにちは,+      #"3",+      #":",+      #"Foo",+      #"The quick brown fox",+      #"\"",+      (++) #hello #world,+      (++) #"hello" #"world",+      #"hello" # 1, -- equivalent to `(fromLabel @"hello") # 1`+      f "hello" #2 -- equivalent to `f ("hello"# :: Addr#) 2`+    ]

@@ -2,3 +2,33 @@  foo = #field bar = (#this ) ( #that)+baz = #Foo #"Hello world!" #"\"" #3 #"\n"++-- from https://gitlab.haskell.org/ghc/ghc/-/blob/ghc-9.6.1-alpha3/testsuite/tests/overloadedrecflds/should_run/T11671_run.hs+-- unnecessary once https://github.com/tweag/ormolu/issues/821 lands+main = traverse_ putStrLn+  [ #a+  , #number17+  , #do+  , #type+  , #Foo+  , #3+  , #"199.4"+  , #17a23b+  , #f'a'+  , #'a'+  , #'+  , #''notTHSplice+  , #"..."+  , #привет+  , #こんにちは+  , #"3"+  , #":"+  , #"Foo"+  , #"The quick brown fox"+  , #"\""+  , (++) #hello#world+  , (++) #"hello"#"world"+  , #"hello"# 1 -- equivalent to `(fromLabel @"hello") # 1`+  , f "hello"#2 -- equivalent to `f ("hello"# :: Addr#) 2`+  ]

@@ -0,0 +1,82 @@+module ColumnLimitTest where++-- Less than 80 characters+import Data.List (isPrefixOf, head, tail)++-- Over 80 characters, should break this line when column-limit is set to 80.+import Data.Maybe (maybe, fromMaybe, fromJust, catMaybe, mapMaybe, isJust, isNothing, listToMaybe, maybeToList)++-- For reference, this line had exactly 80 characters -------------------------|++oneVeryLongLine :: [String]+oneVeryLongLine = ["akjsndjklansdsad"] ++ ["jkanskdjnajsndjnasd"] ++ ["jknasdljknasdlnasdn"] ++ ["lajndljnasdlnasds"]++oneVeryLongList :: [String]+oneVeryLongList = ["akjsndjklansdsad", "jkanskdjnajsndjnasd", "jknasdljknasdlnasdn", "lajndljnasdlnasds"]+++data NewDataType = NewDataType {field1 :: String, field2 :: String, field3 :: String, field4 :: String}++-- Test if the current line breaking still works normally, i.e. if the user+-- breaks the line, fourmolu breaks and aligns the rest.    +data SecondDataType = SecondDataType {field1 :: String+    , field2 :: String, field3 :: String, field4 :: String}++data DataTypeWithAVeryLongName = DataTypeWithAVeryLongName String String String String String+++-- Long function signatures++-- For reference, this line had exactly 80 characters -------------------------|++longFunction0 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String -> [String]+longFunction0 veryLongArg1 a b c d e f = ["a list", "of strings", "that will break the", "column limit"]++longFunction1 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction1 +    veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 veryLongArgument5 veryLongArg6 = undefined++longFunction12 veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 veryLongArgument5 +longFunction12 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String -> String+    veryLongArg6 veryLongArg6 = undefined+++longFunction2 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction2 veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 a veryLongArg6 =+    let aVeryLongLine = ["list one", "list one", "list one", "list one", "list one", "list one"]+    in undefined++longFunction3 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction3 veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 veryLongArgument5 veryLongArg6 = undefined+++-- For reference, this line had exactly 80 characters -------------------------|++-- ----------------  Known limitation: idempotence is broken ----------------++-- With the column-limit option set, fourmolu will not be idempotent in some+-- cases. An example can be seen below, where the long line ends with a `do`.++-- Original code+testFund :: Maybe Int+testFund = +  firstTest oneFunctionArgument abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde $ do+    result <- aRandomResult++-- Will become this when formatted with column-limit set to 80.+testFund :: Maybe Int+testFund =+    firstTest+        oneFunctionArgument+        abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde $ do+        result <- aRandomResult+++-- Which, if formatted again, will become this:+testFund :: Maybe Int+testFund =+    firstTest+        oneFunctionArgument+        abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde+        $ do+            result <- aRandomResult

@@ -0,0 +1,108 @@+module ColumnLimitTest where++-- Less than 80 characters+import Data.List (head, isPrefixOf, tail)++-- Over 80 characters, should break this line when column-limit is set to 80.+import Data.Maybe (+    catMaybe,+    fromJust,+    fromMaybe,+    isJust,+    isNothing,+    listToMaybe,+    mapMaybe,+    maybe,+    maybeToList,+ )++-- For reference, this line had exactly 80 characters -------------------------|++oneVeryLongLine :: [String]+oneVeryLongLine =+    ["akjsndjklansdsad"] ++ ["jkanskdjnajsndjnasd"] ++ ["jknasdljknasdlnasdn"] ++ ["lajndljnasdlnasds"]++oneVeryLongList :: [String]+oneVeryLongList = ["akjsndjklansdsad", "jkanskdjnajsndjnasd", "jknasdljknasdlnasdn", "lajndljnasdlnasds"]++data NewDataType = NewDataType {field1 :: String, field2 :: String, field3 :: String, field4 :: String}++-- Test if the current line breaking still works normally, i.e. if the user+-- breaks the line, fourmolu breaks and aligns the rest.+data SecondDataType = SecondDataType+    { field1 :: String+    , field2 :: String+    , field3 :: String+    , field4 :: String+    }++data DataTypeWithAVeryLongName = DataTypeWithAVeryLongName String String String String String++-- Long function signatures++-- For reference, this line had exactly 80 characters -------------------------|++longFunction0 ::+    String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String -> [String]+longFunction0 veryLongArg1 a b c d e f = ["a list", "of strings", "that will break the", "column limit"]++longFunction1 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction1+    veryLongArg1+    veryLongArg2+    veryLongArg3+    veryLongArg4+    veryLongArgument5+    veryLongArg6 = undefined++longFunction12 veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 veryLongArgument5+longFunction12 ::+    String ->+    String ->+    String ->+    Maybe Int ->+    Maybe Int ->+    Maybe Int ->+    String ->+    String+        veryLongArg6+        veryLongArg6 = undefined++longFunction2 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction2 veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 a veryLongArg6 =+    let aVeryLongLine = ["list one", "list one", "list one", "list one", "list one", "list one"]+     in undefined++longFunction3 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction3 veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 veryLongArgument5 veryLongArg6 = undefined++-- For reference, this line had exactly 80 characters -------------------------|++-- ----------------  Known limitation: idempotence is broken ----------------++-- With the column-limit option set, fourmolu will not be idempotent in some+-- cases. An example can be seen below, where the long line ends with a `do`.++-- Original code+testFund :: Maybe Int+testFund =+    firstTest oneFunctionArgument abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde $ do+        result <- aRandomResult++-- Will become this when formatted with column-limit set to 80.+testFund :: Maybe Int+testFund =+    firstTest+        oneFunctionArgument+        abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde+        $ do+            result <- aRandomResult++-- Which, if formatted again, will become this:+testFund :: Maybe Int+testFund =+    firstTest+        oneFunctionArgument+        abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde+        $ do+            result <- aRandomResult

@@ -0,0 +1,135 @@+module ColumnLimitTest where++-- Less than 80 characters+import Data.List (head, isPrefixOf, tail)++-- Over 80 characters, should break this line when column-limit is set to 80.+import Data.Maybe (+    catMaybe,+    fromJust,+    fromMaybe,+    isJust,+    isNothing,+    listToMaybe,+    mapMaybe,+    maybe,+    maybeToList,+ )++-- For reference, this line had exactly 80 characters -------------------------|++oneVeryLongLine :: [String]+oneVeryLongLine =+    ["akjsndjklansdsad"]+        ++ ["jkanskdjnajsndjnasd"]+        ++ ["jknasdljknasdlnasdn"]+        ++ ["lajndljnasdlnasds"]++oneVeryLongList :: [String]+oneVeryLongList =+    [ "akjsndjklansdsad"+    , "jkanskdjnajsndjnasd"+    , "jknasdljknasdlnasdn"+    , "lajndljnasdlnasds"+    ]++data NewDataType = NewDataType+    {field1 :: String, field2 :: String, field3 :: String, field4 :: String}++-- Test if the current line breaking still works normally, i.e. if the user+-- breaks the line, fourmolu breaks and aligns the rest.+data SecondDataType = SecondDataType+    { field1 :: String+    , field2 :: String+    , field3 :: String+    , field4 :: String+    }++data DataTypeWithAVeryLongName+    = DataTypeWithAVeryLongName String String String String String++-- Long function signatures++-- For reference, this line had exactly 80 characters -------------------------|++longFunction0 ::+    String ->+    String ->+    String ->+    Maybe Int ->+    Maybe Int ->+    Maybe Int ->+    String ->+    [String]+longFunction0 veryLongArg1 a b c d e f = ["a list", "of strings", "that will break the", "column limit"]++longFunction1 ::+    String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction1+    veryLongArg1+    veryLongArg2+    veryLongArg3+    veryLongArg4+    veryLongArgument5+    veryLongArg6 = undefined++longFunction12+    veryLongArg1+    veryLongArg2+    veryLongArg3+    veryLongArg4+    veryLongArgument5+longFunction12 ::+    String ->+    String ->+    String ->+    Maybe Int ->+    Maybe Int ->+    Maybe Int ->+    String ->+    String+        veryLongArg6+        veryLongArg6 = undefined++longFunction2 ::+    String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction2 veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 a veryLongArg6 =+    let aVeryLongLine = ["list one", "list one", "list one", "list one", "list one", "list one"]+     in undefined++longFunction3 ::+    String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction3 veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 veryLongArgument5 veryLongArg6 = undefined++-- For reference, this line had exactly 80 characters -------------------------|++-- ----------------  Known limitation: idempotence is broken ----------------++-- With the column-limit option set, fourmolu will not be idempotent in some+-- cases. An example can be seen below, where the long line ends with a `do`.++-- Original code+testFund :: Maybe Int+testFund =+    firstTest+        oneFunctionArgument+        abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde $ do+        result <- aRandomResult++-- Will become this when formatted with column-limit set to 80.+testFund :: Maybe Int+testFund =+    firstTest+        oneFunctionArgument+        abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde+        $ do+            result <- aRandomResult++-- Which, if formatted again, will become this:+testFund :: Maybe Int+testFund =+    firstTest+        oneFunctionArgument+        abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde+        $ do+            result <- aRandomResult

@@ -0,0 +1,96 @@+module ColumnLimitTest where++-- Less than 80 characters+import Data.List (head, isPrefixOf, tail)++-- Over 80 characters, should break this line when column-limit is set to 80.+import Data.Maybe (catMaybe, fromJust, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybe, maybeToList)++-- For reference, this line had exactly 80 characters -------------------------|++oneVeryLongLine :: [String]+oneVeryLongLine = ["akjsndjklansdsad"] ++ ["jkanskdjnajsndjnasd"] ++ ["jknasdljknasdlnasdn"] ++ ["lajndljnasdlnasds"]++oneVeryLongList :: [String]+oneVeryLongList = ["akjsndjklansdsad", "jkanskdjnajsndjnasd", "jknasdljknasdlnasdn", "lajndljnasdlnasds"]++data NewDataType = NewDataType {field1 :: String, field2 :: String, field3 :: String, field4 :: String}++-- Test if the current line breaking still works normally, i.e. if the user+-- breaks the line, fourmolu breaks and aligns the rest.+data SecondDataType = SecondDataType+    { field1 :: String+    , field2 :: String+    , field3 :: String+    , field4 :: String+    }++data DataTypeWithAVeryLongName = DataTypeWithAVeryLongName String String String String String++-- Long function signatures++-- For reference, this line had exactly 80 characters -------------------------|++longFunction0 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String -> [String]+longFunction0 veryLongArg1 a b c d e f = ["a list", "of strings", "that will break the", "column limit"]++longFunction1 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction1+    veryLongArg1+    veryLongArg2+    veryLongArg3+    veryLongArg4+    veryLongArgument5+    veryLongArg6 = undefined++longFunction12 veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 veryLongArgument5+longFunction12 ::+    String ->+    String ->+    String ->+    Maybe Int ->+    Maybe Int ->+    Maybe Int ->+    String ->+    String+        veryLongArg6+        veryLongArg6 = undefined++longFunction2 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction2 veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 a veryLongArg6 =+    let aVeryLongLine = ["list one", "list one", "list one", "list one", "list one", "list one"]+     in undefined++longFunction3 :: String -> String -> String -> Maybe Int -> Maybe Int -> Maybe Int -> String+longFunction3 veryLongArg1 veryLongArg2 veryLongArg3 veryLongArg4 veryLongArgument5 veryLongArg6 = undefined++-- For reference, this line had exactly 80 characters -------------------------|++-- ----------------  Known limitation: idempotence is broken ----------------++-- With the column-limit option set, fourmolu will not be idempotent in some+-- cases. An example can be seen below, where the long line ends with a `do`.++-- Original code+testFund :: Maybe Int+testFund =+    firstTest oneFunctionArgument abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde $ do+        result <- aRandomResult++-- Will become this when formatted with column-limit set to 80.+testFund :: Maybe Int+testFund =+    firstTest+        oneFunctionArgument+        abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde+        $ do+            result <- aRandomResult++-- Which, if formatted again, will become this:+testFund :: Maybe Int+testFund =+    firstTest+        oneFunctionArgument+        abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde+        $ do+            result <- aRandomResult

@@ -0,0 +1,5 @@+module Main where++functionName :: (C a) => a+functionName1 :: C a => a+functionName2 :: (C a, D a) => a

@@ -0,0 +1,5 @@+module Main where++functionName :: (C a) => a+functionName1 :: (C a) => a+functionName2 :: (C a, D a) => a

@@ -0,0 +1,5 @@+module Main where++functionName :: (C a) => a+functionName1 :: C a => a+functionName2 :: (C a, D a) => a

@@ -0,0 +1,5 @@+module Main where++functionName :: C a => a+functionName1 :: C a => a+functionName2 :: (C a, D a) => a

@@ -1,13 +1,13 @@ cabal-version:      2.4 name:               fourmolu-version:            0.11.0.0+version:            0.12.0.0 license:            BSD-3-Clause license-file:       LICENSE.md maintainer:     Matt Parsons <parsonsmatt@gmail.com>     George Thomas <georgefsthomas@gmail.com>     Brandon Chinn <brandonchinn178@gmail.com>-tested-with:        ghc ==9.0.2 ghc ==9.2.5+tested-with:        ghc ==9.2.7 ghc ==9.4.4 ghc ==9.6.1 homepage:           https://github.com/fourmolu/fourmolu bug-reports:        https://github.com/fourmolu/fourmolu/issues synopsis:           A formatter for Haskell source code@@ -91,18 +91,20 @@         Ormolu.Processing.Cpp         Ormolu.Processing.Preprocess         Ormolu.Terminal+        Ormolu.Terminal.QualifiedDo         Ormolu.Utils         Ormolu.Utils.Cabal         Ormolu.Utils.Fixity         Ormolu.Utils.IO+        Paths_fourmolu     other-modules:         Ormolu.Config.Gen      hs-source-dirs:   src     other-modules:    GHC.DynFlags-    default-language: Haskell2010+    default-language: GHC2021     build-depends:-        Cabal-syntax >=3.8 && <3.9,+        Cabal-syntax >=3.10 && <3.11,         Diff >=0.4 && <1.0,         MemoTrie >=0.6 && <0.7,         ansi-terminal >=0.10 && <1.0,@@ -111,24 +113,24 @@         binary >=0.8 && <0.9,         bytestring >=0.2 && <0.12,         containers >=0.5 && <0.7,+        deepseq >=1.4 && <1.5,         directory ^>=1.3,-        dlist >=0.8 && <2.0,         file-embed >=0.0.15 && <0.1,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.4 && <9.5,+        ghc-lib-parser >=9.6 && <9.7,         megaparsec >=9.0,         mtl >=2.0 && <3.0,         syb >=0.7 && <0.8,         text >=2.0 && <3.0,         -- fourmolu-only deps         aeson >=1.0 && <3.0,+        scientific >=0.3.2 && <1,         yaml >=0.11.6.0 && <1      if flag(dev)         ghc-options:-            -Wall -Werror -Wcompat -Wincomplete-record-updates-            -Wincomplete-uni-patterns -Wnoncanonical-monad-instances-            -Wno-missing-home-modules -Wunused-packages+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages      else         ghc-options: -O2 -Wall@@ -141,13 +143,13 @@     hs-source-dirs:   app     other-modules:    Paths_fourmolu     autogen-modules:  Paths_fourmolu-    default-language: Haskell2010+    default-language: GHC2021     build-depends:         base >=4.12 && <5.0,         containers >=0.5 && <0.7,         directory ^>=1.3,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.4 && <9.5,+        ghc-lib-parser >=9.6 && <9.7,         th-env >=0.1.1 && <0.2,         optparse-applicative >=0.14 && <0.18,         text >=2.0 && <3.0,@@ -158,10 +160,8 @@      if flag(dev)         ghc-options:-            -Wall -Werror -Wcompat -Wincomplete-record-updates-            -Wincomplete-uni-patterns -Wnoncanonical-monad-instances-            -optP-Wno-nonportable-include-path -Wunused-packages-            -Wwarn=unused-packages+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages -Wwarn=unused-packages      else         ghc-options: -O2 -Wall -rtsopts@@ -192,15 +192,15 @@         Ormolu.Parser.PragmaSpec         Ormolu.PrinterSpec -    default-language:   Haskell2010+    default-language:   GHC2021     build-depends:-        Cabal-syntax >=3.8 && <3.9,+        Cabal-syntax >=3.10 && <3.11,         QuickCheck >=2.14,         base >=4.14 && <5.0,         containers >=0.5 && <0.7,         directory ^>=1.3,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.4 && <9.5,+        ghc-lib-parser >=9.6 && <9.7,         hspec >=2.0 && <3.0,         hspec-megaparsec >=2.2,         path >=0.6 && <0.10,@@ -218,7 +218,9 @@         fourmolu      if flag(dev)-        ghc-options: -Wall -Werror -Wunused-packages+        ghc-options:+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages      else         ghc-options: -O2 -Wall

@@ -2,6 +2,7 @@  # Options should imitate Ormolu's style indentation: 2+column-limit: none function-arrows: trailing comma-style: trailing import-export-style: trailing@@ -12,6 +13,7 @@ haddock-style-module: null let-style: inline in-style: right-align+single-constraint-parens: always unicode: never respectful: false fixities: []

@@ -49,8 +49,5 @@           }     } -fakeLlvmConfig :: LlvmConfig-fakeLlvmConfig = LlvmConfig [] []- baseDynFlags :: DynFlags-baseDynFlags = defaultDynFlags fakeSettings fakeLlvmConfig+baseDynFlags = defaultDynFlags fakeSettings

@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} @@ -46,13 +45,13 @@ import Control.Exception import Control.Monad import Control.Monad.IO.Class (MonadIO (..))-import qualified Data.Map.Strict as Map-import qualified Data.Set as Set+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Debug.Trace-import qualified GHC.Driver.CmdLine as GHC-import qualified GHC.Types.SrcLoc as GHC+import GHC.Driver.CmdLine qualified as GHC+import GHC.Types.SrcLoc import Ormolu.Config import Ormolu.Diff.ParseResult import Ormolu.Diff.Text@@ -63,7 +62,7 @@ import Ormolu.Parser.Result import Ormolu.Printer import Ormolu.Utils (showOutputable)-import qualified Ormolu.Utils.Cabal as CabalUtils+import Ormolu.Utils.Cabal qualified as CabalUtils import Ormolu.Utils.Fixity (getFixityOverridesForSourceFile) import Ormolu.Utils.IO import System.FilePath@@ -228,7 +227,7 @@   -- | Fixity Map for operators   LazyFixityMap ->   -- | How to obtain 'OrmoluException' to throw when parsing fails-  (GHC.SrcSpan -> String -> OrmoluException) ->+  (SrcSpan -> String -> OrmoluException) ->   -- | File name to use in errors   FilePath ->   -- | Actual input for the parser@@ -245,7 +244,7 @@ showWarn (GHC.Warn reason l) =   unlines     [ showOutputable reason,-      showOutputable l+      unLoc l     ]  -- | Detect 'SourceType' based on the file extension.

@@ -1,7 +1,5 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}@@ -31,6 +29,7 @@     PrinterOptsPartial,     PrinterOptsTotal,     defaultPrinterOpts,+    defaultPrinterOptsYaml,     fillMissingPrinterOpts,     CommaStyle (..),     FunctionArrowsStyle (..),@@ -40,6 +39,7 @@     LetStyle (..),     InStyle (..),     Unicode (..),+    ColumnLimit (..),     parsePrinterOptsCLI,     parsePrinterOptType, @@ -54,17 +54,17 @@  import Control.Monad (forM) import Data.Aeson ((.!=), (.:?))-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson+import Data.Aeson qualified as Aeson+import Data.Aeson.Types qualified as Aeson import Data.Functor.Identity (Identity (..))-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Set (Set)-import qualified Data.Set as Set+import Data.Set qualified as Set import Data.String (fromString)-import qualified Data.Yaml as Yaml+import Data.Yaml qualified as Yaml import Distribution.Types.PackageName (PackageName) import GHC.Generics (Generic)-import qualified GHC.Types.SrcLoc as GHC+import GHC.Types.SrcLoc qualified as GHC import Ormolu.Config.Gen import Ormolu.Fixity (FixityMap) import Ormolu.Fixity.Parser (parseFixityDeclaration)

@@ -2,6 +2,7 @@ {- ***** DO NOT EDIT: This module is autogenerated ***** -}  {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -15,8 +16,11 @@   , LetStyle (..)   , InStyle (..)   , Unicode (..)+  , SingleConstraintParens (..)+  , ColumnLimit (..)   , emptyPrinterOpts   , defaultPrinterOpts+  , defaultPrinterOptsYaml   , fillMissingPrinterOpts   , parsePrinterOptsCLI   , parsePrinterOptsJSON@@ -27,15 +31,18 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson import Data.Functor.Identity (Identity)+import Data.Scientific (floatingOrInteger) import qualified Data.Text as Text import GHC.Generics (Generic)-import Text.Read (readEither)+import Text.Read (readEither, readMaybe)  -- | Options controlling formatting output. data PrinterOpts f =   PrinterOpts     { -- | Number of spaces per indentation step       poIndentation :: f Int+    , -- | Max line length for automatic line breaking+      poColumnLimit :: f ColumnLimit     , -- | Styling of arrows in type signatures       poFunctionArrows :: f FunctionArrowsStyle     , -- | How to place commas in multi-line lists, records, etc.@@ -56,6 +63,8 @@       poLetStyle :: f LetStyle     , -- | How to align the 'in' keyword with respect to the 'let' keyword       poInStyle :: f InStyle+    , -- | Whether to put parentheses around a single constraint+      poSingleConstraintParens :: f SingleConstraintParens     , -- | Output Unicode syntax       poUnicode :: f Unicode     , -- | Give the programmer more choice on where to insert blank lines@@ -67,6 +76,7 @@ emptyPrinterOpts =   PrinterOpts     { poIndentation = Nothing+    , poColumnLimit = Nothing     , poFunctionArrows = Nothing     , poCommaStyle = Nothing     , poImportExportStyle = Nothing@@ -77,6 +87,7 @@     , poHaddockStyleModule = Nothing     , poLetStyle = Nothing     , poInStyle = Nothing+    , poSingleConstraintParens = Nothing     , poUnicode = Nothing     , poRespectful = Nothing     }@@ -85,6 +96,7 @@ defaultPrinterOpts =   PrinterOpts     { poIndentation = pure 4+    , poColumnLimit = pure NoLimit     , poFunctionArrows = pure TrailingArrows     , poCommaStyle = pure Leading     , poImportExportStyle = pure ImportExportDiffFriendly@@ -95,6 +107,7 @@     , poHaddockStyleModule = pure PrintStyleInherit     , poLetStyle = pure LetAuto     , poInStyle = pure InRightAlign+    , poSingleConstraintParens = pure ConstraintAlways     , poUnicode = pure UnicodeNever     , poRespectful = pure True     }@@ -110,6 +123,7 @@ fillMissingPrinterOpts p1 p2 =   PrinterOpts     { poIndentation = maybe (poIndentation p2) pure (poIndentation p1)+    , poColumnLimit = maybe (poColumnLimit p2) pure (poColumnLimit p1)     , poFunctionArrows = maybe (poFunctionArrows p2) pure (poFunctionArrows p1)     , poCommaStyle = maybe (poCommaStyle p2) pure (poCommaStyle p1)     , poImportExportStyle = maybe (poImportExportStyle p2) pure (poImportExportStyle p1)@@ -120,6 +134,7 @@     , poHaddockStyleModule = maybe (poHaddockStyleModule p2) pure (poHaddockStyleModule p1)     , poLetStyle = maybe (poLetStyle p2) pure (poLetStyle p1)     , poInStyle = maybe (poInStyle p2) pure (poInStyle p1)+    , poSingleConstraintParens = maybe (poSingleConstraintParens p2) pure (poSingleConstraintParens p1)     , poUnicode = maybe (poUnicode p2) pure (poUnicode p1)     , poRespectful = maybe (poRespectful p2) pure (poRespectful p1)     }@@ -135,6 +150,10 @@       "Number of spaces per indentation step (default: 4)"       "INT"     <*> f+      "column-limit"+      "Max line length for automatic line breaking (default: none)"+      "OPTION"+    <*> f       "function-arrows"       "Styling of arrows in type signatures (choices: \"trailing\", \"leading\", or \"leading-args\") (default: trailing)"       "OPTION"@@ -175,6 +194,10 @@       "How to align the 'in' keyword with respect to the 'let' keyword (choices: \"left-align\", \"right-align\", or \"no-space\") (default: right-align)"       "OPTION"     <*> f+      "single-constraint-parens"+      "Whether to put parentheses around a single constraint (choices: \"auto\", \"always\", or \"never\") (default: always)"+      "OPTION"+    <*> f       "unicode"       "Output Unicode syntax (choices: \"detect\", \"always\", or \"never\") (default: never)"       "OPTION"@@ -190,6 +213,7 @@ parsePrinterOptsJSON f =   pure PrinterOpts     <*> f "indentation"+    <*> f "column-limit"     <*> f "function-arrows"     <*> f "comma-style"     <*> f "import-export-style"@@ -200,6 +224,7 @@     <*> f "haddock-style-module"     <*> f "let-style"     <*> f "in-style"+    <*> f "single-constraint-parens"     <*> f "unicode"     <*> f "respectful" @@ -269,6 +294,17 @@   | UnicodeNever   deriving (Eq, Show, Enum, Bounded) +data SingleConstraintParens+  = ConstraintAuto+  | ConstraintAlways+  | ConstraintNever+  deriving (Eq, Show, Enum, Bounded)++data ColumnLimit+  = NoLimit+  | ColumnLimit Int+  deriving (Eq, Show)+ instance Aeson.FromJSON CommaStyle where   parseJSON =     Aeson.withText "CommaStyle" $ \s ->@@ -407,3 +443,101 @@           [ "unknown value: " <> show s           , "Valid values are: \"detect\", \"always\", or \"never\""           ]++instance Aeson.FromJSON SingleConstraintParens where+  parseJSON =+    Aeson.withText "SingleConstraintParens" $ \s ->+      either Aeson.parseFail pure $+        parsePrinterOptType (Text.unpack s)++instance PrinterOptsFieldType SingleConstraintParens where+  parsePrinterOptType s =+    case s of+      "auto" -> Right ConstraintAuto+      "always" -> Right ConstraintAlways+      "never" -> Right ConstraintNever+      _ ->+        Left . unlines $+          [ "unknown value: " <> show s+          , "Valid values are: \"auto\", \"always\", or \"never\""+          ]++instance Aeson.FromJSON ColumnLimit where+  parseJSON =+    \case+       Aeson.String "none" ->+         pure NoLimit+       Aeson.Number x+         | Right x' <- (floatingOrInteger x :: Either Double Int) ->+             pure $ ColumnLimit x'+       s ->+         fail . unlines $+           [ "unknown value: " <> show s,+             "Valid values are: \"none\", or an integer"+           ]++instance PrinterOptsFieldType ColumnLimit where+  parsePrinterOptType =+    \s ->+      case s of+        "none" -> Right NoLimit+        _+          | Just someInt <- readMaybe s ->+              Right . ColumnLimit $ someInt+        _ ->+          Left . unlines $+            [ "unknown value: " <> show s,+              "Valid values are: \"none\", or an integer"+            ]++defaultPrinterOptsYaml :: String+defaultPrinterOptsYaml =+  unlines+    [ "# Number of spaces per indentation step"+    , "indentation: 4"+    , ""+    , "# Max line length for automatic line breaking"+    , "column-limit: none"+    , ""+    , "# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)"+    , "function-arrows: trailing"+    , ""+    , "# How to place commas in multi-line lists, records, etc. (choices: leading or trailing)"+    , "comma-style: leading"+    , ""+    , "# Styling of import/export lists (choices: leading, trailing, or diff-friendly)"+    , "import-export-style: diff-friendly"+    , ""+    , "# Whether to full-indent or half-indent 'where' bindings past the preceding body"+    , "indent-wheres: false"+    , ""+    , "# Whether to leave a space before an opening record brace"+    , "record-brace-space: false"+    , ""+    , "# Number of spaces between top-level declarations"+    , "newlines-between-decls: 1"+    , ""+    , "# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)"+    , "haddock-style: multi-line"+    , ""+    , "# How to print module docstring"+    , "haddock-style-module: null"+    , ""+    , "# Styling of let blocks (choices: auto, inline, newline, or mixed)"+    , "let-style: auto"+    , ""+    , "# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)"+    , "in-style: right-align"+    , ""+    , "# Whether to put parentheses around a single constraint (choices: auto, always, or never)"+    , "single-constraint-parens: always"+    , ""+    , "# Output Unicode syntax (choices: detect, always, or never)"+    , "unicode: never"+    , ""+    , "# Give the programmer more choice on where to insert blank lines"+    , "respectful: true"+    , ""+    , "# Fixity information for operators"+    , "fixities: []"+    ]

@@ -1,13 +1,7 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeepSubsumption #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-}-#if !MIN_VERSION_base(4,17,0)--- needed on GHC 9.0 and 9.2 due to simplified subsumption-{-# LANGUAGE ImpredicativeTypes #-}-#endif  -- | This module allows us to diff two 'ParseResult's. module Ormolu.Diff.ParseResult@@ -18,6 +12,7 @@  import Data.ByteString (ByteString) import Data.Foldable+import Data.Function import Data.Generics import GHC.Hs import GHC.Types.SourceText@@ -58,7 +53,7 @@       prParsedSource = hs1     } =     diffCommentStream cstream0 cstream1-      <> matchIgnoringSrcSpans+      <> diffHsModule         hs0 {hsmodImports = concat . normalizeImports False $ hsmodImports hs0}         hs1 {hsmodImports = concat . normalizeImports False $ hsmodImports hs1} @@ -69,16 +64,18 @@   where     commentLines = concatMap (toList . unComment . unLoc) --- | Compare two values for equality disregarding the following aspects:+-- | Compare two modules for equality disregarding the following aspects: -- --     * 'SrcSpan's --     * ordering of import lists---     * style (ASCII vs Unicode) of arrows+--     * style (ASCII vs Unicode) of arrows, colons --     * LayoutInfo (brace style) in extension fields --     * Empty contexts in type classes --     * Parens around derived type classes-matchIgnoringSrcSpans :: (Data a) => a -> a -> ParseResultDiff-matchIgnoringSrcSpans a = genericQuery a+--     * 'TokenLocation' (in 'LHsToken'/'LHsUniToken')+--     * 'EpaLocation'+diffHsModule :: HsModule GhcPs -> HsModule GhcPs -> ParseResultDiff+diffHsModule = genericQuery   where     genericQuery :: GenericQ (GenericQ ParseResultDiff)     genericQuery x y@@ -94,44 +91,54 @@           mconcat $             gzipWithQ               ( genericQuery-                  `extQ` srcSpanEq+                  `extQ` considerEqual @SrcSpan                   `ext1Q` epAnnEq-                  `extQ` sourceTextEq+                  `extQ` considerEqual @SourceText                   `extQ` hsDocStringEq                   `extQ` importDeclQualifiedStyleEq-                  `extQ` unicodeArrowStyleEq-                  `extQ` layoutInfoEq+                  `extQ` considerEqual @(LayoutInfo GhcPs)                   `extQ` classDeclCtxEq                   `extQ` derivedTyClsParensEq-                  `extQ` epaCommentsEq+                  `extQ` considerEqual @EpAnnComments -- ~ XCGRHSs GhcPs+                  `extQ` considerEqual @TokenLocation -- in LHs(Uni)Token+                  `extQ` considerEqual @EpaLocation                   `ext2Q` forLocated+                  -- unicode-related+                  `extQ` considerEqual @(HsUniToken "->" "→")+                  `extQ` considerEqual @(HsUniToken "::" "∷")+                  `extQ` considerEqual @(HsLinearArrowTokens GhcPs)               )               x               y       | otherwise = Different []-    srcSpanEq :: SrcSpan -> GenericQ ParseResultDiff-    srcSpanEq _ _ = Same-    epAnnEq :: EpAnn a -> GenericQ ParseResultDiff-    epAnnEq _ _ = Same-    sourceTextEq :: SourceText -> GenericQ ParseResultDiff-    sourceTextEq _ _ = Same-    importDeclQualifiedStyleEq ::-      ImportDeclQualifiedStyle ->++    considerEqualVia ::+      forall a.+      (Typeable a) =>+      (a -> a -> ParseResultDiff) ->+      a ->       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 []+    considerEqualVia f x (cast -> Just x') = f x x'+    considerEqualVia _ _ _ = Different []++    considerEqualVia' f =+      considerEqualVia $ \x x' -> if f x x' then Same else Different []++    considerEqual :: forall a. (Typeable a) => a -> GenericQ ParseResultDiff+    considerEqual = considerEqualVia $ \_ _ -> Same++    epAnnEq :: EpAnn a -> b -> ParseResultDiff+    epAnnEq _ _ = Same++    importDeclQualifiedStyleEq = considerEqualVia' f+      where+        f QualifiedPre QualifiedPost = True+        f QualifiedPost QualifiedPre = True+        f x x' = x == x'+     hsDocStringEq :: HsDocString -> GenericQ ParseResultDiff-    hsDocStringEq str0 str1' =-      case cast str1' :: Maybe HsDocString of-        Nothing -> Different []-        Just str1 ->-          if splitDocString True str0 == splitDocString True str1-            then Same-            else Different []+    hsDocStringEq = considerEqualVia' ((==) `on` splitDocString True)+     forLocated ::       (Data e0, Data e1) =>       GenLocated e0 e1 ->@@ -147,25 +154,11 @@             else d         UnhelpfulSpan _ -> d     appendSpan _ d = d-    -- as we normalize arrow styles (e.g. -> vs →), we consider them equal here-    unicodeArrowStyleEq :: HsArrow GhcPs -> GenericQ ParseResultDiff-    unicodeArrowStyleEq (HsUnrestrictedArrow _) (castArrow -> Just (HsUnrestrictedArrow _)) = Same-    unicodeArrowStyleEq (HsLinearArrow _) (castArrow -> Just (HsLinearArrow _)) = Same-    unicodeArrowStyleEq (HsExplicitMult _ _ t) (castArrow -> Just (HsExplicitMult _ _ t')) = genericQuery t t'-    unicodeArrowStyleEq _ _ = Different []-    castArrow :: (Typeable a) => a -> Maybe (HsArrow GhcPs)-    castArrow = cast-    -- LayoutInfo ~ XClassDecl GhcPs tracks brace information-    layoutInfoEq :: LayoutInfo -> GenericQ ParseResultDiff-    layoutInfoEq _ (cast -> Just (_ :: LayoutInfo)) = Same-    layoutInfoEq _ _ = Different []+     classDeclCtxEq :: TyClDecl GhcPs -> GenericQ ParseResultDiff     classDeclCtxEq ClassDecl {tcdCtxt = Just (L _ []), ..} tc' = genericQuery ClassDecl {tcdCtxt = Nothing, ..} tc'     classDeclCtxEq tc tc' = genericQuery tc tc'+     derivedTyClsParensEq :: DerivClauseTys GhcPs -> GenericQ ParseResultDiff     derivedTyClsParensEq (DctSingle NoExtField sigTy) dct' = genericQuery (DctMulti NoExtField [sigTy]) dct'     derivedTyClsParensEq dct dct' = genericQuery dct dct'-    -- EpAnnComments ~ XCGRHSs GhcPs-    epaCommentsEq :: EpAnnComments -> GenericQ ParseResultDiff-    epaCommentsEq _ (cast -> Just (_ :: EpAnnComments)) = Same-    epaCommentsEq _ _ = Different []

@@ -1,7 +1,6 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE QualifiedDo #-} {-# LANGUAGE RecordWildCards #-}  -- | This module allows us to diff two 'Text' values.@@ -13,16 +12,18 @@   ) where -import Control.Monad-import qualified Data.Algorithm.Diff as D+import Control.Monad (unless, when)+import Data.Algorithm.Diff qualified as D+import Data.Foldable (for_) import Data.IntSet (IntSet)-import qualified Data.IntSet as IntSet+import Data.IntSet qualified as IntSet import Data.List (foldl') import Data.Maybe (listToMaybe) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import GHC.Types.SrcLoc import Ormolu.Terminal+import Ormolu.Terminal.QualifiedDo qualified as Term  ---------------------------------------------------------------------------- -- Types@@ -103,39 +104,39 @@  -- | Print the given 'TextDiff' as a 'Term' action. This function tries to -- mimic the style of @git diff@.-printTextDiff :: TextDiff -> Term ()-printTextDiff TextDiff {..} = do-  (bold . putS) textDiffPath+printTextDiff :: TextDiff -> Term+printTextDiff TextDiff {..} = Term.do+  (bold . put . T.pack) textDiffPath   newline-  forM_ (toHunks (assignLines textDiffDiffList)) $ \hunk@Hunk {..} ->-    when (isSelectedLine textDiffSelectedLines hunk) $ do-      cyan $ do+  for_ (toHunks (assignLines textDiffDiffList)) $ \hunk@Hunk {..} ->+    when (isSelectedLine textDiffSelectedLines hunk) $ Term.do+      cyan $ Term.do         put "@@ -"-        putS (show hunkFirstStartLine)+        putShow hunkFirstStartLine         put ","-        putS (show hunkFirstLength)+        putShow hunkFirstLength         put " +"-        putS (show hunkSecondStartLine)+        putShow hunkSecondStartLine         put ","-        putS (show hunkSecondLength)+        putShow hunkSecondLength         put " @@"       newline-      forM_ hunkDiff $ \case+      for_ hunkDiff $ \case         D.Both ys _ ->-          forM_ ys $ \y -> do+          for_ ys $ \y -> Term.do             unless (T.null y) $               put "  "             put y             newline         D.First ys ->-          forM_ ys $ \y -> red $ do+          for_ ys $ \y -> red $ Term.do             put "-"             unless (T.null y) $               put " "             put y             newline         D.Second ys ->-          forM_ ys $ \y -> green $ do+          for_ ys $ \y -> green $ Term.do             put "+"             unless (T.null y) $               put " "

@@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QualifiedDo #-}  -- | 'OrmoluException' type and surrounding definitions. module Ormolu.Exception@@ -10,15 +11,17 @@ where  import Control.Exception-import Control.Monad (forM_)+import Data.Foldable (for_) import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Void (Void)+import Distribution.Parsec.Error (PError, showPError) import GHC.Types.SrcLoc import Ormolu.Diff.Text (TextDiff, printTextDiff) import Ormolu.Terminal+import Ormolu.Terminal.QualifiedDo qualified as Term import System.Exit (ExitCode (..)) import System.IO import Text.Megaparsec (ParseErrorBundle, errorBundlePretty)@@ -36,74 +39,76 @@   | -- | Some GHC options were not recognized     OrmoluUnrecognizedOpts (NonEmpty String)   | -- | Cabal file parsing failed-    OrmoluCabalFileParsingFailed FilePath+    OrmoluCabalFileParsingFailed FilePath (NonEmpty PError)   | -- | Missing input file path when using stdin input and     -- accounting for .cabal files     OrmoluMissingStdinInputFile   | -- | A parse error in a fixity overrides file     OrmoluFixityOverridesParseError (ParseErrorBundle Text Void)-  deriving (Eq, Show)+  deriving (Show)  instance Exception OrmoluException  -- | Print an 'OrmoluException'. printOrmoluException ::   OrmoluException ->-  Term ()+  Term printOrmoluException = \case-  OrmoluParsingFailed s e -> do-    bold (putSrcSpan s)+  OrmoluParsingFailed s e -> Term.do+    bold (putOutputable s)     newline     put "  The GHC parser (in Haddock mode) failed:"     newline     put "  "     put (T.pack e)     newline-  OrmoluOutputParsingFailed s e -> do-    bold (putSrcSpan s)+  OrmoluOutputParsingFailed s e -> Term.do+    bold (putOutputable s)     newline     put "  Parsing of formatted code failed:"+    newline     put "  "     put (T.pack e)     newline-  OrmoluASTDiffers diff ss -> do+  OrmoluASTDiffers diff ss -> Term.do     printTextDiff diff     newline     put "  AST of input and AST of formatted code differ."     newline-    forM_ ss $ \s -> do+    for_ ss $ \s -> Term.do       put "    at "-      putRealSrcSpan s+      putOutputable s       newline     put "  Please, consider reporting the bug."     newline     put "  To format anyway, use --unsafe."     newline-  OrmoluNonIdempotentOutput diff -> do+  OrmoluNonIdempotentOutput diff -> Term.do     printTextDiff diff     newline     put "  Formatting is not idempotent."     newline     put "  Please, consider reporting the bug."     newline-  OrmoluUnrecognizedOpts opts -> do+  OrmoluUnrecognizedOpts opts -> Term.do     put "The following GHC options were not recognized:"     newline     put "  "-    (putS . unwords . NE.toList) opts+    (put . T.unwords . map T.pack . NE.toList) opts     newline-  OrmoluCabalFileParsingFailed cabalFile -> do+  OrmoluCabalFileParsingFailed cabalFile parseErrors -> Term.do     put "Parsing this .cabal file failed:"     newline-    put $ "  " <> T.pack cabalFile-    newline-  OrmoluMissingStdinInputFile -> do+    for_ parseErrors $ \e -> Term.do+      put . T.pack $ "  " <> showPError cabalFile e+      newline+  OrmoluMissingStdinInputFile -> Term.do     put "The --stdin-input-file option is necessary when using input"     newline     put "from stdin and accounting for .cabal files"     newline-  OrmoluFixityOverridesParseError errorBundle -> do-    putS (errorBundlePretty errorBundle)+  OrmoluFixityOverridesParseError errorBundle -> Term.do+    put . T.pack . errorBundlePretty $ errorBundle     newline  -- | Inside this wrapper 'OrmoluException' will be caught and displayed

@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}@@ -27,27 +26,25 @@   ) where -import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.ByteString.Lazy as BL+import Data.Binary qualified as Binary+import Data.Binary.Get qualified as Binary+import Data.ByteString.Lazy qualified as BL import Data.Foldable (foldl') import Data.List.NonEmpty (NonEmpty ((:|)))-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe) import Data.MemoTrie (memo) import Data.Semigroup (sconcat) import Data.Set (Set)-import qualified Data.Set as Set+import Data.Set qualified as Set import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName) import Ormolu.Fixity.Internal #if BUNDLE_FIXITIES import Data.FileEmbed (embedFile) #else-import qualified Data.ByteString.Unsafe as BU-import Foreign.Ptr-import System.Environment (getEnv)+import qualified Data.ByteString as B import System.IO.Unsafe (unsafePerformIO) #endif @@ -59,12 +56,10 @@     BL.fromStrict $(embedFile "extract-hackage-info/hackage-info.bin") #else -- The GHC WASM backend does not yet support Template Haskell, so we instead--- pass in the encoded fixity DB at runtime by storing the pointer and length of--- the bytes in an environment variable.-HackageInfo packageToOps packageToPopularity = unsafePerformIO $ do-  (ptr, len) <- read <$> getEnv "ORMOLU_HACKAGE_INFO"-  Binary.runGet Binary.get . BL.fromStrict-    <$> BU.unsafePackMallocCStringLen (intPtrToPtr $ IntPtr ptr, len)+-- pass in the encoded fixity DB via pre-initialization with Wizer.+HackageInfo packageToOps packageToPopularity =+  unsafePerformIO $+    Binary.runGet Binary.get . BL.fromStrict <$> B.readFile "hackage-info.bin" {-# NOINLINE packageToOps #-} {-# NOINLINE packageToPopularity #-} #endif

@@ -1,11 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-}  module Ormolu.Fixity.Internal@@ -24,16 +19,17 @@   ) where +import Control.DeepSeq (NFData) import Data.Binary (Binary) import Data.ByteString.Short (ShortByteString)-import qualified Data.ByteString.Short as SBS+import Data.ByteString.Short qualified as SBS import Data.Foldable (asum) import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.String (IsString (..)) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import Data.Text qualified as T+import Data.Text.Encoding qualified as T import Distribution.Types.PackageName (PackageName) import GHC.Data.FastString (fs_sbs) import GHC.Generics (Generic)@@ -45,7 +41,7 @@   | InfixR   | InfixN   deriving stock (Eq, Ord, Show, Generic)-  deriving anyclass (Binary)+  deriving anyclass (Binary, NFData)  -- | Fixity information about an infix operator that takes the uncertainty -- that can arise from conflicting definitions into account.@@ -60,7 +56,7 @@     fiMaxPrecedence :: Int   }   deriving stock (Eq, Ord, Show, Generic)-  deriving anyclass (Binary)+  deriving anyclass (Binary, NFData)  -- | The lowest level of information we can have about an operator. defaultFixityInfo :: FixityInfo@@ -100,7 +96,7 @@   { -- | Invariant: UTF-8 encoded     getOpName :: ShortByteString   }-  deriving newtype (Eq, Ord, Binary)+  deriving newtype (Eq, Ord, Binary, NFData)  -- | Convert an 'OpName' to 'Text'. unOpName :: OpName -> Text@@ -140,9 +136,9 @@ -- each package, if available. data HackageInfo   = HackageInfo+      -- | Map from package name to a map from operator name to its fixity       (Map PackageName FixityMap)-      -- ^ Map from package name to a map from operator name to its fixity+      -- | Map from package name to its 30-days download count from Hackage       (Map PackageName Int)-      -- ^ Map from package name to its 30-days download count from Hackage   deriving stock (Generic)   deriving anyclass (Binary)

@@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-}  -- | Parser for fixity maps. module Ormolu.Fixity.Parser@@ -13,15 +12,15 @@   ) where -import qualified Data.Char as Char-import qualified Data.Map.Strict as Map+import Data.Char qualified as Char+import Data.Map.Strict qualified as Map import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Void (Void) import Ormolu.Fixity import Text.Megaparsec import Text.Megaparsec.Char-import qualified Text.Megaparsec.Char.Lexer as L+import Text.Megaparsec.Char.Lexer qualified as L  type Parser = Parsec Void Text 

@@ -7,14 +7,14 @@   ) where -import qualified Data.Char as Char-import qualified Data.Map.Strict as Map+import Data.Char qualified as Char+import Data.Map.Strict qualified as Map import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL+import Data.Text qualified as T+import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Builder (Builder)-import qualified Data.Text.Lazy.Builder as B-import qualified Data.Text.Lazy.Builder.Int as B+import Data.Text.Lazy.Builder qualified as B+import Data.Text.Lazy.Builder.Int qualified as B import Ormolu.Fixity  -- | Print out a textual representation of a 'FixityMap'.

@@ -1,5 +1,5 @@+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} @@ -15,7 +15,7 @@ import Data.Function (on) import Data.List (foldl', nubBy, sortBy, sortOn) import Data.Map.Strict (Map)-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import GHC.Data.FastString import GHC.Hs import GHC.Hs.ImpExp as GHC@@ -23,8 +23,6 @@ import GHC.Types.PkgQual import GHC.Types.SourceText import GHC.Types.SrcLoc-import GHC.Unit.Module.Name-import GHC.Unit.Types import Ormolu.Utils (groupBy', notImplemented, separatedByBlank, showOutputable)  -- | Sort, group and normalize imports.@@ -49,7 +47,7 @@       L         l         ImportDecl-          { ideclHiding = second (fmap normalizeLies) <$> ideclHiding,+          { ideclImportList = second (fmap normalizeLies) <$> ideclImportList,             ..           } @@ -63,7 +61,7 @@   L     lx     ImportDecl-      { ideclHiding = case (ideclHiding, GHC.ideclHiding y) of+      { ideclImportList = case (ideclImportList, GHC.ideclImportList y) of           (Just (hiding, L l' xs), Just (_, L _ ys)) ->             Just (hiding, (L l' (normalizeLies (xs ++ ys))))           _ -> Nothing,@@ -80,12 +78,23 @@     importSource :: IsBootInterface,     importSafe :: Bool,     importQualified :: Bool,-    importImplicit :: Bool,     importAs :: Maybe ModuleName,-    importHiding :: Maybe Bool+    importHiding :: Maybe ImportListInterpretationOrd   }   deriving (Eq, Ord) +-- | 'ImportListInterpretation' does not have an 'Ord' instance.+newtype ImportListInterpretationOrd = ImportListInterpretationOrd+  { unImportListInterpretationOrd :: ImportListInterpretation+  }+  deriving stock (Eq)++instance Ord ImportListInterpretationOrd where+  compare = compare `on` toBool . unImportListInterpretationOrd+    where+      toBool Exactly = False+      toBool EverythingBut = True+ -- | Obtain an 'ImportId' for a given import. importId :: LImportDecl GhcPs -> ImportId importId (L _ ImportDecl {..}) =@@ -99,9 +108,8 @@         QualifiedPre -> True         QualifiedPost -> True         NotQualified -> False,-      importImplicit = ideclImplicit,       importAs = unLoc <$> ideclAs,-      importHiding = fst <$> ideclHiding+      importHiding = ImportListInterpretationOrd . fst <$> ideclImportList     }   where     isPrelude = moduleNameString moduleName == "Prelude"@@ -163,15 +171,15 @@                in Just (f <$> old)        in M.alter alter wname m --- | A wrapper for @'IEWrappedName' 'RdrName'@ that allows us to define an+-- | A wrapper for @'IEWrappedName' 'GhcPs'@ that allows us to define an -- 'Ord' instance for it.-newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)+newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName GhcPs)   deriving (Eq)  instance Ord IEWrappedNameOrd where   compare (IEWrappedNameOrd x) (IEWrappedNameOrd y) = compareIewn x y --- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@.+-- | Project @'IEWrappedName' 'GhcPs'@ from @'IE' 'GhcPs'@. getIewn :: IE GhcPs -> IEWrappedNameOrd getIewn = \case   IEVar NoExtField x -> IEWrappedNameOrd (unLoc x)@@ -184,18 +192,18 @@   IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"  -- | Like 'compareIewn' for located wrapped names.-compareLIewn :: LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering+compareLIewn :: LIEWrappedName GhcPs -> LIEWrappedName GhcPs -> Ordering compareLIewn = compareIewn `on` unLoc --- | Compare two @'IEWrapppedName' 'RdrName'@ things.-compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering-compareIewn (IEName x) (IEName y) = unLoc x `compareRdrName` unLoc y-compareIewn (IEName _) (IEPattern _ _) = LT-compareIewn (IEName _) (IEType _ _) = LT-compareIewn (IEPattern _ _) (IEName _) = GT+-- | Compare two @'IEWrapppedName' 'GhcPs'@ things.+compareIewn :: IEWrappedName GhcPs -> IEWrappedName GhcPs -> Ordering+compareIewn (IEName _ x) (IEName _ y) = unLoc x `compareRdrName` unLoc y+compareIewn (IEName _ _) (IEPattern _ _) = LT+compareIewn (IEName _ _) (IEType _ _) = LT+compareIewn (IEPattern _ _) (IEName _ _) = GT compareIewn (IEPattern _ x) (IEPattern _ y) = unLoc x `compareRdrName` unLoc y compareIewn (IEPattern _ _) (IEType _ _) = LT-compareIewn (IEType _ _) (IEName _) = GT+compareIewn (IEType _ _) (IEName _ _) = GT compareIewn (IEType _ _) (IEPattern _ _) = GT compareIewn (IEType _ x) (IEType _ y) = unLoc x `compareRdrName` unLoc y 

@@ -1,7 +1,8 @@+{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -18,29 +19,31 @@ import Control.Monad.IO.Class import Data.Char (isSpace) import Data.Functor+import Data.Functor.Identity (Identity (..)) import Data.Generics-import qualified Data.List as L-import qualified Data.List.NonEmpty as NE+import Data.List qualified as L+import Data.List.NonEmpty qualified as NE import Data.Text (Text) import GHC.Data.Bag (bagToList)-import qualified GHC.Data.EnumSet as EnumSet-import qualified GHC.Data.FastString as GHC-import qualified GHC.Driver.CmdLine as GHC+import GHC.Data.EnumSet qualified as EnumSet+import GHC.Data.FastString qualified as GHC+import GHC.Driver.CmdLine qualified as GHC import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Session as GHC import GHC.DynFlags (baseDynFlags) import GHC.Hs hiding (UnicodeSyntax) import GHC.LanguageExtensions.Type (Extension (..))-import qualified GHC.Parser as GHC-import qualified GHC.Parser.Header as GHC-import qualified GHC.Parser.Lexer as GHC-import GHC.Types.Error (getMessages)-import qualified GHC.Types.SourceError as GHC (handleSourceError)+import GHC.Parser qualified as GHC+import GHC.Parser.Header qualified as GHC+import GHC.Parser.Lexer qualified as GHC+import GHC.Types.Error (NoDiagnosticOpts (..), getMessages)+import GHC.Types.SourceError qualified as GHC (handleSourceError) import GHC.Types.SrcLoc import GHC.Utils.Error import GHC.Utils.Outputable (defaultSDocContext)-import qualified GHC.Utils.Panic as GHC+import GHC.Utils.Panic qualified as GHC import Ormolu.Config+import Ormolu.Config.Gen (SingleConstraintParens (..)) import Ormolu.Exception import Ormolu.Fixity (LazyFixityMap) import Ormolu.Parser.CommentStream@@ -98,7 +101,7 @@   FilePath ->   Text ->   m (Either (SrcSpan, String) ParseResult)-parseModuleSnippet Config {..} fixityMap dynFlags path rawInput = liftIO $ do+parseModuleSnippet config@Config {..} fixityMap dynFlags path rawInput = liftIO $ do   let (input, indent) = removeIndentation . linesInRegion cfgRegion $ rawInput   let pStateErrors pstate =         let errs = bagToList . getMessages $ GHC.getPsErrorMessages pstate@@ -107,15 +110,19 @@               SevError -> 1 :: Int               SevWarning -> 2               SevIgnore -> 3-            showErr =-              showOutputable-                . formatBulleted defaultSDocContext-                . diagnosticMessage-                . errMsgDiagnostic+            showErr (errMsgDiagnostic -> err) = codeMsg <> msg+              where+                codeMsg = case diagnosticCode err of+                  Just code -> "[" <> showOutputable code <> "] "+                  Nothing -> ""+                msg =+                  showOutputable+                    . formatBulleted defaultSDocContext+                    . diagnosticMessage NoDiagnosticOpts+                    $ err          in case L.sortOn (rateSeverity . errMsgSeverity) errs of               [] -> Nothing               err : _ ->-                -- Show instance returns a short error message                 Just (fixupErrSpan (errMsgSpan err), showErr err)       parser = case cfgSourceType of         ModuleSource -> GHC.parseModule@@ -125,7 +132,7 @@           case pStateErrors pstate of             Just err -> Left err             Nothing -> error "PFailed does not have an error"-        GHC.POk pstate (L _ (normalizeModule -> hsModule)) ->+        GHC.POk pstate (L _ (normalizeModule config -> hsModule)) ->           case pStateErrors pstate of             -- Some parse errors (pattern/arrow syntax in expr context)             -- do not cause a parse error, but they are replaced with "_"@@ -151,8 +158,8 @@  -- | Normalize a 'HsModule' by sorting its export lists, dropping -- blank comments, etc.-normalizeModule :: HsModule -> HsModule-normalizeModule hsmod =+normalizeModule :: Config RegionDeltas -> HsModule GhcPs -> HsModule GhcPs+normalizeModule Config {..} hsmod =   everywhere     (extT (mkT dropBlankTypeHaddocks) patchContext)     hsmod@@ -160,8 +167,11 @@           hsmodImports hsmod,         hsmodDecls =           filter (not . isBlankDocD . unLoc) (hsmodDecls hsmod),-        hsmodHaddockModHeader =-          mfilter (not . isBlankDocString) (hsmodHaddockModHeader hsmod),+        hsmodExt =+          (hsmodExt hsmod)+            { hsmodHaddockModHeader =+                mfilter (not . isBlankDocString) (hsmodHaddockModHeader (hsmodExt hsmod))+            },         hsmodExports =           (fmap . fmap) (filter (not . isBlankDocIE . unLoc)) (hsmodExports hsmod)       }@@ -179,10 +189,17 @@         | isBlankDocString s -> ty       a -> a     patchContext :: LHsContext GhcPs -> LHsContext GhcPs-    patchContext = mapLoc $ \case-      [x@(L _ (HsParTy _ _))] -> [x]-      [x@(L lx _)] -> [L lx (HsParTy EpAnnNotUsed x)]+    patchContext = fmap $ \case+      [x@(L _ (HsParTy _ t))] -> unwrapParens x t+      [x@(L _ _)] -> wrapParens x       xs -> xs+    constraintParens = runIdentity (poSingleConstraintParens cfgPrinterOpts)+    unwrapParens outer inner = case constraintParens of+      ConstraintNever -> [inner]+      _ -> [outer]+    wrapParens x@(L lx _) = case constraintParens of+      ConstraintAlways -> [L lx (HsParTy EpAnnNotUsed x)]+      _ -> [x]  -- | Enable all language extensions that we think should be enabled by -- default for ease of use.@@ -220,7 +237,8 @@     LexicalNegation, -- implies NegativeLiterals     LinearTypes, -- steals the (%) type operator in some cases     OverloadedRecordDot, -- f.g parses differently-    OverloadedRecordUpdate -- qualified fields are not supported+    OverloadedRecordUpdate, -- qualified fields are not supported+    OverloadedLabels -- a#b is parsed differently   ]  -- | Run a 'GHC.P' computation.

@@ -1,9 +1,5 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-}  -- | Functions for working with comment stream.@@ -26,19 +22,19 @@ import Data.Data (Data) import Data.Generics.Schemes import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NE-import qualified Data.Map.Lazy as M+import Data.List.NonEmpty qualified as NE+import Data.Map.Lazy qualified as M import Data.Maybe-import qualified Data.Set as S+import Data.Set qualified as S import Data.Text (Text)-import qualified Data.Text as T-import qualified GHC.Data.Strict as Strict+import Data.Text qualified as T+import GHC.Data.Strict qualified as Strict import GHC.Hs (HsModule) import GHC.Hs.Doc import GHC.Hs.Extension import GHC.Hs.ImpExp import GHC.Parser.Annotation (EpAnnComments (..), getLocA)-import qualified GHC.Parser.Annotation as GHC+import GHC.Parser.Annotation qualified as GHC import GHC.Types.SrcLoc import Ormolu.Parser.Pragma import Ormolu.Utils (onTheSameLine, showOutputable)@@ -57,7 +53,7 @@   -- | Original input   Text ->   -- | Module to use for comment extraction-  HsModule ->+  HsModule GhcPs ->   -- | Stack header, pragmas, and comment stream   ( Maybe (RealLocated Comment),     [([RealLocated Comment], Pragma)],

@@ -10,12 +10,12 @@  import Data.Char (isSpace) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import Data.Text qualified as T+import Data.Text.Encoding qualified as T import GHC.Data.FastString (bytesFS, mkFastString) import GHC.Driver.Config.Parser (initParserOpts) import GHC.DynFlags (baseDynFlags)-import qualified GHC.Parser.Lexer as L+import GHC.Parser.Lexer qualified as L import GHC.Types.SrcLoc import Ormolu.Utils (textToStringBuffer) 

@@ -1,5 +1,3 @@-{-# LANGUAGE RecordWildCards #-}- -- | A type for result of parsing. module Ormolu.Parser.Result   ( SourceSnippet (..),@@ -23,7 +21,7 @@ -- | A collection of data that represents a parsed module in Ormolu. data ParseResult = ParseResult   { -- | Parsed module or signature-    prParsedSource :: HsModule,+    prParsedSource :: HsModule GhcPs,     -- | Either regular module or signature file     prSourceType :: SourceType,     -- | Stack header

@@ -1,5 +1,4 @@ {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  -- | Pretty-printer for Haskell AST.@@ -10,7 +9,7 @@ where  import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Ormolu.Config import Ormolu.Parser.Result import Ormolu.Printer.Combinators

@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}@@ -32,6 +31,7 @@     located,     located',     switchLayout,+    switchLayoutNoLimit,     Layout (..),     vlayout,     getLayout,@@ -95,7 +95,7 @@ import Control.Monad import Data.List (intersperse) import Data.Text (Text)-import qualified GHC.Data.Strict as Strict+import GHC.Data.Strict qualified as Strict import GHC.LanguageExtensions.Type import GHC.Types.SrcLoc import Ormolu.Config@@ -151,22 +151,48 @@ -- provided by GHC AST. It is relatively rare that this one is needed. -- -- Given empty list this function will set layout to single line.-switchLayout ::+switchLayout' ::+  -- | Should enforce column limit, if one is set+  Bool ->   -- | Span that controls layout   [SrcSpan] ->   -- | Computation to run with changed layout   R () ->   R ()-switchLayout spans' = enterLayout (spansLayout spans')+switchLayout' useColLimit spans' r = do+  columnLimit <-+    if useColLimit then getPrinterOpt poColumnLimit else pure NoLimit+  enterLayout (spansLayout columnLimit spans') r +switchLayout :: [SrcSpan] -> R () -> R ()+switchLayout = switchLayout' True++-- | Switch layout version that disregards the column limit.+-- It should be used for the argument list in function definitions because+-- the column limit can't be enforced there without changing the AST.+switchLayoutNoLimit :: [SrcSpan] -> R () -> R ()+switchLayoutNoLimit = switchLayout' False+ -- | Which layout combined spans result in?-spansLayout :: [SrcSpan] -> Layout-spansLayout = \case+spansLayout :: ColumnLimit -> [SrcSpan] -> Layout+spansLayout colLimit = \case   [] -> SingleLine   (x : xs) ->-    if isOneLineSpan (foldr combineSrcSpans x xs)+    if isOneLineSpan combinedSpan && not (shouldBreakSingleLine combinedSpan)       then SingleLine       else MultiLine+    where+      combinedSpan = foldr combineSrcSpans x xs++      shouldBreakSingleLine :: SrcSpan -> Bool+      shouldBreakSingleLine (RealSrcSpan rs _) =+        case colLimit of+          ColumnLimit maxLineLength ->+            spanLineLength > fromIntegral maxLineLength+          NoLimit -> False+        where+          spanLineLength = srcSpanEndCol rs - srcSpanStartCol rs+      shouldBreakSingleLine _ = False  -- | Insert a space if enclosing layout is single-line, or newline if it's -- multiline.

@@ -1,4 +1,3 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}  -- | Helpers for formatting of comments. This is low-level code, use@@ -13,7 +12,7 @@ where  import Control.Monad-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Maybe (listToMaybe) import GHC.Types.SrcLoc import Ormolu.Parser.CommentStream

@@ -1,7 +1,5 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}  -- | In most cases import "Ormolu.Printer.Combinators" instead, these -- functions are the low-level building blocks and should not be used on@@ -69,11 +67,11 @@ import Data.Functor.Identity (runIdentity) import Data.Maybe (listToMaybe) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL+import Data.Text qualified as T+import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Builder import GHC.Data.EnumSet (EnumSet)-import qualified GHC.Data.EnumSet as EnumSet+import GHC.Data.EnumSet qualified as EnumSet import GHC.LanguageExtensions.Type import GHC.Types.SrcLoc import GHC.Utils.Outputable (Outputable)

@@ -1,5 +1,4 @@ {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}  -- | Rendering of commonly useful bits.@@ -18,7 +17,7 @@  import Control.Monad import Data.Foldable (traverse_)-import qualified Data.Text as T+import Data.Text qualified as T import GHC.Hs.Doc import GHC.Hs.Extension (GhcPs) import GHC.Hs.ImpExp@@ -27,7 +26,7 @@ import GHC.Types.Name.Reader import GHC.Types.SourceText import GHC.Types.SrcLoc-import GHC.Unit.Module.Name+import Language.Haskell.Syntax.Module.Name import Ormolu.Config import Ormolu.Printer.Combinators import Ormolu.Utils@@ -49,9 +48,9 @@   space   atom mname -p_ieWrappedName :: IEWrappedName RdrName -> R ()+p_ieWrappedName :: IEWrappedName GhcPs -> R () p_ieWrappedName = \case-  IEName x -> p_rdrName x+  IEName _ x -> p_rdrName x   IEPattern _ x -> do     txt "pattern"     space@@ -235,4 +234,4 @@ p_sourceText :: SourceText -> R () p_sourceText = \case   NoSourceText -> pure ()-  SourceText s -> space >> txt (T.pack s)+  SourceText s -> txt (T.pack s)

@@ -1,5 +1,4 @@ {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-}@@ -13,7 +12,7 @@  import Data.List (sort) import Data.List.NonEmpty (NonEmpty (..), (<|))-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import GHC.Hs import GHC.Types.Name.Occurrence (occNameFS) import GHC.Types.Name.Reader@@ -254,12 +253,12 @@     RdrName -> HsDecl GhcPs pattern InlinePragma n <- SigD _ (InlineSig _ (L _ n) _) pattern SpecializePragma n <- SigD _ (SpecSig _ (L _ n) _ _)-pattern SCCPragma n <- SigD _ (SCCFunSig _ _ (L _ n) _)-pattern AnnTypePragma n <- AnnD _ (HsAnnotation _ _ (TypeAnnProvenance (L _ n)) _)-pattern AnnValuePragma n <- AnnD _ (HsAnnotation _ _ (ValueAnnProvenance (L _ n)) _)+pattern SCCPragma n <- SigD _ (SCCFunSig _ (L _ n) _)+pattern AnnTypePragma n <- AnnD _ (HsAnnotation _ (TypeAnnProvenance (L _ n)) _)+pattern AnnValuePragma n <- AnnD _ (HsAnnotation _ (ValueAnnProvenance (L _ n)) _) pattern Pattern n <- ValD _ (PatSynBind _ (PSB _ (L _ n) _ _ _)) pattern DataDeclaration n <- TyClD _ (DataDecl _ (L _ n) _ _ _)-pattern ClassDeclaration n <- TyClD _ (ClassDecl _ _ (L _ n) _ _ _ _ _ _ _ _)+pattern ClassDeclaration n <- TyClD _ (ClassDecl _ _ _ (L _ n) _ _ _ _ _ _ _ _) pattern KindSignature n <- KindSigD _ (StandaloneKindSig _ (L _ n) _) pattern FamilyDeclaration n <- TyClD _ (FamDecl _ (FamilyDecl _ _ _ (L _ n) _ _ _ _)) pattern TypeSynonym n <- TyClD _ (SynDecl _ (L _ n) _ _ _)@@ -294,8 +293,8 @@ defSigRdrNames _ = Nothing  funRdrNames :: HsDecl GhcPs -> Maybe [RdrName]-funRdrNames (ValD _ (FunBind _ (L _ n) _ _)) = Just [n]-funRdrNames (ValD _ (PatBind _ (L _ n) _ _)) = Just $ patBindNames n+funRdrNames (ValD _ (FunBind _ (L _ n) _)) = Just [n]+funRdrNames (ValD _ (PatBind _ (L _ n) _)) = Just $ patBindNames n funRdrNames _ = Nothing  patSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]@@ -303,7 +302,7 @@ patSigRdrNames _ = Nothing  warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]-warnSigRdrNames (WarningD _ (Warnings _ _ ws)) = Just $+warnSigRdrNames (WarningD _ (Warnings _ ws)) = Just $   flip concatMap ws $     \(L _ (Warning _ ns _)) -> map unLoc ns warnSigRdrNames _ = Nothing@@ -316,7 +315,7 @@ patBindNames (BangPat _ (L _ p)) = patBindNames p patBindNames (ParPat _ _ (L _ p) _) = patBindNames p patBindNames (ListPat _ ps) = concatMap (patBindNames . unLoc) ps-patBindNames (AsPat _ (L _ n) (L _ p)) = n : patBindNames p+patBindNames (AsPat _ (L _ n) _ (L _ p)) = n : patBindNames p patBindNames (SumPat _ (L _ p) _ _) = patBindNames p patBindNames (ViewPat _ _ (L _ p)) = patBindNames p patBindNames (SplicePat _ _) = []

@@ -12,7 +12,7 @@ import Ormolu.Printer.Meat.Declaration.Value  p_annDecl :: AnnDecl GhcPs -> R ()-p_annDecl (HsAnnotation _ _ annProv expr) =+p_annDecl (HsAnnotation _ annProv expr) =   pragma "ANN" . inci $ do     p_annProv annProv     breakpoint

@@ -11,10 +11,12 @@ where  import Control.Monad+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE import Data.Maybe (isJust, maybeToList)-import qualified Data.Text as Text+import Data.Text qualified as Text import Data.Void-import qualified GHC.Data.Strict as Strict+import GHC.Data.Strict qualified as Strict import GHC.Hs import GHC.Types.Fixity import GHC.Types.ForeignCall@@ -39,19 +41,22 @@   HsDataDefn GhcPs ->   R () p_dataDecl style name tpats fixity HsDataDefn {..} = do-  txt $ case dd_ND of-    NewType -> "newtype"-    DataType -> "data"+  txt $ case dd_cons of+    NewTypeCon _ -> "newtype"+    DataTypeCons False _ -> "data"+    DataTypeCons True _ -> "type data"   txt $ case style of     Associated -> mempty     Free -> " instance"   case unLoc <$> dd_cType of     Nothing -> pure ()     Just (CType prag header (type_, _)) -> do+      space       p_sourceText prag       case header of         Nothing -> pure ()         Just (Header h _) -> space *> p_sourceText h+      space       p_sourceText type_       txt " #-}"   let constructorSpans = getLocA name : fmap lhsTypeArgSrcSpan tpats@@ -71,18 +76,21 @@         token'dcolon         breakpoint         inci $ located k p_hsType-  let gadt = isJust dd_kindSig || any (isGadt . unLoc) dd_cons-  unless (null dd_cons) $+  let dd_cons' = case dd_cons of+        NewTypeCon a -> [a]+        DataTypeCons _ as -> as+      gadt = isJust dd_kindSig || any (isGadt . unLoc) dd_cons'+  unless (null dd_cons') $     if gadt       then inci $ do         switchLayout declHeaderSpans $ do           breakpoint           txt "where"         breakpoint-        sepSemi (located' (p_conDecl False)) dd_cons-      else switchLayout (getLocA name : (getLocA <$> dd_cons)) . inci $ do-        let singleConstRec = isSingleConstRec dd_cons-        if hasHaddocks dd_cons+        sepSemi (located' (p_conDecl False)) dd_cons'+      else switchLayout (getLocA name : (getLocA <$> dd_cons')) . inci $ do+        let singleConstRec = isSingleConstRec dd_cons'+        if hasHaddocks dd_cons'           then newline           else             if singleConstRec@@ -92,14 +100,14 @@         space         layout <- getLayout         let s =-              if layout == MultiLine || hasHaddocks dd_cons+              if layout == MultiLine || hasHaddocks dd_cons'                 then newline >> txt "|" >> space                 else space >> txt "|" >> space             sitcc' =-              if hasHaddocks dd_cons || not singleConstRec+              if hasHaddocks dd_cons' || not singleConstRec                 then sitcc                 else id-        sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons+        sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons'   unless (null dd_derivs) breakpoint   inci $ sep newline (located' p_hsDerivingClause) dd_derivs @@ -111,7 +119,7 @@   ConDeclGADT {..} -> do     mapM_ (p_hsDoc Pipe True) con_doc     let conDeclSpn =-          fmap getLocA con_names+          fmap getLocA (NE.toList con_names)             <> [getLocA con_bndrs]             <> maybeToList (fmap getLocA con_mb_cxt)             <> conArgsSpans@@ -120,13 +128,11 @@               PrefixConGADT xs -> getLocA . hsScaledThing <$> xs               RecConGADT x _ -> [getLocA x]     switchLayout conDeclSpn $ do-      case con_names of-        [] -> return ()-        (c : cs) -> do-          p_rdrName c-          unless (null cs) . inci $ do-            commaDel-            sep commaDel p_rdrName cs+      let c :| cs = con_names+      p_rdrName c+      unless (null cs) . inci $ do+        commaDel+        sep commaDel p_rdrName cs       inci $ do         let conTy = case con_g_args of               PrefixConGADT xs ->@@ -152,7 +158,7 @@     mapM_ (p_hsDoc Pipe True) con_doc     let conDeclWithContextSpn =           [ RealSrcSpan real Strict.Nothing-            | Just (EpaSpan real) <- matchAddEpAnn AnnForall <$> epAnnAnns con_ext+            | Just (EpaSpan real _) <- matchAddEpAnn AnnForall <$> epAnnAnns con_ext           ]             <> fmap getLocA con_ex_tvs             <> maybeToList (fmap getLocA con_mb_cxt)@@ -174,8 +180,12 @@       switchLayout conDeclSpn $ case con_args of         PrefixCon [] xs -> do           p_rdrName con_name-          unless (null xs) breakpoint-          inci . sitcc $ sep breakpoint (sitcc . located' p_hsTypePostDoc) (hsScaledThing <$> xs)+          let args = hsScaledThing <$> xs+              argsHaveDocs = conArgsHaveHaddocks args+              delimiter = if argsHaveDocs then newline else breakpoint+          unless (null xs) delimiter+          inci . sitcc $+            sep delimiter (sitcc . located' p_hsType) args         PrefixCon (v : _) _ -> absurd v         RecCon l -> do           p_rdrName con_name@@ -263,5 +273,16 @@ hasHaddocks :: [LConDecl GhcPs] -> Bool hasHaddocks = any (f . unLoc)   where-    f ConDeclH98 {..} = isJust con_doc+    f ConDeclH98 {..} =+      isJust con_doc || case con_args of+        PrefixCon [] xs ->+          conArgsHaveHaddocks (hsScaledThing <$> xs)+        _ -> False     f _ = False++conArgsHaveHaddocks :: [LBangType GhcPs] -> Bool+conArgsHaveHaddocks xs =+  let hasDocs = \case+        HsDocTy {} -> True+        _ -> False+   in any (hasDocs . unLoc) xs

@@ -1,4 +1,3 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}  module Ormolu.Printer.Meat.Declaration.Default

@@ -1,5 +1,4 @@ {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}  module Ormolu.Printer.Meat.Declaration.Foreign@@ -50,18 +49,20 @@ -- We also layout the identifier using the 'SourceText', because printing -- with the other two fields of 'CImport' is very complicated. See the -- 'Outputable' instance of 'ForeignImport' for details.-p_foreignImport :: ForeignImport -> R ()-p_foreignImport (CImport cCallConv safety _ _ sourceText) = do+p_foreignImport :: ForeignImport GhcPs -> R ()+p_foreignImport (CImport sourceText cCallConv safety _ _) = do   txt "foreign import"   space   located cCallConv atom   -- Need to check for 'noLoc' for the 'safe' annotation   when (isGoodSrcSpan $ getLoc safety) (space >> atom safety)+  space   located sourceText p_sourceText -p_foreignExport :: ForeignExport -> R ()-p_foreignExport (CExport (L loc (CExportStatic _ _ cCallConv)) sourceText) = do+p_foreignExport :: ForeignExport GhcPs -> R ()+p_foreignExport (CExport sourceText (L loc (CExportStatic _ _ cCallConv))) = do   txt "foreign export"   space   located (L loc cCallConv) atom+  space   located sourceText p_sourceText

@@ -1,4 +1,3 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} 

@@ -1,6 +1,5 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE PatternSynonyms #-}  -- | Printing of operator trees. module Ormolu.Printer.Meat.Declaration.OpTree

@@ -18,7 +18,7 @@ import Ormolu.Printer.Meat.Type  p_ruleDecls :: RuleDecls GhcPs -> R ()-p_ruleDecls (HsRules _ _ xs) =+p_ruleDecls (HsRules _ xs) =   pragma "RULES" $ sep breakpoint (sitcc . located' p_ruleDecl) xs  p_ruleDecl :: RuleDecl GhcPs -> R ()@@ -46,8 +46,8 @@       breakpoint       located rhs p_hsExpr -p_ruleName :: (SourceText, RuleName) -> R ()-p_ruleName (_, name) = atom $ (HsString NoSourceText name :: HsLit GhcPs)+p_ruleName :: RuleName -> R ()+p_ruleName name = atom (HsString NoSourceText name :: HsLit GhcPs)  p_ruleBndr :: RuleBndr GhcPs -> R () p_ruleBndr = \case

@@ -32,11 +32,10 @@   FixSig _ sig -> p_fixSig sig   InlineSig _ name inlinePragma -> p_inlineSig name inlinePragma   SpecSig _ name ts inlinePragma -> p_specSig name ts inlinePragma-  SpecInstSig _ _ sigType -> p_specInstSig sigType-  MinimalSig _ _ booleanFormula -> p_minimalSig booleanFormula-  CompleteMatchSig _ _sourceText cs ty -> p_completeSig cs ty-  SCCFunSig _ _ name literal -> p_sccSig name literal-  _ -> notImplemented "certain types of signature declarations"+  SpecInstSig _ sigType -> p_specInstSig sigType+  MinimalSig _ booleanFormula -> p_minimalSig booleanFormula+  CompleteMatchSig _ cs ty -> p_completeSig cs ty+  SCCFunSig _ name literal -> p_sccSig name literal  p_typeSig ::   -- | Should the tail of the names be indented

@@ -1,5 +1,3 @@-{-# LANGUAGE LambdaCase #-}- module Ormolu.Printer.Meat.Declaration.Splice   ( p_spliceDecl,   )@@ -7,8 +5,8 @@  import GHC.Hs import Ormolu.Printer.Combinators-import Ormolu.Printer.Meat.Declaration.Value (p_hsSplice)+import Ormolu.Printer.Meat.Declaration.Value (p_hsUntypedSplice)  p_spliceDecl :: SpliceDecl GhcPs -> R ()-p_spliceDecl = \case-  SpliceDecl NoExtField splice _explicit -> located splice p_hsSplice+p_spliceDecl (SpliceDecl NoExtField splice deco) =+  located splice $ p_hsUntypedSplice deco

@@ -1,19 +1,15 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-}  module Ormolu.Printer.Meat.Declaration.Value   ( p_valDecl,     p_pat,     p_hsExpr,-    p_hsSplice,+    p_hsUntypedSplice,     p_stringLit,     p_hsExpr',     p_hsCmdTop,@@ -31,14 +27,13 @@ import Data.Generics.Schemes (everything) import Data.List (find, intersperse, sortBy) import Data.List.NonEmpty (NonEmpty (..), (<|))-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Maybe import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import Data.Void import GHC.Data.Bag (bagToList)-import GHC.Data.FastString (FastString, lengthFS)-import qualified GHC.Data.Strict as Strict+import GHC.Data.Strict qualified as Strict import GHC.Hs import GHC.LanguageExtensions.Type (Extension (NegativeLiterals)) import GHC.Parser.CharClass (is_space)@@ -47,6 +42,7 @@ import GHC.Types.Name.Reader import GHC.Types.SourceText import GHC.Types.SrcLoc+import Language.Haskell.Syntax.Basic import Ormolu.Config import Ormolu.Printer.Combinators import Ormolu.Printer.Internal (sitccIfTrailing)@@ -73,8 +69,8 @@  p_valDecl :: HsBind GhcPs -> R () p_valDecl = \case-  FunBind _ funId funMatches _ -> p_funBind funId funMatches-  PatBind _ pat grhss _ -> p_match PatternBind False NoSrcStrict [pat] grhss+  FunBind _ funId funMatches -> p_funBind funId funMatches+  PatBind _ pat grhss -> p_match PatternBind False NoSrcStrict [pat] grhss   VarBind {} -> notImplemented "VarBinds" -- introduced by the type checker   PatSynBind _ psb -> p_patSynBind psb @@ -199,7 +195,7 @@             _ -> patSpans           patSpans = combineSrcSpans' (getLocA <$> ne_pats)           indentBody = not (isOneLineSpan combinedSpans)-      switchLayout [combinedSpans] $ do+      switchLayoutNoLimit [combinedSpans] $ do         let stdCase = sep breakpoint (located' p_pat) m_pats         case style of           Function name ->@@ -554,21 +550,8 @@       _ -> id  p_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()-p_ldotFieldOcc = located' $ p_lFieldLabelString . dfoLabel-  where-    p_lFieldLabelString (L (locA -> s) fs) = parensIfOp . atom @FastString $ fs-      where-        -- HACK For OverloadedRecordUpdate:-        -- In operator field updates (i.e. `f {(+) = 1}`), we don't have-        -- information whether parens are necessary. As a workaround,-        -- we look if the RealSrcSpan is bigger than the string fs.-        parensIfOp-          | isOneLineSpan s,-            Just realS <- srcSpanToRealSrcSpan s,-            let spanLength = srcSpanEndCol realS - srcSpanStartCol realS,-            lengthFS fs < spanLength =-              parens N-          | otherwise = id+p_ldotFieldOcc =+  located' $ p_rdrName . fmap (mkVarUnqual . field_label) . dfoLabel  p_ldotFieldOccs :: [XRec GhcPs (DotFieldOcc GhcPs)] -> R () p_ldotFieldOccs = sep (txt ".") p_ldotFieldOcc@@ -600,9 +583,9 @@   HsVar _ name -> p_rdrName name   HsUnboundVar _ occ -> atom occ   HsRecSel _ fldOcc -> p_fieldOcc fldOcc-  HsOverLabel _ v -> do+  HsOverLabel _ sourceText _ -> do     txt "#"-    atom v+    p_sourceText sourceText   HsIPVar _ (HsIPName name) -> do     txt "?"     atom name@@ -678,7 +661,7 @@           sep breakpoint (located' p_hsExpr) initp         placeHanging placement . dontUseBraces $           located lastp p_hsExpr-  HsAppType _ e a -> do+  HsAppType _ e _ a -> do     located e p_hsExpr     breakpoint     inci $ do@@ -849,7 +832,8 @@     breakpoint'     txt "||]"   HsUntypedBracket epAnn x -> p_hsQuote epAnn x-  HsSpliceE _ splice -> p_hsSplice splice+  HsTypedSplice _ expr -> p_hsSpliceTH True expr DollarSplice+  HsUntypedSplice _ untySplice -> p_hsUntypedSplice DollarSplice untySplice   HsProc _ p e -> do     txt "proc"     located p $ \x -> do@@ -864,7 +848,7 @@     breakpoint     inci (located e p_hsExpr)   HsPragE _ prag x -> case prag of-    HsPragSCC _ _ name -> do+    HsPragSCC _ name -> do       txt "{-# SCC "       atom name       txt " #-}"@@ -1103,7 +1087,7 @@   LazyPat _ pat -> do     txt "~"     located pat p_pat-  AsPat _ name pat -> do+  AsPat _ name _ pat -> do     p_rdrName name     txt "@"     located pat p_pat@@ -1128,7 +1112,7 @@         p_rdrName pat         unless (null tys && null xs) breakpoint         inci . sitcc $-          sep breakpoint (sitcc . either p_hsPatSigType (located' p_pat)) $+          sep breakpoint (sitcc . either p_hsConPatTyArg (located' p_pat)) $             (Left <$> tys) <> (Right <$> xs)       RecCon (HsRecFields fields dotdot) -> do         p_rdrName pat@@ -1139,7 +1123,7 @@         inci . braces N . sep commaDel f $           case dotdot of             Nothing -> Just <$> fields-            Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]+            Just (L _ (RecFieldsDotDot n)) -> (Just <$> take n fields) ++ [Nothing]       InfixCon l r -> do         switchLayout [getLocA l, getLocA r] $ do           located l p_pat@@ -1154,7 +1138,7 @@     token'rarrow     breakpoint     inci (located pat p_pat)-  SplicePat _ splice -> p_hsSplice splice+  SplicePat _ splice -> p_hsUntypedSplice DollarSplice splice   LitPat _ p -> atom p   NPat _ v (isJust -> isNegated) _ -> do     when isNegated $ do@@ -1176,6 +1160,9 @@ p_hsPatSigType :: HsPatSigType GhcPs -> R () p_hsPatSigType (HsPS _ ty) = txt "@" *> located ty p_hsType +p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()+p_hsConPatTyArg (HsConPatTyArg _ patSigTy) = p_hsPatSigType patSigTy+ p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R () p_pat_hsFieldBind HsFieldBind {..} = do   located hfbLHS p_fieldOcc@@ -1200,11 +1187,10 @@             space   parensHash s $ sep (txt "|") f args -p_hsSplice :: HsSplice GhcPs -> R ()-p_hsSplice = \case-  HsTypedSplice _ deco _ expr -> p_hsSpliceTH True expr deco-  HsUntypedSplice _ deco _ expr -> p_hsSpliceTH False expr deco-  HsQuasiQuote _ _ quoterName _ str -> do+p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()+p_hsUntypedSplice deco = \case+  HsUntypedSpliceExpr _ expr -> p_hsSpliceTH False expr deco+  HsQuasiQuote _ quoterName str -> do     txt "["     p_rdrName (noLocA quoterName)     txt "|"@@ -1212,7 +1198,6 @@     -- formatting here without potentially breaking someone's code.     atom str     txt "|]"-  HsSpliced {} -> notImplemented "HsSpliced"  p_hsSpliceTH ::   -- | Typed splice?@@ -1365,7 +1350,7 @@ exprPlacement = \case   -- Only hang lambdas with single line parameter lists   HsLam _ mg -> case mg of-    MG _ (L _ [L _ (Match _ _ (x : xs) _)]) _+    MG _ (L _ [L _ (Match _ _ (x : xs) _)])       | isOneLineSpan (combineSrcSpans' $ fmap getLocA (x :| xs)) ->           Hanging     _ -> Normal

@@ -2,7 +2,7 @@   ( p_valDecl,     p_pat,     p_hsExpr,-    p_hsSplice,+    p_hsUntypedSplice,     p_stringLit,     p_hsExpr',     p_hsCmdTop,@@ -11,16 +11,13 @@   ) where -import GHC.Hs.Binds-import GHC.Hs.Expr-import GHC.Hs.Extension-import GHC.Hs.Pat+import GHC.Hs import Ormolu.Printer.Combinators  p_valDecl :: HsBindLR GhcPs GhcPs -> R () p_pat :: Pat GhcPs -> R () p_hsExpr :: HsExpr GhcPs -> R ()-p_hsSplice :: HsSplice GhcPs -> R ()+p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R () p_stringLit :: String -> R () p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R () p_hsCmdTop :: BracketStyle -> HsCmdTop GhcPs -> R ()

@@ -18,7 +18,7 @@ import Ormolu.Printer.Meat.Common  p_warnDecls :: WarnDecls GhcPs -> R ()-p_warnDecls (Warnings _ _ warnings) =+p_warnDecls (Warnings _ warnings) =   traverse_ (located' p_warnDecl) warnings  p_warnDecl :: WarnDecl GhcPs -> R ()

@@ -10,12 +10,11 @@ where  import Control.Monad-import qualified Data.Text as T+import Data.Text qualified as T import GHC.Hs import GHC.LanguageExtensions.Type import GHC.Types.PkgQual import GHC.Types.SrcLoc-import GHC.Unit.Types import Ormolu.Config import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common@@ -64,13 +63,12 @@         space         located l atom     space-    case ideclHiding of-      Nothing -> return ()-      Just (hiding, _) ->-        when hiding (txt "hiding")-    case ideclHiding of+    case ideclImportList of       Nothing -> return ()-      Just (_, L _ xs) -> do+      Just (hiding, L _ xs) -> do+        case hiding of+          Exactly -> pure ()+          EverythingBut -> txt "hiding"         breakIfNotDiffFriendly         parens' True $ do           layout <- getLayout

@@ -11,7 +11,6 @@ import Control.Monad import GHC.Hs hiding (comment) import GHC.Types.SrcLoc-import GHC.Unit.Module.Name import GHC.Utils.Outputable (ppr, showSDocUnsafe) import Ormolu.Config import Ormolu.Imports (normalizeImports)@@ -33,10 +32,11 @@   -- | Pragmas and the associated comments   [([RealLocated Comment], Pragma)] ->   -- | AST to print-  HsModule ->+  HsModule GhcPs ->   R () p_hsModule mstackHeader pragmas hsmod@HsModule {..} = do-  let deprecSpan = maybe [] (pure . getLocA) hsmodDeprecMessage+  let XModulePs {..} = hsmodExt+      deprecSpan = maybe [] (pure . getLocA) hsmodDeprecMessage       exportSpans = maybe [] (pure . getLocA) hsmodExports   switchLayout (deprecSpan <> exportSpans) $ do     forM_ mstackHeader $ \(L spn comment) -> do@@ -58,8 +58,8 @@       newline       spitRemainingComments -p_hsModuleHeader :: HsModule -> LocatedA ModuleName -> R ()-p_hsModuleHeader HsModule {..} moduleName = do+p_hsModuleHeader :: HsModule GhcPs -> LocatedA ModuleName -> R ()+p_hsModuleHeader HsModule {hsmodExt = XModulePs {..}, ..} moduleName = do   located moduleName $ \name -> do     poHStyle <-       getPrinterOpt poHaddockStyleModule >>= \case

@@ -9,11 +9,11 @@  import Control.Monad import Data.Char (isUpper)-import qualified Data.List as L+import Data.List qualified as L import Data.Set (Set)-import qualified Data.Set as Set+import Data.Set qualified as Set import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import GHC.Driver.Flags (Language) import GHC.Types.SrcLoc import Ormolu.Parser.CommentStream

@@ -1,13 +1,11 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-}  -- | Rendering of types. module Ormolu.Printer.Meat.Type   ( p_hsType,-    p_hsTypePostDoc,     startTypeAnnotation,     startTypeAnnotationDecl,     hasDocStrings,@@ -25,8 +23,8 @@ where  import Control.Monad-import GHC.Hs-import GHC.Types.Basic hiding (isPromoted)+import Data.Functor ((<&>))+import GHC.Hs hiding (isPromoted) import GHC.Types.SourceText import GHC.Types.SrcLoc import GHC.Types.Var@@ -34,30 +32,17 @@ import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree (p_tyOpTree, tyOpTree)-import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice, p_stringLit)+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsUntypedSplice, p_stringLit) import Ormolu.Printer.Operators import Ormolu.Utils  p_hsType :: HsType GhcPs -> R () p_hsType t = do-  s <--    getPrinterOpt poFunctionArrows >>= \case-      TrailingArrows -> pure PipeStyle-      LeadingArrows -> pure CaretStyle-      LeadingArgsArrows -> pure CaretStyle   layout <- getLayout-  p_hsType' (hasDocStrings t || layout == MultiLine) s t--p_hsTypePostDoc :: HsType GhcPs -> R ()-p_hsTypePostDoc t = p_hsType' (hasDocStrings t) CaretStyle t---- | How to render Haddocks associated with a type.-data TypeDocStyle-  = PipeStyle-  | CaretStyle+  p_hsType' (hasDocStrings t || layout == MultiLine) t -p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R ()-p_hsType' multilineArgs docStyle = \case+p_hsType' :: Bool -> HsType GhcPs -> R ()+p_hsType' multilineArgs = \case   HsForAllTy _ tele t -> do     vis <-       case tele of@@ -150,13 +135,18 @@   HsKindSig _ t k -> sitcc $ do     located t p_hsType     inci $ startTypeAnnotation k p_hsType-  HsSpliceTy _ splice -> p_hsSplice splice-  HsDocTy _ t str ->-    case docStyle of-      PipeStyle -> do+  HsSpliceTy _ splice -> p_hsUntypedSplice DollarSplice splice+  HsDocTy _ t str -> do+    usePipe <-+      getPrinterOpt poFunctionArrows <&> \case+        TrailingArrows -> True+        LeadingArrows -> False+        LeadingArgsArrows -> False+    if usePipe+      then do         p_hsDoc Pipe True str         located t p_hsType-      CaretStyle -> do+      else do         located t p_hsType         newline         p_hsDoc Caret False str@@ -177,17 +167,17 @@       IsPromoted -> txt "'"       NotPromoted -> return ()     brackets N $ do-      -- If both this list itself and the first element is promoted,-      -- we need to put a space in between or it fails to parse.+      -- If this list is promoted and the first element starts with a single+      -- quote, we need to put a space in between or it fails to parse.       case (p, xs) of-        (IsPromoted, L _ t : _) | isPromoted t -> space+        (IsPromoted, L _ t : _) | startsWithSingleQuote t -> space         _ -> return ()       sep commaDel (sitcc . located' p_hsType) xs   HsExplicitTupleTy _ xs -> do     txt "'"     parens N $ do       case xs of-        L _ t : _ | isPromoted t -> space+        L _ t : _ | startsWithSingleQuote t -> space         _ -> return ()       sep commaDel (located' p_hsType) xs   HsTyLit _ t ->@@ -197,17 +187,18 @@   HsWildCardTy _ -> txt "_"   XHsType t -> atom t   where-    isPromoted = \case-      HsAppTy _ (L _ f) _ -> isPromoted f+    startsWithSingleQuote = \case+      HsAppTy _ (L _ f) _ -> startsWithSingleQuote f       HsTyVar _ IsPromoted _ -> True       HsExplicitTupleTy {} -> True       HsExplicitListTy {} -> True+      HsTyLit _ HsCharTy {} -> True       _ -> False     interArgBreak =       if multilineArgs         then newline         else breakpoint-    p_hsTypeR m = p_hsType' multilineArgs docStyle m+    p_hsTypeR m = p_hsType' multilineArgs m  startTypeAnnotation ::   (HasSrcSpan l) =>

@@ -1,5 +1,4 @@ {-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE ScopedTypeVariables #-}  -- | This module helps handle operator chains composed of different -- operators that may have different precedence and fixities.@@ -13,8 +12,8 @@ where  import Control.Applicative ((<|>))-import qualified Data.List.NonEmpty as NE-import qualified Data.Map.Strict as Map+import Data.List.NonEmpty qualified as NE+import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe) import GHC.Types.Name.Reader import GHC.Types.SrcLoc

@@ -1,6 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}- -- | Build span stream from AST. module Ormolu.Printer.SpanStream   ( SpanStream (..),@@ -8,12 +5,13 @@   ) where -import Data.DList (DList)-import qualified Data.DList as D import Data.Data (Data)+import Data.Foldable (toList) import Data.Generics (everything, ext1Q, ext2Q) import Data.List (sortOn) import Data.Maybe (maybeToList)+import Data.Sequence (Seq)+import Data.Sequence qualified as Seq import Data.Typeable (cast) import GHC.Parser.Annotation import GHC.Types.SrcLoc@@ -34,16 +32,16 @@ mkSpanStream a =   SpanStream     . sortOn realSrcSpanStart-    . D.toList+    . toList     $ everything mappend (const mempty `ext2Q` queryLocated `ext1Q` querySrcSpanAnn) a   where     queryLocated ::       (Data e0) =>       GenLocated e0 e1 ->-      DList RealSrcSpan+      Seq RealSrcSpan     queryLocated (L mspn _) =-      maybe mempty srcSpanToRealSrcSpanDList (cast mspn :: Maybe SrcSpan)-    querySrcSpanAnn :: SrcSpanAnn' a -> DList RealSrcSpan-    querySrcSpanAnn = srcSpanToRealSrcSpanDList . locA-    srcSpanToRealSrcSpanDList =-      D.fromList . maybeToList . srcSpanToRealSrcSpan+      maybe mempty srcSpanToRealSrcSpanSeq (cast mspn :: Maybe SrcSpan)+    querySrcSpanAnn :: SrcSpanAnn' a -> Seq RealSrcSpan+    querySrcSpanAnn = srcSpanToRealSrcSpanSeq . locA+    srcSpanToRealSrcSpanSeq =+      Seq.fromList . maybeToList . srcSpanToRealSrcSpan

@@ -13,9 +13,9 @@  import Data.Char (isSpace) import Data.IntSet (IntSet)-import qualified Data.IntSet as IntSet+import Data.IntSet qualified as IntSet import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Ormolu.Config  -- | Remove indentation from a given 'Text'. Return the input with indentation

@@ -7,10 +7,10 @@ where  import Data.IntSet (IntSet)-import qualified Data.IntSet as IntSet+import Data.IntSet qualified as IntSet import Data.Maybe (isJust) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T  -- | State of the CPP processor. data State

@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -15,13 +14,13 @@ import Data.Char (isSpace) import Data.Function ((&)) import Data.IntMap (IntMap)-import qualified Data.IntMap.Strict as IntMap+import Data.IntMap.Strict qualified as IntMap import Data.IntSet (IntSet)-import qualified Data.IntSet as IntSet-import qualified Data.List as L+import Data.IntSet qualified as IntSet+import Data.List qualified as L import Data.Maybe (isJust) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Ormolu.Config (RegionDeltas (..)) import Ormolu.Processing.Common import Ormolu.Processing.Cpp

@@ -1,13 +1,13 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}  -- | An abstraction for colorful output in terminal. module Ormolu.Terminal-  ( -- * The 'Term' monad+  ( -- * The 'Term' abstraction     Term,     ColorMode (..),     runTerm,+    runTermPure,      -- * Styling     bold,@@ -17,114 +17,114 @@      -- * Printing     put,-    putS,-    putSrcSpan,-    putRealSrcSpan,+    putShow,+    putOutputable,     newline,   ) where -import Control.Monad.Reader+import Control.Applicative (Const (..))+import Control.Monad (forM_)+import Data.Foldable (toList)+import Data.Sequence (Seq)+import Data.Sequence qualified as Seq import Data.Text (Text)-import qualified Data.Text.IO as T-import GHC.Types.SrcLoc+import Data.Text qualified as T+import Data.Text.IO qualified as T+import GHC.Utils.Outputable (Outputable) import Ormolu.Utils (showOutputable) import System.Console.ANSI-import System.IO (Handle, hFlush, hPutStr)+import System.IO (Handle, hFlush)  ------------------------------------------------------------------------------- The 'Term' monad+-- The 'Term' abstraction --- | Terminal monad.-newtype Term a = Term (ReaderT RC IO a)-  deriving (Functor, Applicative, Monad)+type Term = TermOutput () --- | Reader context of 'Term'.-data RC = RC-  { -- | Whether to use colors-    rcUseColor :: Bool,-    -- | Handle to print to-    rcHandle :: Handle-  }+newtype TermOutput a = TermOutput (Const (Seq TermOutputNode) a)+  deriving (Semigroup, Monoid, Functor, Applicative) +data TermOutputNode+  = OutputText Text+  | WithColor Color Term+  | WithBold Term++singleTerm :: TermOutputNode -> Term+singleTerm = TermOutput . Const . Seq.singleton+ -- | Whether to use colors and other features of ANSI terminals. data ColorMode = Never | Always | Auto   deriving (Eq, Show, Enum, Bounded)  -- | Run 'Term' monad. runTerm ::-  -- | Monad to run-  Term a ->+  Term ->   -- | Color mode   ColorMode ->   -- | Handle to print to   Handle ->-  IO a-runTerm (Term m) colorMode rcHandle = do-  rcUseColor <- case colorMode of+  IO ()+runTerm term0 colorMode handle = do+  useSGR <- case colorMode of     Never -> return False     Always -> return True-    Auto -> hSupportsANSI rcHandle-  x <- runReaderT m RC {..}-  hFlush rcHandle-  return x+    Auto -> hSupportsANSI handle+  runTerm' useSGR term0+  hFlush handle+  where+    runTerm' useSGR = go+      where+        go (TermOutput (Const nodes)) =+          forM_ nodes $ \case+            OutputText s -> T.hPutStr handle s+            WithColor color term -> withSGR [SetColor Foreground Dull color] (go term)+            WithBold term -> withSGR [SetConsoleIntensity BoldIntensity] (go term) +        withSGR sgrs m+          | useSGR = hSetSGR handle sgrs >> m >> hSetSGR handle [Reset]+          | otherwise = m++runTermPure :: Term -> Text+runTermPure (TermOutput (Const nodes)) =+  T.concat . toList . flip fmap nodes $ \case+    OutputText s -> s+    WithColor _ term -> runTermPure term+    WithBold term -> runTermPure term+ ---------------------------------------------------------------------------- -- Styling --- | Make the inner computation output bold text.-bold :: Term a -> Term a-bold = withSGR [SetConsoleIntensity BoldIntensity]---- | Make the inner computation output cyan text.-cyan :: Term a -> Term a-cyan = withSGR [SetColor Foreground Dull Cyan]+-- | Make the output bold text.+bold :: Term -> Term+bold = singleTerm . WithBold --- | Make the inner computation output green text.-green :: Term a -> Term a-green = withSGR [SetColor Foreground Dull Green]+-- | Make the output cyan text.+cyan :: Term -> Term+cyan = singleTerm . WithColor Cyan --- | Make the inner computation output red text.-red :: Term a -> Term a-red = withSGR [SetColor Foreground Dull Red]+-- | Make the output green text.+green :: Term -> Term+green = singleTerm . WithColor Green --- | Alter 'SGR' for inner computation.-withSGR :: [SGR] -> Term a -> Term a-withSGR sgrs (Term m) = Term $ do-  RC {..} <- ask-  if rcUseColor-    then do-      liftIO $ hSetSGR rcHandle sgrs-      x <- m-      liftIO $ hSetSGR rcHandle [Reset]-      return x-    else m+-- | Make the output red text.+red :: Term -> Term+red = singleTerm . WithColor Red  ---------------------------------------------------------------------------- -- Printing  -- | Output 'Text'.-put :: Text -> Term ()-put txt = Term $ do-  RC {..} <- ask-  liftIO $ T.hPutStr rcHandle txt---- | Output 'String'.-putS :: String -> Term ()-putS str = Term $ do-  RC {..} <- ask-  liftIO $ hPutStr rcHandle str+put :: Text -> Term+put = singleTerm . OutputText --- | Output a 'GHC.SrcSpan'.-putSrcSpan :: SrcSpan -> Term ()-putSrcSpan = putS . showOutputable+-- | Output a 'Show' value.+putShow :: (Show a) => a -> Term+putShow = put . T.pack . show --- | Output a 'GHC.RealSrcSpan'.-putRealSrcSpan :: RealSrcSpan -> Term ()-putRealSrcSpan = putS . showOutputable+-- | Output an 'Outputable' value.+putOutputable :: (Outputable a) => a -> Term+putOutputable = put . T.pack . showOutputable  -- | Output a newline.-newline :: Term ()-newline = Term $ do-  RC {..} <- ask-  liftIO $ T.hPutStr rcHandle "\n"+newline :: Term+newline = put "\n"

@@ -0,0 +1,7 @@+module Ormolu.Terminal.QualifiedDo ((>>)) where++import Ormolu.Terminal+import Prelude hiding ((>>))++(>>) :: Term -> Term -> Term+(>>) = (<>)

@@ -1,7 +1,5 @@ {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}  -- | Random utilities used by the code. module Ormolu.Utils@@ -25,13 +23,13 @@  import Data.List (dropWhileEnd) import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Foreign as TFFI+import Data.Text qualified as T+import Data.Text.Foreign qualified as TFFI import Foreign (pokeElemOff, withForeignPtr)-import qualified GHC.Data.Strict as Strict+import GHC.Data.Strict qualified as Strict import GHC.Data.StringBuffer (StringBuffer (..)) import GHC.Driver.Ppr import GHC.DynFlags (baseDynFlags)@@ -39,7 +37,7 @@ import GHC.Hs import GHC.IO.Unsafe (unsafePerformIO) import GHC.Types.SrcLoc-import GHC.Utils.Outputable+import GHC.Utils.Outputable (Outputable (..))  -- | Relative positions in a list. data RelativePos

@@ -1,6 +1,5 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-}  module Ormolu.Utils.Cabal@@ -15,17 +14,17 @@  import Control.Exception import Control.Monad.IO.Class-import qualified Data.ByteString as B+import Data.ByteString qualified as B import Data.IORef import Data.Map.Lazy (Map)-import qualified Data.Map.Lazy as M+import Data.Map.Lazy qualified as M import Data.Maybe (maybeToList) import Data.Set (Set)-import qualified Data.Set as Set-import qualified Distribution.ModuleName as ModuleName+import Data.Set qualified as Set+import Distribution.ModuleName qualified as ModuleName import Distribution.PackageDescription import Distribution.PackageDescription.Parsec-import qualified Distribution.Types.CondTree as CT+import Distribution.Types.CondTree qualified as CT import Distribution.Utils.Path (getSymbolicPath) import Language.Haskell.Extension import Ormolu.Config@@ -141,8 +140,8 @@   CachedCabalFile {..} <- whenNothing (M.lookup cabalFile cabalCache) $ do     cabalFileBs <- B.readFile cabalFile     genericPackageDescription <--      whenNothing (parseGenericPackageDescriptionMaybe cabalFileBs) $-        throwIO (OrmoluCabalFileParsingFailed cabalFile)+      whenLeft (snd . runParseResult $ parseGenericPackageDescription cabalFileBs) $+        throwIO . OrmoluCabalFileParsingFailed cabalFile . snd     let extensionsAndDeps =           getExtensionAndDepsMap cabalFile genericPackageDescription         cachedCabalFile = CachedCabalFile {..}@@ -163,8 +162,10 @@         }     )   where-    whenNothing :: (Monad m) => Maybe a -> m a -> m a+    whenNothing :: (Applicative f) => Maybe a -> f a -> f a     whenNothing maya ma = maybe ma pure maya+    whenLeft :: (Applicative f) => Either e a -> (e -> f a) -> f a+    whenLeft eitha ma = either ma pure eitha  -- | Get a map from Haskell source file paths (without any extensions) to -- the corresponding 'DynOption's and dependencies.

@@ -11,8 +11,8 @@ import Data.Bifunctor (first) import Data.IORef import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import qualified Data.Text as T+import Data.Map.Strict qualified as Map+import Data.Text qualified as T import Ormolu.Exception import Ormolu.Fixity import Ormolu.Fixity.Parser

@@ -10,9 +10,9 @@ import Control.Exception (throwIO) import Control.Monad.IO.Class import Data.ByteString (ByteString)-import qualified Data.ByteString as B+import Data.ByteString qualified as B import Data.Text (Text)-import qualified Data.Text.Encoding as TE+import Data.Text.Encoding qualified as TE  -- | Write a 'Text' to a file using UTF8 and ignoring native -- line ending conventions.

@@ -2,7 +2,7 @@  module Ormolu.CabalInfoSpec (spec) where -import qualified Data.Set as Set+import Data.Set qualified as Set import Distribution.Types.PackageName (unPackageName) import Ormolu.Config (DynOption (..)) import Ormolu.Utils.Cabal@@ -35,15 +35,15 @@       (mentioned, CabalInfo {..}) <- parseCabalInfo "fourmolu.cabal" "src/Ormolu/Config.hs"       mentioned `shouldBe` True       unPackageName ciPackageName `shouldBe` "fourmolu"-      ciDynOpts `shouldBe` [DynOption "-XHaskell2010"]-      Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "MemoTrie", "aeson", "ansi-terminal", "array", "base", "binary", "bytestring", "containers", "directory", "dlist", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "text", "yaml"]+      ciDynOpts `shouldBe` [DynOption "-XGHC2021"]+      Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "MemoTrie", "aeson", "ansi-terminal", "array", "base", "binary", "bytestring", "containers", "deepseq", "directory", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "scientific", "syb", "text", "yaml"]       ciCabalFilePath `shouldSatisfy` isAbsolute       makeRelativeToCurrentDirectory ciCabalFilePath `shouldReturn` "fourmolu.cabal"     it "extracts correct cabal info from fourmolu.cabal for tests/Ormolu/PrinterSpec.hs" $ do       (mentioned, CabalInfo {..}) <- parseCabalInfo "fourmolu.cabal" "tests/Ormolu/PrinterSpec.hs"       mentioned `shouldBe` True       unPackageName ciPackageName `shouldBe` "fourmolu"-      ciDynOpts `shouldBe` [DynOption "-XHaskell2010"]+      ciDynOpts `shouldBe` [DynOption "-XGHC2021"]       Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "QuickCheck", "base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "fourmolu", "path", "path-io", "pretty", "process", "temporary", "text"]       ciCabalFilePath `shouldSatisfy` isAbsolute       makeRelativeToCurrentDirectory ciCabalFilePath `shouldReturn` "fourmolu.cabal"

@@ -1,5 +1,6 @@ module Ormolu.Config.OptionsSpec (spec) where +import Data.List (isPrefixOf) import IntegrationUtils (getFourmoluExe, readProcess) import System.FilePath ((</>)) import System.IO.Temp (withSystemTempDirectory)@@ -44,6 +45,11 @@          withCLI <- readProcess fourmoluExe ["--indentation=4", hsFile]         withCLI `shouldBe` indented4++    it "prints defaults to stdout" $ \fourmoluExe -> do+      stdOutput <- readProcess fourmoluExe ["--print-defaults"]+      -- Only check prefix of the output, so we don't have to update the test with every new option added+      stdOutput `shouldSatisfy` isPrefixOf "# Number of spaces per indentation step\nindentation: 4\n"   where     withTempDir = withSystemTempDirectory "fourmolu-cli-options-test"     indented2 =

@@ -14,10 +14,10 @@ import Control.Monad (forM_, when) import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff) import Data.Char (isSpace)-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Maybe (isJust) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import GHC.Stack (withFrozenCallStack) import Ormolu   ( Config (..),@@ -28,7 +28,7 @@     detectSourceType,     ormolu,   )-import Ormolu.Config (HaddockPrintStyleModule (..))+import Ormolu.Config (ColumnLimit (..), HaddockPrintStyleModule (..)) import Ormolu.Exception (OrmoluException, printOrmoluException) import Ormolu.Terminal (ColorMode (..), runTerm) import Ormolu.Utils.IO (readFileUtf8, writeFileUtf8)@@ -48,7 +48,7 @@ import System.IO.Temp (withSystemTempFile) import System.IO.Unsafe (unsafePerformIO) import Test.Hspec-import qualified Text.PrettyPrint as Doc+import Text.PrettyPrint qualified as Doc import Text.Printf (printf)  data TestGroup = forall a.@@ -57,7 +57,8 @@     testCases :: [a],     updateConfig :: a -> PrinterOptsTotal -> PrinterOptsTotal,     showTestCase :: a -> String,-    testCaseSuffix :: a -> String+    testCaseSuffix :: a -> String,+    checkIdempotence :: Bool   }  spec :: Spec@@ -84,22 +85,38 @@           showTestCase = \(indent, indentWheres) ->             show indent ++ if indentWheres then " + indent wheres" else "",           testCaseSuffix = \(indent, indentWheres) ->-            suffixWith [show indent, if indentWheres then "indent_wheres" else ""]+            suffixWith [show indent, if indentWheres then "indent_wheres" else ""],+          checkIdempotence = True         },       TestGroup+        { label = "column-limit",+          testCases = [NoLimit, ColumnLimit 80, ColumnLimit 100],+          updateConfig = \columnLimit opts -> opts {poColumnLimit = pure columnLimit},+          showTestCase = show,+          testCaseSuffix = \columnLimit ->+            let limitStr =+                  case columnLimit of+                    NoLimit -> "none"+                    ColumnLimit x -> show x+             in suffixWith ["limit=" ++ limitStr],+          checkIdempotence = False+        },+      TestGroup         { label = "function-arrows",           testCases = allOptions,           updateConfig = \functionArrows opts ->             opts {poFunctionArrows = pure functionArrows},           showTestCase = show,-          testCaseSuffix = suffix1+          testCaseSuffix = suffix1,+          checkIdempotence = True         },       TestGroup         { label = "comma-style",           testCases = allOptions,           updateConfig = \commaStyle opts -> opts {poCommaStyle = pure commaStyle},           showTestCase = show,-          testCaseSuffix = suffix1+          testCaseSuffix = suffix1,+          checkIdempotence = True         },       TestGroup         { label = "import-export",@@ -107,14 +124,16 @@           updateConfig = \commaStyle opts ->             opts {poImportExportStyle = pure commaStyle},           showTestCase = show,-          testCaseSuffix = suffix1+          testCaseSuffix = suffix1,+          checkIdempotence = True         },       TestGroup         { label = "record-brace-space",           testCases = allOptions,           updateConfig = \recordBraceSpace opts -> opts {poRecordBraceSpace = pure recordBraceSpace},           showTestCase = show,-          testCaseSuffix = suffix1+          testCaseSuffix = suffix1,+          checkIdempotence = True         },       TestGroup         { label = "newlines-between-decls",@@ -127,7 +146,8 @@           showTestCase = \(newlines, respectful) ->             show newlines ++ if respectful then " (respectful)" else "",           testCaseSuffix = \(newlines, respectful) ->-            suffixWith [show newlines, if respectful then "respectful" else ""]+            suffixWith [show newlines, if respectful then "respectful" else ""],+          checkIdempotence = True         },       TestGroup         { label = "haddock-style",@@ -148,7 +168,8 @@                 case haddockStyleModule of                   PrintStyleInherit -> ""                   PrintStyleOverride style -> "module=" ++ show style-              ]+              ],+          checkIdempotence = True         },       TestGroup         { label = "let-style",@@ -162,21 +183,32 @@           showTestCase = \(letStyle, inStyle, indent) ->             printf "%s + %s (indent=%d)" (show letStyle) (show inStyle) indent,           testCaseSuffix = \(letStyle, inStyle, indent) ->-            suffixWith [show letStyle, show inStyle, "indent=" ++ show indent]+            suffixWith [show letStyle, show inStyle, "indent=" ++ show indent],+          checkIdempotence = True         },       TestGroup+        { label = "single-constraint-parens",+          testCases = allOptions,+          updateConfig = \parens opts -> opts {poSingleConstraintParens = pure parens},+          showTestCase = show,+          testCaseSuffix = suffix1,+          checkIdempotence = True+        },+      TestGroup         { label = "unicode-syntax",           testCases = allOptions,           updateConfig = \unicodePreference options -> options {poUnicode = pure unicodePreference},           showTestCase = show,-          testCaseSuffix = suffix1+          testCaseSuffix = suffix1,+          checkIdempotence = True         },       TestGroup         { label = "respectful",           testCases = allOptions,           updateConfig = \respectful opts -> opts {poRespectful = pure respectful},           showTestCase = show,-          testCaseSuffix = suffix1+          testCaseSuffix = suffix1,+          checkIdempotence = True         }     ] @@ -198,7 +230,8 @@           showTestCase = \(respectful, importExportStyle) ->             (if respectful then "respectful" else "not respectful") ++ " + " ++ show importExportStyle,           testCaseSuffix = \(respectful, importExportStyle) ->-            suffixWith ["respectful=" ++ show respectful, show importExportStyle]+            suffixWith ["respectful=" ++ show respectful, show importExportStyle],+          checkIdempotence = True         }     ] @@ -215,8 +248,8 @@         input <- readFileUtf8 inputPath         actual <-           if isMulti-            then overSectionsM (T.pack "{- // -}") (runOrmolu opts inputPath) input-            else runOrmolu opts inputPath input+            then overSectionsM (T.pack "{- // -}") (runOrmolu opts checkIdempotence inputPath) input+            else runOrmolu opts checkIdempotence inputPath input         checkResult outputFile actual   where     testDir = toRelDir $ "data/fourmolu/" ++ label@@ -229,8 +262,8 @@         Just path -> path         Nothing -> error $ "Not a valid file name: " ++ show name -runOrmolu :: PrinterOptsTotal -> FilePath -> Text -> IO Text-runOrmolu opts inputPath input =+runOrmolu :: PrinterOptsTotal -> Bool -> FilePath -> Text -> IO Text+runOrmolu opts checkIdempotence inputPath input =   ormolu config inputPath input `catch` \e -> do     msg <- renderOrmoluException e     expectationFailure' $ unlines ["Got ormolu exception:", "", msg]@@ -239,7 +272,7 @@       defaultConfig         { cfgPrinterOpts = opts,           cfgSourceType = detectSourceType inputPath,-          cfgCheckIdempotence = True+          cfgCheckIdempotence = checkIdempotence         }  checkResult :: Path Rel File -> Text -> Expectation

@@ -2,14 +2,11 @@  module Ormolu.Diff.TextSpec (spec) where -import Data.Text (Text) import Ormolu.Diff.Text import Ormolu.Terminal import Ormolu.Utils.IO import Path-import Path.IO-import qualified System.FilePath as FP-import System.IO (hClose)+import System.FilePath qualified as FP import Test.Hspec  spec :: Spec@@ -48,16 +45,7 @@     parseRelFile expectedDiffPath       >>= readFileUtf8 . toFilePath . (diffOutputsDir </>)   Just actualDiff <- pure $ diffText inputA inputB "TEST"-  actualDiffText <- printDiff actualDiff-  actualDiffText `shouldBe` expectedDiffText---- | Print to a 'Text' value.-printDiff :: TextDiff -> IO Text-printDiff diff =-  withSystemTempFile "ormolu-diff-test" $ \path h -> do-    runTerm (printTextDiff diff) Never h-    hClose h-    readFileUtf8 (toFilePath path)+  runTermPure (printTextDiff actualDiff) `shouldBe` expectedDiffText  diffTestsDir :: Path Rel Dir diffTestsDir = $(mkRelDir "data/diff-tests")

@@ -2,9 +2,9 @@  module Ormolu.Fixity.ParserSpec (spec) where -import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Ormolu.Fixity import Ormolu.Fixity.Parser import Test.Hspec

@@ -2,9 +2,9 @@  module Ormolu.Fixity.PrinterSpec (spec) where -import qualified Data.Char as Char-import qualified Data.Map.Strict as Map-import qualified Data.Text as T+import Data.Char qualified as Char+import Data.Map.Strict qualified as Map+import Data.Text qualified as T import Ormolu.Fixity import Ormolu.Fixity.Parser import Ormolu.Fixity.Printer

@@ -1,11 +1,10 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}  module Ormolu.HackageInfoSpec (spec) where -import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe)-import qualified Data.Set as Set+import Data.Set qualified as Set import Distribution.Types.PackageName (PackageName) import Ormolu.Fixity import Test.Hspec

@@ -2,10 +2,10 @@  module Ormolu.OpTreeSpec (spec) where -import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Maybe (fromJust) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import GHC.Types.Name (mkOccName, varName) import GHC.Types.Name.Reader (mkRdrUnqual) import Ormolu.Fixity

@@ -3,7 +3,7 @@  module Ormolu.Parser.OptionsSpec (spec) where -import qualified Data.Text as T+import Data.Text qualified as T import Ormolu import Test.Hspec 

@@ -3,7 +3,7 @@ module Ormolu.Parser.PragmaSpec (spec) where  import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Ormolu.Parser.Pragma import Test.Hspec 

@@ -7,11 +7,11 @@ import Control.Exception import Control.Monad import Data.List (isSuffixOf)-import qualified Data.Map as Map+import Data.Map qualified as Map import Data.Maybe (isJust) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.IO as T+import Data.Text qualified as T+import Data.Text.IO qualified as T import Ormolu import Ormolu.Config import Ormolu.Fixity@@ -19,7 +19,7 @@ import Path import Path.IO import System.Environment (lookupEnv)-import qualified System.FilePath as F+import System.FilePath qualified as F import Test.Hspec  spec :: Spec