ormolu 0.7.4.0 → 0.7.5.0

raw patch · 51 files changed

+488/−298 lines, 51 filesdep ~Cabal-syntaxdep ~ghc-lib-parserdep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

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

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• README.md +2/−0
• app/Main.hs +7/−8
• data/examples/declaration/signature/fixity/infix-out.hs +2/−0
• data/examples/declaration/signature/fixity/infix.hs +2/−0
• data/examples/declaration/signature/fixity/infixl-out.hs +2/−0
• data/examples/declaration/signature/fixity/infixl.hs +2/−0
• data/examples/declaration/signature/fixity/infixr-out.hs +2/−0
• data/examples/declaration/signature/fixity/infixr.hs +2/−0
• data/examples/declaration/value/function/pragmas-out.hs +1/−1
• data/examples/declaration/value/function/required-type-arguments-out.hs +21/−0
• data/examples/declaration/value/function/required-type-arguments.hs +13/−0
• data/examples/declaration/value/function/type-abstractions-out.hs +9/−0
• data/examples/declaration/value/function/type-abstractions.hs +8/−0
• data/examples/declaration/warning/warning-multiline-out.hs +9/−0
• data/examples/declaration/warning/warning-multiline.hs +8/−0
• data/examples/declaration/warning/warning-single-line-out.hs +10/−2
• data/examples/declaration/warning/warning-single-line.hs +8/−2
• data/examples/import/docstrings-after-exports-out.hs +12/−0
• data/examples/import/docstrings-after-exports.hs +11/−0
• extract-hackage-info/hackage-info.bin binary
• ormolu.cabal +17/−17
• src/Ormolu.hs +3/−3
• src/Ormolu/Diff/ParseResult.hs +11/−5
• src/Ormolu/Diff/Text.hs +4/−1
• src/Ormolu/Fixity/Imports.hs +4/−4
• src/Ormolu/Fixity/Parser.hs +11/−0
• src/Ormolu/Imports.hs +23/−18
• src/Ormolu/Parser.hs +1/−1
• src/Ormolu/Parser/CommentStream.hs +4/−3
• src/Ormolu/Printer/Combinators.hs +7/−6
• src/Ormolu/Printer/Internal.hs +12/−0
• src/Ormolu/Printer/Meat/Common.hs +19/−13
• src/Ormolu/Printer/Meat/Declaration.hs +6/−4
• src/Ormolu/Printer/Meat/Declaration/Data.hs +15/−13
• src/Ormolu/Printer/Meat/Declaration/Foreign.hs +1/−1
• src/Ormolu/Printer/Meat/Declaration/Instance.hs +12/−4
• src/Ormolu/Printer/Meat/Declaration/OpTree.hs +1/−2
• src/Ormolu/Printer/Meat/Declaration/Signature.hs +5/−4
• src/Ormolu/Printer/Meat/Declaration/Value.hs +100/−83
• src/Ormolu/Printer/Meat/Declaration/Warning.hs +10/−14
• src/Ormolu/Printer/Meat/ImportExport.hs +48/−18
• src/Ormolu/Printer/Meat/Type.hs +8/−8
• src/Ormolu/Printer/Operators.hs +3/−2
• src/Ormolu/Printer/SpanStream.hs +5/−3
• src/Ormolu/Terminal.hs +2/−2
• src/Ormolu/Utils.hs +0/−17
• src/Ormolu/Utils/Fixity.hs +3/−2
• src/Ormolu/Utils/IO.hs +1/−29
• tests/Ormolu/Diff/TextSpec.hs +4/−4
• tests/Ormolu/PrinterSpec.hs +3/−4

@@ -1,3 +1,17 @@+## Ormolu 0.7.5.0++* Switched to `ghc-lib-parser-9.10`, with the following new syntactic features/behaviors:+  * GHC proposal [#575](https://github.com/ghc-proposals/ghc-proposals/blob/10290a668608d608c3f6c6010be265cf7a02e1fc/proposals/0575-deprecated-instances.rst): deprecated instances.+  * GHC proposal [#281](https://github.com/ghc-proposals/ghc-proposals/blob/10290a668608d608c3f6c6010be265cf7a02e1fc/proposals/0281-visible-forall.rst): visible forall in types of terms.+    Enabled by `RequiredTypeArguments` (enabled by default).+  * `LinearTypes`: `let` and `where` bindings can now be linear, in particular have multiplicity annotations.+  * Using `forall` as an identifier is now a parse error.+  * GHC proposal [#65](https://github.com/ghc-proposals/ghc-proposals/blob/10290a668608d608c3f6c6010be265cf7a02e1fc/proposals/0065-type-infix.rst): namespacing fixity declarations for type names and WARNING/DEPRECATED pragmas.+  * `TypeAbstractions` now supports `@`-binders in lambdas and function equations.+  * Support for the `GHC2024` language.++* Updated to `Cabal-syntax-3.12`.+ ## Ormolu 0.7.4.0  * Don't error when the `JavaScriptFFI` language pragma is present. [Issue

@@ -248,6 +248,8 @@ `--end-line` command line options. `--start-line` defaults to the beginning of the file, while `--end-line` defaults to the end. +Note that the selected region needs to be parseable Haskell code on its own.+ ### Exit codes  Exit code | Meaning

@@ -15,7 +15,7 @@ import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe, mapMaybe, maybeToList) import Data.Set qualified as Set-import Data.Text.IO qualified as TIO+import Data.Text.IO.Utf8 qualified as T.Utf8 import Data.Version (showVersion) import Distribution.ModuleName (ModuleName) import Distribution.Types.PackageName (PackageName)@@ -28,7 +28,6 @@ import Ormolu.Terminal import Ormolu.Utils (showOutputable) import Ormolu.Utils.Fixity-import Ormolu.Utils.IO import Paths_ormolu (version) import System.Directory import System.Exit (ExitCode (..), exitWith)@@ -117,7 +116,7 @@         config <- patchConfig Nothing mcabalInfo mdotOrmolu         case mode of           Stdout -> do-            ormoluStdin config >>= TIO.putStr+            ormoluStdin config >>= T.Utf8.putStr             return ExitSuccess           InPlace -> do             hPutStrLn@@ -127,7 +126,7 @@             return (ExitFailure 101)           Check -> do             -- ormoluStdin is not used because we need the originalInput-            originalInput <- getContentsUtf8+            originalInput <- T.Utf8.getContents             let stdinRepr = "<stdin>"             formattedInput <-               ormolu config stdinRepr originalInput@@ -146,19 +145,19 @@             mdotOrmolu         case mode of           Stdout -> do-            ormoluFile config inputFile >>= TIO.putStr+            ormoluFile config inputFile >>= T.Utf8.putStr             return ExitSuccess           InPlace -> do             -- ormoluFile is not used because we need originalInput-            originalInput <- readFileUtf8 inputFile+            originalInput <- T.Utf8.readFile inputFile             formattedInput <-               ormolu config inputFile originalInput             when (formattedInput /= originalInput) $-              writeFileUtf8 inputFile formattedInput+              T.Utf8.writeFile inputFile formattedInput             return ExitSuccess           Check -> do             -- ormoluFile is not used because we need originalInput-            originalInput <- readFileUtf8 inputFile+            originalInput <- T.Utf8.readFile inputFile             formattedInput <-               ormolu config inputFile originalInput             handleDiff originalInput formattedInput inputFile

@@ -3,3 +3,5 @@ infix 9 <^-^>  infix 2 ->++infix 0 type <!>

@@ -2,3 +2,5 @@ infix 9 <^-^>  infix 2 ->++infix 0 type <!>

@@ -1,3 +1,5 @@ infixl 8 ***  infixl 0 $, *, +, &&, **++infixl 9 type $

@@ -1,2 +1,4 @@ infixl 8 *** infixl 0 $, *, +, &&, **++infixl 9 type $

@@ -1,3 +1,5 @@ infixr 8 `Foo`  infixr 0 ***, &&&++infixr 0 data $

@@ -1,2 +1,4 @@ infixr 8 `Foo` infixr 0 ***, &&&++infixr 0 data $

