fourmolu 0.14.1.0 → 0.15.0.0

raw patch · 83 files changed

+739/−224 lines, 83 filesdep ~ansi-terminal

Dependency ranges changed: ansi-terminal

Files

• CHANGELOG.md +24/−0
• README.md +28/−0
• app/Main.hs +9/−7
• data/examples/declaration/data/ctype-0-four-out.hs +1/−0
• data/examples/declaration/data/ctype-0-out.hs +1/−0
• data/examples/declaration/data/ctype-0.hs +1/−0
• data/examples/declaration/data/ctype-1-four-out.hs +6/−0
• data/examples/declaration/data/ctype-1-out.hs +6/−0
• data/examples/declaration/data/ctype-1.hs +6/−0
• data/examples/declaration/data/ctype-four-out.hs +0/−1
• data/examples/declaration/data/ctype-out.hs +0/−1
• data/examples/declaration/data/ctype.hs +0/−1
• data/examples/declaration/data/field-layout/record-0-four-out.hs +10/−0
• data/examples/declaration/data/field-layout/record-0-out.hs +10/−0
• data/examples/declaration/data/field-layout/record-0.hs +9/−0
• data/examples/declaration/data/field-layout/record-1-four-out.hs +11/−0
• data/examples/declaration/data/field-layout/record-1-out.hs +11/−0
• data/examples/declaration/data/field-layout/record-1.hs +10/−0
• data/examples/declaration/data/field-layout/record-2-four-out.hs +7/−0
• data/examples/declaration/data/field-layout/record-2-out.hs +7/−0
• data/examples/declaration/data/field-layout/record-2.hs +7/−0
• data/examples/declaration/data/field-layout/record-four-out.hs +0/−12
• data/examples/declaration/data/field-layout/record-out.hs +0/−12
• data/examples/declaration/data/field-layout/record.hs +0/−11
• data/examples/declaration/data/record-fancy-existential-four-out.hs +6/−0
• data/examples/declaration/data/record-fancy-existential-out.hs +6/−0
• data/examples/declaration/data/record-fancy-existential.hs +5/−0
• data/examples/declaration/data/simple-broken-four-out.hs +2/−1
• data/examples/declaration/data/simple-broken-out.hs +2/−1
• data/examples/declaration/value/function/if-single-line-functions-do-four-out.hs +5/−0
• data/examples/declaration/value/function/if-single-line-functions-do-out.hs +5/−0
• data/examples/declaration/value/function/if-single-line-functions-do.hs +5/−0
• data/examples/declaration/value/function/if-single-line-functions-four-out.hs +4/−0
• data/examples/declaration/value/function/if-single-line-functions-out.hs +4/−0
• data/examples/declaration/value/function/if-single-line-functions.hs +4/−0
• data/examples/declaration/value/function/if-with-comment-above-branches-four-out.hs +7/−0
• data/examples/declaration/value/function/if-with-comment-above-branches-out.hs +7/−0
• data/examples/declaration/value/function/if-with-comment-above-branches.hs +8/−0
• data/examples/declaration/value/function/if-with-comment-before-do-blocks-four-out.hs +10/−0
• data/examples/declaration/value/function/if-with-comment-before-do-blocks-out.hs +10/−0
• data/examples/declaration/value/function/if-with-comment-before-do-blocks.hs +10/−0
• data/examples/declaration/value/function/if-with-comment-four-out.hs +0/−8
• data/examples/declaration/value/function/if-with-comment-in-branches-four-out.hs +14/−0
• data/examples/declaration/value/function/if-with-comment-in-branches-out.hs +14/−0
• data/examples/declaration/value/function/if-with-comment-in-branches-with-functions-four-out.hs +12/−0
• data/examples/declaration/value/function/if-with-comment-in-branches-with-functions-out.hs +12/−0
• data/examples/declaration/value/function/if-with-comment-in-branches-with-functions.hs +12/−0
• data/examples/declaration/value/function/if-with-comment-in-branches.hs +14/−0
• data/examples/declaration/value/function/if-with-comment-next-to-keyword-four-out.hs +10/−0
• data/examples/declaration/value/function/if-with-comment-next-to-keyword-out.hs +10/−0
• data/examples/declaration/value/function/if-with-comment-next-to-keyword.hs +10/−0
• data/examples/declaration/value/function/if-with-comment-out.hs +0/−8
• data/examples/declaration/value/function/if-with-comment.hs +0/−8
• data/examples/other/jsffi-four-out.hs +1/−0
• data/examples/other/jsffi-out.hs +1/−0
• data/examples/other/jsffi.hs +1/−0
• data/fourmolu/single-deriving-parens/input.hs +10/−0
• data/fourmolu/single-deriving-parens/output-DerivingAlways.hs +10/−0
• data/fourmolu/single-deriving-parens/output-DerivingAuto.hs +10/−0
• data/fourmolu/single-deriving-parens/output-DerivingNever.hs +10/−0
• fixity-tests/test-0-no-extra-info-expected.hs +0/−10
• fixity-tests/test-0-ugly-expected.hs +10/−0
• fourmolu.cabal +2/−2
• fourmolu.yaml +1/−0
• src/GHC/DynFlags.hs +2/−1
• src/Ormolu.hs +2/−2
• src/Ormolu/Config.hs +3/−1
• src/Ormolu/Config/Gen.hs +38/−0
• src/Ormolu/Diff/ParseResult.hs +5/−2
• src/Ormolu/Fixity/Internal.hs +55/−16
• src/Ormolu/Printer.hs +4/−1
• src/Ormolu/Printer/Combinators.hs +1/−0
• src/Ormolu/Printer/Internal.hs +13/−3
• src/Ormolu/Printer/Meat/Declaration/Data.hs +103/−90
• src/Ormolu/Printer/Meat/Declaration/Value.hs +43/−13
• src/Ormolu/Printer/Meat/Type.hs +2/−1
• src/Ormolu/Printer/Operators.hs +10/−6
• src/Ormolu/Utils.hs +3/−0
• tests/Ormolu/Config/PrinterOptsSpec.hs +11/−1
• tests/Ormolu/ConfigSpec.hs +6/−1
• tests/Ormolu/FixitySpec.hs +1/−1
• tests/Ormolu/Integration/FixitySpec.hs +8/−1
• tests/Ormolu/OpTreeSpec.hs +1/−1

