ormolu 0.8.0.2 → 0.8.1.0

raw patch · 57 files changed

+675/−249 lines, 57 filesdep ~Cabal-syntaxdep ~ghc-lib-parserPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

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

API changes (from Hackage documentation)

Files

• CHANGELOG.md +29/−0
• DESIGN.md +2/−2
• app/Main.hs +1/−1
• data/examples/declaration/data/linear-out.hs +11/−0
• data/examples/declaration/data/linear.hs +10/−0
• data/examples/declaration/data/record-out.hs +1/−1
• data/examples/declaration/data/record.hs +1/−1
• data/examples/declaration/data/required-type-arguments-out.hs +27/−0
• data/examples/declaration/data/required-type-arguments.hs +24/−0
• data/examples/declaration/foreign/foreign-import-multiline-out.hs +8/−0
• data/examples/declaration/foreign/foreign-import-multiline.hs +6/−0
• data/examples/declaration/rewrite-rule/prelude2-out.hs +1/−1
• data/examples/declaration/rewrite-rule/prelude2.hs +1/−1
• data/examples/declaration/signature/specialize/specialize-2-out.hs +8/−0
• data/examples/declaration/signature/specialize/specialize-2.hs +9/−0
• data/examples/declaration/signature/specialize/specialize-3-out.hs +10/−0
• data/examples/declaration/signature/specialize/specialize-3.hs +4/−0
• data/examples/declaration/value/function/arrow/proc-do-complex-out.hs +1/−1
• data/examples/declaration/value/function/arrow/proc-do-complex.hs +1/−1
• data/examples/declaration/value/function/guards-out.hs +2/−0
• data/examples/declaration/value/function/guards.hs +2/−0
• data/examples/declaration/value/function/linear-bindings-out.hs +9/−0
• data/examples/declaration/value/function/linear-bindings.hs +9/−0
• data/examples/declaration/value/function/multiline-strings-9-out.hs +11/−0
• data/examples/declaration/value/function/multiline-strings-9.hs +11/−0
• data/examples/declaration/value/function/pattern/or-patterns-out.hs +9/−1
• data/examples/declaration/value/function/pattern/or-patterns.hs +7/−1
• data/examples/declaration/value/function/strings-out.hs +2/−0
• data/examples/declaration/value/function/strings.hs +2/−0
• data/examples/import/data-out.hs +3/−0
• data/examples/import/data.hs +6/−0
• data/examples/import/explicit-level-imports-out.hs +10/−0
• data/examples/import/explicit-level-imports-qualified-post-out.hs +5/−0
• data/examples/import/explicit-level-imports-qualified-post.hs +5/−0
• data/examples/import/explicit-level-imports.hs +10/−0
• data/examples/other/empty-forall-out.hs +1/−1
• ormolu.cabal +14/−14
• src/GHC/DynFlags.hs +6/−0
• src/Ormolu/Diff/ParseResult.hs +4/−1
• src/Ormolu/Diff/Text.hs +0/−4
• src/Ormolu/Imports.hs +1/−4
• src/Ormolu/Parser.hs +7/−2
• src/Ormolu/Printer/Combinators.hs +25/−2
• src/Ormolu/Printer/Internal.hs +14/−0
• src/Ormolu/Printer/Meat/Common.hs +13/−13
• src/Ormolu/Printer/Meat/Declaration.hs +7/−1
• src/Ormolu/Printer/Meat/Declaration/Data.hs +61/−59
• src/Ormolu/Printer/Meat/Declaration/Foreign.hs +7/−2
• src/Ormolu/Printer/Meat/Declaration/OpTree.hs +1/−6
• src/Ormolu/Printer/Meat/Declaration/Rule.hs +15/−13
• src/Ormolu/Printer/Meat/Declaration/Signature.hs +66/−13
• src/Ormolu/Printer/Meat/Declaration/Signature.hs-boot +14/−0
• src/Ormolu/Printer/Meat/Declaration/StringLiteral.hs +18/−5
• src/Ormolu/Printer/Meat/Declaration/Value.hs +64/−60
• src/Ormolu/Printer/Meat/ImportExport.hs +13/−0
• src/Ormolu/Printer/Meat/Type.hs +65/−37
• tests/Ormolu/Fixity/ParserSpec.hs +1/−1

@@ -1,3 +1,32 @@+## Ormolu 0.8.1.0++* Fixed printing of guards on pattern binds. [Issue+  1178](https://github.com/tweag/ormolu/issues/1178).++* Switched to `ghc-lib-parser-9.14`, with the following new syntactic features:+   * GHC proposal [#493](https://github.com/ghc-proposals/ghc-proposals/blob/e2c683698323cec3e33625369ae2b5f585387c70/proposals/0493-specialise-expressions.rst): expressions in SPECIALISE pragmas+   * Multiline strings in foreign import declarations.+   * `ExplicitNamespaces` supports the `data` namespace specifier in import and export lists, replacing `pattern`.+   * `LinearTypes` adds new syntax to support non-linear record fields.+   * `RequiredTypeArguments` allows visible forall in GADT syntax.++* Updated to `Cabal-syntax-3.16`.++* Correctly format string literals containing the `\^\` escape sequence. [Issue+  1165](https://github.com/tweag/ormolu/issues/1165).++* Correctly preserve consecutive blank lines in multiline strings. [Issue+  1194](https://github.com/tweag/ormolu/issues/1194).++* Fixed printing of multi-line or-patterns inside as-patterns. [Issue+  1183](https://github.com/tweag/ormolu/issues/1183).++* Fixed an issue where or-patterns would be indented twice. [Issue+  1188](https://github.com/tweag/ormolu/issues/1188).++* Add support for `ExplicitLevelImports`. [Issue+  1192](https://github.com/tweag/ormolu/issues/1192).+ ## Ormolu 0.8.0.2  * Fixed a performance regression introduced in 0.8.0.0. [Issue

@@ -65,7 +65,7 @@ of which fit in linear space. So care is necessary to keep memory bounded. -The compexities of the `BriDoc` structure, together with the lack of+The complexities of the `BriDoc` structure, together with the lack of documentation, make Brittany at least challenging to maintain.  ### Hindent@@ -386,7 +386,7 @@ Forking or contributing to Hindent is not an option because if we replace `haskell-src-exts` with `ghc` (or `ghc-exact-print`) then we'll have to work with a different AST type and all the code in Hindent will become-incompatible and there won't be much code to be re-used in that case. It is+incompatible and there won't be much code to be reused in that case. It is also possible that we'll find a nicer way to write pretty-printer.  ## Examples

@@ -361,7 +361,7 @@         help "Fail if formatting is not idempotent"       ]     -- We cannot parse the source type here, because we might need to do-    -- autodection based on the input file extension (not available here)+    -- autodetection based on the input file extension (not available here)     -- before storing the resolved value in the config struct.     <*> pure ModuleSource     <*> (option parseColorMode . mconcat)