@@ -1,4 +1,4 @@-sccfoo = {-# SCC foo #-} 1+sccfoo = {-# SCC "foo" #-} 1  sccbar =   {-# SCC "barbaz" #-}

@@ -0,0 +1,21 @@+vshow :: forall a -> (Show a) => a -> String+vshow t x = show (x :: t)++s1 = vshow Int 42++s2 = vshow Double 42++a1 = f (type (Int -> Bool))++a2 = f (type ((Read T) => T))++a3 = f (type (forall a. a))++a4 = f (type (forall a. (Read a) => String -> a))++foo =+  f+    ( type ( Maybe+               Int+           )+    )

@@ -0,0 +1,13 @@+vshow :: forall a -> Show a => a -> String+vshow t x = show (x :: t)++s1 = vshow Int    42+s2 = vshow Double 42++a1 = f (type (Int -> Bool))+a2 = f (type (Read T => T))+a3 = f (type (forall a. a))+a4 = f (type (forall a. Read a => String -> a))++foo = f (type (Maybe+            Int))

@@ -0,0 +1,9 @@+id :: forall a. a -> a+id @t x = x :: t++f1 :: forall a. a -> forall b. b -> (a, b)+f1 @a x @b y = (x :: a, y :: b)++f2 =+  (\ @a x @b y -> (x :: a, y :: b)) ::+    forall a. a -> forall b. b -> (a, b)

@@ -0,0 +1,8 @@+id :: forall a. a -> a+id @t x = x :: t++f1 :: forall a. a -> forall b. b -> (a, b)+f1 @a x @b y = (x :: a, y :: b)++f2 = (\ @a x @b y -> (x :: a, y :: b) )+    :: forall a. a -> forall b. b -> (a, b)

@@ -7,3 +7,12 @@   #-} test :: IO () test = pure ()++instance+  {-# WARNING "Don't use" #-}+  Show G1 where+  show = "G1"++deriving instance+    {-# WARNING "to be removed" #-}+  Eq G2

@@ -2,3 +2,11 @@   foo ["These are bad functions", "Really bad!"] #-} test :: IO () test = pure ()++instance+  {-# WARNING "Don't use" #-}+  Show G1 where+  show = "G1"++deriving instance+  {-# WARNING "to be removed" #-} Eq G2

@@ -6,11 +6,19 @@ bar = 3 {-# DEPRECATED bar "Bar is deprecated" #-} -{-# DEPRECATED baz "Baz is also deprecated" #-}+{-# DEPRECATED data baz "Baz is also deprecated" #-} baz = 5  data Number = Number Dobule-{-# DEPRECATED Number "Use Scientific instead." #-}+{-# DEPRECATED type Number "Use Scientific instead." #-}  head (a : _) = a {-# WARNING in "x-partial" head "This function is partial..." #-}++instance {-# DEPRECATED "Don't use" #-} Show T1++instance {-# WARNING "Don't use either" #-} Show G1++deriving instance {-# DEPRECATED "to be removed" #-} Eq T2++deriving instance {-# WARNING "to be removed as well" #-} Eq G2

@@ -8,11 +8,17 @@  {-# Deprecated bar "Bar is deprecated" #-} -{-# DEPRECATED baz "Baz is also deprecated" #-}+{-# DEPRECATED data baz "Baz is also deprecated" #-} baz = 5  data Number = Number Dobule-{-# DEPRECATED Number "Use Scientific instead." #-}+{-# DEPRECATED type Number "Use Scientific instead." #-}  head (a:_) = a {-# WARNING in "x-partial" head "This function is partial..." #-}++instance {-# DEPRECATED "Don't use" #-}     Show T1 where+instance {-# WARNING "Don't use either" #-} Show G1 where++deriving instance {-# DEPRECATED "to be removed" #-}      Eq T2+deriving instance {-# WARNING "to be removed as well" #-} Eq G2

@@ -0,0 +1,12 @@+module Test+  ( since1, -- ^ @since 1.0+    since2, -- ^ @since 2.0+    since3, -- ^ @since 3.0+    SinceType (..), -- ^ @since 4.0+    SinceClass (..), -- ^ @since 5.0+    Multi (..),+    -- ^ since 6.0+    -- multi+    -- line+  )+where

@@ -0,0 +1,11 @@+module Test (+        since1, -- ^ @since 1.0+        since2  -- ^ @since 2.0+      , since3  -- ^ @since 3.0+      , SinceType(..) -- ^ @since 4.0+      , SinceClass(..) -- ^ @since 5.0+      , Multi(..)+        -- ^ since 6.0+        -- multi+        -- line+      ) where

binary file changed (952236 → 989821 bytes)

@@ -1,10 +1,10 @@ cabal-version:      2.4 name:               ormolu-version:            0.7.4.0+version:            0.7.5.0 license:            BSD-3-Clause license-file:       LICENSE.md maintainer:         Mark Karpov <mark.karpov@tweag.io>-tested-with:        ghc ==9.4.7 ghc ==9.6.3 ghc ==9.8.1+tested-with:        ghc ==9.6.5 ghc ==9.8.2 ghc ==9.10.1 homepage:           https://github.com/tweag/ormolu bug-reports:        https://github.com/tweag/ormolu/issues synopsis:           A formatter for Haskell source code@@ -97,10 +97,10 @@     other-modules:    GHC.DynFlags     default-language: GHC2021     build-depends:-        Cabal-syntax >=3.10 && <3.11,+        Cabal-syntax >=3.12 && <3.13,         Diff >=0.4 && <1,         MemoTrie >=0.6 && <0.7,-        ansi-terminal >=0.10 && <1.1,+        ansi-terminal >=0.10 && <1.2,         array >=0.5 && <0.6,         base >=4.14 && <5,         binary >=0.8 && <0.9,@@ -109,12 +109,12 @@         deepseq >=1.4 && <1.6,         directory ^>=1.3,         file-embed >=0.0.15 && <0.1,-        filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.8 && <9.9,+        filepath >=1.2 && <1.6,+        ghc-lib-parser >=9.10 && <9.11,         megaparsec >=9,         mtl >=2 && <3,         syb >=0.7 && <0.8,-        text >=2 && <3+        text >=2.1 && <3      if flag(dev)         ghc-options:@@ -134,15 +134,15 @@     autogen-modules:  Paths_ormolu     default-language: GHC2021     build-depends:-        Cabal-syntax >=3.10 && <3.11,+        Cabal-syntax >=3.12 && <3.13,         base >=4.12 && <5,-        containers >=0.5 && <0.7,+        containers >=0.5 && <0.8,         directory ^>=1.3,-        filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.8 && <9.9,+        filepath >=1.2 && <1.6,+        ghc-lib-parser >=9.10 && <9.11,         optparse-applicative >=0.14 && <0.19,         ormolu,-        text >=2 && <3,+        text >=2.1 && <3,         th-env >=0.1.1 && <0.2      if flag(dev)@@ -172,13 +172,13 @@      default-language:   GHC2021     build-depends:-        Cabal-syntax >=3.10 && <3.11,+        Cabal-syntax >=3.12 && <3.13,         QuickCheck >=2.14,         base >=4.14 && <5,-        containers >=0.5 && <0.7,+        containers >=0.5 && <0.8,         directory ^>=1.3,-        filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.8 && <9.9,+        filepath >=1.2 && <1.6,+        ghc-lib-parser >=9.10 && <9.11,         hspec >=2 && <3,         hspec-megaparsec >=2.2,         megaparsec >=9,@@ -186,7 +186,7 @@         path >=0.6 && <0.10,         path-io >=1.4.2 && <2,         temporary ^>=1.3,-        text >=2 && <3+        text >=2.1 && <3      if flag(dev)         ghc-options:

@@ -45,6 +45,7 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T+import Data.Text.IO.Utf8 qualified as T.Utf8 import Debug.Trace import GHC.Driver.Errors.Types import GHC.Types.Error@@ -62,7 +63,6 @@ import Ormolu.Utils (showOutputable) import Ormolu.Utils.Cabal qualified as CabalUtils import Ormolu.Utils.Fixity (getDotOrmoluForSourceFile)-import Ormolu.Utils.IO import System.FilePath  -- | Format a 'Text'.@@ -159,7 +159,7 @@   -- | Resulting rendition   m Text ormoluFile cfg path =-  readFileUtf8 path >>= ormolu cfg path+  liftIO (T.Utf8.readFile path) >>= ormolu cfg path  -- | Read input from stdin and format it. --@@ -173,7 +173,7 @@   -- | Resulting rendition   m Text ormoluStdin cfg =-  getContentsUtf8 >>= ormolu cfg "<stdin>"+  liftIO T.Utf8.getContents >>= ormolu cfg "<stdin>"  -- | Refine a 'Config' by incorporating given 'SourceType', 'CabalInfo', and -- fixity overrides 'FixityMap'. You can use 'detectSourceType' to deduce

@@ -93,17 +93,20 @@                   `extQ` considerEqual @SourceText                   `extQ` hsDocStringEq                   `extQ` importDeclQualifiedStyleEq-                  `extQ` considerEqual @(LayoutInfo GhcPs)                   `extQ` classDeclCtxEq                   `extQ` derivedTyClsParensEq                   `extQ` considerEqual @EpAnnComments -- ~ XCGRHSs GhcPs                   `extQ` considerEqual @TokenLocation -- in LHs(Uni)Token                   `extQ` considerEqual @EpaLocation+                  `extQ` considerEqual @EpLayout+                  `extQ` considerEqual @[AddEpAnn]+                  `extQ` considerEqual @AnnSig+                  `extQ` considerEqual @HsRuleAnn                   `ext2Q` forLocated                   -- unicode-related-                  `extQ` considerEqual @(HsUniToken "->" "→")-                  `extQ` considerEqual @(HsUniToken "::" "∷")-                  `extQ` considerEqual @(HsLinearArrowTokens GhcPs)+                  `extQ` considerEqual @(EpUniToken "->" "→")+                  `extQ` considerEqual @(EpUniToken "::" "∷")+                  `extQ` considerEqual @EpLinearArrow               )               x               y@@ -141,7 +144,10 @@       GenLocated e0 e1 ->       GenericQ ParseResultDiff     forLocated x@(L mspn _) y =-      maybe id appendSpan (cast `ext1Q` (Just . locA) $ mspn) (genericQuery x y)+      maybe id appendSpan (cast `ext1Q` (Just . epAnnLoc) $ mspn) (genericQuery x y)+      where+        epAnnLoc :: EpAnn ann -> SrcSpan+        epAnnLoc = locA     appendSpan :: SrcSpan -> ParseResultDiff -> ParseResultDiff     appendSpan s' d@(Different ss) =       case s' of

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QualifiedDo #-}@@ -17,13 +18,15 @@ import Data.Foldable (for_) import Data.IntSet (IntSet) import Data.IntSet qualified as IntSet-import Data.List (foldl') import Data.Maybe (listToMaybe) import Data.Text (Text) import Data.Text qualified as T 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

@@ -69,10 +69,10 @@  ieToOccNames :: IE GhcPs -> [OccName] ieToOccNames = \case-  IEVar _ (L _ x) -> [occName x]-  IEThingAbs _ (L _ x) -> [occName x]-  IEThingAll _ (L _ x) -> [occName x] -- TODO not quite correct, but how to do better?-  IEThingWith _ (L _ x) _ xs -> occName x : fmap (occName . unLoc) xs+  IEVar _ (L _ x) _ -> [occName x]+  IEThingAbs _ (L _ x) _ -> [occName x]+  IEThingAll _ (L _ x) _ -> [occName x] -- TODO not quite correct, but how to do better?+  IEThingWith _ (L _ x) _ xs _ -> occName x : fmap (occName . unLoc) xs   _ -> []  -- | Apply given module re-exports.

@@ -45,6 +45,17 @@  type Parser = Parsec Void Text +-- TODO Support fixity namespacing?+-- https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0065-type-infix.rst+--+-- Note that currently, our fixity machinery does *not* do any namespacing:+--+--  - https://github.com/tweag/ormolu/pull/994#pullrequestreview-1396958951+--    brought this up in the past+--+--  - https://github.com/tweag/ormolu/pull/1029#issue-1718217029+--    has a concrete example (morley-prelude) where namespacing would matter+ -- | Parse textual representation of 'FixityOverrides'. parseDotOrmolu ::   -- | Location of the file we are parsing (only for parse errors)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}@@ -13,7 +14,7 @@ import Data.Bifunctor import Data.Char (isAlphaNum) import Data.Function (on)-import Data.List (foldl', nubBy, sortBy, sortOn)+import Data.List (nubBy, sortBy, sortOn) import Data.Map.Strict (Map) import Data.Map.Strict qualified as M import GHC.Data.FastString@@ -24,6 +25,9 @@ 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]@@ -138,33 +142,34 @@           alter = \case             Nothing -> Just . L new_l $               case new of-                IEThingWith _ n wildcard g ->-                  IEThingWith (Nothing, EpAnnNotUsed) n wildcard (normalizeWNames g)+                IEThingWith x n wildcard g _ ->+                  IEThingWith x n wildcard (normalizeWNames g) Nothing                 other -> other             Just old ->               let f = \case-                    IEVar _ n -> IEVar Nothing n-                    IEThingAbs _ _ -> new-                    IEThingAll _ n -> IEThingAll (Nothing, EpAnnNotUsed) n-                    IEThingWith _ n wildcard g ->+                    IEVar _ n _ -> IEVar Nothing n Nothing+                    IEThingAbs _ _ _ -> new+                    IEThingAll x n _ -> IEThingAll x n Nothing+                    IEThingWith _ n wildcard g _ ->                       case new of-                        IEVar _ _ ->+                        IEVar _ _ _ ->                           error "Ormolu.Imports broken presupposition"-                        IEThingAbs _ _ ->-                          IEThingWith (Nothing, EpAnnNotUsed) n wildcard g-                        IEThingAll _ n' ->-                          IEThingAll (Nothing, EpAnnNotUsed) n'-                        IEThingWith _ n' wildcard' g' ->+                        IEThingAbs x _ _ ->+                          IEThingWith x n wildcard g Nothing+                        IEThingAll x n' _ ->+                          IEThingAll x n' Nothing+                        IEThingWith x n' wildcard' g' _ ->                           let combinedWildcard =                                 case (wildcard, wildcard') of                                   (IEWildcard _, _) -> IEWildcard 0                                   (_, IEWildcard _) -> IEWildcard 0                                   _ -> NoIEWildcard                            in IEThingWith-                                (Nothing, EpAnnNotUsed)+                                x                                 n'                                 combinedWildcard                                 (normalizeWNames (g <> g'))+                                Nothing                         IEModuleContents _ _ -> notImplemented "IEModuleContents"                         IEGroup NoExtField _ _ -> notImplemented "IEGroup"                         IEDoc NoExtField _ -> notImplemented "IEDoc"@@ -187,10 +192,10 @@ -- | Project @'IEWrappedName' 'GhcPs'@ from @'IE' 'GhcPs'@. getIewn :: IE GhcPs -> IEWrappedNameOrd getIewn = \case-  IEVar _ x -> IEWrappedNameOrd (unLoc x)-  IEThingAbs _ x -> IEWrappedNameOrd (unLoc x)-  IEThingAll _ x -> IEWrappedNameOrd (unLoc x)-  IEThingWith _ x _ _ -> IEWrappedNameOrd (unLoc x)+  IEVar _ x _ -> IEWrappedNameOrd (unLoc x)+  IEThingAbs _ x _ -> IEWrappedNameOrd (unLoc x)+  IEThingAll _ x _ -> IEWrappedNameOrd (unLoc x)+  IEThingWith _ x _ _ _ -> IEWrappedNameOrd (unLoc x)   IEModuleContents _ _ -> notImplemented "IEModuleContents"   IEGroup NoExtField _ _ -> notImplemented "IEGroup"   IEDoc NoExtField _ -> notImplemented "IEDoc"

@@ -212,7 +212,7 @@     patchContext :: LHsContext GhcPs -> LHsContext GhcPs     patchContext = fmap $ \case       [x@(L _ (HsParTy _ _))] -> [x]-      [x@(L lx _)] -> [L lx (HsParTy EpAnnNotUsed x)]+      [x@(L lx _)] -> [L lx (HsParTy noAnn x)]       xs -> xs  -- | Enable all language extensions that we think should be enabled by

@@ -223,7 +223,7 @@  -- | Extract @'RealLocated' 'Text'@ from 'GHC.LEpaComment'. unAnnotationComment :: GHC.LEpaComment -> Maybe (RealLocated Text)-unAnnotationComment (L (GHC.Anchor anchor _) (GHC.EpaComment eck _)) =+unAnnotationComment (L epaLoc (GHC.EpaComment eck _)) =   case eck of     GHC.EpaDocComment s ->       let trigger = case s of@@ -239,9 +239,10 @@         "---" -> s         _ -> insertAt " " s 3     GHC.EpaBlockComment s -> mkL (T.pack s)-    GHC.EpaEofComment -> Nothing   where-    mkL = Just . L anchor+    mkL = case epaLoc of+      GHC.EpaSpan (RealSrcSpan s _) -> Just . L s+      _ -> const Nothing     insertAt x xs n = T.take (n - 1) xs <> x <> T.drop (n - 1) xs     haddock mtrigger =       mkL . dashPrefix . escapeHaddockTriggers . (trigger <>) <=< dropBlank

@@ -11,6 +11,7 @@     runR,     getEnclosingSpan,     getEnclosingSpanWhere,+    getEnclosingComments,     isExtensionEnabled,      -- * Combinators@@ -76,10 +77,10 @@ import Data.List (intersperse) import Data.Text (Text) import GHC.Data.Strict qualified as Strict+import GHC.Parser.Annotation import GHC.Types.SrcLoc import Ormolu.Printer.Comments import Ormolu.Printer.Internal-import Ormolu.Utils (HasSrcSpan (..), getLoc')  ---------------------------------------------------------------------------- -- Basic@@ -99,13 +100,13 @@ -- 'Located' wrapper, it should be “discharged” with a corresponding -- 'located' invocation. located ::-  (HasSrcSpan l) =>+  (HasLoc l) =>   -- | Thing to enter   GenLocated l a ->   -- | How to render inner value   (a -> R ()) ->   R ()-located (L l' a) f = case loc' l' of+located (L l' a) f = case locA l' of   UnhelpfulSpan _ -> f a   RealSrcSpan l _ -> do     spitPrecedingComments l@@ -117,7 +118,7 @@ -- virtual elements at the start and end of the source span to prevent comments -- from "floating out". encloseLocated ::-  (HasSrcSpan l) =>+  (HasLoc l) =>   GenLocated l [a] ->   ([a] -> R ()) ->   R ()@@ -126,13 +127,13 @@   f a   when (null a) $ located (L endSpan ()) pure   where-    l = getLoc' la+    l = locA la     (startLoc, endLoc) = (srcSpanStart l, srcSpanEnd l)     (startSpan, endSpan) = (mkSrcSpan startLoc startLoc, mkSrcSpan endLoc endLoc)  -- | A version of 'located' with arguments flipped. located' ::-  (HasSrcSpan l) =>+  (HasLoc l) =>   -- | How to render inner value   (a -> R ()) ->   -- | Thing to enter

@@ -37,6 +37,7 @@     trimSpanStream,     nextEltSpan,     popComment,+    getEnclosingComments,     getEnclosingSpan,     getEnclosingSpanWhere,     withEnclosingSpan,@@ -59,6 +60,7 @@ import Control.Monad.State.Strict import Data.Bool (bool) import Data.Coerce+import Data.Functor ((<&>)) import Data.List (find) import Data.Maybe (listToMaybe) import Data.Text (Text)@@ -499,6 +501,16 @@       modify $ \sc -> sc {scCommentStream = CommentStream xs}       return $ Just x     _ -> return Nothing++-- | Get the comments contained in the enclosing span.+getEnclosingComments :: R [LComment]+getEnclosingComments = do+  isEnclosed <-+    getEnclosingSpan <&> \case+      Just enclSpan -> containsSpan enclSpan+      Nothing -> const False+  CommentStream cstream <- R $ gets scCommentStream+  pure $ takeWhile (isEnclosed . getLoc) cstream  -- | Get the immediately enclosing 'RealSrcSpan'. getEnclosingSpan :: R (Maybe RealSrcSpan)

@@ -13,12 +13,14 @@     p_hsDoc,     p_hsDocName,     p_sourceText,+    p_namespaceSpec,   ) where  import Control.Monad import Data.Text qualified as T import GHC.Data.FastString+import GHC.Hs.Binds import GHC.Hs.Doc import GHC.Hs.Extension (GhcPs) import GHC.Hs.ImpExp@@ -66,18 +68,16 @@ p_rdrName :: LocatedN RdrName -> R () p_rdrName l = located l $ \x -> do   unboxedSums <- isExtensionEnabled UnboxedSums-  let wrapper = \case-        EpAnn {anns} -> case anns of-          NameAnnQuote {nann_quoted} -> tickPrefix . wrapper (ann nann_quoted)-          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-        EpAnnNotUsed -> id+  let wrapper EpAnn {anns} = case anns of+        NameAnnQuote {nann_quoted} -> tickPrefix . wrapper nann_quoted+        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        -- When UnboxedSums is enabled, `(#` is a single lexeme, so we have to       -- insert spaces when we have a parenthesized operator starting with `#`.@@ -88,7 +88,7 @@             \y -> space *> y <* space         | otherwise = id -  wrapper (ann . getLoc $ l) $ case x of+  wrapper (getLoc l) $ case x of     Unqual occName ->       atom occName     Qual mname occName ->@@ -192,3 +192,9 @@ p_sourceText = \case   NoSourceText -> pure ()   SourceText s -> atom @FastString s++p_namespaceSpec :: NamespaceSpecifier -> R ()+p_namespaceSpec = \case+  NoNamespaceSpecifier -> pure ()+  TypeNamespaceSpecifier _ -> txt "type" *> space+  DataNamespaceSpecifier _ -> txt "data" *> space

@@ -260,7 +260,7 @@ pattern AnnValuePragma n <- AnnD _ (HsAnnotation _ (ValueAnnProvenance (L _ n)) _) pattern Pattern n <- ValD _ (PatSynBind _ (PSB _ (L _ n) _ _ _)) pattern DataDeclaration n <- TyClD _ (DataDecl _ (L _ n) _ _ _)-pattern ClassDeclaration n <- TyClD _ (ClassDecl _ _ _ (L _ n) _ _ _ _ _ _ _ _)+pattern ClassDeclaration n <- TyClD _ (ClassDecl _ _ (L _ n) _ _ _ _ _ _ _ _) pattern KindSignature n <- KindSigD _ (StandaloneKindSig _ (L _ n) _) pattern FamilyDeclaration n <- TyClD _ (FamDecl _ (FamilyDecl _ _ _ (L _ n) _ _ _ _)) pattern TypeSynonym n <- TyClD _ (SynDecl _ (L _ n) _ _ _)@@ -296,7 +296,7 @@  funRdrNames :: HsDecl GhcPs -> Maybe [RdrName] funRdrNames (ValD _ (FunBind _ (L _ n) _)) = Just [n]-funRdrNames (ValD _ (PatBind _ (L _ n) _)) = Just $ patBindNames n+funRdrNames (ValD _ (PatBind _ (L _ n) _ _)) = Just $ patBindNames n funRdrNames _ = Nothing  patSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]@@ -315,9 +315,9 @@ patBindNames (WildPat _) = [] patBindNames (LazyPat _ (L _ p)) = patBindNames p patBindNames (BangPat _ (L _ p)) = patBindNames p-patBindNames (ParPat _ _ (L _ p) _) = patBindNames p+patBindNames (ParPat _ (L _ p)) = patBindNames p patBindNames (ListPat _ ps) = concatMap (patBindNames . unLoc) ps-patBindNames (AsPat _ (L _ n) _ (L _ p)) = n : patBindNames p+patBindNames (AsPat _ (L _ n) (L _ p)) = n : patBindNames p patBindNames (SumPat _ (L _ p) _ _) = patBindNames p patBindNames (ViewPat _ _ (L _ p)) = patBindNames p patBindNames (SplicePat _ _) = []@@ -326,3 +326,5 @@ patBindNames (NPat _ _ _ _) = [] patBindNames (NPlusKPat _ (L _ n) _ _ _ _) = [n] patBindNames (ConPat _ _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d)+patBindNames (EmbTyPat _ _) = []+patBindNames (InvisPat _ _) = []

@@ -13,7 +13,7 @@ import Control.Monad import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE-import Data.Maybe (isJust, maybeToList)+import Data.Maybe (isJust, mapMaybe, maybeToList) import Data.Void import GHC.Data.Strict qualified as Strict import GHC.Hs@@ -139,8 +139,8 @@             <> conArgsSpans           where             conArgsSpans = case con_g_args of-              PrefixConGADT xs -> getLocA . hsScaledThing <$> xs-              RecConGADT x _ -> [getLocA x]+              PrefixConGADT NoExtField xs -> getLocA . hsScaledThing <$> xs+              RecConGADT _ x -> [getLocA x]     switchLayout conDeclSpn $ do       let c :| cs = con_names       p_rdrName c@@ -149,23 +149,24 @@         sep commaDel p_rdrName cs       inci $ do         let conTy = case con_g_args of-              PrefixConGADT xs ->-                let go (HsScaled a b) t = addCLocAA t b (HsFunTy EpAnnNotUsed a b t)+              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 _ ->-                addCLocAA r con_res_ty $+              RecConGADT _ r ->+                addCLocA r con_res_ty $                   HsFunTy-                    EpAnnNotUsed-                    (HsUnrestrictedArrow noHsUniTok)-                    (la2la $ HsRecTy EpAnnNotUsed <$> r)+                    NoExtField+                    (HsUnrestrictedArrow noAnn)+                    (la2la $ HsRecTy noAnn <$> r)                     con_res_ty             qualTy = case con_mb_cxt of               Nothing -> conTy               Just qs ->-                addCLocAA qs conTy $+                addCLocA qs conTy $                   HsQualTy NoExtField qs conTy+            quantifiedTy :: LHsType GhcPs             quantifiedTy =-              addCLocAA con_bndrs qualTy $+              addCLocA con_bndrs qualTy $                 hsOuterTyVarBndrsToHsType (unLoc con_bndrs) qualTy         space         txt "::"@@ -178,7 +179,8 @@     let conNameSpn = getLocA con_name         conNameWithContextSpn =           [ RealSrcSpan real Strict.Nothing-            | Just (EpaSpan real _) <- matchAddEpAnn AnnForall <$> epAnnAnns con_ext+            | EpaSpan (RealSrcSpan real _) <-+                mapMaybe (matchAddEpAnn AnnForall) con_ext           ]             <> fmap getLocA con_ex_tvs             <> maybeToList (fmap getLocA con_mb_cxt)

@@ -55,7 +55,7 @@   space   located cCallConv atom   -- Need to check for 'noLoc' for the 'safe' annotation-  when (isGoodSrcSpan $ getLoc safety) (space >> atom safety)+  when (isGoodSrcSpan $ getLocA safety) (space >> atom safety)   space   located sourceText p_sourceText 

@@ -15,6 +15,7 @@ import Data.Foldable import Data.Function (on) import Data.List (sortBy)+import Data.Maybe (maybeToList) import GHC.Hs import GHC.Types.Basic import GHC.Types.SrcLoc@@ -23,13 +24,17 @@ import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration import Ormolu.Printer.Meat.Declaration.Data import Ormolu.Printer.Meat.Declaration.TypeFamily+import Ormolu.Printer.Meat.Declaration.Warning import Ormolu.Printer.Meat.Type  p_standaloneDerivDecl :: DerivDecl GhcPs -> R ()-p_standaloneDerivDecl DerivDecl {..} = do+p_standaloneDerivDecl DerivDecl {deriv_ext = (mWarnTxt, _), ..} = do   let typesAfterInstance = located (hswc_body deriv_type) p_hsSigType       instTypes toIndent = inci $ do         txt "instance"+        for_ mWarnTxt $ \warnTxt -> do+          breakpoint+          located warnTxt p_warningTxt         breakpoint         match_overlap_mode deriv_overlap_mode breakpoint         inciIf toIndent typesAfterInstance@@ -56,7 +61,7 @@         instTypes True  p_clsInstDecl :: ClsInstDecl GhcPs -> R ()-p_clsInstDecl ClsInstDecl {..} = do+p_clsInstDecl ClsInstDecl {cid_ext = (mWarnTxt, _, _), ..} = do   txt "instance"   -- GHC's AST does not necessarily store each kind of element in source   -- location order. This happens because different declarations are stored in@@ -74,9 +79,12 @@           <$> cid_datafam_insts       allDecls =         snd <$> sortBy (leftmost_smallest `on` fst) (sigs <> vals <> tyFamInsts <> dataFamInsts)-  located cid_poly_ty $ \sigTy -> do+  switchLayout (maybeToList (getLocA <$> mWarnTxt) <> [getLocA cid_poly_ty]) $ do+    for_ mWarnTxt $ \warnTxt -> do+      breakpoint+      located warnTxt p_warningTxt     breakpoint-    inci $ do+    located cid_poly_ty $ \sigTy -> inci $ do       match_overlap_mode cid_overlap_mode breakpoint       p_hsSigType sigTy       unless (null allDecls) $ do

@@ -34,7 +34,6 @@   ) import Ormolu.Printer.Meat.Type (p_hsType) import Ormolu.Printer.Operators-import Ormolu.Utils (HasSrcSpan)  -- | Extract the operator name of the specified 'HsExpr' if this expression -- corresponds to an operator.@@ -49,7 +48,7 @@  -- | Decide if the operands of an operator chain should be hanging. opBranchPlacement ::-  (HasSrcSpan l) =>+  (HasLoc l) =>   -- | Placer function for nodes   (ty -> Placement) ->   -- | first expression of the chain

