fourmolu 0.14.0.0 → 0.14.1.0

raw patch · 53 files changed

+486/−272 lines, 53 filesdep ~Diffdep ~basedep ~containerssetup-changed

Dependency ranges changed: Diff, base, containers, ghc-lib-parser, hspec, megaparsec, mtl, path-io, text

Files

• CHANGELOG.md +20/−0
• Setup.hs +0/−6
• data/examples/declaration/data/invisible-binders-four-out.hs +2/−0
• data/examples/declaration/data/invisible-binders-out.hs +2/−0
• data/examples/declaration/data/invisible-binders.hs +2/−0
• data/examples/declaration/signature/fixity/infix-four-out.hs +2/−0
• data/examples/declaration/signature/fixity/infix-out.hs +2/−0
• data/examples/declaration/signature/fixity/infix.hs +2/−0
• data/examples/declaration/value/function/primitive-literals-four-out.hs +10/−0
• data/examples/declaration/value/function/primitive-literals-out.hs +10/−0
• data/examples/declaration/value/function/primitive-literals.hs +9/−0
• data/examples/declaration/warning/warning-single-line-four-out.hs +3/−0
• data/examples/declaration/warning/warning-single-line-out.hs +3/−0
• data/examples/declaration/warning/warning-single-line.hs +3/−0
• data/examples/import/deprecated-export-multi-line-four-out.hs +6/−0
• data/examples/import/deprecated-export-multi-line-out.hs +7/−0
• data/examples/import/deprecated-export-multi-line.hs +5/−0
• data/examples/import/deprecated-export-single-line-four-out.hs +3/−0
• data/examples/import/deprecated-export-single-line-out.hs +3/−0
• data/examples/import/deprecated-export-single-line.hs +1/−0
• data/fourmolu/column-limit/input-multi.hs +91/−0
• data/fourmolu/column-limit/input.hs +0/−82
• data/fourmolu/column-limit/output-limit=100.hs +19/−5
• data/fourmolu/column-limit/output-limit=80.hs +19/−5
• data/fourmolu/column-limit/output-limit=none.hs +17/−5
• data/fourmolu/import-export/input-multi.hs +10/−0
• data/fourmolu/import-export/output-ImportExportDiffFriendly.hs +11/−0
• data/fourmolu/import-export/output-ImportExportLeading.hs +11/−0
• data/fourmolu/import-export/output-ImportExportTrailing.hs +11/−0
• data/fourmolu/single-constraint-parens/input.hs +3/−0
• data/fourmolu/single-constraint-parens/output-ConstraintAlways.hs +2/−0
• data/fourmolu/single-constraint-parens/output-ConstraintAuto.hs +2/−0
• data/fourmolu/single-constraint-parens/output-ConstraintNever.hs +2/−0
• fourmolu.cabal +19/−19
• src/Ormolu.hs +7/−4
• src/Ormolu/Fixity/Imports.hs +1/−1
• src/Ormolu/Imports.hs +9/−9
• src/Ormolu/Parser.hs +6/−6
• src/Ormolu/Printer/Combinators.hs +27/−30
• src/Ormolu/Printer/Meat/Common.hs +4/−1
• src/Ormolu/Printer/Meat/Declaration.hs +3/−1
• src/Ormolu/Printer/Meat/Declaration/Data.hs +10/−6
• src/Ormolu/Printer/Meat/Declaration/Instance.hs +8/−1
• src/Ormolu/Printer/Meat/Declaration/OpTree.hs +13/−17
• src/Ormolu/Printer/Meat/Declaration/Value.hs +16/−20
• src/Ormolu/Printer/Meat/Declaration/Value.hs-boot +2/−1
• src/Ormolu/Printer/Meat/Declaration/Warning.hs +12/−4
• src/Ormolu/Printer/Meat/ImportExport.hs +9/−3
• src/Ormolu/Printer/Meat/Module.hs +1/−1
• src/Ormolu/Printer/Meat/Type.hs +21/−26
• src/Ormolu/Printer/Operators.hs +23/−18
• tests/Ormolu/Config/PrinterOptsSpec.hs +1/−1
• tests/Ormolu/OpTreeSpec.hs +1/−0

@@ -1,3 +1,23 @@+## Fourmolu 0.14.1.0++* Fix `single-constraint-parens: never` for nested quantified constraints ([#374](https://github.com/fourmolu/fourmolu/issues/374))++* Fix `column-limit` with `BlockArguments` ([#377](https://github.com/fourmolu/fourmolu/issues/377))++* Fixed an issue where re-exporting a module with Haddock comments + `import-exports=leading` was indented too far ([#381](https://github.com/fourmolu/fourmolu/issues/381))++### Upstream changes:++#### Ormolu 0.7.3.0++* Switched to `ghc-lib-parser-9.8`, with the following new syntactic features:+  * `ExtendedLiterals`: `123#Int8` is a literal of type `Int8#`. (disabled by+    default)+  * `TypeAbstractions`: `@k`-binders in data type declarations (enabled by+    default)+  * GHC proposal [#134](https://github.com/ghc-proposals/ghc-proposals/blob/0b652bd70258e354dfe4a05940182007596f8bf7/proposals/0134-deprecating-exports-proposal.rst): deprecating/warning about exports+  * GHC proposal [#541](https://github.com/ghc-proposals/ghc-proposals/blob/0b652bd70258e354dfe4a05940182007596f8bf7/proposals/0541-warning-pragmas-with-categories.rst): warning categories+ ## Fourmolu 0.14.0.0  * Provide `resolvePrinterOpts` instead of `fillMissingPrinterOpts`

@@ -1,6 +0,0 @@-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain

@@ -0,0 +1,2 @@+type T :: forall k. k -> forall j. j -> Type+data T @k (a :: k) @(j :: Type) (b :: j)

@@ -0,0 +1,2 @@+type T :: forall k. k -> forall j. j -> Type+data T @k (a :: k) @(j :: Type) (b :: j)

@@ -0,0 +1,2 @@+type T :: forall k. k -> forall j. j -> Type+data T @k (a :: k) @(j :: Type) (b :: j)

@@ -1,2 +1,4 @@ infix 0 <?> infix 9 <^-^>++infix 2 ->

@@ -1,3 +1,5 @@ infix 0 <?>  infix 9 <^-^>++infix 2 ->

@@ -1,2 +1,4 @@ infix 0 <?> infix 9 <^-^>++infix 2 ->