@@ -0,0 +1,11 @@+{-# LANGUAGE LinearTypes #-}++data Record = Rec {x %'Many :: Int, y :: Char}++data T2 a b c where+  MkT2 :: a -> b %1 -> c %1 -> T2 a b c++data T2 a b c = MkT2 {x %Many :: a, y :: b, z :: c}++data T3 a m where+  MkT3 :: a %m -> T3 a m

@@ -0,0 +1,10 @@+{-# LANGUAGE LinearTypes #-}+data Record = Rec { x %'Many :: Int, y :: Char }++data T2 a b c where+    MkT2 :: a -> b %1 -> c %1 -> T2 a b c++data T2 a b c = MkT2 { x %Many :: a, y :: b, z :: c }++data T3 a m where+    MkT3 :: a %m -> T3 a m

@@ -12,7 +12,7 @@     fooGag,     fooGog ::       NonEmpty-        ( Indentity+        ( Identity             Bool         ),     -- | Huh!

@@ -6,7 +6,7 @@   { fooX :: Int -- ^ X   , fooY :: Int -- ^ Y   , fooBar, fooBaz :: NonEmpty (Identity Bool) -- ^ BarBaz-  , fooGag, fooGog :: NonEmpty (Indentity+  , fooGag, fooGog :: NonEmpty (Identity                                   Bool)     -- ^ GagGog   , fooFoo

@@ -0,0 +1,27 @@+data T a where+  Typed :: forall a -> a -> T a++f1 (Typed a x) = x :: a++f2 (Typed Int n) = n * 2++f3 (Typed ((->) w Bool) g) = not . g++data D x where+  MkD1 ::+    forall a b ->+    a ->+    b ->+    D (a, b)+  MkD2 ::+    forall a.+    forall b ->+    a ->+    b ->+    D (a, b)+  MkD3 ::+    forall a ->+    a ->+    forall b ->+    b ->+    D (a, b)

@@ -0,0 +1,24 @@+data T a where+  Typed :: forall a -> a -> T a++f1 (Typed a x) = x :: a+f2 (Typed Int n) = n*2+f3 (Typed ((->) w Bool) g) = not . g++data D x where+  MkD1 :: forall a b ->+          a ->+          b ->+          D (a, b)++  MkD2 :: forall a.+          forall b ->+          a ->+          b ->+          D (a, b)++  MkD3 :: forall a ->+          a ->+          forall b ->+          b ->+          D (a, b)

@@ -0,0 +1,8 @@+{-# LANGUAGE MultilineStrings #-}++foreign import capi+  """+  foo+     bar+  """+  foo :: Int -> Int

@@ -0,0 +1,6 @@+{-# language MultilineStrings #-}++foreign import capi """+         foo+            bar+     """ foo :: Int -> Int

@@ -11,7 +11,7 @@ -- when we disable the rule that expands (++) into foldr  -- The foldr/cons rule looks nice, but it can give disastrously--- bloated code when commpiling+-- bloated code when compiling --      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ] -- i.e. when there are very very long literal lists -- So I've disabled it for now. We could have special cases

@@ -11,7 +11,7 @@         -- when we disable the rule that expands (++) into foldr  -- The foldr/cons rule looks nice, but it can give disastrously--- bloated code when commpiling+-- bloated code when compiling --      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ] -- i.e. when there are very very long literal lists -- So I've disabled it for now. We could have special cases

@@ -0,0 +1,8 @@+{-# SPECIALIZE addMult @Double #-}+{-# SPECIALIZE addMult (5 :: Int) #-}+{-# SPECIALIZE addMult 5 :: Int -> Int #-}++{-# SPECIALIZE [1] forall x y. f @Int True (x, y) #-}++{-# SPECIALIZE forall x xs. loop (x : xs)+  #-}

@@ -0,0 +1,9 @@+{-# SPECIALISE addMult @Double #-}+{-# SPECIALISE addMult (5 :: Int) #-}+{-# SPECIALISE addMult 5 :: Int -> Int #-}++{-# SPECIALISE [1] forall x y. f @Int True (x,y) #-}++{-# SPECIALISE+  forall x xs .+  loop (x:xs) #-}

@@ -0,0 +1,10 @@+sep, fsep, hsep :: (Applicative m, Foldable t) => t (m Doc) -> m Doc+sep = fmap P.sep . sequenceAFoldable+{-# SPECIALIZE NOINLINE sep :: [TCM Doc] -> TCM Doc #-}+{-# SPECIALIZE NOINLINE sep :: List1 (TCM Doc) -> TCM Doc #-}+fsep = fmap P.fsep . sequenceAFoldable+{-# SPECIALIZE NOINLINE [2] fsep :: [TCM Doc] -> TCM Doc #-}+{-# SPECIALIZE NOINLINE [2] fsep :: List1 (TCM Doc) -> TCM Doc #-}+hsep = fmap P.hsep . sequenceAFoldable+{-# SPECIALIZE NOINLINE [~2] hsep :: [TCM Doc] -> TCM Doc #-}+{-# SPECIALIZE NOINLINE [~2] hsep :: List1 (TCM Doc) -> TCM Doc #-}

@@ -0,0 +1,4 @@+sep, fsep, hsep :: (Applicative m, Foldable t) => t (m Doc) -> m Doc+sep  = fmap P.sep  . sequenceAFoldable  ; {-# SPECIALIZE NOINLINE sep  :: [TCM Doc] -> TCM Doc #-} ; {-# SPECIALIZE NOINLINE sep  :: List1 (TCM Doc) -> TCM Doc #-}+fsep = fmap P.fsep . sequenceAFoldable  ; {-# SPECIALIZE NOINLINE [2] fsep :: [TCM Doc] -> TCM Doc #-} ; {-# SPECIALIZE NOINLINE [2] fsep :: List1 (TCM Doc) -> TCM Doc #-}+hsep = fmap P.hsep . sequenceAFoldable  ; {-# SPECIALIZE NOINLINE [~2] hsep :: [TCM Doc] -> TCM Doc #-} ; {-# SPECIALIZE NOINLINE [~2] hsep :: List1 (TCM Doc) -> TCM Doc #-}

@@ -12,7 +12,7 @@         )     -> do       -- Begin do-      (x, y) <- -- GHC parser fails if layed out over multiple lines+      (x, y) <- -- GHC parser fails if laid out over multiple lines         f -- Call into f           ( a,             c -- Tuple together arguments

@@ -9,7 +9,7 @@         (e, f)       ) ->     do -- Begin do-        (x,y) -- GHC parser fails if layed out over multiple lines+        (x,y) -- GHC parser fails if laid out over multiple lines          <- f -- Call into f               (a,                c) -- Tuple together arguments

@@ -10,3 +10,5 @@ quux :: Int -> Int quux x | x < 0 = x quux x = x++(a, b) | c = d

@@ -10,3 +10,5 @@ quux :: Int -> Int quux x | x < 0 = x quux x = x++(a, b) | c = d

@@ -0,0 +1,9 @@+{-# LANGUAGE LinearTypes #-}++h x = g y+  where+    %1 y = f x++let %1 x = u in ()+let %Many (x, y) = u in ()+let %1 ~(x, y) = u in ()

@@ -0,0 +1,9 @@+{-# Language LinearTypes #-}++h x = g y+  where+    %1 y = f x++let %1 x = u in ()+let %Many (x, y) = u in ()+let %1 ~(x, y) = u in ()

@@ -0,0 +1,11 @@+{-# LANGUAGE MultilineStrings #-}++multilineBlank =+  """+  1+++++  6+  """

@@ -0,0 +1,11 @@+{-# LANGUAGE MultilineStrings #-}++multilineBlank =+  """+  1+++++  6+  """

@@ -21,7 +21,8 @@ sane e = case e of   1   2-  3 -> a+  3 ->+    a   4   5   6 -> b@@ -34,3 +35,10 @@   (D; E (Just _) Nothing) ->     4   F -> 5++food+  foo@( A;+        B;+        C+        ) = Just foo+food _ = Nothing

@@ -20,7 +20,8 @@ sane e = case e of   1   2-  3 -> a+  3 ->+    a   4   5;6 -> b   7;8 -> c@@ -31,3 +32,8 @@   (D; E (Just _) Nothing)    -> 4   F -> 5++food foo@(A;+          B;+          C) = Just foo+food _ = Nothing

@@ -10,3 +10,5 @@   \baz"  weirdGap = "\65\ \0"++weirdEscape = "\^\ "

@@ -7,3 +7,5 @@     \baz"  weirdGap = "\65\ \0"++weirdEscape = "\^\ "

@@ -0,0 +1,3 @@+module Bar (data P, T (data P), data f) where++import N (T (data P), data P, data f)

@@ -0,0 +1,6 @@++module Bar (data P, T(data P), data f) where++import N (data P)+import N (T(data P))+import N (data f)

@@ -0,0 +1,10 @@+{-# LANGUAGE ExplicitLevelImports #-}++import A splice+import {-# SOURCE #-} safe qualified A splice as QA hiding (a, b, c, d, e, f)+import quote qualified B as QB+import qualified C splice as SC+import qualified D splice+import Data.ByteString (e)+import Data.ByteString.Lazy quote (d)+import splice Data.Text (a, b, c)

@@ -0,0 +1,5 @@+{-# LANGUAGE ExplicitLevelImports #-}+{-# LANGUAGE ImportQualifiedPost #-}++import quote A qualified as QA+import B quote qualified as QB

@@ -0,0 +1,5 @@+{-# LANGUAGE ExplicitLevelImports #-}+{-# LANGUAGE ImportQualifiedPost #-}++import qualified B quote as QB+import quote qualified A as QA

@@ -0,0 +1,10 @@+{-# LANGUAGE ExplicitLevelImports #-}++import splice Data.Text (a, b, c)+import Data.ByteString.Lazy quote (d)+import Data.ByteString (e)+import {-# SOURCE #-} safe qualified A splice as QA hiding (a, b, c, d, e, f)+import quote qualified B as QB+import qualified C splice as SC+import A splice+import qualified D splice

@@ -12,7 +12,7 @@   forall. T x = x  {-# RULES-"r"+"r" forall.   r a =     ()   #-}

@@ -1,13 +1,13 @@ cabal-version: 2.4 name: ormolu-version: 0.8.0.2+version: 0.8.1.0 license: BSD-3-Clause license-file: LICENSE.md maintainer: Mark Karpov <mark.karpov@tweag.io> tested-with:-  ghc ==9.8.4-  ghc ==9.10.1-  ghc ==9.12.1+  ghc ==9.10.2+  ghc ==9.12.2+  ghc ==9.14.1  homepage: https://github.com/tweag/ormolu bug-reports: https://github.com/tweag/ormolu/issues@@ -95,7 +95,7 @@   other-modules: GHC.DynFlags   default-language: GHC2021   build-depends:-    Cabal-syntax >=3.14 && <3.15,+    Cabal-syntax >=3.16 && <3.17,     Diff >=0.4 && <2,     MemoTrie >=0.6 && <0.7,     ansi-terminal >=0.10 && <1.2,@@ -104,11 +104,11 @@     binary >=0.8 && <0.9,     bytestring >=0.2 && <0.13,     choice >=0.2.4.1 && <0.3,-    containers >=0.5 && <0.8,+    containers >=0.5 && <0.9,     directory ^>=1.3,     file-embed >=0.0.15 && <0.1,     filepath >=1.2 && <1.6,-    ghc-lib-parser >=9.12 && <9.13,+    ghc-lib-parser >=9.14 && <9.15,     megaparsec >=9,     mtl >=2 && <3,     syb >=0.7 && <0.8,@@ -133,13 +133,13 @@   autogen-modules: Paths_ormolu   default-language: GHC2021   build-depends:-    Cabal-syntax >=3.14 && <3.15,+    Cabal-syntax >=3.16 && <3.17,     base >=4.12 && <5,-    containers >=0.5 && <0.8,+    containers >=0.5 && <0.9,     directory ^>=1.3,     filepath >=1.2 && <1.6,-    ghc-lib-parser >=9.12 && <9.13,-    optparse-applicative >=0.14 && <0.19,+    ghc-lib-parser >=9.14 && <9.15,+    optparse-applicative >=0.14 && <0.20,     ormolu,     text >=2.1 && <3,     th-env >=0.1.1 && <0.2,@@ -184,14 +184,14 @@    default-language: GHC2021   build-depends:-    Cabal-syntax >=3.14 && <3.15,+    Cabal-syntax >=3.16 && <3.17,     QuickCheck >=2.14,     base >=4.14 && <5,     choice >=0.2.4.1 && <0.3,-    containers >=0.5 && <0.8,+    containers >=0.5 && <0.9,     directory ^>=1.3,     filepath >=1.2 && <1.6,-    ghc-lib-parser >=9.12 && <9.13,+    ghc-lib-parser >=9.14 && <9.15,     hspec >=2 && <3,     hspec-megaparsec >=2.2,     megaparsec >=9,

@@ -7,10 +7,12 @@   ) where +import GHC.Data.FastString import GHC.Driver.Session import GHC.Platform import GHC.Settings import GHC.Settings.Config+import GHC.Unit.Types import GHC.Utils.Fingerprint  fakeSettings :: Settings@@ -43,6 +45,10 @@             platform_constants = Nothing           },       sPlatformMisc = PlatformMisc {},+      sUnitSettings =+        UnitSettings+          { unitSettings_baseUnitId = UnitId $ fsLit "ormolu"+          },       sToolSettings =         ToolSettings           { toolSettings_opt_P_fingerprint = fingerprint0,

@@ -98,10 +98,12 @@                   `extQ` considerEqual @EpLayout                   `extQ` considerEqual @AnnSig                   `extQ` considerEqual @HsRuleAnn-                  `extQ` considerEqual @EpLinearArrow+                  `extQ` considerEqual @EpLinear                   `extQ` considerEqual @AnnSynDecl                   -- FastString (for example for string literals)                   `extQ` considerEqualVia' ((==) @FastString)+                  -- ModuleName is a newtype of FastString+                  `extQ` considerEqualVia' ((==) @ModuleName)                   -- Haddock strings                   `extQ` hsDocStringEq                   -- Whether imports are pre- or post-qualified@@ -151,6 +153,7 @@     epAnnEq :: EpAnn a -> b -> ParseResultDiff     epAnnEq _ _ = Same +    importDeclQualifiedStyleEq :: forall a. (Data a) => ImportDeclQualifiedStyle -> a -> ParseResultDiff     importDeclQualifiedStyleEq = considerEqualVia' f       where         f QualifiedPre QualifiedPost = True

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QualifiedDo #-}@@ -24,9 +23,6 @@ import GHC.Types.SrcLoc import Ormolu.Terminal import Ormolu.Terminal.QualifiedDo qualified as Term-#if !MIN_VERSION_base(4,20,0)-import Data.List (foldl')-#endif  ---------------------------------------------------------------------------- -- Types

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}@@ -26,9 +25,6 @@ import GHC.Types.SourceText import GHC.Types.SrcLoc import Ormolu.Utils (notImplemented, showOutputable)-#if !MIN_VERSION_base(4,20,0)-import Data.List (foldl')-#endif  -- | Sort and normalize imports. normalizeImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]@@ -216,6 +212,7 @@       IEDefault _ x -> (1, x)       IEPattern _ x -> (2, x)       IEType _ x -> (3, x)+      IEData _ x -> (4, x)  compareRdrName :: RdrName -> RdrName -> Ordering compareRdrName x y =

@@ -28,7 +28,7 @@ import GHC.Data.FastString qualified as GHC import GHC.Data.Maybe (orElse) import GHC.Data.StringBuffer (StringBuffer)-import GHC.Driver.Config.Parser (initParserOpts)+import GHC.Driver.Config.Parser (initParserOpts, supportedLanguagePragmas) import GHC.Driver.Errors.Types qualified as GHC import GHC.Driver.Session as GHC import GHC.DynFlags (baseDynFlags)@@ -43,6 +43,7 @@ import GHC.Types.SrcLoc import GHC.Utils.Error import GHC.Utils.Exception (ExceptionMonad)+import GHC.Utils.Logger (initLogger) import GHC.Utils.Panic qualified as GHC import Ormolu.Config import Ormolu.Exception@@ -306,10 +307,14 @@     let (_warnings, fileOpts) =           GHC.getOptions             (initParserOpts flags)+            (supportedLanguagePragmas flags)             input             filepath+    -- 'initLogger' does not have any hooks installed, so we don't get any+    -- (unwanted) output.+    logger <- initLogger     (flags', leftovers, warnings) <--      parseDynamicFilePragma flags (extraOpts <> fileOpts)+      parseDynamicFilePragma logger flags (extraOpts <> fileOpts)     case NE.nonEmpty leftovers of       Nothing -> return ()       Just unrecognizedOpts ->

@@ -21,6 +21,7 @@     atom,     space,     newline,+    newlineLiteral,     inci,     inciIf,     askSourceType,@@ -39,6 +40,7 @@     -- ** Formatting lists     sep,     sepSemi,+    sepSemi',     canUseBraces,     useBraces,     dontUseBraces,@@ -207,7 +209,25 @@   -- | Elements to render   [a] ->   R ()-sepSemi f xs = vlayout singleLine multiLine+sepSemi = sepSemi' False++-- | A version of 'sepSemi' that allows to control whether semicolons should+-- be inserted in multi-line layout.+--+-- > useBraces $ sepSemi' False txt ["foo", "bar"]+-- >   == vlayout (txt "{ foo; bar }") (txt "foo\nbar")+--+-- > dontUseBraces $ sepSemi' True txt ["foo", "bar"]+-- >   == vlayout (txt "foo; bar") (txt "foo;\nbar")+sepSemi' ::+  -- | Whether to insert semicolons in multi-line layout+  Bool ->+  -- | How to render an element+  (a -> R ()) ->+  -- | Elements to render+  [a] ->+  R ()+sepSemi' addMultiColSemi f xs = vlayout singleLine multiLine   where     singleLine = do       ub <- canUseBraces@@ -223,7 +243,10 @@               txt "}"             else sep (txt ";" >> space) f xs'     multiLine =-      sep newline (dontUseBraces . f) xs+      sep+        (if addMultiColSemi then txt ";" >> newline else newline)+        (dontUseBraces . f)+        xs  ---------------------------------------------------------------------------- -- Wrapping

@@ -17,6 +17,7 @@     atom,     space,     newline,+    newlineLiteral,     askSourceType,     askModuleFixityMap,     askDebug,@@ -385,6 +386,19 @@             VeryBeginning -> VeryBeginning             _ -> AfterNewline         }++-- | Insert a newline literal without modifying the internal state of the+-- parser. This is to be used exceptionally, e.g. for printing multiline+-- string literals.+newlineLiteral :: R ()+newlineLiteral = R . modify $ \sc ->+  sc+    { scBuilder = scBuilder sc <> "\n",+      scColumn = 0,+      scIndent = 0,+      scThisLineSpans = [],+      scRequestedDelimiter = AfterNewline+    }  -- | Return the source type. askSourceType :: R SourceType

@@ -15,7 +15,7 @@     p_hsDocName,     p_sourceText,     p_namespaceSpec,-    p_arrow,+    p_hsMultAnn,   ) where @@ -28,13 +28,13 @@ import GHC.Hs.Doc import GHC.Hs.Extension (GhcPs) import GHC.Hs.ImpExp+import GHC.Hs.Type import GHC.LanguageExtensions.Type (Extension (..)) import GHC.Parser.Annotation import GHC.Types.Name.Occurrence (OccName (..), occNameString) import GHC.Types.Name.Reader import GHC.Types.SourceText import GHC.Types.SrcLoc-import Language.Haskell.Syntax (HsArrowOf (..)) import Language.Haskell.Syntax.Module.Name import Ormolu.Config (SourceType (..)) import Ormolu.Printer.Combinators@@ -47,7 +47,7 @@   | -- | Top-level declarations     Free --- | Outputs the name of the module-like entity, preceeded by the correct prefix ("module" or "signature").+-- | Outputs the name of the module-like entity, preceded by the correct prefix ("module" or "signature"). p_hsmodName :: ModuleName -> R () p_hsmodName mname = do   sourceType <- askSourceType@@ -72,6 +72,10 @@     txt "type"     space     p_rdrName x+  IEData _ x -> do+    txt "data"+    space+    p_rdrName x  -- | Render a @'LocatedN' 'RdrName'@. p_rdrName :: LocatedN RdrName -> R ()@@ -92,7 +96,7 @@       -- insert spaces when we have a parenthesized operator starting with `#`.       handleUnboxedSumsAndHashInteraction         | unboxedSums,-          -- Qualified names do not start wth a `#`.+          -- Qualified names do not start with a `#`.           Unqual (occNameString -> '#' : _) <- x =             \y -> space *> y <* space         | otherwise = id@@ -208,12 +212,8 @@   TypeNamespaceSpecifier _ -> txt "type" *> space   DataNamespaceSpecifier _ -> txt "data" *> space -p_arrow :: (mult -> R ()) -> HsArrowOf mult GhcPs -> R ()-p_arrow p_mult = \case-  HsUnrestrictedArrow _ -> txt "->"-  HsLinearArrow _ -> txt "%1 ->"-  HsExplicitMult _ mult -> do-    txt "%"-    p_mult mult-    space-    txt "->"+p_hsMultAnn :: (mult -> R ()) -> HsMultAnnOf mult GhcPs -> R ()+p_hsMultAnn p_mult = \case+  HsUnannotated _ -> pure ()+  HsLinearAnn _ -> txt "%1"+  HsExplicitMult _ mult -> txt "%" *> p_mult mult

@@ -256,7 +256,7 @@   TypeSynonym ::     RdrName -> HsDecl GhcPs pattern InlinePragma n <- SigD _ (InlineSig _ (L _ n) _)-pattern SpecializePragma n <- SigD _ (SpecSig _ (L _ n) _ _)+pattern SpecializePragma n <- SigD _ (isSpecSig -> Just n) pattern SCCPragma n <- SigD _ (SCCFunSig _ (L _ n) _) pattern AnnTypePragma n <- AnnD _ (HsAnnotation _ (TypeAnnProvenance (L _ n)) _) pattern AnnValuePragma n <- AnnD _ (HsAnnotation _ (ValueAnnProvenance (L _ n)) _)@@ -266,6 +266,12 @@ pattern KindSignature n <- KindSigD _ (StandaloneKindSig _ (L _ n) _) pattern FamilyDeclaration n <- TyClD _ (FamDecl _ (FamilyDecl _ _ _ (L _ n) _ _ _ _)) pattern TypeSynonym n <- TyClD _ (SynDecl _ (L _ n) _ _ _)++isSpecSig :: Sig GhcPs -> Maybe RdrName+isSpecSig = \case+  SpecSig _ (L _ n) _ _ -> Just n+  SpecSigE _ _ (deconstructExprFromSpecSigE -> (L _ n, _, _)) _ -> Just n+  _ -> Nothing  -- Declarations which can refer to multiple names 

@@ -19,7 +19,6 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import Data.Maybe (isJust, isNothing, maybeToList)-import Data.Void import GHC.Hs import GHC.Types.Fixity import GHC.Types.ForeignCall@@ -141,66 +140,78 @@     unless (null cs) . inci $ do       commaDel       sep commaDel p_rdrName cs-    inci $ do-      let conTy = case con_g_args of-            PrefixConGADT NoExtField xs ->-              let go (HsScaled a b) t = addCLocA t b (HsFunTy NoExtField a b t)-               in foldr go con_res_ty xs-            RecConGADT _ r ->-              addCLocA r con_res_ty $-                HsFunTy-                  NoExtField-                  (HsUnrestrictedArrow noAnn)-                  (la2la $ HsRecTy noAnn <$> r)-                  con_res_ty-          qualTy = case con_mb_cxt of-            Nothing -> conTy-            Just qs ->-              addCLocA qs conTy $-                HsQualTy NoExtField qs conTy-          quantifiedTy :: LHsType GhcPs-          quantifiedTy =-            addCLocA con_bndrs qualTy $-              hsOuterTyVarBndrsToHsType (unLoc con_bndrs) qualTy-      space-      txt "::"-      if hasDocStrings (unLoc con_res_ty)-        then newline-        else breakpoint-      located quantifiedTy p_hsType+    space+    txt "::"+    delimiter+    inci . switchLayout conSigSpans $ do+      located con_outer_bndrs p_hsOuterTyVarBndrs+      case unLoc con_outer_bndrs of+        HsOuterImplicit {} -> pure ()+        HsOuterExplicit {} -> delimiter+      forM_ con_inner_bndrs $ \tele -> do+        p_hsForAllTelescope tele+        delimiter+      forM_ con_mb_cxt $ \qs -> do+        located qs p_hsContext+        space+        txt "=>"+        delimiter+      switchLayout conArgResSpans $ do+        case con_g_args of+          PrefixConGADT NoExtField xs ->+            forM_ xs $ \x -> do+              p_hsConDeclFieldWithDoc x+              space+              p_hsMultAnn (located' p_hsType) (cdf_multiplicity x)+              space+              txt "->"+              delimiter+          RecConGADT _ x -> do+            located x p_hsConDeclRecFields+            space+            txt "->"+            delimiter+        located con_res_ty p_hsType   where+    delimiter = if anyDocStrings then newline else breakpoint+    anyDocStrings =+      hasDocStrings (unLoc con_res_ty) || case con_g_args of+        PrefixConGADT _ xs -> conArgsHaveHaddocks xs+        RecConGADT _ (L _ xs) -> conArgsHaveHaddocks $ cdrf_spec . unLoc <$> xs+     conDeclSpn =-      fmap getLocA (NE.toList con_names)-        <> [getLocA con_bndrs]+      fmap getLocA (NE.toList con_names) <> conSigSpans+    conSigSpans =+      [getLocA con_outer_bndrs]         <> maybeToList (fmap getLocA con_mb_cxt)-        <> conArgsSpans-    conArgsSpans = case con_g_args of-      PrefixConGADT NoExtField xs -> getLocA . hsScaledThing <$> xs-      RecConGADT _ x -> [getLocA x]+        <> conArgResSpans+    conArgResSpans =+      getLocA con_res_ty : case con_g_args of+        PrefixConGADT NoExtField xs -> getLocA . cdf_type <$> xs+        RecConGADT _ x -> [getLocA x] p_conDecl singleRecCon ConDeclH98 {..} =   case con_args of-    PrefixCon (_ :: [Void]) xs -> do+    PrefixCon xs -> do       renderConDoc       renderContext       switchLayout conDeclSpn $ do         p_rdrName con_name-        let args = hsScaledThing <$> xs-            argsHaveDocs = conArgsHaveHaddocks args+        let argsHaveDocs = conArgsHaveHaddocks xs             delimiter = if argsHaveDocs then newline else breakpoint         unless (null xs) delimiter         inci . sitcc $-          sep delimiter (sitcc . located' p_hsType) args+          sep delimiter (sitcc . p_hsConDeclFieldWithDoc) xs     RecCon l -> do       renderConDoc       renderContext       switchLayout conDeclSpn $ do         p_rdrName con_name         breakpoint-        inciIf (Choice.isFalse singleRecCon) (located l p_conDeclFields)-    InfixCon (HsScaled _ l) (HsScaled _ r) -> do+        inciIf (Choice.isFalse singleRecCon) (located l p_hsConDeclRecFields)+    InfixCon l r -> do       -- manually render these-      let (lType, larg_doc) = splitDocTy l-      let (rType, rarg_doc) = splitDocTy r+      let larg_doc = cdf_doc l+          rarg_doc = cdf_doc r        -- the constructor haddock can go on top of the entire constructor       -- only if neither argument has haddocks@@ -213,10 +224,10 @@         if isJust con_doc           then do             mapM_ (p_hsDoc Pipe (With #endNewline)) larg_doc-            located lType p_hsType+            p_hsConDeclField l             breakpoint           else do-            located lType p_hsType+            p_hsConDeclField l             case larg_doc of               Just doc -> space >> p_hsDoc Caret (With #endNewline) doc               Nothing -> breakpoint@@ -226,7 +237,7 @@           case rarg_doc of             Just doc -> newline >> p_hsDoc Pipe (With #endNewline) doc             Nothing -> breakpoint-          located rType p_hsType+          p_hsConDeclField r   where     renderConDoc = mapM_ (p_hsDoc Pipe (With #endNewline)) con_doc     renderContext =@@ -244,13 +255,9 @@     conDeclSpn = conNameSpn : conArgsSpans     conNameSpn = getLocA con_name     conArgsSpans = case con_args of-      PrefixCon (_ :: [Void]) xs -> getLocA . hsScaledThing <$> xs+      PrefixCon xs -> getLocA . cdf_type <$> xs       RecCon l -> [getLocA l]-      InfixCon x y -> getLocA . hsScaledThing <$> [x, y]--    splitDocTy = \case-      L _ (HsDocTy _ ty doc) -> (ty, Just doc)-      ty -> (ty, Nothing)+      InfixCon x y -> getLocA . cdf_type <$> [x, y]  p_lhsContext ::   LHsContext GhcPs ->@@ -321,14 +328,9 @@   where     f ConDeclH98 {..} =       isJust con_doc || case con_args of-        PrefixCon [] xs ->-          conArgsHaveHaddocks (hsScaledThing <$> xs)+        PrefixCon xs -> conArgsHaveHaddocks xs         _ -> False     f _ = False -conArgsHaveHaddocks :: [LBangType GhcPs] -> Bool-conArgsHaveHaddocks xs =-  let hasDocs = \case-        HsDocTy {} -> True-        _ -> False-   in any (hasDocs . unLoc) xs+conArgsHaveHaddocks :: [HsConDeclField GhcPs] -> Bool+conArgsHaveHaddocks = any (isJust . cdf_doc)

@@ -9,10 +9,12 @@ import Control.Monad import GHC.Hs import GHC.Types.ForeignCall+import GHC.Types.SourceText import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Signature+import Ormolu.Printer.Meat.Declaration.StringLiteral  p_foreignDecl :: ForeignDecl GhcPs -> R () p_foreignDecl = \case@@ -56,8 +58,11 @@   located cCallConv atom   -- Need to check for 'noLoc' for the 'safe' annotation   when (isGoodSrcSpan $ getLocA safety) (space >> atom safety)-  space-  located sourceText p_sourceText+  inci $ located sourceText $ \case+    NoSourceText -> pure ()+    SourceText lit -> do+      breakpoint+      p_stringLit lit  p_foreignExport :: ForeignExport GhcPs -> R () p_foreignExport (CExport sourceText (L loc (CExportStatic _ _ cCallConv))) = do

@@ -132,12 +132,7 @@       putOpsExprs prevExpr (opi : ops') (expr : exprs') = do         let isLast = null exprs'             ub' = if not isLast then ub else id-            -- Distinguish holes used in infix notation.-            -- eg. '1 _foo 2' and '1 `_foo` 2'-            opWrapper = case unLoc (opiOp opi) of-              HsUnboundVar _ _ -> backticks-              _ -> id-            p_op = located (opiOp opi) (opWrapper . p_hsExpr)+            p_op = located (opiOp opi) p_hsExpr             p_y = ub' $ p_exprOpTree N expr         if isTrailing           then do

@@ -4,16 +4,16 @@  module Ormolu.Printer.Meat.Declaration.Rule   ( p_ruleDecls,+    p_ruleBndrs,   ) where -import Control.Monad (unless) import GHC.Hs import GHC.Types.Basic import GHC.Types.SourceText import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common-import Ormolu.Printer.Meat.Declaration.Signature+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Signature import Ormolu.Printer.Meat.Declaration.Value import Ormolu.Printer.Meat.Type @@ -22,21 +22,12 @@   pragma "RULES" $ sep breakpoint (sitcc . located' p_ruleDecl) xs  p_ruleDecl :: RuleDecl GhcPs -> R ()-p_ruleDecl (HsRule _ ruleName activation tyvars ruleBndrs lhs rhs) = do+p_ruleDecl (HsRule _ ruleName activation ruleBndrs lhs rhs) = do   located ruleName p_ruleName   space   p_activation activation   space-  case tyvars of-    Nothing -> return ()-    Just xs -> do-      p_forallBndrs ForAllInvis p_hsTyVarBndr xs-      space-  -- It appears that there is no way to tell if there was an empty forall-  -- in the input or no forall at all. We do not want to add redundant-  -- foralls, so let's just skip the empty ones.-  unless (null ruleBndrs) $-    p_forallBndrs ForAllInvis p_ruleBndr ruleBndrs+  p_ruleBndrs ruleBndrs   breakpoint   inci $ do     located lhs p_hsExpr@@ -48,6 +39,17 @@  p_ruleName :: RuleName -> R () p_ruleName name = atom (HsString NoSourceText name :: HsLit GhcPs)++p_ruleBndrs :: RuleBndrs GhcPs -> R ()+p_ruleBndrs (RuleBndrs HsRuleBndrsAnn {..} tyvars ruleBndrs) = do+  case tyvars of+    Nothing -> return ()+    Just xs -> do+      p_forallBndrs ForAllInvis p_hsTyVarBndr xs+      space+  case rb_tmanns of+    Nothing -> pure ()+    Just _ -> p_forallBndrs ForAllInvis p_ruleBndr ruleBndrs  p_ruleBndr :: RuleBndr GhcPs -> R () p_ruleBndr = \case

@@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}  -- | Type signature declarations. module Ormolu.Printer.Meat.Declaration.Signature@@ -8,12 +9,15 @@     p_typeAscription,     p_activation,     p_standaloneKindSig,+    deconstructExprFromSpecSigE,   ) where  import Control.Monad+import Data.Maybe (maybeToList) import GHC.Data.BooleanFormula import GHC.Hs+import GHC.Stack (HasCallStack) import GHC.Types.Basic import GHC.Types.Fixity import GHC.Types.Name.Reader@@ -21,6 +25,8 @@ import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Declaration.Rule+import Ormolu.Printer.Meat.Declaration.Value (p_hsExpr) import Ormolu.Printer.Meat.Type import Ormolu.Utils @@ -31,7 +37,9 @@   ClassOpSig _ def names sigType -> p_classOpSig def names sigType   FixSig _ sig -> p_fixSig sig   InlineSig _ name inlinePragma -> p_inlineSig name inlinePragma-  SpecSig _ name ts inlinePragma -> p_specSig name ts inlinePragma+  SpecSig _ name ts inlinePragma ->+    p_specSig Nothing (noLocA $ HsVar NoExtField name) ts inlinePragma+  SpecSigE _ ruleBndrs expr inlinePragma -> p_specSigE ruleBndrs expr inlinePragma   SpecInstSig _ sigType -> p_specInstSig sigType   MinimalSig _ booleanFormula -> p_minimalSig booleanFormula   CompleteMatchSig _ cs ty -> p_completeSig cs ty@@ -122,26 +130,71 @@   p_rdrName name  p_specSig ::-  -- | Name-  LocatedN RdrName ->+  -- | Rule binders+  Maybe (RuleBndrs GhcPs) ->+  -- | Expression to specialize+  LHsExpr GhcPs ->   -- | The types to specialize to   [LHsSigType GhcPs] ->   -- | For specialize inline   InlinePragma ->   R ()-p_specSig name ts InlinePragma {..} = pragmaBraces $ do+p_specSig mRuleBndrs specExpr ts InlinePragma {..} = pragmaBraces $ do   txt "SPECIALIZE"   space   p_inlineSpec inl_inline   space-  p_activation inl_act-  space-  p_rdrName name-  space-  txt "::"-  breakpoint-  inci $ sep commaDel (located' p_hsSigType) ts+  case (inl_inline, inl_act) of+    (NoInline _, NeverActive) -> return ()+    _ -> p_activation inl_act+  inci $ do+    space+    forM_ mRuleBndrs $ \ruleBndrs -> do+      p_ruleBndrs ruleBndrs+      space+    located specExpr p_hsExpr+    case ts of+      [] -> pure ()+      _ -> do+        space+        txt "::"+        breakpoint+        sep commaDel (located' p_hsSigType) ts +p_specSigE ::+  -- | Rule binders+  RuleBndrs GhcPs ->+  -- | Expression to specialize+  LHsExpr GhcPs ->+  -- | For specialize inline+  InlinePragma ->+  R ()+p_specSigE ruleBndrs expr =+  p_specSig (Just ruleBndrs) specExpr (maybeToList sigTy)+  where+    (_, specExpr, sigTy) = deconstructExprFromSpecSigE expr++-- | The 'LHsExpr' in a 'SpecSigE' can only be of a very specific form, namely a+-- variable applied to value/type-level arguments, optionally with a type+-- signature.+--+-- https://github.com/ghc-proposals/ghc-proposals/blob/e2c683698323cec3e33625369ae2b5f585387c70/proposals/0493-specialise-expressions.rst#2proposed-change-specification+deconstructExprFromSpecSigE ::+  (HasCallStack) =>+  LHsExpr GhcPs ->+  (LocatedN RdrName, LHsExpr GhcPs, Maybe (LHsSigType GhcPs))+deconstructExprFromSpecSigE = \case+  L _ (ExprWithTySig _ e HsWC {hswc_body}) ->+    (findVar e, e, Just hswc_body)+  e -> (findVar e, e, Nothing)+  where+    findVar :: LHsExpr GhcPs -> LocatedN RdrName+    findVar = \case+      L _ (HsVar _ name) -> name+      L _ (HsApp _ e _) -> findVar e+      L _ (HsAppType _ e _) -> findVar e+      _ -> error "unreachble"+ p_inlineSpec :: InlineSpec -> R () p_inlineSpec = \case   Inline _ -> txt "INLINE"@@ -171,7 +224,7 @@  p_minimalSig ::   -- | Boolean formula-  LBooleanFormula (LocatedN RdrName) ->+  LBooleanFormula GhcPs ->   R () p_minimalSig =   located' $ \booleanFormula ->@@ -179,7 +232,7 @@  p_booleanFormula ::   -- | Boolean formula-  BooleanFormula (LocatedN RdrName) ->+  BooleanFormula GhcPs ->   R () p_booleanFormula = \case   Var name -> p_rdrName name

@@ -0,0 +1,14 @@+module Ormolu.Printer.Meat.Declaration.Signature+  ( p_sigDecl,+    p_typeAscription,+    p_activation,+  )+where++import GHC.Hs+import GHC.Types.Basic+import Ormolu.Printer.Combinators++p_sigDecl :: Sig GhcPs -> R ()+p_typeAscription :: LHsSigType GhcPs -> R ()+p_activation :: Activation -> R ()

@@ -40,7 +40,7 @@                   LastPos -> txt "\\" *> txt s         vlayout singleLine multiLine       MultilineStringLiteral ->-        sep breakpoint' txt segments+        sep newlineLiteral txt segments     txt endMarker  -- | The start/end marker of the literal, whether it is a regular or a multiline@@ -91,12 +91,25 @@       where         go [] = [s]         go ((pre, suf) : bs) = case T.uncons suf of-          Just ('\\', T.uncons -> Just (c, s'))-            | is_space c,-              let rest = T.drop 1 $ T.dropWhile (/= '\\') s' ->+          Just ('\\', suf')+            | (gap, T.uncons -> Just ('\\', rest)) <- T.span is_space suf',+              -- If there is a space after the backslash, this definitely is a+              -- string gap. Continue parsing gaps after the next backslash.+              not $ T.null gap ->                 pre : splitGaps rest-            | otherwise -> go $ (if c == '\\' then drop 1 else id) bs+            | otherwise ->+                -- Check whether @suf@ starts with an escape sequence involving+                -- another backslash. If so, it can not be the start of a string+                -- gap, so we skip it.+                let skipNextBackslash =+                      any (`T.isPrefixOf` suf') escapesWithAnotherBackslash+                 in go $ (if skipNextBackslash then drop 1 else id) bs           _ -> go bs++        -- All escape sequences (without the initial backslash) with another+        -- backslash. See+        -- https://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6+        escapesWithAnotherBackslash = ["\\", "^\\"]      -- See the the MultilineStrings GHC proposal and 'lexMultilineString' from     -- "GHC.Parser.String" for reference.

@@ -28,7 +28,6 @@ import Data.List.NonEmpty qualified as NE import Data.Maybe import Data.Text (Text)-import Data.Void import GHC.Data.Strict qualified as Strict import GHC.Hs import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))@@ -42,7 +41,7 @@ import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree-import Ormolu.Printer.Meat.Declaration.Signature+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Signature import Ormolu.Printer.Meat.Declaration.StringLiteral import Ormolu.Printer.Meat.Type import Ormolu.Printer.Operators@@ -112,7 +111,7 @@         render         (adjustMatchGroupStyle m style)         (isInfixMatch m)-        (HsNoMultAnn NoExtField)+        (HsUnannotated EpPatBind)         (matchStrictness m)         -- We use the spans of the individual patterns.         (unLoc m_pats)@@ -121,7 +120,7 @@ -- | Function id obtained through pattern matching on 'FunBind' should not -- be used to print the actual equations because the different ‘RdrNames’ -- used in the equations may have different “decorations” (such as backticks--- and paretheses) associated with them. It is necessary to use per-equation+-- and parentheses) associated with them. It is necessary to use per-equation -- names obtained from 'm_ctxt' of 'Match'. This function replaces function -- name inside of 'Function' accordingly. adjustMatchGroupStyle ::@@ -129,14 +128,13 @@   MatchGroupStyle ->   MatchGroupStyle adjustMatchGroupStyle m = \case-  Function _ -> (Function . mc_fun . m_ctxt) m+  Function _ | FunRhs {mc_fun = f} <- m_ctxt m -> Function f   style -> style  matchStrictness :: Match id body -> SrcStrictness-matchStrictness match =-  case m_ctxt match of-    FunRhs {mc_strictness = s} -> s-    _ -> NoSrcStrict+matchStrictness = \case+  Match {m_ctxt = FunRhs {mc_strictness = s}} -> s+  _ -> NoSrcStrict  p_match ::   -- | Style of the group@@ -181,17 +179,19 @@   -- would start with two indentation steps applied, which is ugly, so we   -- need to be a bit more clever here and bump indentation level only when   -- pattern group is multiline.+  p_hsMultAnn (located' p_hsType) multAnn   case multAnn of-    HsNoMultAnn NoExtField -> pure ()-    HsPct1Ann _ -> txt "%1" *> space-    HsMultAnn _ ty -> do-      txt "%"-      located ty p_hsType-      space+    HsUnannotated {} -> pure ()+    HsLinearAnn {} -> space+    HsExplicitMult {} -> space   case strictness of     NoSrcStrict -> return ()     SrcStrict -> txt "!"     SrcLazy -> txt "~"+  let isCase = \case+        Case -> True+        LambdaCase -> True+        _ -> False   indentBody <- case NE.nonEmpty m_pats of     Nothing ->       False <$ case style of@@ -202,7 +202,12 @@             Function name -> combineSrcSpans (getLocA name) patSpans             _ -> patSpans           patSpans = combineSrcSpans' (getLocA <$> ne_pats)-          indentBody = not (isOneLineSpan combinedSpans)+          containsOrPat = everything (||) $ \b -> case cast @_ @(Pat GhcPs) b of+            Just OrPat {} -> True+            _ -> False+          indentBody =+            not (isOneLineSpan combinedSpans)+              && not (isCase style && containsOrPat ne_pats)       switchLayout [combinedSpans] $ do         let stdCase = sep breakpoint (located' p_pat) m_pats         case style of@@ -239,14 +244,10 @@           Function name -> Just (getLocA name)           _ -> Nothing         Just pats -> (Just . getLocA . NE.last) pats-      isCase = \case-        Case -> True-        LambdaCase -> True-        _ -> False       hasGuards = withGuards grhssGRHSs       grhssSpan =         combineSrcSpans' $-          getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs+          getGRHSSpan . unLoc <$> grhssGRHSs       patGrhssSpan =         maybe           grhssSpan@@ -272,7 +273,7 @@         sep           breakpoint           (located' (p_grhs' placement placer render groupStyle))-          grhssGRHSs+          (NE.toList grhssGRHSs)       p_where = do         unless (eqEmptyLocalBinds grhssLocalBinds) $ do           breakpoint@@ -284,6 +285,7 @@       case style of         Function _ | hasGuards -> return ()         Function _ -> space >> inci equals+        PatternBind | hasGuards -> return ()         PatternBind -> space >> inci equals         s | isCase s && hasGuards -> return ()         _ -> space >> txt "->"@@ -561,8 +563,8 @@ p_dotFieldOcc =   p_rdrName . fmap (mkVarUnqual . field_label) . dfoLabel -p_dotFieldOccs :: [DotFieldOcc GhcPs] -> R ()-p_dotFieldOccs = sep (txt ".") p_dotFieldOcc+p_dotFieldOccs :: NonEmpty (DotFieldOcc GhcPs) -> R ()+p_dotFieldOccs = sep (txt ".") p_dotFieldOcc . NE.toList  p_fieldOcc :: FieldOcc GhcPs -> R () p_fieldOcc FieldOcc {..} = p_rdrName foLabel@@ -587,7 +589,7 @@ p_hsExpr = p_hsExpr' NotApplicand N  -- | An applicand is the left-hand side in a function application, i.e. @f@ in--- @f a@. We need to track this in order to add extra identation in cases like+-- @f a@. We need to track this in order to add extra indentation in cases like -- -- > foo = -- >   do@@ -603,7 +605,6 @@ p_hsExpr' :: IsApplicand -> BracketStyle -> HsExpr GhcPs -> R () p_hsExpr' isApp s = \case   HsVar _ name -> p_rdrName name-  HsUnboundVar _ occ -> atom occ   HsOverLabel sourceText _ -> do     txt "#"     p_sourceText sourceText@@ -733,7 +734,8 @@   HsMultiIf _ guards -> do     txt "if"     breakpoint-    inciApplicand isApp $ sep breakpoint (located' (p_grhs RightArrow)) guards+    inciApplicand isApp $+      sep breakpoint (located' (p_grhs RightArrow)) (NE.toList guards)   HsLet _ localBinds e ->     p_let p_hsExpr localBinds e   HsDo _ doFlavor es -> do@@ -779,7 +781,7 @@     located gf_field p_dotFieldOcc   HsProjection {..} -> parens N $ do     txt "."-    p_dotFieldOccs (NE.toList proj_flds)+    p_dotFieldOccs proj_flds   ExprWithTySig _ x HsWC {hswc_body} -> sitcc $ do     located x p_hsExpr     space@@ -815,7 +817,7 @@     breakpoint'     txt "||]"   HsUntypedBracket _ x -> p_hsQuote x-  HsTypedSplice _ expr -> p_hsSpliceTH True expr DollarSplice+  HsTypedSplice _ (HsTypedSpliceExpr _ expr) -> p_hsSpliceTH True expr DollarSplice   HsUntypedSplice _ untySplice -> p_hsUntypedSplice DollarSplice untySplice   HsProc _ p e -> do     txt "proc"@@ -842,6 +844,9 @@     txt "type"     space     located hswc_body p_hsType+  HsHole holeKind -> case holeKind of+    HoleVar name -> p_rdrName name+    HoleError -> error "parse error"   -- similar to HsForAllTy   HsForAll _ tele e -> do     p_hsForAllTelescope tele@@ -855,10 +860,12 @@     breakpoint     located e p_hsExpr   -- similar to HsFunTy-  HsFunArr _ arrow x y -> do+  HsFunArr _ multAnn x y -> do     located x p_hsExpr     space-    p_arrow (located' p_hsExpr) arrow+    p_hsMultAnn (located' p_hsExpr) multAnn+    space+    txt "->"     breakpoint     case unLoc y of       HsFunArr {} -> p_hsExpr (unLoc y)@@ -961,7 +968,7 @@   -- will be ParStmt.   [L _ (ParStmt _ blocks _ _)] ->     [ concatMap collectNonParStmts stmts-    | ParStmtBlock _ stmts _ _ <- blocks+    | ParStmtBlock _ stmts _ _ <- NE.toList blocks     ]   -- Otherwise, list will not contain any ParStmt   stmts ->@@ -1002,7 +1009,7 @@             inci (p_matchGroup (Function psb_id) mgroup)   txt "pattern"   case psb_args of-    PrefixCon [] xs -> do+    PrefixCon xs -> do       space       p_rdrName psb_id       inci $ do@@ -1011,7 +1018,6 @@           unless (null xs) breakpoint           sitcc (sep breakpoint p_rdrName xs)         rhs conSpans-    PrefixCon (v : _) _ -> absurd v     RecCon xs -> do       space       p_rdrName psb_id@@ -1148,41 +1154,42 @@   sitcc (located e render)  p_pat :: Pat GhcPs -> R ()-p_pat = \case+p_pat = p_pat' False++p_pat' :: Bool -> Pat GhcPs -> R ()+p_pat' inAsPat = \case   WildPat _ -> txt "_"   VarPat _ name -> p_rdrName name   LazyPat _ pat -> do     txt "~"-    located pat p_pat+    located pat (p_pat' inAsPat)   AsPat _ name pat -> do     p_rdrName name     txt "@"-    located pat p_pat+    located pat (p_pat' True)   ParPat _ pat ->-    located pat (parens S . p_pat)+    located pat (parens S . p_pat' inAsPat)   BangPat _ pat -> do     txt "!"-    located pat p_pat+    located pat (p_pat' inAsPat)   ListPat _ pats ->-    brackets S $ sep commaDel (located' p_pat) pats+    brackets S $ sep commaDel (located' (p_pat' inAsPat)) pats   TuplePat _ pats boxing -> do     let parens' =           case boxing of             Boxed -> parens S             Unboxed -> parensHash S-    parens' $ sep commaDel (sitcc . located' p_pat) pats-  OrPat _ pats ->-    sepSemi (located' p_pat) (NE.toList pats)+    parens' $ sep commaDel (sitcc . located' (p_pat' inAsPat)) pats+  OrPat _ pats -> do+    sepSemi' inAsPat (located' (p_pat' inAsPat)) (NE.toList pats)   SumPat _ pat tag arity ->-    p_unboxedSum S tag arity (located pat p_pat)+    p_unboxedSum S tag arity (located pat (p_pat' inAsPat))   ConPat _ pat details ->     case details of-      PrefixCon tys xs -> sitcc $ do+      PrefixCon xs -> sitcc $ do         p_rdrName pat-        unless (null tys && null xs) breakpoint-        inci . sitcc $-          sep breakpoint (sitcc . either p_hsConPatTyArg (located' p_pat)) $-            (Left <$> tys) <> (Right <$> xs)+        unless (null xs) breakpoint+        inci . sitcc $ sep breakpoint (sitcc . located' (p_pat' inAsPat)) xs       RecCon (HsRecFields _ fields dotdot) -> do         p_rdrName pat         breakpoint@@ -1195,18 +1202,18 @@             Just (L _ (RecFieldsDotDot n)) -> (Just <$> take n fields) ++ [Nothing]       InfixCon l r -> do         switchLayout [getLocA l, getLocA r] $ do-          located l p_pat+          located l (p_pat' inAsPat)           breakpoint           inci $ do             p_rdrName pat             space-            located r p_pat+            located r (p_pat' inAsPat)   ViewPat _ expr pat -> sitcc $ do     located expr p_hsExpr     space     txt "->"     breakpoint-    inci (located pat p_pat)+    inci (located pat (p_pat' inAsPat))   SplicePat _ splice -> p_hsUntypedSplice DollarSplice splice   LitPat _ p -> atom p   NPat _ v (isJust -> isNegated) _ -> do@@ -1223,7 +1230,7 @@       space       located k (atom . ol_val)   SigPat _ pat HsPS {..} -> do-    located pat p_pat+    located pat (p_pat' inAsPat)     p_typeAscription (lhsTypeToSigType hsps_body)   EmbTyPat _ (HsTP _ ty) -> do     txt "type"@@ -1234,9 +1241,6 @@ p_tyPat :: HsTyPat GhcPs -> R () p_tyPat (HsTP _ ty) = txt "@" *> located ty p_hsType -p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()-p_hsConPatTyArg (HsConPatTyArg _ patSigTy) = p_tyPat patSigTy- p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R () p_pat_hsFieldBind HsFieldBind {..} = do   located hfbLHS p_fieldOcc@@ -1266,7 +1270,7 @@   HsUntypedSpliceExpr _ expr -> p_hsSpliceTH False expr deco   HsQuasiQuote _ quoterName str -> do     txt "["-    p_rdrName (noLocA quoterName)+    p_rdrName quoterName     txt "|"     -- QuasiQuoters often rely on precise custom strings. We cannot do any     -- formatting here without potentially breaking someone's code.@@ -1346,9 +1350,9 @@ -- | Determine placement of a given block. blockPlacement ::   (body -> Placement) ->-  [LGRHS GhcPs (LocatedA body)] ->+  NonEmpty (LGRHS GhcPs (LocatedA body)) ->   Placement-blockPlacement placer [L _ (GRHS _ _ (L _ x))] = placer x+blockPlacement placer (L _ (GRHS _ _ (L _ x)) :| []) = placer x blockPlacement _ _ = Normal  -- | Determine placement of a given command.@@ -1392,7 +1396,7 @@   _ -> Normal  -- | Return 'True' if any of the RHS expressions has guards.-withGuards :: [LGRHS GhcPs body] -> Bool+withGuards :: NonEmpty (LGRHS GhcPs body) -> Bool withGuards = any (checkOne . unLoc)   where     checkOne (GRHS _ [] _) = False

@@ -46,6 +46,10 @@   space   when ideclSafe (txt "safe")   space+  case ideclLevelSpec of+    LevelStylePre l -> p_declLevel l+    _ -> return ()+  space   when     (isImportDeclQualified ideclQualified && not useQualifiedPost)     (txt "qualified")@@ -56,6 +60,10 @@   space   inci $ do     located ideclName atom+    space+    case ideclLevelSpec of+      LevelStylePost l -> p_declLevel l+      _ -> return ()     when       (isImportDeclQualified ideclQualified && useQualifiedPost)       (space >> txt "qualified")@@ -81,6 +89,11 @@             (\(p, l) -> sitcc (located l (p_lie layout p)))             (attachRelativePos xs)     newline++p_declLevel :: ImportDeclLevel -> R ()+p_declLevel = \case+  ImportDeclSplice -> txt "splice"+  ImportDeclQuote -> txt "quote"  p_lie :: Layout -> RelativePos -> IE GhcPs -> R () p_lie encLayout relativePos = \case

@@ -14,11 +14,13 @@     p_hsTyVarBndr,     ForAllVisibility (..),     p_forallBndrs,-    p_conDeclFields,+    p_hsConDeclRecFields,+    p_hsConDeclField,+    p_hsConDeclFieldWithDoc,     p_lhsTypeArg,     p_hsSigType,     p_hsForAllTelescope,-    hsOuterTyVarBndrsToHsType,+    p_hsOuterTyVarBndrs,     lhsTypeToSigType,   ) where@@ -87,10 +89,12 @@     inci $ do       txt "@"       located kd p_hsType-  HsFunTy _ arrow x y -> do+  HsFunTy _ multAnn x y -> do     located x p_hsType     space-    p_arrow (located' p_hsTypeR) arrow+    p_hsMultAnn (located' p_hsTypeR) multAnn+    space+    txt "->"     interArgBreak     case unLoc y of       HsFunTy {} -> p_hsTypeR (unLoc y)@@ -134,18 +138,6 @@   HsDocTy _ t str -> do     p_hsDoc Pipe (With #endNewline) str     located t p_hsType-  HsBangTy _ (HsBang u s) t -> do-    case u of-      SrcUnpack -> txt "{-# UNPACK #-}" >> space-      SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space-      NoSrcUnpack -> return ()-    case s of-      SrcLazy -> txt "~"-      SrcStrict -> txt "!"-      NoSrcStrict -> return ()-    located t p_hsType-  HsRecTy _ fields ->-    p_conDeclFields fields   HsExplicitListTy _ p xs -> do     case p of       IsPromoted -> txt "'"@@ -173,7 +165,20 @@       HsStrTy (SourceText s) _ -> p_stringLit s       a -> atom a   HsWildCardTy _ -> txt "_"-  XHsType t -> atom t+  XHsType ext -> case ext of+    HsCoreTy t -> atom @HsCoreTy t+    HsBangTy _ (HsSrcBang _ u s) t -> do+      case u of+        SrcUnpack -> txt "{-# UNPACK #-}" >> space+        SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space+        NoSrcUnpack -> return ()+      case s of+        SrcLazy -> txt "~"+        SrcStrict -> txt "!"+        NoSrcStrict -> return ()+      located t p_hsType+    HsRecTy _ fields ->+      p_hsConDeclRecFields fields   where     startsWithSingleQuote = \case       HsAppTy _ (L _ f) _ -> startsWithSingleQuote f@@ -267,23 +272,45 @@         ForAllInvis -> txt "."         ForAllVis -> space >> txt "->" -p_conDeclFields :: [LConDeclField GhcPs] -> R ()-p_conDeclFields xs =-  braces N $ sep commaDel (sitcc . located' p_conDeclField) xs+p_hsConDeclRecFields :: [LHsConDeclRecField GhcPs] -> R ()+p_hsConDeclRecFields xs =+  braces N $ sep commaDel (sitcc . located' p_hsConDeclRecField) xs -p_conDeclField :: ConDeclField GhcPs -> R ()-p_conDeclField ConDeclField {..} = do-  mapM_ (p_hsDoc Pipe (With #endNewline)) cd_fld_doc+p_hsConDeclRecField :: HsConDeclRecField GhcPs -> R ()+p_hsConDeclRecField HsConDeclRecField {..} = do+  mapM_ (p_hsDoc Pipe (With #endNewline)) (cdf_doc cdrf_spec)   sitcc $     sep       commaDel       (located' (p_rdrName . foLabel))-      cd_fld_names+      cdrf_names   space+  p_hsMultAnn (located' p_hsType) (cdf_multiplicity cdrf_spec)+  space   txt "::"   breakpoint-  sitcc . inci $ p_hsType (unLoc cd_fld_type)+  sitcc . inci $ p_hsConDeclField cdrf_spec +-- | This does not print 'cdf_doc' and 'cdf_multiplicity' as there is no single+-- strategy for where to print them (see call sites).+p_hsConDeclField :: HsConDeclField GhcPs -> R ()+p_hsConDeclField CDF {..} = do+  case cdf_unpack of+    SrcUnpack -> txt "{-# UNPACK #-}" *> space+    SrcNoUnpack -> txt "{-# NOUNPACK #-}" *> space+    NoSrcUnpack -> pure ()+  located cdf_type $ \ty -> do+    case cdf_bang of+      SrcLazy -> txt "~"+      SrcStrict -> txt "!"+      NoSrcStrict -> pure ()+    p_hsType ty++p_hsConDeclFieldWithDoc :: HsConDeclField GhcPs -> R ()+p_hsConDeclFieldWithDoc cdf = do+  mapM_ (p_hsDoc Pipe (With #endNewline)) (cdf_doc cdf)+  p_hsConDeclField cdf+ p_lhsTypeArg :: LHsTypeArg GhcPs -> R () p_lhsTypeArg = \case   HsValArg NoExtField ty -> located ty p_hsType@@ -294,26 +321,27 @@   HsArgPar _ -> notImplemented "HsArgPar"  p_hsSigType :: HsSigType GhcPs -> R ()-p_hsSigType HsSig {..} =-  p_hsType $ hsOuterTyVarBndrsToHsType sig_bndrs sig_body+p_hsSigType HsSig {..} = do+  p_hsOuterTyVarBndrs sig_bndrs+  case sig_bndrs of+    HsOuterImplicit {} -> pure ()+    HsOuterExplicit {} -> breakpoint+  located sig_body p_hsType  p_hsForAllTelescope :: HsForAllTelescope GhcPs -> R () p_hsForAllTelescope = \case   HsForAllInvis _ bndrs -> p_forallBndrs ForAllInvis p_hsTyVarBndr bndrs   HsForAllVis _ bndrs -> p_forallBndrs ForAllVis p_hsTyVarBndr bndrs +p_hsOuterTyVarBndrs ::+  HsOuterTyVarBndrs Specificity GhcPs ->+  R ()+p_hsOuterTyVarBndrs = \case+  HsOuterImplicit _ -> pure ()+  HsOuterExplicit _ bndrs -> p_hsForAllTelescope $ mkHsForAllInvisTele noAnn bndrs+ ---------------------------------------------------------------------------- -- Conversion functions---- could be generalized to also handle () instead of Specificity-hsOuterTyVarBndrsToHsType ::-  HsOuterTyVarBndrs Specificity GhcPs ->-  LHsType GhcPs ->-  HsType GhcPs-hsOuterTyVarBndrsToHsType obndrs ty = case obndrs of-  HsOuterImplicit NoExtField -> unLoc ty-  HsOuterExplicit _ bndrs ->-    HsForAllTy NoExtField (mkHsForAllInvisTele noAnn bndrs) ty  lhsTypeToSigType :: LHsType GhcPs -> LHsSigType GhcPs lhsTypeToSigType ty =

@@ -214,7 +214,7 @@                 elabel "module name"               ]           )-    it "fails with correct parse error (typo: export intead exports)" $+    it "fails with correct parse error (typo: export instead exports)" $       parseModuleReexportDeclaration "module Control.Lens export Control.Lens.Lens"         `shouldFailWith` err           20