@@ -1,3 +1,27 @@+## Fourmolu 0.15.0.0++* Add `single-deriving-parens` configuration option to determine if `deriving` clauses of a single type should be parenthesized ([#386](https://github.com/fourmolu/fourmolu/pull/386))++* Fix the order in which the configurations are applied ([#390](https://github.com/fourmolu/fourmolu/issues/390))++### Upstream changes:++#### Ormolu 0.7.4.0++* Don't error when the `JavaScriptFFI` language pragma is present. [Issue+  1087](https://github.com/tweag/ormolu/issues/1087).+* Improve comment placement in if-then-else blocks. [Issue+  998](https://github.com/tweag/ormolu/issues/998).+* Now command line options for fixity overrides and module re-exports+  overwrite information from `.ormolu` files. [Issue+  1030](https://github.com/tweag/ormolu/issues/1030).+* Respect newlines in data declarations in more cases. [Issue+  1077](https://github.com/tweag/ormolu/issues/1077) and [issue+  947](https://github.com/tweag/ormolu/issues/947).+* The `-d / --debug` command line option now makes Ormolu print out debug+  information regarding operator fixity inference. [Issue+  1060](https://github.com/tweag/ormolu/issues/1060).+ ## Fourmolu 0.14.1.0  * Fix `single-constraint-parens: never` for nested quantified constraints ([#374](https://github.com/fourmolu/fourmolu/issues/374))