@@ -93,7 +93,7 @@   FixitySig GhcPs ->   R () p_fixSig = \case-  FixitySig NoExtField names (Fixity _ n dir) -> do+  FixitySig namespace names (Fixity _ n dir) -> do     txt $ case dir of       InfixL -> "infixl"       InfixR -> "infixr"@@ -101,6 +101,7 @@     space     atom n     space+    p_namespaceSpec namespace     sitcc $ sep commaDel p_rdrName names  p_inlineSig ::@@ -198,12 +199,12 @@  p_completeSig ::   -- | Constructors\/patterns-  Located [LocatedN RdrName] ->+  [LIdP GhcPs] ->   -- | Type   Maybe (LocatedN RdrName) ->   R ()-p_completeSig cs' mty =-  located cs' $ \cs ->+p_completeSig cs mty =+  switchLayout (getLocA <$> cs) $     pragma "COMPLETE" . inci $ do       sep commaDel p_rdrName cs       forM_ mty $ \ty -> do

@@ -69,7 +69,8 @@ p_valDecl :: HsBind GhcPs -> R () p_valDecl = \case   FunBind _ funId funMatches -> p_funBind funId funMatches-  PatBind _ pat grhss -> p_match PatternBind False NoSrcStrict [pat] grhss+  PatBind _ pat multAnn grhss ->+    p_match PatternBind False multAnn NoSrcStrict [pat] grhss   VarBind {} -> notImplemented "VarBinds" -- introduced by the type checker   PatSynBind _ psb -> p_patSynBind psb @@ -86,7 +87,7 @@ p_matchGroup = p_matchGroup' exprPlacement p_hsExpr  p_matchGroup' ::-  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,+  ( Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,     Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA   ) =>   -- | How to get body placement@@ -116,6 +117,7 @@         render         (adjustMatchGroupStyle m style)         (isInfixMatch m)+        (HsNoMultAnn NoExtField)         (matchStrictness m)         m_pats         m_grhss@@ -145,6 +147,8 @@   MatchGroupStyle ->   -- | Is this an infix match?   Bool ->+  -- | Multiplicity annotation+  HsMultAnn GhcPs ->   -- | Strictness prefix (FunBind)   SrcStrictness ->   -- | Argument patterns@@ -155,7 +159,7 @@ p_match = p_match' exprPlacement p_hsExpr  p_match' ::-  (Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns) =>+  (Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO) =>   -- | How to get body placement   (body -> Placement) ->   -- | How to print body@@ -164,6 +168,8 @@   MatchGroupStyle ->   -- | Is this an infix match?   Bool ->+  -- | Multiplicity annotation+  HsMultAnn GhcPs ->   -- | Strictness prefix (FunBind)   SrcStrictness ->   -- | Argument patterns@@ -171,7 +177,7 @@   -- | Equations   GRHSs GhcPs (LocatedA body) ->   R ()-p_match' placer render style isInfix strictness m_pats GRHSs {..} = do+p_match' placer render style isInfix multAnn strictness m_pats GRHSs {..} = do   -- Normally, since patterns may be placed in a multi-line layout, it is   -- necessary to bump indentation for the pattern group so it's more   -- indented than function name. This in turn means that indentation for@@ -179,6 +185,13 @@   -- 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.+  case multAnn of+    HsNoMultAnn NoExtField -> pure ()+    HsPct1Ann _ -> txt "%1" *> space+    HsMultAnn _ ty -> do+      txt "%"+      located ty p_hsType+      space   case strictness of     NoSrcStrict -> return ()     SrcStrict -> txt "!"@@ -210,6 +223,7 @@                   LazyPat _ _ -> True                   BangPat _ _ -> True                   SplicePat _ _ -> True+                  InvisPat _ _ -> True                   _ -> False             txt "\\"             when needsSpace space@@ -358,15 +372,13 @@     located cmd (p_hsCmd' Applicand s)     breakpoint     inci $ located expr p_hsExpr-  HsCmdLam _ mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup-  HsCmdPar _ _ c _ -> parens N (located c p_hsCmd)+  HsCmdLam _ variant mgroup -> p_lam isApp variant cmdPlacement p_hsCmd mgroup+  HsCmdPar _ c -> parens N (located c p_hsCmd)   HsCmdCase _ e mgroup ->     p_case isApp cmdPlacement p_hsCmd e mgroup-  HsCmdLamCase _ variant mgroup ->-    p_lamcase isApp variant cmdPlacement p_hsCmd mgroup   HsCmdIf anns _ if' then' else' ->     p_if cmdPlacement p_hsCmd anns if' then' else'-  HsCmdLet _ _ localBinds _ c ->+  HsCmdLet _ localBinds c ->     p_let p_hsCmd localBinds c   HsCmdDo _ es -> do     txt "do"@@ -551,11 +563,10 @@     -- of p_hsLocalBinds). Hence, we introduce a manual Located as we     -- depend on the layout being correctly set.     pseudoLocated = \case-      EpAnn {anns = AnnList {al_anchor = Just Anchor {anchor}}}-        | let sp = RealSrcSpan anchor Strict.Nothing,-          -- excluding cases where there are no bindings-          not $ isZeroWidthSpan sp ->-            located (L sp ()) . const+      EpAnn {anns = AnnList {al_anchor}}+        | -- excluding cases where there are no bindings+          not $ isZeroWidthSpan (locA al_anchor) ->+            located (L al_anchor ()) . const       _ -> id  p_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()@@ -569,7 +580,7 @@ p_fieldOcc FieldOcc {..} = p_rdrName foLabel  p_hsFieldBind ::-  (lhs ~ GenLocated l a, HasSrcSpan l) =>+  (lhs ~ GenLocated l a, HasLoc l) =>   (lhs -> R ()) ->   HsFieldBind lhs (LHsExpr GhcPs) ->   R ()@@ -579,7 +590,7 @@     space     equals     let placement =-          if onTheSameLine (getLoc' hfbLHS) (getLocA hfbRHS)+          if onTheSameLine (getLocA hfbLHS) (getLocA hfbRHS)             then exprPlacement (unLoc hfbRHS)             else Normal     placeHanging placement (located hfbRHS p_hsExpr)@@ -618,10 +629,8 @@       HsString (SourceText stxt) _ -> p_stringLit stxt       HsStringPrim (SourceText stxt) _ -> p_stringLit stxt       r -> atom r-  HsLam _ mgroup ->-    p_matchGroup Lambda mgroup-  HsLamCase _ variant mgroup ->-    p_lamcase isApp variant exprPlacement p_hsExpr mgroup+  HsLam _ variant mgroup ->+    p_lam isApp variant exprPlacement p_hsExpr mgroup   HsApp _ f x -> do     let -- In order to format function applications with multiple parameters         -- nicer, traverse the AST to gather the function and all the@@ -667,7 +676,7 @@           sep breakpoint (located' p_hsExpr) initp         placeHanging placement $           located lastp p_hsExpr-  HsAppType _ e _ a -> do+  HsAppType _ e a -> do     located e p_hsExpr     breakpoint     inci $ do@@ -696,7 +705,7 @@     -- negated literals, as `- 1` and `-1` have differing AST.     when (negativeLiterals && isLiteral) space     located e p_hsExpr-  HsPar _ _ e _ ->+  HsPar _ e ->     parens s (located e (dontUseBraces . p_hsExpr))   SectionL _ x op -> do     located x p_hsExpr@@ -739,7 +748,7 @@     txt "if"     breakpoint     inciApplicand isApp $ sep newline (located' (p_grhs RightArrow)) guards-  HsLet _ _ localBinds _ e ->+  HsLet _ localBinds e ->     p_let p_hsExpr localBinds e   HsDo _ doFlavor es -> do     let doBody moduleName header = do@@ -840,7 +849,7 @@     located expr p_hsExpr     breakpoint'     txt "||]"-  HsUntypedBracket epAnn x -> p_hsQuote epAnn x+  HsUntypedBracket anns x -> p_hsQuote anns x   HsTypedSplice _ expr -> p_hsSpliceTH True expr DollarSplice   HsUntypedSplice _ untySplice -> p_hsUntypedSplice DollarSplice untySplice   HsProc _ p e -> do@@ -864,6 +873,10 @@       breakpoint       let inciIfS = case s of N -> id; S -> inci       inciIfS $ located x p_hsExpr+  HsEmbTy _ HsWC {hswc_body} -> do+    txt "type"+    space+    located hswc_body p_hsType  p_patSynBind :: PatSynBind GhcPs GhcPs -> R () p_patSynBind PSB {..} = do@@ -925,7 +938,7 @@       inci (rhs conSpans)  p_case ::-  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,+  ( Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,     Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA   ) =>   IsApplicand ->@@ -947,13 +960,13 @@   breakpoint   inciApplicand isApp (p_matchGroup' placer render Case mgroup) -p_lamcase ::-  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,+p_lam ::+  ( Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,     Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA   ) =>   IsApplicand ->-  -- | Variant (@\\case@ or @\\cases@)-  LamCaseVariant ->+  -- | Variant (@\\@ or @\\case@ or @\\cases@)+  HsLamVariant ->   -- | Placer   (body -> Placement) ->   -- | Render@@ -961,12 +974,19 @@   -- | Expression   MatchGroup GhcPs (LocatedA body) ->   R ()-p_lamcase isApp variant placer render mgroup = do-  txt $ case variant of-    LamCase -> "\\case"-    LamCases -> "\\cases"-  breakpoint-  inciApplicand isApp (p_matchGroup' placer render LambdaCase mgroup)+p_lam isApp variant placer render mgroup = do+  let mCaseTxt = case variant of+        LamSingle -> Nothing+        LamCase -> Just "\\case"+        LamCases -> Just "\\cases"+      mgs = if isJust mCaseTxt then LambdaCase else Lambda+      pMatchGroup = p_matchGroup' placer render mgs mgroup+  case mCaseTxt of+    Nothing -> pMatchGroup+    Just caseTxt -> do+      txt caseTxt+      breakpoint+      inciApplicand isApp pMatchGroup  p_if ::   -- | Placer@@ -974,7 +994,7 @@   -- | Render   (body -> R ()) ->   -- | Annotations-  EpAnn AnnsIf ->+  AnnsIf ->   -- | If   LHsExpr GhcPs ->   -- | Then@@ -982,11 +1002,30 @@   -- | Else   LocatedA body ->   R ()-p_if placer render epAnn if' then' else' = do+p_if placer render anns if' then' else' = do   txt "if"   space   located if' p_hsExpr   breakpoint+  commentSpans <- fmap getLoc <$> getEnclosingComments+  let (thenSpan, elseSpan) = (locA aiThen, locA aiElse)+        where+          AnnsIf {aiThen, aiElse} = anns++      locatedToken tokenSpan token =+        located (L tokenSpan ()) $ \_ -> txt token++      betweenSpans spanA spanB s = spanA < s && s < spanB++      placeHangingLocated tokenSpan bodyLoc@(L _ body) = do+        let bodySpan = getLocA bodyLoc+            hasComments = fromMaybe False $ do+              tokenRealSpan <- srcSpanToRealSrcSpan tokenSpan+              bodyRealSpan <- srcSpanToRealSrcSpan bodySpan+              pure $ any (betweenSpans tokenRealSpan bodyRealSpan) commentSpans+            placement = if hasComments then Normal else placer body+        switchLayout [tokenSpan, bodySpan] $+          placeHanging placement (located bodyLoc render)   inci $ do     locatedToken thenSpan "then"     space@@ -995,35 +1034,7 @@     locatedToken elseSpan "else"     space     placeHangingLocated elseSpan else'-  where-    (thenSpan, elseSpan, commentSpans) =-      case epAnn of-        EpAnn {anns = AnnsIf {aiThen, aiElse}, comments} ->-          ( loc' $ epaLocationRealSrcSpan aiThen,-            loc' $ epaLocationRealSrcSpan aiElse,-            map (anchor . getLoc) $-              case comments of-                EpaComments cs -> cs-                EpaCommentsBalanced pre post -> pre <> post-          )-        EpAnnNotUsed ->-          (noSrcSpan, noSrcSpan, []) -    locatedToken tokenSpan token =-      located (L tokenSpan ()) $ \_ -> txt token--    betweenSpans spanA spanB s = spanA < s && s < spanB--    placeHangingLocated tokenSpan bodyLoc@(L _ body) = do-      let bodySpan = getLoc' bodyLoc-          hasComments = fromMaybe False $ do-            tokenRealSpan <- srcSpanToRealSrcSpan tokenSpan-            bodyRealSpan <- srcSpanToRealSrcSpan bodySpan-            pure $ any (betweenSpans tokenRealSpan bodyRealSpan) commentSpans-          placement = if hasComments then Normal else placer body-      switchLayout [tokenSpan, bodySpan] $-        placeHanging placement (located bodyLoc render)- p_let ::   -- | Render   (body -> R ()) ->@@ -1046,11 +1057,11 @@   LazyPat _ pat -> do     txt "~"     located pat p_pat-  AsPat _ name _ pat -> do+  AsPat _ name pat -> do     p_rdrName name     txt "@"     located pat p_pat-  ParPat _ _ pat _ ->+  ParPat _ pat ->     located pat (parens S . p_pat)   BangPat _ pat -> do     txt "!"@@ -1115,12 +1126,17 @@   SigPat _ pat HsPS {..} -> do     located pat p_pat     p_typeAscription (lhsTypeToSigType hsps_body)+  EmbTyPat _ (HsTP _ ty) -> do+    txt "type"+    space+    located ty p_hsType+  InvisPat _ tyPat -> p_tyPat tyPat -p_hsPatSigType :: HsPatSigType GhcPs -> R ()-p_hsPatSigType (HsPS _ ty) = txt "@" *> located ty p_hsType+p_tyPat :: HsTyPat GhcPs -> R ()+p_tyPat (HsTP _ ty) = txt "@" *> located ty p_hsType  p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()-p_hsConPatTyArg (HsConPatTyArg _ patSigTy) = p_hsPatSigType patSigTy+p_hsConPatTyArg (HsConPatTyArg _ patSigTy) = p_tyPat patSigTy  p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R () p_pat_hsFieldBind HsFieldBind {..} = do@@ -1175,11 +1191,11 @@   where     decoSymbol = if isTyped then "$$" else "$" -p_hsQuote :: EpAnn [AddEpAnn] -> HsQuote GhcPs -> R ()-p_hsQuote epAnn = \case+p_hsQuote :: [AddEpAnn] -> HsQuote GhcPs -> R ()+p_hsQuote anns = \case   ExpBr _ expr -> do     let name-          | any isJust (matchAddEpAnn AnnOpenEQ <$> epAnnAnns epAnn) = ""+          | any (isJust . matchAddEpAnn AnnOpenEQ) anns = ""           | otherwise = "e"     quote name (located expr p_hsExpr)   PatBr _ pat -> located pat (quote "p" . p_pat)@@ -1288,10 +1304,9 @@ -- | Determine placement of a given command. cmdPlacement :: HsCmd GhcPs -> Placement cmdPlacement = \case-  HsCmdLam _ _ -> Hanging-  HsCmdCase _ _ _ -> Hanging-  HsCmdLamCase _ _ _ -> Hanging-  HsCmdDo _ _ -> Hanging+  HsCmdLam {} -> Hanging+  HsCmdCase {} -> Hanging+  HsCmdDo {} -> Hanging   _ -> Normal  -- | Determine placement of a top level command.@@ -1302,12 +1317,14 @@ exprPlacement :: HsExpr GhcPs -> Placement exprPlacement = \case   -- Only hang lambdas with single line parameter lists-  HsLam _ mg -> case mg of-    MG _ (L _ [L _ (Match _ _ (x : xs) _)])-      | isOneLineSpan (combineSrcSpans' $ fmap getLocA (x :| xs)) ->-          Hanging-    _ -> Normal-  HsLamCase _ _ _ -> Hanging+  HsLam _ variant mg -> case variant of+    LamSingle -> case mg of+      MG _ (L _ [L _ (Match _ _ (x : xs) _)])+        | isOneLineSpan (combineSrcSpans' $ fmap getLocA (x :| xs)) ->+            Hanging+      _ -> Normal+    LamCase -> Hanging+    LamCases -> Hanging   HsCase _ _ _ -> Hanging   HsDo _ (DoExpr _) _ -> Hanging   HsDo _ (MDoExpr _) _ -> Hanging

@@ -12,7 +12,6 @@ import Data.Text (Text) import Data.Text qualified as T import GHC.Hs-import GHC.Types.Name.Reader import GHC.Types.SourceText import GHC.Types.SrcLoc import GHC.Unit.Module.Warnings@@ -25,24 +24,21 @@   traverse_ (located' p_warnDecl) warnings  p_warnDecl :: WarnDecl GhcPs -> R ()-p_warnDecl (Warning _ functions warningTxt) =-  p_topLevelWarning functions warningTxt--p_warningTxt :: WarningTxt GhcPs -> R ()-p_warningTxt wtxt = do-  let (pragmaText, lits) = warningText wtxt-  inci $ pragma pragmaText $ inci $ p_lits lits--p_topLevelWarning :: [LocatedN RdrName] -> WarningTxt GhcPs -> R ()-p_topLevelWarning fnames wtxt = do+p_warnDecl (Warning (namespace, _) fnames wtxt) = do   let (pragmaText, lits) = warningText wtxt-  switchLayout (fmap getLocA fnames ++ fmap getLoc lits) $+  switchLayout (fmap getLocA fnames ++ fmap getLocA lits) $     pragma pragmaText . inci $ do+      p_namespaceSpec namespace       sep commaDel p_rdrName fnames       breakpoint       p_lits lits -warningText :: WarningTxt GhcPs -> (Text, [Located StringLiteral])+p_warningTxt :: WarningTxt GhcPs -> R ()+p_warningTxt wtxt = do+  let (pragmaText, lits) = warningText wtxt+  inci $ pragma pragmaText $ inci $ p_lits lits++warningText :: WarningTxt GhcPs -> (Text, [LocatedE StringLiteral]) warningText = \case   WarningTxt mcat _ lits -> ("WARNING" <> T.pack cat, fmap hsDocString <$> lits)     where@@ -52,7 +48,7 @@         Nothing -> ""   DeprecatedTxt _ lits -> ("DEPRECATED", fmap hsDocString <$> lits) -p_lits :: [Located StringLiteral] -> R ()+p_lits :: [LocatedE StringLiteral] -> R () p_lits = \case   [l] -> atom l   ls -> brackets N $ sep commaDel atom ls

@@ -10,7 +10,7 @@ where  import Control.Monad-import Data.Foldable (for_)+import Data.Foldable (for_, traverse_) import GHC.Hs import GHC.LanguageExtensions.Type import GHC.Types.PkgQual@@ -26,8 +26,13 @@     layout <- getLayout     sep       breakpoint-      (\(p, l) -> sitcc (located l (p_lie layout p)))+      (\(p, l) -> sitcc (located (addDocSrcSpan l) (p_lie layout p)))       (attachRelativePos xs)+  where+    -- In order to correctly set the layout when a doc comment is present.+    addDocSrcSpan lie@(L l ie) = case ieExportDoc ie of+      Nothing -> lie+      Just (L l' _) -> L (l <> noAnnSrcSpan l') ie  p_hsmodImport :: ImportDecl GhcPs -> R () p_hsmodImport ImportDecl {..} = do@@ -76,33 +81,38 @@  p_lie :: Layout -> RelativePos -> IE GhcPs -> R () p_lie encLayout relativePos = \case-  IEVar mwarn l1 -> do+  IEVar mwarn l1 exportDoc -> do     for_ mwarn $ \warnTxt -> do       located warnTxt p_warningTxt       breakpoint     located l1 p_ieWrappedName     p_comma-  IEThingAbs _ l1 -> do+    p_exportDoc exportDoc+  IEThingAbs _ l1 exportDoc -> do     located l1 p_ieWrappedName     p_comma-  IEThingAll _ l1 -> do+    p_exportDoc exportDoc+  IEThingAll _ l1 exportDoc -> do     located l1 p_ieWrappedName     space     txt "(..)"     p_comma-  IEThingWith _ l1 w xs -> sitcc $ do-    located l1 p_ieWrappedName-    breakpoint-    inci $ do-      let names :: [R ()]-          names = located' p_ieWrappedName <$> xs-      parens N . sep commaDel sitcc $-        case w of-          NoIEWildcard -> names-          IEWildcard n ->-            let (before, after) = splitAt n names-             in before ++ [txt ".."] ++ after-    p_comma+    p_exportDoc exportDoc+  IEThingWith _ l1 w xs exportDoc -> do+    sitcc $ do+      located l1 p_ieWrappedName+      breakpoint+      inci $ do+        let names :: [R ()]+            names = located' p_ieWrappedName <$> xs+        parens N . sep commaDel sitcc $+          case w of+            NoIEWildcard -> names+            IEWildcard n ->+              let (before, after) = splitAt n names+               in before ++ [txt ".."] ++ after+      p_comma+    p_exportDoc exportDoc   IEModuleContents _ l1 -> do     located l1 p_hsmodName     p_comma@@ -126,3 +136,23 @@             MiddlePos -> comma             LastPos -> return ()         MultiLine -> comma++    -- This is used to support `@since` annotations for (re)exported items. It+    -- /must/ use caret style comments, see+    -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/12098 and+    -- https://github.com/haskell/haddock/issues/1629#issuecomment-1931354411.+    p_exportDoc :: Maybe (ExportDoc GhcPs) -> R ()+    p_exportDoc = traverse_ $ \exportDoc -> do+      breakpoint+      p_hsDoc Caret False exportDoc++ieExportDoc :: IE GhcPs -> Maybe (ExportDoc GhcPs)+ieExportDoc = \case+  IEVar _ _ doc -> doc+  IEThingAbs _ _ doc -> doc+  IEThingAll _ _ doc -> doc+  IEThingWith _ _ _ _ doc -> doc+  IEModuleContents {} -> Nothing+  IEGroup {} -> Nothing+  IEDoc {} -> Nothing+  IEDocNamed {} -> Nothing

@@ -73,7 +73,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.@@ -88,7 +88,7 @@     case arrow of       HsUnrestrictedArrow _ -> txt "->"       HsLinearArrow _ -> txt "%1 ->"-      HsExplicitMult _ mult _ -> do+      HsExplicitMult _ mult -> do         txt "%"         p_hsTypeR (unLoc mult)         space@@ -215,7 +215,7 @@ instance IsTyVarBndrFlag (HsBndrVis GhcPs) where   isInferred _ = False   p_tyVarBndrFlag = \case-    HsBndrRequired -> pure ()+    HsBndrRequired NoExtField -> pure ()     HsBndrInvisible _ -> txt "@"  p_hsTyVarBndr :: (IsTyVarBndrFlag flag) => HsTyVarBndr flag GhcPs -> R ()@@ -236,7 +236,7 @@  -- | Render several @forall@-ed variables. p_forallBndrs ::-  (HasSrcSpan l) =>+  (HasLoc l) =>   ForAllVisibility ->   (a -> R ()) ->   [GenLocated l a] ->@@ -244,7 +244,7 @@ p_forallBndrs ForAllInvis _ [] = txt "forall." p_forallBndrs ForAllVis _ [] = txt "forall ->" p_forallBndrs vis p tyvars =-  switchLayout (getLoc' <$> tyvars) $ do+  switchLayout (locA <$> tyvars) $ do     txt "forall"     breakpoint     inci $ do@@ -272,7 +272,7 @@  p_lhsTypeArg :: LHsTypeArg GhcPs -> R () p_lhsTypeArg = \case-  HsValArg ty -> located ty p_hsType+  HsValArg NoExtField ty -> located ty p_hsType   -- first argument is the SrcSpan of the @,   -- but the @ always has to be directly before the type argument   HsTypeArg _ ty -> txt "@" *> located ty p_hsType@@ -294,8 +294,8 @@ hsOuterTyVarBndrsToHsType obndrs ty = case obndrs of   HsOuterImplicit NoExtField -> unLoc ty   HsOuterExplicit _ bndrs ->-    HsForAllTy NoExtField (mkHsForAllInvisTele EpAnnNotUsed bndrs) ty+    HsForAllTy NoExtField (mkHsForAllInvisTele noAnn bndrs) ty  lhsTypeToSigType :: LHsType GhcPs -> LHsSigType GhcPs lhsTypeToSigType ty =-  reLocA . L (getLocA ty) . HsSig NoExtField (HsOuterImplicit NoExtField) $ ty+  L (getLoc ty) . HsSig NoExtField (HsOuterImplicit NoExtField) $ ty

@@ -15,6 +15,7 @@  import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE+import GHC.Parser.Annotation import GHC.Types.Name.Reader import GHC.Types.SrcLoc import Ormolu.Fixity@@ -81,8 +82,8 @@         _ -> False  -- | Return combined 'SrcSpan's of all elements in this 'OpTree'.-opTreeLoc :: (HasSrcSpan l) => OpTree (GenLocated l a) b -> SrcSpan-opTreeLoc (OpNode n) = getLoc' n+opTreeLoc :: (HasLoc l) => OpTree (GenLocated l a) b -> SrcSpan+opTreeLoc (OpNode n) = getHasLoc n opTreeLoc (OpBranches exprs _) =   combineSrcSpans' . fmap opTreeLoc $ exprs 

@@ -33,7 +33,7 @@   SpanStream     . sortOn realSrcSpanStart     . toList-    $ everything mappend (const mempty `ext2Q` queryLocated `ext1Q` querySrcSpanAnn) a+    $ everything mappend (const mempty `ext2Q` queryLocated `ext1Q` queryEpAnn) a   where     queryLocated ::       (Data e0) =>@@ -41,7 +41,9 @@       Seq RealSrcSpan     queryLocated (L mspn _) =       maybe mempty srcSpanToRealSrcSpanSeq (cast mspn :: Maybe SrcSpan)-    querySrcSpanAnn :: SrcSpanAnn' a -> Seq RealSrcSpan-    querySrcSpanAnn = srcSpanToRealSrcSpanSeq . locA++    queryEpAnn :: EpAnn ann -> Seq RealSrcSpan+    queryEpAnn = srcSpanToRealSrcSpanSeq . locA+     srcSpanToRealSrcSpanSeq =       Seq.fromList . maybeToList . srcSpanToRealSrcSpan

@@ -30,7 +30,7 @@ import Data.Sequence qualified as Seq import Data.Text (Text) import Data.Text qualified as T-import Data.Text.IO qualified as T+import Data.Text.IO.Utf8 qualified as T.Utf8 import GHC.Utils.Outputable (Outputable) import Ormolu.Utils (showOutputable) import System.Console.ANSI@@ -76,7 +76,7 @@       where         go (TermOutput (Const nodes)) =           forM_ nodes $ \case-            OutputText s -> T.hPutStr handle s+            OutputText s -> T.Utf8.hPutStr handle s             WithColor color term -> withSGR [SetColor Foreground Dull color] (go term)             WithBold term -> withSGR [SetConsoleIntensity BoldIntensity] (go term) 

@@ -13,8 +13,6 @@     separatedByBlank,     separatedByBlankNE,     onTheSameLine,-    HasSrcSpan (..),-    getLoc',     matchAddEpAnn,     textToStringBuffer,     ghcModuleNameToCabal,@@ -140,21 +138,6 @@ onTheSameLine :: SrcSpan -> SrcSpan -> Bool onTheSameLine a b =   isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))--class HasSrcSpan l where-  loc' :: l -> SrcSpan--instance HasSrcSpan SrcSpan where-  loc' = id--instance HasSrcSpan RealSrcSpan where-  loc' l = RealSrcSpan l Strict.Nothing--instance HasSrcSpan (SrcSpanAnn' ann) where-  loc' = locA--getLoc' :: (HasSrcSpan l) => GenLocated l a -> SrcSpan-getLoc' = loc' . getLoc  -- | Check whether the given 'AnnKeywordId' or its Unicode variant is in an -- 'AddEpAnn', and return the 'EpaLocation' if so.

@@ -15,12 +15,13 @@ import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Text qualified as T+import Data.Text.IO.Utf8 qualified as T.Utf8 import Distribution.ModuleName (ModuleName) import Distribution.Types.PackageName (PackageName) import Ormolu.Exception import Ormolu.Fixity import Ormolu.Fixity.Parser-import Ormolu.Utils.IO (findClosestFileSatisfying, readFileUtf8, withIORefCache)+import Ormolu.Utils.IO (findClosestFileSatisfying, withIORefCache) import System.Directory import System.IO.Unsafe (unsafePerformIO) import Text.Megaparsec (errorBundlePretty)@@ -38,7 +39,7 @@   liftIO (findDotOrmoluFile sourceFile) >>= \case     Just dotOrmoluFile -> liftIO $ withIORefCache cacheRef dotOrmoluFile $ do       dotOrmoluRelative <- makeRelativeToCurrentDirectory dotOrmoluFile-      contents <- readFileUtf8 dotOrmoluFile+      contents <- T.Utf8.readFile dotOrmoluFile       case parseDotOrmolu dotOrmoluRelative contents of         Left errorBundle ->           throwIO (OrmoluFixityOverridesParseError errorBundle)

@@ -1,48 +1,20 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns #-} --- | Write 'Text' to files using UTF8 and ignoring native--- line ending conventions. module Ormolu.Utils.IO-  ( writeFileUtf8,-    readFileUtf8,-    getContentsUtf8,-    findClosestFileSatisfying,+  ( findClosestFileSatisfying,     withIORefCache,   ) where  import Control.Exception (catch, throwIO) import Control.Monad.IO.Class-import Data.ByteString (ByteString)-import Data.ByteString qualified as B import Data.IORef import Data.Map.Lazy (Map) import Data.Map.Lazy qualified as M-import Data.Text (Text)-import Data.Text.Encoding qualified as TE import System.Directory import System.FilePath import System.IO.Error (isDoesNotExistError)---- | Write a 'Text' to a file using UTF8 and ignoring native--- line ending conventions.-writeFileUtf8 :: (MonadIO m) => FilePath -> Text -> m ()-writeFileUtf8 p = liftIO . B.writeFile p . TE.encodeUtf8---- | Read an entire file strictly into a 'Text' using UTF8 and--- ignoring native line ending conventions.-readFileUtf8 :: (MonadIO m) => FilePath -> m Text-readFileUtf8 p = liftIO (B.readFile p) >>= decodeUtf8---- | Read stdin as UTF8-encoded 'Text' value.-getContentsUtf8 :: (MonadIO m) => m Text-getContentsUtf8 = liftIO B.getContents >>= decodeUtf8---- | A helper function for decoding a strict 'ByteString' into 'Text'. It is--- strict and fails immediately if decoding encounters a problem.-decodeUtf8 :: (MonadIO m) => ByteString -> m Text-decodeUtf8 = liftIO . either throwIO pure . TE.decodeUtf8'  -- | Find the path to the closest file higher in the file hierarchy that -- satisfies a given predicate.

@@ -2,9 +2,9 @@  module Ormolu.Diff.TextSpec (spec) where +import Data.Text.IO.Utf8 qualified as T.Utf8 import Ormolu.Diff.Text import Ormolu.Terminal-import Ormolu.Utils.IO import Path import System.FilePath qualified as FP import Test.Hspec@@ -36,14 +36,14 @@ stdTest name pathA pathB = it name $ do   inputA <-     parseRelFile (FP.addExtension pathA "hs")-      >>= readFileUtf8 . toFilePath . (diffInputsDir </>)+      >>= T.Utf8.readFile . toFilePath . (diffInputsDir </>)   inputB <-     parseRelFile (FP.addExtension pathB "hs")-      >>= readFileUtf8 . toFilePath . (diffInputsDir </>)+      >>= T.Utf8.readFile . toFilePath . (diffInputsDir </>)   let expectedDiffPath = FP.addExtension name "txt"   expectedDiffText <-     parseRelFile expectedDiffPath-      >>= readFileUtf8 . toFilePath . (diffOutputsDir </>)+      >>= T.Utf8.readFile . toFilePath . (diffOutputsDir </>)   Just actualDiff <- pure $ diffText inputA inputB "TEST"   runTermPure (printTextDiff actualDiff) `shouldBe` expectedDiffText 

@@ -11,10 +11,9 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T-import Data.Text.IO qualified as T+import Data.Text.IO.Utf8 qualified as T.Utf8 import Ormolu import Ormolu.Fixity-import Ormolu.Utils.IO import Path import Path.IO import System.Environment (lookupEnv)@@ -63,8 +62,8 @@   -- 3. Check the output against expected output. Thus all tests should   -- include two files: input and expected output.   whenShouldRegenerateOutput $-    T.writeFile (fromRelFile expectedOutputPath) formatted0-  expected <- readFileUtf8 $ fromRelFile expectedOutputPath+    T.Utf8.writeFile (fromRelFile expectedOutputPath) formatted0+  expected <- T.Utf8.readFile $ fromRelFile expectedOutputPath   shouldMatch False formatted0 expected   -- 4. Check that running the formatter on the output produces the same   -- output again (the transformation is idempotent).