@@ -0,0 +1,10 @@+{-# LANGUAGE ExtendedLiterals #-}+{-# LANGUAGE MagicHash #-}++foo = 1#++bar = 2##++baz = 3#Word32++baz = 0b1010#Int64

@@ -0,0 +1,10 @@+{-# LANGUAGE ExtendedLiterals #-}+{-# LANGUAGE MagicHash #-}++foo = 1#++bar = 2##++baz = 3#Word32++baz = 0b1010#Int64

@@ -0,0 +1,9 @@+{-# LANGUAGE ExtendedLiterals, MagicHash #-}++foo = 1#++bar = 2##++baz = 3#Word32++baz =  0b1010#Int64

@@ -11,3 +11,6 @@  data Number = Number Dobule {-# DEPRECATED Number "Use Scientific instead." #-}++head (a : _) = a+{-# WARNING in "x-partial" head "This function is partial..." #-}

@@ -11,3 +11,6 @@  data Number = Number Dobule {-# DEPRECATED Number "Use Scientific instead." #-}++head (a : _) = a+{-# WARNING in "x-partial" head "This function is partial..." #-}

@@ -13,3 +13,6 @@  data Number = Number Dobule {-# DEPRECATED Number "Use Scientific instead." #-}++head (a:_) = a+{-# WARNING in "x-partial" head "This function is partial..." #-}

@@ -0,0 +1,6 @@+module X (+    {-# DEPRECATE D(D1) "D1 will not be exposed in a version 0.2 and later" #-}+    D (D1, D2),+) where++data D = D1 | D2

@@ -0,0 +1,7 @@+module X+  ( {-# DEPRECATE D(D1) "D1 will not be exposed in a version 0.2 and later" #-}+    D (D1, D2),+  )+where++data D = D1 | D2

@@ -0,0 +1,5 @@+module X+    ( {-# DEPRECATE D(D1) "D1 will not be exposed in a version 0.2 and later" #-}+      D(D1, D2)+    ) where+data D = D1 | D2

@@ -0,0 +1,3 @@+module A ({-# DEPRECATED "blah" #-} x) where++x = True

@@ -0,0 +1,3 @@+module A ({-# DEPRECATED "blah" #-} x) where++x = True

@@ -0,0 +1,1 @@+module A ( {-# DEPRECATED "blah" #-} x ) where { x = True }

@@ -0,0 +1,91 @@+-- 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++-- For reference, this line had exactly 80 characters -------------------------|++{----- Long function signatures -----}++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++{- // -}++{----- BlockArguments (https://github.com/fourmolu/fourmolu/issues/377) -----}+++{-# LANGUAGE BlockArguments #-}++putThen :: String -> IO a -> IO a+putThen s action =+    putStrLn s >> action++main :: IO ()+main = do+    putThen "012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789" do+        putStrLn ""

@@ -1,82 +0,0 @@-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

@@ -1,5 +1,3 @@-module ColumnLimitTest where- -- Less than 80 characters import Data.List (head, isPrefixOf, tail) @@ -38,10 +36,10 @@  data DataTypeWithAVeryLongName = DataTypeWithAVeryLongName String String String String String --- Long function signatures- -- For reference, this line had exactly 80 characters -------------------------| +{----- Long function signatures -----}+ 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"]@@ -78,7 +76,7 @@  -- For reference, this line had exactly 80 characters -------------------------| --- ----------------  Known limitation: idempotence is broken ----------------+{-----  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`.@@ -106,3 +104,19 @@         abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde         $ do             result <- aRandomResult++{- // -}++{----- BlockArguments (https://github.com/fourmolu/fourmolu/issues/377) -----}+{-# LANGUAGE BlockArguments #-}++putThen :: String -> IO a -> IO a+putThen s action =+    putStrLn s >> action++main :: IO ()+main = do+    putThen+        "012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789"+        do+            putStrLn ""

@@ -1,5 +1,3 @@-module ColumnLimitTest where- -- Less than 80 characters import Data.List (head, isPrefixOf, tail) @@ -48,10 +46,10 @@ data DataTypeWithAVeryLongName     = DataTypeWithAVeryLongName String String String String String --- Long function signatures- -- For reference, this line had exactly 80 characters -------------------------| +{----- Long function signatures -----}+ longFunction0 ::     String ->     String ->@@ -103,7 +101,7 @@  -- For reference, this line had exactly 80 characters -------------------------| --- ----------------  Known limitation: idempotence is broken ----------------+{-----  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`.@@ -133,3 +131,19 @@         abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde         $ do             result <- aRandomResult++{- // -}++{----- BlockArguments (https://github.com/fourmolu/fourmolu/issues/377) -----}+{-# LANGUAGE BlockArguments #-}++putThen :: String -> IO a -> IO a+putThen s action =+    putStrLn s >> action++main :: IO ()+main = do+    putThen+        "012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789"+        do+            putStrLn ""

@@ -1,5 +1,3 @@-module ColumnLimitTest where- -- Less than 80 characters import Data.List (head, isPrefixOf, tail) @@ -27,10 +25,10 @@  data DataTypeWithAVeryLongName = DataTypeWithAVeryLongName String String String String String --- Long function signatures- -- For reference, this line had exactly 80 characters -------------------------| +{----- Long function signatures -----}+ 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"] @@ -66,7 +64,7 @@  -- For reference, this line had exactly 80 characters -------------------------| --- ----------------  Known limitation: idempotence is broken ----------------+{-----  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`.@@ -94,3 +92,17 @@         abcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcdeabcde         $ do             result <- aRandomResult++{- // -}++{----- BlockArguments (https://github.com/fourmolu/fourmolu/issues/377) -----}+{-# LANGUAGE BlockArguments #-}++putThen :: String -> IO a -> IO a+putThen s action =+    putStrLn s >> action++main :: IO ()+main = do+    putThen "012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789" do+        putStrLn ""

@@ -40,3 +40,13 @@   ( -- | asdf     singleExport   ) where++{- // -}++-- https://github.com/fourmolu/fourmolu/issues/381+module Foo (+    -- * Re-export of module+    module X,+    -- * Some other thing+    Foo,+) where

@@ -39,3 +39,14 @@     -- | asdf     singleExport, ) where++{- // -}++-- https://github.com/fourmolu/fourmolu/issues/381+module Foo (+    -- * Re-export of module+    module X,++    -- * Some other thing+    Foo,+) where

@@ -39,3 +39,14 @@     ( -- | asdf       singleExport     ) where++{- // -}++-- https://github.com/fourmolu/fourmolu/issues/381+module Foo+    ( -- * Re-export of module+      module X++      -- * Some other thing+    , Foo+    ) where

@@ -39,3 +39,14 @@     ( -- | asdf       singleExport,     ) where++{- // -}++-- https://github.com/fourmolu/fourmolu/issues/381+module Foo+    ( -- * Re-export of module+      module X,++      -- * Some other thing+      Foo,+    ) where

@@ -6,3 +6,6 @@  -- https://github.com/fourmolu/fourmolu/issues/340 quantifiedConstraint :: (forall a. Show a => Show (f a)) => f Int++-- https://github.com/fourmolu/fourmolu/issues/374+nestedConstraint :: ((c a, c b) => c (f a b)) => Is c a -> Is c b -> Is c (f a b)

@@ -5,3 +5,5 @@ functionName2 :: (C a, D a) => a -- https://github.com/fourmolu/fourmolu/issues/340 quantifiedConstraint :: (forall a. (Show a) => Show (f a)) => f Int+-- https://github.com/fourmolu/fourmolu/issues/374+nestedConstraint :: ((c a, c b) => c (f a b)) => Is c a -> Is c b -> Is c (f a b)

@@ -5,3 +5,5 @@ functionName2 :: (C a, D a) => a -- https://github.com/fourmolu/fourmolu/issues/340 quantifiedConstraint :: (forall a. Show a => Show (f a)) => f Int+-- https://github.com/fourmolu/fourmolu/issues/374+nestedConstraint :: ((c a, c b) => c (f a b)) => Is c a -> Is c b -> Is c (f a b)

@@ -5,3 +5,5 @@ functionName2 :: (C a, D a) => a -- https://github.com/fourmolu/fourmolu/issues/340 quantifiedConstraint :: (forall a. Show a => Show (f a)) => f Int+-- https://github.com/fourmolu/fourmolu/issues/374+nestedConstraint :: ((c a, c b) => c (f a b)) => Is c a -> Is c b -> Is c (f a b)

@@ -1,13 +1,13 @@ cabal-version:      2.4 name:               fourmolu-version:            0.14.0.0+version:            0.14.1.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.2.8 ghc ==9.4.5 ghc ==9.6.2+tested-with:        ghc ==9.4.7 ghc ==9.6.3 ghc ==9.8.1 homepage:           https://github.com/fourmolu/fourmolu bug-reports:        https://github.com/fourmolu/fourmolu/issues synopsis:           A formatter for Haskell source code@@ -106,23 +106,23 @@     default-language: GHC2021     build-depends:         Cabal-syntax >=3.10 && <3.11,-        Diff >=0.4 && <1.0,+        Diff >=0.4 && <1,         MemoTrie >=0.6 && <0.7,         ansi-terminal >=0.10 && <1.1,         array >=0.5 && <0.6,-        base >=4.14 && <5.0,+        base >=4.14 && <5,         binary >=0.8 && <0.9,         bytestring >=0.2 && <0.13,-        containers >=0.5 && <0.7,+        containers >=0.5 && <0.8,         deepseq >=1.4 && <1.6,         directory ^>=1.3,         file-embed >=0.0.15 && <0.1,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.6 && <9.7,-        megaparsec >=9.0,-        mtl >=2.0 && <3.0,+        ghc-lib-parser >=9.8 && <9.9,+        megaparsec >=9,+        mtl >=2 && <3,         syb >=0.7 && <0.8,-        text >=2.0 && <3.0,+        text >=2 && <3,         -- fourmolu-only deps         aeson >=1.0 && <3.0,         scientific >=0.3.2 && <1,@@ -147,13 +147,13 @@     default-language: GHC2021     build-depends:         Cabal-syntax >=3.10 && <3.11,-        base >=4.12 && <5.0,+        base >=4.12 && <5,         containers >=0.5 && <0.7,         directory ^>=1.3,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.6 && <9.7,+        ghc-lib-parser >=9.8 && <9.9,         optparse-applicative >=0.14 && <0.19,-        text >=2.0 && <3.0,+        text >=2 && <3,         th-env >=0.1.1 && <0.2,         -- fourmolu-only deps         directory >=1.3.3 && <1.4,@@ -171,7 +171,7 @@ test-suite tests     type:               exitcode-stdio-1.0     main-is:            Spec.hs-    build-tool-depends: hspec-discover:hspec-discover >=2.0 && <3.0+    build-tool-depends: hspec-discover:hspec-discover >=2 && <3     hs-source-dirs:     tests     other-modules:         Ormolu.CabalInfoSpec@@ -189,18 +189,18 @@     build-depends:         Cabal-syntax >=3.10 && <3.11,         QuickCheck >=2.14,-        base >=4.14 && <5.0,+        base >=4.14 && <5,         containers >=0.5 && <0.7,         directory ^>=1.3,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.6 && <9.7,-        hspec >=2.0 && <3.0,+        ghc-lib-parser >=9.8 && <9.9,+        hspec >=2 && <3,         hspec-megaparsec >=2.2,-        megaparsec >=9.0,+        megaparsec >=9,         path >=0.6 && <0.10,-        path-io >=1.4.2 && <2.0,+        path-io >=1.4.2 && <2,         temporary ^>=1.3,-        text >=2.0 && <3.0+        text >=2 && <3      -- specific to fourmolu tests     other-modules:

@@ -53,8 +53,10 @@ import Data.Text (Text) import Data.Text qualified as T import Debug.Trace-import GHC.Driver.CmdLine qualified as GHC+import GHC.Driver.Errors.Types+import GHC.Types.Error import GHC.Types.SrcLoc+import GHC.Utils.Error import Ormolu.Config import Ormolu.Diff.ParseResult import Ormolu.Diff.Text@@ -102,8 +104,9 @@   (warnings, result0) <-     parseModule' cfg fixityMap OrmoluParsingFailed path originalInput   when (cfgDebug cfg) $ do-    forM_ warnings $ \(GHC.Warn reason (L loc msg)) ->-      traceM $ unwords ["*** WARNING ***", showOutputable loc, msg, showOutputable reason]+    forM_ warnings $ \driverMsg -> do+      let driverMsgSDoc = formatBulleted $ diagnosticMessage defaultOpts driverMsg+      traceM $ unwords ["*** WARNING ***", showOutputable driverMsgSDoc]     forM_ result0 $ \case       ParsedSnippet r -> do         let CommentStream comments = prCommentStream r@@ -250,7 +253,7 @@   FilePath ->   -- | Actual input for the parser   Text ->-  m ([GHC.Warn], [SourceSnippet])+  m (DriverMessages, [SourceSnippet]) parseModule' cfg fixityMap mkException path str = do   (warnings, r) <- parseModule cfg fixityMap path str   case r of

@@ -16,7 +16,7 @@ import Distribution.ModuleName (ModuleName) import Distribution.Types.PackageName import GHC.Data.FastString qualified as GHC-import GHC.Hs hiding (ModuleName)+import GHC.Hs hiding (ModuleName, OpName) import GHC.Types.Name.Occurrence import GHC.Types.PkgQual (RawPkgQual (..)) import GHC.Types.SourceText (StringLiteral (..))

@@ -133,7 +133,7 @@     isPrelude = moduleNameString moduleName == "Prelude"     moduleName = unLoc ideclName --- | Normalize a collection of import\/export items.+-- | Normalize a collection of import items. normalizeLies :: [LIE GhcPs] -> [LIE GhcPs] normalizeLies = sortOn (getIewn . unLoc) . M.elems . foldl' combine M.empty   where@@ -149,21 +149,21 @@             Nothing -> Just . L new_l $               case new of                 IEThingWith _ n wildcard g ->-                  IEThingWith EpAnnNotUsed n wildcard (normalizeWNames g)+                  IEThingWith (Nothing, EpAnnNotUsed) n wildcard (normalizeWNames g)                 other -> other             Just old ->               let f = \case-                    IEVar _ n -> IEVar NoExtField n+                    IEVar _ n -> IEVar Nothing n                     IEThingAbs _ _ -> new-                    IEThingAll _ n -> IEThingAll EpAnnNotUsed n+                    IEThingAll _ n -> IEThingAll (Nothing, EpAnnNotUsed) n                     IEThingWith _ n wildcard g ->                       case new of-                        IEVar NoExtField _ ->+                        IEVar _ _ ->                           error "Ormolu.Imports broken presupposition"                         IEThingAbs _ _ ->-                          IEThingWith EpAnnNotUsed n wildcard g+                          IEThingWith (Nothing, EpAnnNotUsed) n wildcard g                         IEThingAll _ n' ->-                          IEThingAll EpAnnNotUsed n'+                          IEThingAll (Nothing, EpAnnNotUsed) n'                         IEThingWith _ n' wildcard' g' ->                           let combinedWildcard =                                 case (wildcard, wildcard') of@@ -171,7 +171,7 @@                                   (_, IEWildcard _) -> IEWildcard 0                                   _ -> NoIEWildcard                            in IEThingWith-                                EpAnnNotUsed+                                (Nothing, EpAnnNotUsed)                                 n'                                 combinedWildcard                                 (normalizeWNames (g <> g'))@@ -197,7 +197,7 @@ -- | Project @'IEWrappedName' 'GhcPs'@ from @'IE' 'GhcPs'@. getIewn :: IE GhcPs -> IEWrappedNameOrd getIewn = \case-  IEVar NoExtField x -> IEWrappedNameOrd (unLoc x)+  IEVar _ x -> IEWrappedNameOrd (unLoc x)   IEThingAbs _ x -> IEWrappedNameOrd (unLoc x)   IEThingAll _ x -> IEWrappedNameOrd (unLoc x)   IEThingWith _ x _ _ -> IEWrappedNameOrd (unLoc x)

@@ -30,7 +30,6 @@ import GHC.Data.FastString qualified as GHC import GHC.Data.Maybe (orElse) import GHC.Data.StringBuffer (StringBuffer)-import GHC.Driver.CmdLine qualified as GHC import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Errors.Types qualified as GHC import GHC.Driver.Session as GHC@@ -46,7 +45,6 @@ import GHC.Types.SrcLoc import GHC.Utils.Error import GHC.Utils.Exception (ExceptionMonad)-import GHC.Utils.Outputable (defaultSDocContext) import GHC.Utils.Panic qualified as GHC import Ormolu.Config import Ormolu.Config.Gen (SingleConstraintParens (..))@@ -72,7 +70,7 @@   -- | Input for parser   Text ->   m-    ( [GHC.Warn],+    ( GHC.DriverMessages,       Either (SrcSpan, String) [SourceSnippet]     ) parseModule config@Config {..} packageFixityMap path rawInput = liftIO $ do@@ -136,7 +134,7 @@                   Nothing -> ""                 msg =                   showOutputable-                    . formatBulleted defaultSDocContext+                    . formatBulleted                     . diagnosticMessage GHC.NoDiagnosticOpts                     $ err          in case L.sortOn (rateSeverity . errMsgSeverity) errs of@@ -217,6 +215,7 @@     patchContext = fmap $ \case       [x@(L _ (HsParTy _ inner))]         | L _ HsForAllTy {} <- inner -> [x]+        | L _ HsQualTy {} <- inner -> [x]         | ConstraintNever <- constraintParens -> [inner]         | otherwise -> [x]       [x@(L lx _)]@@ -262,7 +261,8 @@     LinearTypes, -- steals the (%) type operator in some cases     OverloadedRecordDot, -- f.g parses differently     OverloadedRecordUpdate, -- qualified fields are not supported-    OverloadedLabels -- a#b is parsed differently+    OverloadedLabels, -- a#b is parsed differently+    ExtendedLiterals -- 1#Word32 is parsed differently   ]  -- | Run a 'GHC.P' computation.@@ -297,7 +297,7 @@   FilePath ->   -- | Input for parser   StringBuffer ->-  IO (Either String ([GHC.Warn], DynFlags))+  IO (Either String (GHC.DriverMessages, DynFlags)) parsePragmasIntoDynFlags flags extraOpts filepath input =   catchGhcErrors $ do     let (_warnings, fileOpts) =

@@ -32,6 +32,7 @@     located',     switchLayout,     switchLayoutNoLimit,+    spansLayout,     Layout (..),     vlayout,     getLayout,@@ -97,7 +98,7 @@ import Data.Text (Text) import GHC.Data.Strict qualified as Strict import GHC.LanguageExtensions.Type-import GHC.Types.SrcLoc+import GHC.Types.SrcLoc hiding (spans) import Ormolu.Config import Ormolu.Printer.Comments import Ormolu.Printer.Internal@@ -168,48 +169,44 @@ -- 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' ::-  -- | Should enforce column limit, if one is set-  Bool ->+switchLayout ::   -- | Span that controls layout   [SrcSpan] ->   -- | Computation to run with changed layout   R () ->   R ()-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+switchLayout spans r = do+  layout <- spansLayout spans+  enterLayout layout r --- | Switch layout version that disregards the column limit.+-- | Same as 'switchLayout', except 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+switchLayoutNoLimit spans = enterLayout (spansLayoutWithLimit NoLimit spans)  -- | Which layout combined spans result in?-spansLayout :: ColumnLimit -> [SrcSpan] -> Layout-spansLayout colLimit = \case+spansLayout :: [SrcSpan] -> R Layout+spansLayout spans = do+  colLimit <- getPrinterOpt poColumnLimit+  pure $ spansLayoutWithLimit colLimit spans++spansLayoutWithLimit :: ColumnLimit -> [SrcSpan] -> Layout+spansLayoutWithLimit colLimit = \case   [] -> SingleLine   (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+    let combinedSpan = foldr combineSrcSpans x xs+     in if isOneLineSpan combinedSpan && not (shouldBreakSingleLine combinedSpan)+          then SingleLine+          else MultiLine+  where+    shouldBreakSingleLine srcSpan =+      case (srcSpan, colLimit) of+        (RealSrcSpan rs _, ColumnLimit maxLineLength) ->+          let spanLineLength = srcSpanEndCol rs - srcSpanStartCol rs+           in spanLineLength > fromIntegral maxLineLength+        _ -> False  -- | Insert a space if enclosing layout is single-line, or newline if it's -- multiline.

@@ -19,6 +19,7 @@ import Control.Monad import Data.Foldable (traverse_) import Data.Text qualified as T+import GHC.Data.FastString import GHC.Hs.Doc import GHC.Hs.Extension (GhcPs) import GHC.Hs.ImpExp@@ -72,6 +73,8 @@           NameAnn {nann_adornment = NameParens} ->             parens N . handleUnboxedSumsAndHashInteraction           NameAnn {nann_adornment = NameBackquotes} -> backticks+          -- whether the `->` identifier is parenthesized+          NameAnnRArrow {nann_mopen = Just _} -> parens N           -- special case for unboxed unit tuples           NameAnnOnly {nann_adornment = NameParensHash} -> const $ txt "(# #)"           _ -> id@@ -248,4 +251,4 @@ p_sourceText :: SourceText -> R () p_sourceText = \case   NoSourceText -> pure ()-  SourceText s -> txt (T.pack s)+  SourceText s -> atom @FastString s

@@ -139,7 +139,9 @@     p_dataDecl       Associated       tcdLName-      (tyVarsToTyPats tcdTyVars)+      (hsq_explicit tcdTyVars)+      getLocA+      (located' p_hsTyVarBndr)       tcdFixity       tcdDataDefn   ClassDecl {..} ->

@@ -26,21 +26,25 @@ import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type-import Ormolu.Utils (matchAddEpAnn)+import Ormolu.Utils  p_dataDecl ::   -- | Whether to format as data family   FamilyStyle ->   -- | Type constructor   LocatedN RdrName ->-  -- | Type patterns-  HsTyPats GhcPs ->+  -- | Type variables+  [tyVar] ->+  -- | Get location information for type variables+  (tyVar -> SrcSpan) ->+  -- | How to print type variables+  (tyVar -> R ()) ->   -- | Lexical fixity   LexicalFixity ->   -- | Data definition   HsDataDefn GhcPs ->   R ()-p_dataDecl style name tpats fixity HsDataDefn {..} = do+p_dataDecl style name tyVars getTyVarLoc p_tyVar fixity HsDataDefn {..} = do   txt $ case dd_cons of     NewTypeCon _ -> "newtype"     DataTypeCons False _ -> "data"@@ -59,7 +63,7 @@       space       p_sourceText type_       txt " #-}"-  let constructorSpans = getLocA name : fmap lhsTypeArgSrcSpan tpats+  let constructorSpans = getLocA name : fmap getTyVarLoc tyVars       sigSpans = maybeToList . fmap getLocA $ dd_kindSig       declHeaderSpans =         maybeToList (getLocA <$> dd_ctxt) ++ constructorSpans ++ sigSpans@@ -78,7 +82,7 @@           (isInfix fixity)           True           (p_rdrName name)-          (p_lhsTypeArg <$> tpats)+          (p_tyVar <$> tyVars)       forM_ dd_kindSig $ \k -> do         space         token'dcolon

@@ -97,7 +97,14 @@  p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R () p_dataFamInstDecl style (DataFamInstDecl {dfid_eqn = FamEqn {..}}) =-  p_dataDecl style feqn_tycon feqn_pats feqn_fixity feqn_rhs+  p_dataDecl+    style+    feqn_tycon+    feqn_pats+    lhsTypeArgSrcSpan+    p_lhsTypeArg+    feqn_fixity+    feqn_rhs  match_overlap_mode :: Maybe (LocatedP OverlapMode) -> R () -> R () match_overlap_mode overlap_mode layoutStrategy =

@@ -15,6 +15,8 @@ where  import Data.Functor ((<&>))+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE import GHC.Hs import GHC.Types.Fixity import GHC.Types.Name (occNameString)@@ -82,7 +84,7 @@ -- | Convert a 'LHsExpr' containing an operator tree to the 'OpTree' -- intermediate representation. exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)-exprOpTree (L _ (OpApp _ x op y)) = OpBranches [exprOpTree x, exprOpTree y] [op]+exprOpTree (L _ (OpApp _ x op y)) = BinaryOpBranches (exprOpTree x) op (exprOpTree y) exprOpTree n = OpNode n  -- | Print an operator tree where leaves are values.@@ -94,17 +96,15 @@   OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs)) ->   R () p_exprOpTree s (OpNode x) = located x (p_hsExpr' NotApplicand s)-p_exprOpTree s t@(OpBranches exprs ops) = do-  let firstExpr = head exprs-      otherExprs = tail exprs-      placement =+p_exprOpTree s t@(OpBranches exprs@(firstExpr :| otherExprs) ops) = do+  let placement =         opBranchPlacement           exprPlacement           firstExpr           (last otherExprs)       rightMostNode = \case         n@(OpNode _) -> n-        OpBranches exprs'' _ -> rightMostNode (last exprs'')+        OpBranches exprs'' _ -> rightMostNode (NE.last exprs'')       isDoBlock = \case         OpNode (L _ (HsDo _ ctx _)) -> case ctx of           DoExpr _ -> True@@ -128,7 +128,7 @@           && not (isDoBlock $ rightMostNode prevExpr)       -- If all operators at the current level match the conditions to be       -- trailing, then put them in a trailing position-      isTrailing = all couldBeTrailing $ zip exprs ops+      isTrailing = all couldBeTrailing $ zip (NE.toList exprs) ops   ub <- if isTrailing then return useBraces else opBranchBraceStyle placement   indent <- getPrinterOpt poIndentation   let p_x = ub $ p_exprOpTree s firstExpr@@ -183,7 +183,7 @@ cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) cmdOpTree = \case   (L _ (HsCmdTop _ (L _ (HsCmdArrForm _ op Infix _ [x, y])))) ->-    OpBranches [cmdOpTree x, cmdOpTree y] [op]+    BinaryOpBranches (cmdOpTree x) op (cmdOpTree y)   n -> OpNode n  -- | Print an operator tree where leaves are commands.@@ -195,10 +195,8 @@   OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs)) ->   R () p_cmdOpTree s (OpNode x) = located x (p_hsCmdTop s)-p_cmdOpTree s t@(OpBranches exprs ops) = do-  let firstExpr = head exprs-      otherExprs = tail exprs-      placement =+p_cmdOpTree s t@(OpBranches (firstExpr :| otherExprs) ops) = do+  let placement =         opBranchPlacement           cmdTopPlacement           firstExpr@@ -230,7 +228,7 @@ -- intermediate representation. tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (LocatedN RdrName) tyOpTree (L _ (HsOpTy _ _ l op r)) =-  OpBranches [tyOpTree l, tyOpTree r] [op]+  BinaryOpBranches (tyOpTree l) op (tyOpTree r) tyOpTree n = OpNode n  -- | Print an operator tree where leaves are types.@@ -240,10 +238,8 @@   OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName)) ->   R () p_tyOpTree (OpNode n) = located n p_hsType-p_tyOpTree t@(OpBranches exprs ops) = do-  let firstExpr = head exprs-      otherExprs = tail exprs-      placement =+p_tyOpTree t@(OpBranches (firstExpr :| otherExprs) ops) = do+  let placement =         opBranchPlacement           tyOpPlacement           firstExpr

@@ -34,6 +34,7 @@ import Data.Text qualified as Text import Data.Void import GHC.Data.Bag (bagToList)+import GHC.Data.FastString import GHC.Data.Strict qualified as Strict import GHC.Hs import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))@@ -352,7 +353,7 @@       inci (sequence_ (intersperse breakpoint (located' (p_hsCmdTop N) <$> cmds)))   HsCmdArrForm _ form Infix _ [left, right] -> do     modFixityMap <- askModuleFixityMap-    let opTree = OpBranches [cmdOpTree left, cmdOpTree right] [form]+    let opTree = BinaryOpBranches (cmdOpTree left) form (cmdOpTree right)     p_cmdOpTree       s       (reassociateOpTree (getOpName . unLoc) modFixityMap opTree)@@ -643,12 +644,11 @@         initSpan =           combineSrcSpans' $             getLocA f :| [(srcLocSpan . srcSpanStart . getLocA) lastp]-        -- Hang the last argument only if the initial arguments span one-        -- line.-        placement =-          if isOneLineSpan initSpan-            then exprPlacement (unLoc lastp)-            else Normal+    -- Hang the last argument only if the initial arguments span one line.+    placement <-+      spansLayout [initSpan] <&> \case+        SingleLine -> exprPlacement (unLoc lastp)+        MultiLine -> Normal     -- If the last argument is not hanging, just separate every argument as     -- usual. If it is hanging, print the initial arguments and hang the     -- last one. Also, use braces around the every argument except the last@@ -699,7 +699,7 @@       located (hswc_body a) p_hsType   OpApp _ x op y -> do     modFixityMap <- askModuleFixityMap-    let opTree = OpBranches [exprOpTree x, exprOpTree y] [op]+    let opTree = BinaryOpBranches (exprOpTree x) op (exprOpTree y)     p_exprOpTree       s       (reassociateOpTree (getOpName . unLoc) modFixityMap opTree)@@ -812,11 +812,11 @@               Ambiguous NoExtField n -> n         p_recFields p_lbl =           sep commaDel (sitcc . located' (p_hsFieldBind p_lbl))-    inci . braces N $-      either-        (p_recFields p_updLbl)-        (p_recFields $ located' $ coerce p_ldotFieldOccs)-        rupd_flds+    inci . braces N $ case rupd_flds of+      RegularRecUpdFields {..} ->+        p_recFields p_updLbl recUpdFields+      OverloadedRecUpdFields {..} ->+        p_recFields (located' (coerce p_ldotFieldOccs)) olRecUpdFields   HsGetField {..} -> do     located gf_expr p_hsExpr     txt "."@@ -1284,9 +1284,9 @@           _ -> False  -- | Print the source text of a string literal while indenting gaps correctly.-p_stringLit :: String -> R ()+p_stringLit :: FastString -> R () p_stringLit src =-  let s = splitGaps src+  let s = splitGaps (unpackFS src)       singleLine =         txt $ Text.pack (mconcat s)       multiLine =@@ -1321,11 +1321,7 @@     -- Attaches previous and next items to each list element     zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]     zipPrevNext xs =-      let z =-            zip-              (zip (Nothing : map Just xs) xs)-              (map Just (tail xs) ++ repeat Nothing)-       in map (\((p, x), n) -> (p, x, n)) z+      zip3 (Nothing : map Just xs) xs (map Just (drop 1 xs) ++ [Nothing])     orig (_, x, _) = x  ----------------------------------------------------------------------------

@@ -11,6 +11,7 @@   ) where +import GHC.Data.FastString import GHC.Hs import Ormolu.Printer.Combinators @@ -18,7 +19,7 @@ p_pat :: Pat GhcPs -> R () p_hsExpr :: HsExpr GhcPs -> R () p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()-p_stringLit :: String -> R ()+p_stringLit :: FastString -> R ()  data IsApplicand 

@@ -1,14 +1,16 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}  module Ormolu.Printer.Meat.Declaration.Warning   ( p_warnDecls,-    p_moduleWarning,+    p_warningTxt,   ) where  import Data.Foldable import Data.Text (Text)+import Data.Text qualified as T import GHC.Hs import GHC.Types.Name.Reader import GHC.Types.SourceText@@ -16,6 +18,7 @@ import GHC.Unit.Module.Warnings import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common+import Ormolu.Utils  p_warnDecls :: WarnDecls GhcPs -> R () p_warnDecls (Warnings _ warnings) =@@ -25,8 +28,8 @@ p_warnDecl (Warning _ functions warningTxt) =   p_topLevelWarning functions warningTxt -p_moduleWarning :: WarningTxt GhcPs -> R ()-p_moduleWarning wtxt = do+p_warningTxt :: WarningTxt GhcPs -> R ()+p_warningTxt wtxt = do   let (pragmaText, lits) = warningText wtxt   inci $ pragma pragmaText $ inci $ p_lits lits @@ -41,7 +44,12 @@  warningText :: WarningTxt GhcPs -> (Text, [Located StringLiteral]) warningText = \case-  WarningTxt _ lits -> ("WARNING", fmap hsDocString <$> lits)+  WarningTxt mcat _ lits -> ("WARNING" <> T.pack cat, fmap hsDocString <$> lits)+    where+      cat = case unLoc <$> mcat of+        Just InWarningCategory {..} ->+          " in " <> show (showOutputable @WarningCategory (unLoc iwc_wc))+        Nothing -> ""   DeprecatedTxt _ lits -> ("DEPRECATED", fmap hsDocString <$> lits)  p_lits :: [Located StringLiteral] -> R ()

@@ -10,6 +10,7 @@ where  import Control.Monad+import Data.Foldable (for_) import Data.List (inits) import Data.Text qualified as T import GHC.Hs@@ -19,6 +20,7 @@ import Ormolu.Config import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Declaration.Warning import Ormolu.Utils (RelativePos (..), attachRelativePos)  p_hsmodExports :: [LIE GhcPs] -> R ()@@ -77,7 +79,10 @@  p_lie :: Layout -> Bool -> RelativePos -> IE GhcPs -> R () p_lie encLayout isAllPrevDoc relativePos = \case-  IEVar NoExtField l1 ->+  IEVar mwarn l1 -> do+    for_ mwarn $ \warnTxt -> do+      located warnTxt p_warningTxt+      breakpoint     withComma $       located l1 p_ieWrappedName   IEThingAbs _ l1 ->@@ -99,8 +104,9 @@           IEWildcard n ->             let (before, after) = splitAt n names              in before ++ [txt ".."] ++ after-  IEModuleContents _ l1 -> withComma $ do-    indentDoc $ located l1 p_hsmodName+  IEModuleContents _ l1 ->+    withComma $+      located l1 p_hsmodName   IEGroup NoExtField n str -> do     case relativePos of       SinglePos -> return ()

@@ -70,7 +70,7 @@    forM_ hsmodDeprecMessage $ \w -> do     breakpoint-    located' p_moduleWarning w+    located' p_warningTxt w    isRespectful <- getPrinterOpt poRespectful   isDiffFriendly <- (== ImportExportDiffFriendly) <$> getPrinterOpt poImportExportStyle

@@ -16,7 +16,6 @@     p_conDeclFields,     p_lhsTypeArg,     p_hsSigType,-    tyVarsToTyPats,     hsOuterTyVarBndrsToHsType,     lhsTypeToSigType,   )@@ -85,7 +84,7 @@       breakpoint       inci $         sep breakpoint (located' p_hsType) args-  HsAppKindTy _ ty kd -> sitcc $ do+  HsAppKindTy _ ty _ kd -> sitcc $ do     -- The first argument is the location of the "@..." part. Not 100% sure,     -- but I think we can ignore it as long as we use 'located' on both the     -- type and the kind.@@ -122,7 +121,7 @@       sep (space >> txt "|" >> breakpoint) (sitcc . located' p_hsType) xs   HsOpTy _ _ x op y -> do     modFixityMap <- askModuleFixityMap-    let opTree = OpBranches [tyOpTree x, tyOpTree y] [op]+    let opTree = BinaryOpBranches (tyOpTree x) op (tyOpTree y)     p_tyOpTree       (reassociateOpTree (Just . unLoc) modFixityMap opTree)   HsParTy _ t ->@@ -263,24 +262,35 @@   [x] -> located x p_hsType   xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs -class IsInferredTyVarBndr flag where+class IsTyVarBndrFlag flag where   isInferred :: flag -> Bool+  p_tyVarBndrFlag :: flag -> R ()+  p_tyVarBndrFlag _ = pure () -instance IsInferredTyVarBndr () where+instance IsTyVarBndrFlag () where   isInferred () = False -instance IsInferredTyVarBndr Specificity where+instance IsTyVarBndrFlag Specificity where   isInferred = \case     InferredSpec -> True     SpecifiedSpec -> False -p_hsTyVarBndr :: (IsInferredTyVarBndr flag) => HsTyVarBndr flag GhcPs -> R ()+instance IsTyVarBndrFlag (HsBndrVis GhcPs) where+  isInferred _ = False+  p_tyVarBndrFlag = \case+    HsBndrRequired -> pure ()+    HsBndrInvisible _ -> txt "@"++p_hsTyVarBndr :: (IsTyVarBndrFlag flag) => HsTyVarBndr flag GhcPs -> R () p_hsTyVarBndr = \case-  UserTyVar _ flag x ->+  UserTyVar _ flag x -> do+    p_tyVarBndrFlag flag     (if isInferred flag then braces N else id) $ p_rdrName x-  KindedTyVar _ flag l k -> (if isInferred flag then braces else parens) N . sitcc $ do-    located l atom-    inci $ startTypeAnnotation k p_hsType+  KindedTyVar _ flag l k -> do+    p_tyVarBndrFlag flag+    (if isInferred flag then braces else parens) N . sitcc $ do+      located l atom+      inci $ startTypeAnnotation k p_hsType  data ForAllVisibility = ForAllInvis | ForAllVis @@ -356,21 +366,6 @@  ---------------------------------------------------------------------------- -- Conversion functions--tyVarToType :: HsTyVarBndr () GhcPs -> HsType GhcPs-tyVarToType = \case-  UserTyVar _ () tvar -> HsTyVar EpAnnNotUsed NotPromoted tvar-  KindedTyVar _ () tvar kind ->-    -- Note: we always add parentheses because for whatever reason GHC does-    -- not use HsParTy for left-hand sides of declarations. Please see-    -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as-    -- long as 'tyVarToType' does not get applied to right-hand sides of-    -- declarations.-    HsParTy EpAnnNotUsed . noLocA $-      HsKindSig EpAnnNotUsed (noLocA (HsTyVar EpAnnNotUsed NotPromoted tvar)) kind--tyVarsToTyPats :: LHsQTyVars GhcPs -> HsTyPats GhcPs-tyVarsToTyPats HsQTvs {..} = HsValArg . fmap tyVarToType <$> hsq_explicit  -- could be generalized to also handle () instead of Specificity hsOuterTyVarBndrsToHsType ::

@@ -1,9 +1,11 @@ {-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE PatternSynonyms #-}  -- | This module helps handle operator chains composed of different -- operators that may have different precedence and fixities. module Ormolu.Printer.Operators   ( OpTree (..),+    pattern BinaryOpBranches,     OpInfo (..),     opTreeLoc,     reassociateOpTree,@@ -11,6 +13,7 @@   ) where +import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import GHC.Types.Name.Reader import GHC.Types.SrcLoc@@ -31,9 +34,12 @@   | -- | A subtree of operator application(s); the invariant is: @length     -- exprs == length ops + 1@. @OpBranches [x, y, z] [op1, op2]@     -- represents the expression @x op1 y op2 z@.-    OpBranches [OpTree ty op] [op]+    OpBranches (NonEmpty (OpTree ty op)) [op]   deriving (Eq, Show) +pattern BinaryOpBranches :: OpTree ty op -> op -> OpTree ty op -> OpTree ty op+pattern BinaryOpBranches x op y = OpBranches (x :| [y]) [op]+ -- | Wrapper for an operator, carrying information about its name and -- fixity. data OpInfo op = OpInfo@@ -78,7 +84,7 @@ opTreeLoc :: (HasSrcSpan l) => OpTree (GenLocated l a) b -> SrcSpan opTreeLoc (OpNode n) = getLoc' n opTreeLoc (OpBranches exprs _) =-  combineSrcSpans' . NE.fromList . fmap opTreeLoc $ exprs+  combineSrcSpans' . fmap opTreeLoc $ exprs  -- | Re-associate an 'OpTree' taking into account precedence of operators. -- Users are expected to first construct an initial 'OpTree', then@@ -129,11 +135,11 @@   OpBranches rExprs rOps   where     makeFlatOpTree' expr = case makeFlatOpTree expr of-      OpNode n -> ([OpNode n], [])+      OpNode n -> (NE.singleton (OpNode n), [])       OpBranches noptExprs noptOps -> (noptExprs, noptOps)     flattenedSubTrees = makeFlatOpTree' <$> exprs-    rExprs = concatMap fst flattenedSubTrees-    rOps = concat $ interleave (snd <$> flattenedSubTrees) (pure <$> ops)+    rExprs = fst =<< flattenedSubTrees+    rOps = concat $ interleave (snd <$> NE.toList flattenedSubTrees) (pure <$> ops)     interleave (x : xs) (y : ys) = x : y : interleave xs ys     interleave [] ys = ys     interleave xs [] = xs@@ -239,7 +245,7 @@     --   [ex0 op0 ex1 op1 ex2 op2 ex3 op3 ex4 op4 ex5 op5 ex6 op6 ex7]     -- into     --   [ex0 op0 [ex1 op1 ex2] op2 [ex3 op3 ex4 op4 ex5] op5 [ex6 op6 ex7]]-    splitTree nExprs nOps indices = go nExprs nOps indices 0 [] [] [] []+    splitTree nExprs nOps indices = go (NE.toList nExprs) nOps indices 0 [] [] [] []       where         go ::           -- Remaining exprs to look up@@ -267,15 +273,15 @@           -- expr in the subExprs bag, so we build a subtree (if necessary)           -- with sub-bags, add the node/subtree to the result bag, and then           -- emit the result tree-          let resExpr = buildFromSub subExprs subOps-           in OpBranches (reverse (resExpr : resExprs)) (reverse resOps)+          let resExpr = buildFromSub (NE.fromList subExprs) subOps+           in OpBranches (NE.reverse (resExpr :| resExprs)) (reverse resOps)         go (x : xs) (o : os) (idx : idxs) i subExprs subOps resExprs resOps           | i == idx =               -- The op we are looking at is one on which we need to split.               -- So we build a subtree from the sub-bags and the current               -- expr, append it to the result exprs, and continue with               -- cleared sub-bags-              let resExpr = buildFromSub (x : subExprs) subOps+              let resExpr = buildFromSub (x :| subExprs) subOps                in go xs os idxs (i + 1) [] [] (resExpr : resExprs) (o : resOps)         go (x : xs) ops idxs i subExprs subOps resExprs resOps =           -- Either there is no op left, or the op we are looking at is not@@ -288,7 +294,7 @@     --   [ex0 op0 ex1 op1 ex2 op2 ex3 op3 ex4 op4 ex5 op5 ex6 op6 ex7]     -- into     --   [[ex0 op0 ex1 op1 ex2] op2 ex3 op3 [ex4 op4 ex5] op5 ex6 op6 ex7]-    groupTree nExprs nOps indices = go nExprs nOps indices 0 [] [] [] []+    groupTree nExprs nOps indices = go (NE.toList nExprs) nOps indices 0 [] [] [] []       where         go ::           -- remaining exprs to look up@@ -316,11 +322,10 @@           -- empty. If it is not, we build a subtree (if necessary) with           -- sub-bags and add the resulting node/subtree to the result bag.           -- In any case, we then emit the result tree-          let resExprs' =-                if null subExprs-                  then resExprs-                  else buildFromSub subExprs subOps : resExprs-           in OpBranches (reverse resExprs') (reverse resOps)+          let resExprs' = case NE.nonEmpty subExprs of+                Nothing -> NE.fromList resExprs+                Just subExprs' -> buildFromSub subExprs' subOps :| resExprs+           in OpBranches (NE.reverse resExprs') (reverse resOps)         go (x : xs) (o : os) (idx : idxs) i subExprs subOps resExprs resOps           | i == idx =               -- The op we are looking at is one on which we need to group.@@ -333,7 +338,7 @@           -- the current expr, to form a subtree which is then added to the           -- result bag.           let (ops', resOps') = moveOneIfPossible ops resOps-              resExpr = buildFromSub (x : subExprs) subOps+              resExpr = buildFromSub (x :| subExprs) subOps            in go xs ops' idxs (i + 1) [] [] (resExpr : resExprs) resOps'         go (x : xs) ops idxs i [] subOps resExprs resOps =           -- Either there is no op left, or the op we are looking at is not@@ -349,8 +354,8 @@     buildFromSub subExprs subOps = reassociateFlatOpTree $ case subExprs of       -- Do not build a subtree when the potential subtree would have       -- 1 expr(s) and 0 op(s)-      [x] -> x-      _ -> OpBranches (reverse subExprs) (reverse subOps)+      x :| [] -> x+      _ -> OpBranches (NE.reverse subExprs) (reverse subOps)  -- | Indicate if an operator has @'InfixR' 0@ fixity. We special-case this -- class of operators because they often have, like ('$'), a specific

@@ -86,7 +86,7 @@         },       TestGroup         { label = "column-limit",-          isMulti = False,+          isMulti = True,           testCases = [NoLimit, ColumnLimit 80, ColumnLimit 100],           updateConfig = \columnLimit opts -> opts {poColumnLimit = pure columnLimit},           showTestCase = show,

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-}  module Ormolu.OpTreeSpec (spec) where