@@ -15,6 +15,8 @@     * [Regions](#regions)     * [Exit codes](#exit-codes)     * [Using as a library](#using-as-a-library)+* [Troubleshooting](#troubleshooting)+    * [Operators are being formatted weirdly!](#operators-are-being-formatted-weirdly) * [Limitations](#limitations) * [Contributing](#contributing) * [License](#license)@@ -229,6 +231,32 @@ For these purposes only the top `Ormolu` module should be considered stable. It follows [PVP](https://pvp.haskell.org/) starting from the version 0.10.2.0. Rely on other modules at your own risk.++## Troubleshooting++### Operators are being formatted weirdly!++This can happen when Ormolu doesn't know or can't determine the fixity of an+operator.++* If this is a custom operator, see the instructions in the [Language+  extensions, dependencies, and+  fixities](#language-extensions-dependencies-and-fixities) section to+  specify the correct fixities in a `.ormolu` file.++* If this is a third-party operator (e.g. from `base` or some other package+  from Hackage), Ormolu probably doesn't recognize that the operator is the+  same as the third-party one.++  Some reasons this might be the case:++    * You might have a custom Prelude that re-exports things from Prelude+    * You might have `-XNoImplicitPrelude` turned on++  If any of these are true, make sure to specify the reexports correctly in+  a `.ormolu` file.++You can see how Ormolu decides the fixity of operators if you use `--debug`.  ## Limitations 

@@ -100,8 +100,8 @@     cliConfig       { cfgPrinterOpts =           resolvePrinterOpts-            [ cliPrinterOpts,-              cfgFilePrinterOpts fourmoluConfig+            [ cfgFilePrinterOpts fourmoluConfig,+              cliPrinterOpts             ],         cfgFixityOverrides =           FixityOverrides . mconcat . map unFixityOverrides $@@ -242,15 +242,17 @@             fromMaybe               ModuleSource               (reqSourceType <|> mdetectedSourceType)-      let mfixityOverrides = fst <$> mdotOrmolu-          mmoduleReexports = snd <$> mdotOrmolu       return $         refineConfig           sourceType           mcabalInfo-          mfixityOverrides-          mmoduleReexports-          rawConfig+          (Just (cfgFixityOverrides rawConfig))+          (Just (cfgModuleReexports rawConfig))+          ( rawConfig+              { cfgFixityOverrides = maybe defaultFixityOverrides fst mdotOrmolu,+                cfgModuleReexports = maybe defaultModuleReexports snd mdotOrmolu+              }+          )     handleDiff originalInput formattedInput fileRepr =       case diffText originalInput formattedInput fileRepr of         Nothing -> return ExitSuccess

@@ -0,0 +1,1 @@+data {-# CTYPE "unistd.h" "useconds_t" #-} T

@@ -0,0 +1,1 @@+data {-# CTYPE "unistd.h" "useconds_t" #-} T

@@ -0,0 +1,1 @@+data    {-# CTYPE "unistd.h" "useconds_t" #-} T

@@ -0,0 +1,6 @@+data+    {-# CTYPE "header.h" "an-ffi-type-with-along-name" #-}+    AnFFITypeWithAlongName = AnFFITypeWithAlongName+    { a :: X+    , b :: Y+    }

@@ -0,0 +1,6 @@+data+  {-# CTYPE "header.h" "an-ffi-type-with-along-name" #-}+  AnFFITypeWithAlongName = AnFFITypeWithAlongName+  { a :: X,+    b :: Y+  }

@@ -0,0 +1,6 @@+data+  {-# CTYPE "header.h" "an-ffi-type-with-along-name"  #-}+  AnFFITypeWithAlongName = AnFFITypeWithAlongName+  { a :: X,+    b :: Y+  }

@@ -1,1 +0,0 @@-data {-# CTYPE "unistd.h" "useconds_t" #-} T

@@ -1,1 +0,0 @@-data {-# CTYPE "unistd.h" "useconds_t" #-} T

@@ -1,1 +0,0 @@-data    {-# CTYPE "unistd.h" "useconds_t" #-} T

@@ -0,0 +1,10 @@+-- | Foo.+data Foo = Foo+    { foo :: Foo Int Int+    -- ^ Something+    , bar ::+        Bar+            Char+            Char+    -- ^ Something else+    }

@@ -0,0 +1,10 @@+-- | Foo.+data Foo = Foo+  { -- | Something+    foo :: Foo Int Int,+    -- | Something else+    bar ::+      Bar+        Char+        Char+  }

@@ -0,0 +1,9 @@+-- | Foo.++data Foo = Foo+  { foo :: Foo Int Int+    -- ^ Something+  , bar :: Bar Char+           Char+    -- ^ Something else+  }

@@ -0,0 +1,11 @@+-- | Foo.+data Foo+    = Foo+    { foo :: Foo Int Int+    -- ^ Something+    , bar ::+        Bar+            Char+            Char+    -- ^ Something else+    }

@@ -0,0 +1,11 @@+-- | Foo.+data Foo+  = Foo+  { -- | Something+    foo :: Foo Int Int,+    -- | Something else+    bar ::+      Bar+        Char+        Char+  }

@@ -0,0 +1,10 @@+-- | Foo.++data Foo =+  Foo+  { foo :: Foo Int Int+    -- ^ Something+  , bar :: Bar Char+           Char+    -- ^ Something else+  }

@@ -0,0 +1,7 @@+data IndexWithInfo schema+    = forall x.+      IndexWithInfo+    { checkedIndex :: Index schema x+    , checkedIndexName :: U.Variable+    , checkedIndexType :: Type x+    }

@@ -0,0 +1,7 @@+data IndexWithInfo schema+  = forall x.+  IndexWithInfo+  { checkedIndex :: Index schema x,+    checkedIndexName :: U.Variable,+    checkedIndexType :: Type x+  }

@@ -0,0 +1,7 @@+data IndexWithInfo schema =+  forall x.+  IndexWithInfo+    { checkedIndex :: Index schema x+    , checkedIndexName :: U.Variable+    , checkedIndexType :: Type x+    }

@@ -1,12 +0,0 @@-module Main where---- | Foo.-data Foo = Foo-    { foo :: Foo Int Int-    -- ^ Something-    , bar ::-        Bar-            Char-            Char-    -- ^ Something else-    }

@@ -1,12 +0,0 @@-module Main where---- | Foo.-data Foo = Foo-  { -- | Something-    foo :: Foo Int Int,-    -- | Something else-    bar ::-      Bar-        Char-        Char-  }

@@ -1,11 +0,0 @@-module Main where---- | Foo.--data Foo = Foo-  { foo :: Foo Int Int-    -- ^ Something-  , bar :: Bar Char-           Char-    -- ^ Something else-  }

@@ -0,0 +1,6 @@+{-# LANGUAGE ExistentialQuantification #-}++data Foo = forall a b. (Show a, Eq b) => Bar+    { foo :: a+    , bars :: b+    }

@@ -0,0 +1,6 @@+{-# LANGUAGE ExistentialQuantification #-}++data Foo = forall a b. (Show a, Eq b) => Bar+  { foo :: a,+    bars :: b+  }

@@ -0,0 +1,5 @@+{-# LANGUAGE ExistentialQuantification #-}+data Foo = forall a b . (Show a, Eq b) => Bar+  { foo  :: a+  , bars :: b+  }

@@ -1,7 +1,8 @@ module Main where  -- | Here we go.-data Foo = Foo {unFoo :: Int}+data Foo+    = Foo {unFoo :: Int}     deriving (Eq)  -- | And once again.

@@ -1,7 +1,8 @@ module Main where  -- | Here we go.-data Foo = Foo {unFoo :: Int}+data Foo+  = Foo {unFoo :: Int}   deriving (Eq)  -- | And once again.

@@ -0,0 +1,5 @@+foo x = do+    y <- quux+    if x > 2+        then bar x+        else baz y

@@ -0,0 +1,5 @@+foo x = do+  y <- quux+  if x > 2+    then bar x+    else baz y

@@ -0,0 +1,5 @@+foo x = do+  y <- quux+  if x > 2+    then bar x+    else baz y

@@ -0,0 +1,4 @@+foo x =+    if x > 2+        then bar x+        else baz x

@@ -0,0 +1,4 @@+foo x =+  if x > 2+    then bar x+    else baz x

@@ -0,0 +1,4 @@+foo x =+  if x > 2+    then bar x+    else baz x

@@ -0,0 +1,7 @@+foo =+    if undefined+        -- then comment+        then undefined+        -- else comment+        else do+            undefined

@@ -0,0 +1,7 @@+foo =+  if undefined+    -- then comment+    then undefined+    -- else comment+    else do+      undefined

@@ -0,0 +1,8 @@+foo =+  if undefined+    -- then comment+    then undefined+    -- else comment+    else+      do+        undefined

@@ -0,0 +1,10 @@+foo =+    if something+        -- then comment+        then do+            stuff+            stuff+        -- else comment+        else do+            stuff+            stuff

@@ -0,0 +1,10 @@+foo =+  if something+    -- then comment+    then do+      stuff+      stuff+    -- else comment+    else do+      stuff+      stuff

@@ -0,0 +1,10 @@+foo =+  if something+    -- then comment+    then do+      stuff+      stuff+    -- else comment+    else do+      stuff+      stuff

@@ -1,8 +0,0 @@-foo =-    if undefined-        then -- then comment-            undefined-        else -- else comment--        do-            undefined

@@ -0,0 +1,14 @@+foo =+    if x+        then+            -- comment 1+            -- comment 2+            case a of+                Just b -> _+                Nothing -> _+        else+            -- comment 3+            -- comment 4+            case a of+                Just b -> _+                Nothing -> _

@@ -0,0 +1,14 @@+foo =+  if x+    then+      -- comment 1+      -- comment 2+      case a of+        Just b -> _+        Nothing -> _+    else+      -- comment 3+      -- comment 4+      case a of+        Just b -> _+        Nothing -> _

@@ -0,0 +1,12 @@+foo =+    if x+        then+            -- comment 1+            -- comment 2+            foo 1 2 3+        else+            -- comment 3+            -- comment 4+            foo+                "here"+                "there"

@@ -0,0 +1,12 @@+foo =+  if x+    then+      -- comment 1+      -- comment 2+      foo 1 2 3+    else+      -- comment 3+      -- comment 4+      foo+        "here"+        "there"

@@ -0,0 +1,12 @@+foo =+  if x+    then+      -- comment 1+      -- comment 2+      foo 1 2 3+    else+      -- comment 3+      -- comment 4+      foo+        "here"+        "there"

@@ -0,0 +1,14 @@+foo =+  if x+    then+      -- comment 1+      -- comment 2+      case a of+        Just b -> _+        Nothing -> _+    else+      -- comment 3+      -- comment 4+      case a of+        Just b -> _+        Nothing -> _

@@ -0,0 +1,10 @@+foo =+    if x+        then -- comment 1+        -- comment 2+            foo 1 2 3+        else -- comment 3+        -- comment 4+            foo+                "here"+                "there"

@@ -0,0 +1,10 @@+foo =+  if x+    then -- comment 1+    -- comment 2+      foo 1 2 3+    else -- comment 3+    -- comment 4+      foo+        "here"+        "there"

@@ -0,0 +1,10 @@+foo =+  if x+    then -- comment 1+      -- comment 2+      foo 1 2 3+    else -- comment 3+      -- comment 4+      foo+        "here"+        "there"

@@ -1,8 +0,0 @@-foo =-  if undefined-    then -- then comment-      undefined-    else -- else comment--    do-      undefined

@@ -1,8 +0,0 @@-foo =-  if undefined-    -- then comment-    then undefined-    -- else comment-    else-      do-        undefined

@@ -0,0 +1,1 @@+{-# LANGUAGE JavaScriptFFI #-}

@@ -0,0 +1,1 @@+{-# LANGUAGE JavaScriptFFI #-}

@@ -0,0 +1,1 @@+{-# language JavaScriptFFI #-}

@@ -0,0 +1,10 @@+module Main where++data Foo = Foo+    deriving stock Show++data Bar = Bar+    deriving stock (Show, Eq)++data Bat = Bat+    deriving stock (Show)

@@ -0,0 +1,10 @@+module Main where++data Foo = Foo+    deriving stock (Show)++data Bar = Bar+    deriving stock (Show, Eq)++data Bat = Bat+    deriving stock (Show)

@@ -0,0 +1,10 @@+module Main where++data Foo = Foo+    deriving stock Show++data Bar = Bar+    deriving stock (Show, Eq)++data Bat = Bat+    deriving stock (Show)

@@ -0,0 +1,10 @@+module Main where++data Foo = Foo+    deriving stock Show++data Bar = Bar+    deriving stock (Show, Eq)++data Bat = Bat+    deriving stock Show

@@ -1,10 +0,0 @@-instance A.ToJSON UpdateTable where-  toJSON a =-    A.object $-      "TableName"-        .= updateTableName a-        :> "ProvisionedThroughput"-        .= updateProvisionedThroughput a-        :> case updateGlobalSecondaryIndexUpdates a of-          [] -> []-          l -> ["GlobalSecondaryIndexUpdates" .= l]

@@ -0,0 +1,10 @@+instance A.ToJSON UpdateTable where+  toJSON a =+    A.object $+      "TableName"+        .= updateTableName a+        :> "ProvisionedThroughput"+        .= updateProvisionedThroughput a+        :> case updateGlobalSecondaryIndexUpdates a of+          [] -> []+          l -> ["GlobalSecondaryIndexUpdates" .= l]

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               fourmolu-version:            0.14.1.0+version:            0.15.0.0 license:            BSD-3-Clause license-file:       LICENSE.md maintainer:@@ -213,7 +213,7 @@         Ormolu.Integration.Utils     build-depends:         bytestring,-        Diff >=0.3 && <0.5,+        Diff >=0.3 && <1,         pretty >=1.0 && <2.0,         process >=1.6 && <2.0,         yaml,

@@ -14,6 +14,7 @@ let-style: inline in-style: right-align single-constraint-parens: always+single-deriving-parens: always unicode: never respectful: false fixities: []

@@ -26,7 +26,8 @@         Platform           { platformArchOS =               ArchOS-                { archOS_arch = ArchUnknown,+                { -- see https://github.com/tweag/ormolu/issues/1087+                  archOS_arch = ArchJavaScript,                   archOS_OS = OSUnknown                 },             platformWordSize = PW8,

@@ -118,7 +118,7 @@   -- when we try to parse the rendered code back, inside of GHC monad   -- wrapper which will lead to error messages presenting the exceptions as   -- GHC bugs.-  let !formattedText = printSnippets result0 $ cfgPrinterOpts cfgWithIndices+  let !formattedText = printSnippets (cfgDebug cfg) result0 $ cfgPrinterOpts cfgWithIndices   when (not (cfgUnsafe cfg) || cfgCheckIdempotence cfg) $ do     -- Parse the result of pretty-printing again and make sure that AST     -- is the same as AST of original snippet module span positions.@@ -144,7 +144,7 @@     -- Try re-formatting the formatted result to check if we get exactly     -- the same output.     when (cfgCheckIdempotence cfg) . liftIO $-      let reformattedText = printSnippets result1 $ cfgPrinterOpts cfgWithIndices+      let reformattedText = printSnippets (cfgDebug cfg) result1 $ cfgPrinterOpts cfgWithIndices        in case diffText formattedText reformattedText path of             Nothing -> return ()             Just diff -> throwIO (OrmoluNonIdempotentOutput diff)

@@ -42,6 +42,7 @@     InStyle (..),     Unicode (..),     ColumnLimit (..),+    SingleDerivingParens (..),     parsePrinterOptsCLI,     parsePrinterOptType, @@ -58,6 +59,7 @@ import Data.Aeson ((.!=), (.:?)) import Data.Aeson qualified as Aeson import Data.Aeson.Types qualified as Aeson+import Data.Foldable (foldl') import Data.Functor.Identity (Identity (..)) import Data.Map.Strict qualified as Map import Data.Set (Set)@@ -230,7 +232,7 @@  -- | Apply the given configuration in order (later options override earlier). resolvePrinterOpts :: [PrinterOptsPartial] -> PrinterOptsTotal-resolvePrinterOpts = foldr fillMissingPrinterOpts defaultPrinterOpts+resolvePrinterOpts = foldl' (flip fillMissingPrinterOpts) defaultPrinterOpts  ---------------------------------------------------------------------------- -- Loading Fourmolu configuration

@@ -18,6 +18,7 @@   , Unicode (..)   , SingleConstraintParens (..)   , ColumnLimit (..)+  , SingleDerivingParens (..)   , emptyPrinterOpts   , defaultPrinterOpts   , defaultPrinterOptsYaml@@ -65,6 +66,8 @@       poInStyle :: f InStyle     , -- | Whether to put parentheses around a single constraint       poSingleConstraintParens :: f SingleConstraintParens+    , -- | Whether to put parentheses around a single deriving class+      poSingleDerivingParens :: f SingleDerivingParens     , -- | Output Unicode syntax       poUnicode :: f Unicode     , -- | Give the programmer more choice on where to insert blank lines@@ -88,6 +91,7 @@     , poLetStyle = Nothing     , poInStyle = Nothing     , poSingleConstraintParens = Nothing+    , poSingleDerivingParens = Nothing     , poUnicode = Nothing     , poRespectful = Nothing     }@@ -108,6 +112,7 @@     , poLetStyle = pure LetAuto     , poInStyle = pure InRightAlign     , poSingleConstraintParens = pure ConstraintAlways+    , poSingleDerivingParens = pure DerivingAlways     , poUnicode = pure UnicodeNever     , poRespectful = pure True     }@@ -135,6 +140,7 @@     , poLetStyle = maybe (poLetStyle p2) pure (poLetStyle p1)     , poInStyle = maybe (poInStyle p2) pure (poInStyle p1)     , poSingleConstraintParens = maybe (poSingleConstraintParens p2) pure (poSingleConstraintParens p1)+    , poSingleDerivingParens = maybe (poSingleDerivingParens p2) pure (poSingleDerivingParens p1)     , poUnicode = maybe (poUnicode p2) pure (poUnicode p1)     , poRespectful = maybe (poRespectful p2) pure (poRespectful p1)     }@@ -198,6 +204,10 @@       "Whether to put parentheses around a single constraint (choices: \"auto\", \"always\", or \"never\") (default: always)"       "OPTION"     <*> f+      "single-deriving-parens"+      "Whether to put parentheses around a single deriving class (choices: \"auto\", \"always\", or \"never\") (default: always)"+      "OPTION"+    <*> f       "unicode"       "Output Unicode syntax (choices: \"detect\", \"always\", or \"never\") (default: never)"       "OPTION"@@ -225,6 +235,7 @@     <*> f "let-style"     <*> f "in-style"     <*> f "single-constraint-parens"+    <*> f "single-deriving-parens"     <*> f "unicode"     <*> f "respectful" @@ -305,6 +316,12 @@   | ColumnLimit Int   deriving (Eq, Show) +data SingleDerivingParens+  = DerivingAuto+  | DerivingAlways+  | DerivingNever+  deriving (Eq, Show, Enum, Bounded)+ instance Aeson.FromJSON CommaStyle where   parseJSON =     Aeson.withText "CommaStyle" $ \s ->@@ -490,6 +507,24 @@               "Valid values are: \"none\", or an integer"             ] +instance Aeson.FromJSON SingleDerivingParens where+  parseJSON =+    Aeson.withText "SingleDerivingParens" $ \s ->+      either Aeson.parseFail pure $+        parsePrinterOptType (Text.unpack s)++instance PrinterOptsFieldType SingleDerivingParens where+  parsePrinterOptType s =+    case s of+      "auto" -> Right DerivingAuto+      "always" -> Right DerivingAlways+      "never" -> Right DerivingNever+      _ ->+        Left . unlines $+          [ "unknown value: " <> show s+          , "Valid values are: \"auto\", \"always\", or \"never\""+          ]+ defaultPrinterOptsYaml :: String defaultPrinterOptsYaml =   unlines@@ -531,6 +566,9 @@     , ""     , "# Whether to put parentheses around a single constraint (choices: auto, always, or never)"     , "single-constraint-parens: always"+    , ""+    , "# Whether to put parentheses around a single deriving class (choices: auto, always, or never)"+    , "single-deriving-parens: always"     , ""     , "# Output Unicode syntax (choices: detect, always, or never)"     , "unicode: never"

@@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeepSubsumption #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} @@ -160,5 +161,7 @@     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'+    derivedTyClsParensEq = considerEqualVia $ curry $ \case+      (DctSingle _ ty, DctMulti _ [ty']) -> genericQuery ty ty'+      (DctMulti _ [ty], DctSingle _ ty') -> genericQuery ty ty'+      (x, y) -> genericQuery x y

@@ -42,6 +42,7 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as T+import Debug.Trace (trace) import Distribution.ModuleName (ModuleName) import Distribution.Types.PackageName import GHC.Data.FastString (fs_sbs)@@ -256,24 +257,62 @@   deriving stock (Eq, Show)  -- | Get a 'FixityApproximation' of an operator.-inferFixity :: RdrName -> ModuleFixityMap -> FixityApproximation-inferFixity rdrName (ModuleFixityMap m) =-  case Map.lookup opName m of-    Nothing -> defaultFixityApproximation-    Just (Given fixityInfo) ->-      fixityInfoToApproximation fixityInfo-    Just (FromModuleImports xs) ->-      let isMatching (provenance, _fixityInfo) =-            case provenance of-              UnqualifiedAndQualified mn ->-                maybe True (== mn) moduleName-              OnlyQualified mn ->-                maybe False (== mn) moduleName-       in fromMaybe defaultFixityApproximation-            . foldMap (Just . fixityInfoToApproximation . snd)-            $ NE.filter isMatching xs+inferFixity ::+  -- | Whether to print debug info regarding fixity inference+  Bool ->+  -- | Operator name+  RdrName ->+  -- | Module fixity map+  ModuleFixityMap ->+  -- | The resulting fixity approximation+  FixityApproximation+inferFixity debug rdrName (ModuleFixityMap m) =+  if debug+    then+      trace+        (renderFixityJustification opName moduleName m result)+        result+    else result   where+    result =+      case Map.lookup opName m of+        Nothing -> defaultFixityApproximation+        Just (Given fixityInfo) ->+          fixityInfoToApproximation fixityInfo+        Just (FromModuleImports xs) ->+          let isMatching (provenance, _fixityInfo) =+                case provenance of+                  UnqualifiedAndQualified mn ->+                    maybe True (== mn) moduleName+                  OnlyQualified mn ->+                    maybe False (== mn) moduleName+           in fromMaybe defaultFixityApproximation+                . foldMap (Just . fixityInfoToApproximation . snd)+                $ NE.filter isMatching xs     opName = occOpName (rdrNameOcc rdrName)     moduleName = case rdrName of       Qual x _ -> Just (ghcModuleNameToCabal x)       _ -> Nothing++-- | Render a human-readable account of why a certain 'FixityApproximation'+-- was chosen for an operator.+renderFixityJustification ::+  -- | Operator name+  OpName ->+  -- | Qualification of the operator name+  Maybe ModuleName ->+  -- | Module fixity map+  Map OpName FixityProvenance ->+  -- | The chosen fixity approximation+  FixityApproximation ->+  String+renderFixityJustification opName mqualification m approximation =+  concat+    [ "FIXITY analysis of ",+      show opName,+      case mqualification of+        Nothing -> ""+        Just mn -> " qualified in " ++ show mn,+      "\n  Provenance: " ++ show (Map.lookup opName m),+      "\n  Inferred: " ++ show approximation+    ]

@@ -19,12 +19,14 @@  -- | Render several source snippets. printSnippets ::+  -- | Whether to print out debug information during printing+  Bool ->   -- | Result of parsing   [SourceSnippet] ->   PrinterOptsTotal ->   -- | Resulting rendition   Text-printSnippets snippets printerOpts = T.concat . fmap printSnippet $ snippets+printSnippets debug snippets printerOpts = T.concat . fmap printSnippet $ snippets   where     printSnippet = \case       ParsedSnippet ParseResult {..} ->@@ -41,4 +43,5 @@             prSourceType             prExtensions             prModuleFixityMap+            debug       RawSnippet r -> r

@@ -27,6 +27,7 @@     inciByFrac,     askSourceType,     askModuleFixityMap,+    askDebug,     located,     encloseLocated,     located',

@@ -19,6 +19,7 @@     declNewline,     askSourceType,     askModuleFixityMap,+    askDebug,     inci,     inciBy,     inciByFrac,@@ -107,7 +108,9 @@     -- | Whether the source is a signature or a regular module     rcSourceType :: SourceType,     -- | Module fixity map-    rcModuleFixityMap :: ModuleFixityMap+    rcModuleFixityMap :: ModuleFixityMap,+    -- | Whether to print out debug information during printing+    rcDebug :: !Bool   }  -- | State context of 'R'.@@ -179,8 +182,9 @@   -- | Module fixity map   ModuleFixityMap ->   -- | Resulting rendition+  Bool ->   Text-runR (R m) sstream cstream printerOpts sourceType extensions moduleFixityMap =+runR (R m) sstream cstream printerOpts sourceType extensions moduleFixityMap debug =   TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc   where     rc =@@ -192,7 +196,8 @@           rcPrinterOpts = printerOpts,           rcExtensions = extensions,           rcSourceType = sourceType,-          rcModuleFixityMap = moduleFixityMap+          rcModuleFixityMap = moduleFixityMap,+          rcDebug = debug         }     sc =       SC@@ -400,6 +405,11 @@ -- | Retrieve the module fixity map. askModuleFixityMap :: R ModuleFixityMap askModuleFixityMap = R (asks rcModuleFixityMap)++-- | Retrieve whether we should print out certain debug information while+-- printing.+askDebug :: R Bool+askDebug = R (asks rcDebug)  -- | Like 'inci', but indents by exactly the given number of steps. inciBy :: Int -> R () -> R ()

@@ -52,74 +52,78 @@   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 getTyVarLoc tyVars       sigSpans = maybeToList . fmap getLocA $ dd_kindSig+      contextSpans = maybeToList . fmap getLocA $ dd_ctxt+      ctypeSpans = maybeToList . fmap getLocA $ dd_cType       declHeaderSpans =-        maybeToList (getLocA <$> dd_ctxt) ++ constructorSpans ++ sigSpans-  switchLayout declHeaderSpans $ do-    breakpoint-    inci $ do-      case dd_ctxt of-        Nothing -> pure ()-        Just ctxt -> do-          located ctxt p_hsContext-          space-          txt "=>"-          breakpoint-      switchLayout constructorSpans $-        p_infixDefHelper-          (isInfix fixity)-          True-          (p_rdrName name)-          (p_tyVar <$> tyVars)-      forM_ dd_kindSig $ \k -> do-        space-        token'dcolon+        constructorSpans ++ sigSpans ++ contextSpans ++ ctypeSpans+  switchLayout declHeaderSpans . inci $ do+    case unLoc <$> dd_cType of+      Nothing -> pure ()+      Just (CType prag header (type_, _)) -> do         breakpoint-        inci $ located k p_hsType+        p_sourceText prag+        case header of+          Nothing -> pure ()+          Just (Header h _) -> space *> p_sourceText h+        space+        p_sourceText type_+        txt " #-}"+    breakpoint+    forM_ dd_ctxt p_lhsContext+    switchLayout constructorSpans $+      p_infixDefHelper+        (isInfix fixity)+        True+        (p_rdrName name)+        (p_tyVar <$> tyVars)+    forM_ dd_kindSig $ \k -> do+      space+      token'dcolon+      breakpoint+      inci $ located k p_hsType   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+  case dd_cons' of+    [] -> pure ()+    first_dd_cons : _ ->+      if gadt+        then inci $ do+          switchLayout declHeaderSpans $ do+            breakpoint+            txt "where"           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'-          then newline-          else-            if singleConstRec-              then space-              else breakpoint-        equals-        space-        layout <- getLayout-        let s =-              if layout == MultiLine || hasHaddocks dd_cons'-                then newline >> txt "|" >> space-                else space >> txt "|" >> space-            sitcc' =-              if hasHaddocks dd_cons' || not singleConstRec-                then sitcc-                else id-        sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons'+          sepSemi (located' (p_conDecl False)) dd_cons'+        else switchLayout (getLocA name : (getLocA <$> dd_cons')) . inci $ do+          let singleConstRec = isSingleConstRec dd_cons'+              compactLayoutAroundEquals =+                onTheSameLine+                  (getLocA name)+                  (combineSrcSpans' (conDeclConsSpans (unLoc first_dd_cons)))+              conDeclConsSpans = \case+                ConDeclGADT {..} -> getLocA <$> con_names+                ConDeclH98 {..} -> getLocA con_name :| []+          if hasHaddocks dd_cons'+            then newline+            else+              if singleConstRec && compactLayoutAroundEquals+                then space+                else breakpoint+          equals+          space+          layout <- getLayout+          let s =+                if layout == MultiLine || hasHaddocks dd_cons'+                  then newline >> txt "|" >> space+                  else space >> txt "|" >> space+              sitcc' =+                if hasHaddocks dd_cons' || not singleConstRec+                  then sitcc+                  else id+          sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons'   unless (null dd_derivs) breakpoint   inci $ sep newline (located' p_hsDerivingClause) dd_derivs @@ -168,48 +172,49 @@         startTypeAnnotationDecl quantifiedTy id p_hsType   ConDeclH98 {..} -> do     mapM_ (p_hsDoc Pipe True) con_doc-    let conDeclWithContextSpn =+    let conNameSpn = getLocA con_name+        conNameWithContextSpn =           [ RealSrcSpan real Strict.Nothing             | Just (EpaSpan real _) <- matchAddEpAnn AnnForall <$> epAnnAnns con_ext           ]             <> fmap getLocA con_ex_tvs             <> maybeToList (fmap getLocA con_mb_cxt)-            <> conDeclSpn-        conDeclSpn = getLocA con_name : conArgsSpans+            <> [conNameSpn]+        conDeclSpn = conNameSpn : conArgsSpans           where             conArgsSpans = case con_args of               PrefixCon [] xs -> getLocA . hsScaledThing <$> xs               PrefixCon (v : _) _ -> absurd v               RecCon l -> [getLocA l]               InfixCon x y -> getLocA . hsScaledThing <$> [x, y]-    switchLayout conDeclWithContextSpn $ do+    switchLayout conNameWithContextSpn $ do       when con_forall $ do         p_forallBndrs ForAllInvis p_hsTyVarBndr con_ex_tvs         breakpoint         indent <- getPrinterOpt poIndentation         vlayout (pure ()) . txt $ Text.replicate (indent - 2) " "       forM_ con_mb_cxt p_lhsContext-      switchLayout conDeclSpn $ case con_args of-        PrefixCon [] xs -> do-          p_rdrName con_name-          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+    switchLayout conDeclSpn $ case con_args of+      PrefixCon [] xs -> do+        p_rdrName con_name+        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+        breakpoint+        inciIf (not singleConstRec) (located l p_conDeclFields)+      InfixCon (HsScaled _ x) (HsScaled _ y) -> do+        located x p_hsType+        breakpoint+        inci $ do           p_rdrName con_name-          breakpoint-          inciIf (not singleConstRec) (located l p_conDeclFields)-        InfixCon (HsScaled _ x) (HsScaled _ y) -> do-          located x p_hsType-          breakpoint-          inci $ do-            p_rdrName con_name-            space-            located y p_hsType+          space+          located y p_hsType  p_lhsContext ::   LHsContext GhcPs ->@@ -231,15 +236,23 @@   HsDerivingClause GhcPs ->   R () p_hsDerivingClause HsDerivingClause {..} = do+  singleDerivingParens <- getPrinterOpt poSingleDerivingParens+   txt "deriving"   let derivingWhat = located deriv_clause_tys $ \case-        DctSingle NoExtField sigTy -> parens N $ located sigTy p_hsSigType-        DctMulti NoExtField sigTys ->-          parens N $-            sep-              commaDel-              (sitcc . located' p_hsSigType)-              sigTys+        DctSingle NoExtField sigTy+          | DerivingAlways <- singleDerivingParens -> parens N $ located sigTy p_hsSigType+          | otherwise -> located sigTy p_hsSigType+        DctMulti NoExtField sigTys+          | [sigTy] <- sigTys,+            DerivingNever <- singleDerivingParens ->+              located sigTy p_hsSigType+          | otherwise ->+              parens N $+                sep+                  commaDel+                  (sitcc . located' p_hsSigType)+                  sigTys   space   case deriv_clause_strategy of     Nothing -> do

@@ -353,10 +353,11 @@       inci (sequence_ (intersperse breakpoint (located' (p_hsCmdTop N) <$> cmds)))   HsCmdArrForm _ form Infix _ [left, right] -> do     modFixityMap <- askModuleFixityMap+    debug <- askDebug     let opTree = BinaryOpBranches (cmdOpTree left) form (cmdOpTree right)     p_cmdOpTree       s-      (reassociateOpTree (getOpName . unLoc) modFixityMap opTree)+      (reassociateOpTree debug (getOpName . unLoc) modFixityMap opTree)   HsCmdArrForm _ _ Infix _ _ -> notImplemented "HsCmdArrForm"   HsCmdApp _ cmd expr -> do     located cmd (p_hsCmd' Applicand s)@@ -368,8 +369,8 @@     p_case isApp cmdPlacement p_hsCmd e mgroup   HsCmdLamCase _ variant mgroup ->     p_lamcase isApp variant cmdPlacement p_hsCmd mgroup-  HsCmdIf _ _ if' then' else' ->-    p_if cmdPlacement p_hsCmd if' then' else'+  HsCmdIf anns _ if' then' else' ->+    p_if cmdPlacement p_hsCmd anns if' then' else'   HsCmdLet _ letToken localBinds _ c ->     p_let (s == S) p_hsCmd letToken localBinds c   HsCmdDo _ es -> do@@ -699,10 +700,11 @@       located (hswc_body a) p_hsType   OpApp _ x op y -> do     modFixityMap <- askModuleFixityMap+    debug <- askDebug     let opTree = BinaryOpBranches (exprOpTree x) op (exprOpTree y)     p_exprOpTree       s-      (reassociateOpTree (getOpName . unLoc) modFixityMap opTree)+      (reassociateOpTree debug (getOpName . unLoc) modFixityMap opTree)   NegApp _ e _ -> do     negativeLiterals <- isExtensionEnabled NegativeLiterals     let isLiteral = case unLoc e of@@ -751,8 +753,8 @@     p_unboxedSum N tag arity (located e p_hsExpr)   HsCase _ e mgroup ->     p_case isApp exprPlacement p_hsExpr e mgroup-  HsIf _ if' then' else' ->-    p_if exprPlacement p_hsExpr if' then' else'+  HsIf anns if' then' else' ->+    p_if exprPlacement p_hsExpr anns if' then' else'   HsMultiIf _ guards -> do     txt "if"     breakpoint@@ -988,6 +990,8 @@   (body -> Placement) ->   -- | Render   (body -> R ()) ->+  -- | Annotations+  EpAnn AnnsIf ->   -- | If   LHsExpr GhcPs ->   -- | Then@@ -995,21 +999,47 @@   -- | Else   LocatedA body ->   R ()-p_if placer render if' then' else' = do+p_if placer render epAnn if' then' else' = do   txt "if"   space   located if' p_hsExpr   breakpoint   inci $ do-    txt "then"+    locatedToken thenSpan "then"     space-    located then' $ \x ->-      placeHanging (placer x) (render x)+    placeHangingLocated thenSpan then'     breakpoint-    txt "else"+    locatedToken elseSpan "else"     space-    located else' $ \x ->-      placeHanging (placer x) (render x)+    placeHangingLocated elseSpan else'+  where+    (thenSpan, elseSpan, commentSpans) =+      case epAnn of+        EpAnn {anns = AnnsIf {aiThen, aiElse}, comments} ->+          ( loc' $ epaLocationRealSrcSpan aiThen,+            loc' $ epaLocationRealSrcSpan aiElse,+            map (anchor . getLoc) $+              case comments of+                EpaComments cs -> cs+                EpaCommentsBalanced pre post -> pre <> post+          )+        EpAnnNotUsed ->+          (noSrcSpan, noSrcSpan, [])++    locatedToken tokenSpan token =+      located (L tokenSpan ()) $ \_ -> txt token++    betweenSpans spanA spanB s = spanA < s && s < spanB++    placeHangingLocated tokenSpan bodyLoc@(L _ body) = do+      let bodySpan = getLoc' bodyLoc+          hasComments = fromMaybe False $ do+            tokenRealSpan <- srcSpanToRealSrcSpan tokenSpan+            bodyRealSpan <- srcSpanToRealSrcSpan bodySpan+            pure $ any (betweenSpans tokenRealSpan bodyRealSpan) commentSpans+          placement = if hasComments then Normal else placer body+      switchLayout [tokenSpan, bodySpan] $+        placeHanging placement (located bodyLoc render)  p_let ::   -- | True if in do-block

@@ -121,9 +121,10 @@       sep (space >> txt "|" >> breakpoint) (sitcc . located' p_hsType) xs   HsOpTy _ _ x op y -> do     modFixityMap <- askModuleFixityMap+    debug <- askDebug     let opTree = BinaryOpBranches (tyOpTree x) op (tyOpTree y)     p_tyOpTree-      (reassociateOpTree (Just . unLoc) modFixityMap opTree)+      (reassociateOpTree debug (Just . unLoc) modFixityMap opTree)   HsParTy _ t ->     parens N $ sitcc $ located t p_hsType   HsIParamTy _ n t -> sitcc $ do

@@ -90,6 +90,8 @@ -- Users are expected to first construct an initial 'OpTree', then -- re-associate it using this function before printing. reassociateOpTree ::+  -- | Whether to print debug info regarding fixity inference+  Bool ->   -- | How to get name of an operator   (op -> Maybe RdrName) ->   -- | Fixity Map@@ -98,14 +100,16 @@   OpTree ty op ->   -- | Re-associated 'OpTree', with added context and info around operators   OpTree ty (OpInfo op)-reassociateOpTree getOpName modFixityMap =+reassociateOpTree debug getOpName modFixityMap =   reassociateFlatOpTree     . makeFlatOpTree-    . addFixityInfo modFixityMap getOpName+    . addFixityInfo debug modFixityMap getOpName  -- | Wrap every operator of the tree with 'OpInfo' to carry the information -- about its fixity (extracted from the specified fixity map). addFixityInfo ::+  -- | Whether to print debug info regarding fixity inference+  Bool ->   -- | Fixity map for operators   ModuleFixityMap ->   -- | How to get the name of an operator@@ -114,10 +118,10 @@   OpTree ty op ->   -- | 'OpTree', with fixity info wrapped around each operator   OpTree ty (OpInfo op)-addFixityInfo _ _ (OpNode n) = OpNode n-addFixityInfo modFixityMap getOpName (OpBranches exprs ops) =+addFixityInfo _ _ _ (OpNode n) = OpNode n+addFixityInfo debug modFixityMap getOpName (OpBranches exprs ops) =   OpBranches-    (addFixityInfo modFixityMap getOpName <$> exprs)+    (addFixityInfo debug modFixityMap getOpName <$> exprs)     (toOpInfo <$> ops)   where     toOpInfo o = OpInfo o mrdrName fixityApproximation@@ -125,7 +129,7 @@         mrdrName = getOpName o         fixityApproximation = case mrdrName of           Nothing -> defaultFixityApproximation-          Just rdrName -> inferFixity rdrName modFixityMap+          Just rdrName -> inferFixity debug rdrName modFixityMap  -- | Given a 'OpTree' of any shape, produce a flat 'OpTree', where every -- node and operator is directly connected to the root.

@@ -172,6 +172,9 @@ instance HasSrcSpan SrcSpan where   loc' = id +instance HasSrcSpan RealSrcSpan where+  loc' l = RealSrcSpan l Strict.Nothing+ instance HasSrcSpan (SrcSpanAnn' ann) where   loc' = locA 

@@ -50,7 +50,8 @@ import Text.PrettyPrint qualified as Doc import Text.Printf (printf) -data TestGroup = forall a.+data TestGroup+  = forall a.   TestGroup   { label :: String,     -- | When True, takes input from 'input-multi.hs' instead of 'input.hs', where sections@@ -195,6 +196,15 @@           isMulti = False,           testCases = allOptions,           updateConfig = \parens opts -> opts {poSingleConstraintParens = pure parens},+          showTestCase = show,+          testCaseSuffix = suffix1,+          checkIdempotence = True+        },+      TestGroup+        { label = "single-deriving-parens",+          isMulti = False,+          testCases = allOptions,+          updateConfig = \parens opts -> opts {poSingleDerivingParens = pure parens},           showTestCase = show,           testCaseSuffix = suffix1,           checkIdempotence = True

@@ -7,7 +7,7 @@ import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map import Data.Yaml qualified as Yaml-import Ormolu.Config (FourmoluConfig (..))+import Ormolu.Config (FourmoluConfig (..), poIndentation, resolvePrinterOpts) import Ormolu.Fixity (ModuleReexports (..)) import Test.Hspec @@ -26,3 +26,8 @@               [ ("Foo", NonEmpty.fromList [(Nothing, "Bar2"), (Nothing, "Bar1")])               ]       cfgFileReexports config `shouldBe` ModuleReexports expected+    it "applies configurations in correct order" $ do+      let opts1 = mempty {poIndentation = Just 2}+          opts2 = mempty {poIndentation = Just 4}+          configs = [opts1, opts2]+      poIndentation (resolvePrinterOpts configs) `shouldBe` 4

@@ -261,7 +261,7 @@   where     actualResult =       fmap-        (\(k, _) -> (k, inferFixity k resultMap))+        (\(k, _) -> (k, inferFixity False k resultMap))         expectedResult     resultMap =       moduleFixityMap

@@ -61,7 +61,7 @@         testInputFileName = "test-0-input.hs",         testArgs = [],         testUseConfig = False,-        testExpectedFileName = "test-0-no-extra-info-expected.hs"+        testExpectedFileName = "test-0-ugly-expected.hs"       },     Test       { testLabel = "File #0 works with manual fixity info",@@ -76,6 +76,13 @@         testArgs = ["--package", "base"],         testUseConfig = True,         testExpectedFileName = "test-0-with-fixity-info-expected.hs"+      },+    Test+      { testLabel = "File #0 works when CLI overrides .ormolu",+        testInputFileName = "test-0-input.hs",+        testArgs = ["--package", "base", "--fixity", "infixr 5 .=", "--no-cabal"],+        testUseConfig = True,+        testExpectedFileName = "test-0-ugly-expected.hs"       },     Test       { testLabel = "File #1 works with no extra info",

@@ -31,7 +31,7 @@     removeOpInfo (OpNode x) = OpNode x     removeOpInfo (OpBranches exprs ops) =       OpBranches (removeOpInfo <$> exprs) (opiOp <$> ops)-    actualOutputTree = reassociateOpTree convertName modFixityMap inputTree+    actualOutputTree = reassociateOpTree False convertName modFixityMap inputTree     modFixityMap = ModuleFixityMap (Map.map Given (Map.fromList fixities))     convertName = Just . mkRdrUnqual . mkOccName varName . T.unpack . unOpName