ormolu 0.5.3.0 → 0.6.0.0

raw patch · 74 files changed

+653/−560 lines, 74 filesdep +deepseqdep −dlistdep ~Cabal-syntaxdep ~ansi-terminaldep ~ghc-lib-parserPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

Dependencies removed: dlist

Dependency ranges changed: Cabal-syntax, ansi-terminal, ghc-lib-parser, optparse-applicative

API changes (from Hackage documentation)

Files

• CHANGELOG.md +25/−0
• app/Main.hs +4/−7
• data/examples/declaration/data/type-data-out.hs +8/−0
• data/examples/declaration/data/type-data.hs +7/−0
• data/examples/declaration/data/unnamed-field-comment-0-out.hs +2/−2
• data/examples/declaration/data/unnamed-field-comment-1-out.hs +1/−1
• data/examples/declaration/data/unnamed-field-comment-2-out.hs +11/−0
• data/examples/declaration/data/unnamed-field-comment-2.hs +9/−0
• data/examples/declaration/data/unnamed-field-comment-3-out.hs +5/−0
• data/examples/declaration/data/unnamed-field-comment-3.hs +1/−0
• data/examples/declaration/type-families/closed-type-family/promotion-out.hs +2/−0
• data/examples/declaration/type-families/closed-type-family/promotion.hs +2/−0
• data/examples/declaration/type/promotion-1-out.hs +2/−0
• data/examples/declaration/type/promotion-1.hs +2/−0
• data/examples/declaration/value/function/overloaded-labels-out.hs +33/−0
• data/examples/declaration/value/function/overloaded-labels.hs +30/−0
• ormolu.cabal +19/−19
• src/GHC/DynFlags.hs +1/−4
• src/Ormolu.hs +8/−9
• src/Ormolu/Config.hs +3/−5
• src/Ormolu/Diff/ParseResult.hs +45/−48
• src/Ormolu/Diff/Text.hs +21/−20
• src/Ormolu/Exception.hs +27/−22
• src/Ormolu/Fixity.hs +11/−16
• src/Ormolu/Fixity/Internal.hs +10/−14
• src/Ormolu/Fixity/Parser.hs +4/−5
• src/Ormolu/Fixity/Printer.hs +6/−6
• src/Ormolu/Imports.hs +29/−21
• src/Ormolu/Parser.hs +31/−23
• src/Ormolu/Parser/CommentStream.hs +7/−11
• src/Ormolu/Parser/Pragma.hs +3/−3
• src/Ormolu/Parser/Result.hs +1/−3
• src/Ormolu/Printer.hs +1/−2
• src/Ormolu/Printer/Combinators.hs +1/−2
• src/Ormolu/Printer/Comments.hs +1/−2
• src/Ormolu/Printer/Internal.hs +3/−5
• src/Ormolu/Printer/Meat/Common.hs +5/−6
• src/Ormolu/Printer/Meat/Declaration.hs +9/−10
• src/Ormolu/Printer/Meat/Declaration/Annotation.hs +1/−1
• src/Ormolu/Printer/Meat/Declaration/Data.hs +46/−25
• src/Ormolu/Printer/Meat/Declaration/Default.hs +0/−1
• src/Ormolu/Printer/Meat/Declaration/Foreign.hs +6/−5
• src/Ormolu/Printer/Meat/Declaration/Instance.hs +0/−1
• src/Ormolu/Printer/Meat/Declaration/OpTree.hs +0/−1
• src/Ormolu/Printer/Meat/Declaration/Rule.hs +3/−3
• src/Ormolu/Printer/Meat/Declaration/Signature.hs +4/−5
• src/Ormolu/Printer/Meat/Declaration/Splice.hs +3/−5
• src/Ormolu/Printer/Meat/Declaration/Value.hs +27/−42
• src/Ormolu/Printer/Meat/Declaration/Value.hs-boot +3/−6
• src/Ormolu/Printer/Meat/Declaration/Warning.hs +1/−1
• src/Ormolu/Printer/Meat/ImportExport.hs +5/−7
• src/Ormolu/Printer/Meat/Module.hs +3/−3
• src/Ormolu/Printer/Meat/Pragma.hs +3/−3
• src/Ormolu/Printer/Meat/Type.hs +17/−33
• src/Ormolu/Printer/Operators.hs +2/−3
• src/Ormolu/Printer/SpanStream.hs +10/−12
• src/Ormolu/Processing/Common.hs +2/−2
• src/Ormolu/Processing/Cpp.hs +2/−2
• src/Ormolu/Processing/Preprocess.hs +4/−5
• src/Ormolu/Terminal.hs +74/−74
• src/Ormolu/Terminal/QualifiedDo.hs +7/−0
• src/Ormolu/Utils.hs +5/−7
• src/Ormolu/Utils/Cabal.hs +10/−9
• src/Ormolu/Utils/Fixity.hs +2/−2
• src/Ormolu/Utils/IO.hs +2/−2
• tests/Ormolu/CabalInfoSpec.hs +4/−4
• tests/Ormolu/Diff/TextSpec.hs +2/−14
• tests/Ormolu/Fixity/ParserSpec.hs +2/−2
• tests/Ormolu/Fixity/PrinterSpec.hs +3/−3
• tests/Ormolu/HackageInfoSpec.hs +2/−3
• tests/Ormolu/OpTreeSpec.hs +2/−2
• tests/Ormolu/Parser/OptionsSpec.hs +1/−1
• tests/Ormolu/Parser/PragmaSpec.hs +1/−1
• tests/Ormolu/PrinterSpec.hs +4/−4

@@ -1,3 +1,28 @@+## Ormolu 0.6.0.0++* Haddocks attached to arguments of a data constructor are now formatted in+  the pipe style (rather than the caret style), consistent with everything+  else. As a consequence, now Ormolu's output will be deemed invalid by the+  Haddock shipped with GHC <9.0. [Issue+  844](https://github.com/tweag/ormolu/issues/844) and [issue+  828](https://github.com/tweag/ormolu/issues/828).++* Insert space before char literals in ticked promoted constructs when+  necessary. [Issue 1000](https://github.com/tweag/ormolu/issues/1000).++* Switched to `ghc-lib-parser-9.6`:+  * Extended `OverloadedLabels`: `#Foo`, `#3`, `#"Hello there"`.++    Also, it is now disabled by default, as it causes e.g. `a#b` to be parsed+    differently.+  * New extension: `TypeData`, enabled by default.+  * Parse errors now include error codes, cf. https://errors.haskell.org.++* Updated to `Cabal-syntax-3.10`.++* Now whenever Ormolu fails to parse a `.cabal` file it also explains why.+  [PR 999](https://github.com/tweag/ormolu/pull/999).+ ## Ormolu 0.5.3.0  * Stop making empty `let`s move comments. [Issue

@@ -1,12 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeApplications #-}  module Main (main) where @@ -14,10 +11,10 @@ import Control.Monad import Data.Bool (bool) import Data.List (intercalate, sort)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe, mapMaybe, maybeToList)-import qualified Data.Set as Set-import qualified Data.Text.IO as TIO+import Data.Set qualified as Set+import Data.Text.IO qualified as TIO import Data.Version (showVersion) import Language.Haskell.TH.Env (envQ) import Options.Applicative@@ -32,7 +29,7 @@ import Paths_ormolu (version) import System.Directory import System.Exit (ExitCode (..), exitWith)-import qualified System.FilePath as FP+import System.FilePath qualified as FP import System.IO (hPutStrLn, stderr)  -- | Entry point of the program.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@@ -1,10 +1,10 @@ cabal-version:      2.4 name:               ormolu-version:            0.5.3.0+version:            0.6.0.0 license:            BSD-3-Clause license-file:       LICENSE.md maintainer:         Mark Karpov <mark.karpov@tweag.io>-tested-with:        ghc ==9.0.2 ghc ==9.2.5+tested-with:        ghc ==9.2.7 ghc ==9.4.4 ghc ==9.6.1 homepage:           https://github.com/tweag/ormolu bug-reports:        https://github.com/tweag/ormolu/issues synopsis:           A formatter for Haskell source code@@ -86,6 +86,7 @@         Ormolu.Processing.Cpp         Ormolu.Processing.Preprocess         Ormolu.Terminal+        Ormolu.Terminal.QualifiedDo         Ormolu.Utils         Ormolu.Utils.Cabal         Ormolu.Utils.Fixity@@ -93,9 +94,9 @@      hs-source-dirs:   src     other-modules:    GHC.DynFlags-    default-language: Haskell2010+    default-language: GHC2021     build-depends:-        Cabal-syntax >=3.8 && <3.9,+        Cabal-syntax >=3.10 && <3.11,         Diff >=0.4 && <1.0,         MemoTrie >=0.6 && <0.7,         ansi-terminal >=0.10 && <1.0,@@ -104,11 +105,11 @@         binary >=0.8 && <0.9,         bytestring >=0.2 && <0.12,         containers >=0.5 && <0.7,+        deepseq >=1.4 && <1.5,         directory ^>=1.3,-        dlist >=0.8 && <2.0,         file-embed >=0.0.15 && <0.1,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.4 && <9.5,+        ghc-lib-parser >=9.6 && <9.7,         megaparsec >=9.0,         mtl >=2.0 && <3.0,         syb >=0.7 && <0.8,@@ -116,9 +117,8 @@      if flag(dev)         ghc-options:-            -Wall -Werror -Wcompat -Wincomplete-record-updates-            -Wincomplete-uni-patterns -Wnoncanonical-monad-instances-            -Wno-missing-home-modules -Wunused-packages+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages      else         ghc-options: -O2 -Wall@@ -131,13 +131,13 @@     hs-source-dirs:   app     other-modules:    Paths_ormolu     autogen-modules:  Paths_ormolu-    default-language: Haskell2010+    default-language: GHC2021     build-depends:         base >=4.12 && <5.0,         containers >=0.5 && <0.7,         directory ^>=1.3,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.4 && <9.5,+        ghc-lib-parser >=9.6 && <9.7,         th-env >=0.1.1 && <0.2,         optparse-applicative >=0.14 && <0.18,         ormolu,@@ -145,10 +145,8 @@      if flag(dev)         ghc-options:-            -Wall -Werror -Wcompat -Wincomplete-record-updates-            -Wincomplete-uni-patterns -Wnoncanonical-monad-instances-            -optP-Wno-nonportable-include-path -Wunused-packages-            -Wwarn=unused-packages+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages -Wwarn=unused-packages      else         ghc-options: -O2 -Wall -rtsopts@@ -170,15 +168,15 @@         Ormolu.Parser.PragmaSpec         Ormolu.PrinterSpec -    default-language:   Haskell2010+    default-language:   GHC2021     build-depends:-        Cabal-syntax >=3.8 && <3.9,+        Cabal-syntax >=3.10 && <3.11,         QuickCheck >=2.14,         base >=4.14 && <5.0,         containers >=0.5 && <0.7,         directory ^>=1.3,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.4 && <9.5,+        ghc-lib-parser >=9.6 && <9.7,         hspec >=2.0 && <3.0,         hspec-megaparsec >=2.2,         ormolu,@@ -188,7 +186,9 @@         text >=2.0 && <3.0      if flag(dev)-        ghc-options: -Wall -Werror -Wunused-packages+        ghc-options:+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages      else         ghc-options: -O2 -Wall

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

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

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-}  -- | Configuration options used by the tool.@@ -16,12 +14,12 @@   ) where -import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Set (Set)-import qualified Data.Set as Set+import Data.Set qualified as Set import Distribution.Types.PackageName (PackageName) import GHC.Generics (Generic)-import qualified GHC.Types.SrcLoc as GHC+import GHC.Types.SrcLoc qualified as GHC import Ormolu.Fixity (FixityMap) import Ormolu.Terminal (ColorMode (..)) 

@@ -1,13 +1,6 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DeepSubsumption #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-}-#if !MIN_VERSION_base(4,17,0)--- needed on GHC 9.0 and 9.2 due to simplified subsumption-{-# LANGUAGE ImpredicativeTypes #-}-#endif  -- | This module allows us to diff two 'ParseResult's. module Ormolu.Diff.ParseResult@@ -18,6 +11,7 @@  import Data.ByteString (ByteString) import Data.Foldable+import Data.Function import Data.Generics import GHC.Hs import GHC.Types.SourceText@@ -74,6 +68,8 @@ --     * LayoutInfo (brace style) in extension fields --     * Empty contexts in type classes --     * Parens around derived type classes+--     * 'TokenLocation' (in 'LHsUniToken')+--     * 'EpaLocation' matchIgnoringSrcSpans :: (Data a) => a -> a -> ParseResultDiff matchIgnoringSrcSpans a = genericQuery a   where@@ -91,44 +87,51 @@           mconcat $             gzipWithQ               ( genericQuery-                  `extQ` srcSpanEq+                  `extQ` considerEqual @SrcSpan                   `ext1Q` epAnnEq-                  `extQ` sourceTextEq+                  `extQ` considerEqual @SourceText                   `extQ` hsDocStringEq                   `extQ` importDeclQualifiedStyleEq                   `extQ` unicodeArrowStyleEq-                  `extQ` layoutInfoEq+                  `extQ` considerEqual @(LayoutInfo GhcPs)                   `extQ` classDeclCtxEq                   `extQ` derivedTyClsParensEq-                  `extQ` epaCommentsEq+                  `extQ` considerEqual @EpAnnComments -- ~ XCGRHSs GhcPs+                  `extQ` considerEqual @TokenLocation+                  `extQ` considerEqual @EpaLocation                   `ext2Q` forLocated               )               x               y       | otherwise = Different []-    srcSpanEq :: SrcSpan -> GenericQ ParseResultDiff-    srcSpanEq _ _ = Same-    epAnnEq :: EpAnn a -> GenericQ ParseResultDiff-    epAnnEq _ _ = Same-    sourceTextEq :: SourceText -> GenericQ ParseResultDiff-    sourceTextEq _ _ = Same-    importDeclQualifiedStyleEq ::-      ImportDeclQualifiedStyle ->++    considerEqualVia ::+      forall a.+      (Typeable a) =>+      (a -> a -> ParseResultDiff) ->+      a ->       GenericQ ParseResultDiff-    importDeclQualifiedStyleEq d0 d1' =-      case (d0, cast d1' :: Maybe ImportDeclQualifiedStyle) of-        (x, Just x') | x == x' -> Same-        (QualifiedPre, Just QualifiedPost) -> Same-        (QualifiedPost, Just QualifiedPre) -> Same-        _ -> Different []+    considerEqualVia f x (cast -> Just x') = f x x'+    considerEqualVia _ _ _ = Different []++    considerEqualVia' f =+      considerEqualVia $ \x x' -> if f x x' then Same else Different []++    considerEqual :: forall a. (Typeable a) => a -> GenericQ ParseResultDiff+    considerEqual = considerEqualVia $ \_ _ -> Same++    epAnnEq :: EpAnn a -> b -> ParseResultDiff+    epAnnEq _ _ = Same++    importDeclQualifiedStyleEq = considerEqualVia' f+      where+        f QualifiedPre QualifiedPost = True+        f QualifiedPost QualifiedPre = True+        f x x' = x == x'+     hsDocStringEq :: HsDocString -> GenericQ ParseResultDiff-    hsDocStringEq str0 str1' =-      case cast str1' :: Maybe HsDocString of-        Nothing -> Different []-        Just str1 ->-          if splitDocString str0 == splitDocString str1-            then Same-            else Different []+    hsDocStringEq = considerEqualVia' ((==) `on` splitDocString)+     forLocated ::       (Data e0, Data e1) =>       GenLocated e0 e1 ->@@ -144,25 +147,19 @@             else d         UnhelpfulSpan _ -> d     appendSpan _ d = d+     -- as we normalize arrow styles (e.g. -> vs →), we consider them equal here-    unicodeArrowStyleEq :: HsArrow GhcPs -> GenericQ ParseResultDiff-    unicodeArrowStyleEq (HsUnrestrictedArrow _) (castArrow -> Just (HsUnrestrictedArrow _)) = Same-    unicodeArrowStyleEq (HsLinearArrow _) (castArrow -> Just (HsLinearArrow _)) = Same-    unicodeArrowStyleEq (HsExplicitMult _ _ t) (castArrow -> Just (HsExplicitMult _ _ t')) = genericQuery t t'-    unicodeArrowStyleEq _ _ = Different []-    castArrow :: (Typeable a) => a -> Maybe (HsArrow GhcPs)-    castArrow = cast-    -- LayoutInfo ~ XClassDecl GhcPs tracks brace information-    layoutInfoEq :: LayoutInfo -> GenericQ ParseResultDiff-    layoutInfoEq _ (cast -> Just (_ :: LayoutInfo)) = Same-    layoutInfoEq _ _ = Different []+    unicodeArrowStyleEq = considerEqualVia @(HsArrow GhcPs) f+      where+        f (HsUnrestrictedArrow _) (HsUnrestrictedArrow _) = Same+        f (HsLinearArrow _) (HsLinearArrow _) = Same+        f (HsExplicitMult _ _ t) (HsExplicitMult _ _ t') = genericQuery t t'+        f _ _ = Different []+     classDeclCtxEq :: TyClDecl GhcPs -> GenericQ ParseResultDiff     classDeclCtxEq ClassDecl {tcdCtxt = Just (L _ []), ..} tc' = genericQuery ClassDecl {tcdCtxt = Nothing, ..} tc'     classDeclCtxEq tc tc' = genericQuery tc tc'+     derivedTyClsParensEq :: DerivClauseTys GhcPs -> GenericQ ParseResultDiff     derivedTyClsParensEq (DctSingle NoExtField sigTy) dct' = genericQuery (DctMulti NoExtField [sigTy]) dct'     derivedTyClsParensEq dct dct' = genericQuery dct dct'-    -- EpAnnComments ~ XCGRHSs GhcPs-    epaCommentsEq :: EpAnnComments -> GenericQ ParseResultDiff-    epaCommentsEq _ (cast -> Just (_ :: EpAnnComments)) = Same-    epaCommentsEq _ _ = Different []

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

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

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

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

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

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

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

@@ -1,7 +1,7 @@+{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -19,27 +19,27 @@ import Data.Char (isSpace) import Data.Functor import Data.Generics-import qualified Data.List as L-import qualified Data.List.NonEmpty as NE+import Data.List qualified as L+import Data.List.NonEmpty qualified as NE import Data.Text (Text) import GHC.Data.Bag (bagToList)-import qualified GHC.Data.EnumSet as EnumSet-import qualified GHC.Data.FastString as GHC-import qualified GHC.Driver.CmdLine as GHC+import GHC.Data.EnumSet qualified as EnumSet+import GHC.Data.FastString qualified as GHC+import GHC.Driver.CmdLine qualified as GHC import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Session as GHC import GHC.DynFlags (baseDynFlags) import GHC.Hs hiding (UnicodeSyntax) import GHC.LanguageExtensions.Type (Extension (..))-import qualified GHC.Parser as GHC-import qualified GHC.Parser.Header as GHC-import qualified GHC.Parser.Lexer as GHC-import GHC.Types.Error (getMessages)-import qualified GHC.Types.SourceError as GHC (handleSourceError)+import GHC.Parser qualified as GHC+import GHC.Parser.Header qualified as GHC+import GHC.Parser.Lexer qualified as GHC+import GHC.Types.Error (NoDiagnosticOpts (..), getMessages)+import GHC.Types.SourceError qualified as GHC (handleSourceError) import GHC.Types.SrcLoc import GHC.Utils.Error import GHC.Utils.Outputable (defaultSDocContext)-import qualified GHC.Utils.Panic as GHC+import GHC.Utils.Panic qualified as GHC import Ormolu.Config import Ormolu.Exception import Ormolu.Fixity (LazyFixityMap)@@ -108,15 +108,19 @@               SevError -> 1 :: Int               SevWarning -> 2               SevIgnore -> 3-            showErr =-              showOutputable-                . formatBulleted defaultSDocContext-                . diagnosticMessage-                . errMsgDiagnostic+            showErr (errMsgDiagnostic -> err) = codeMsg <> msg+              where+                codeMsg = case diagnosticCode err of+                  Just code -> "[" <> showOutputable code <> "] "+                  Nothing -> ""+                msg =+                  showOutputable+                    . formatBulleted defaultSDocContext+                    . diagnosticMessage NoDiagnosticOpts+                    $ err          in case L.sortOn (rateSeverity . errMsgSeverity) errs of               [] -> Nothing               err : _ ->-                -- Show instance returns a short error message                 Just (fixupErrSpan (errMsgSpan err), showErr err)       parser = case cfgSourceType of         ModuleSource -> GHC.parseModule@@ -152,7 +156,7 @@  -- | Normalize a 'HsModule' by sorting its import\/export lists, dropping -- blank comments, etc.-normalizeModule :: HsModule -> HsModule+normalizeModule :: HsModule GhcPs -> HsModule GhcPs normalizeModule hsmod =   everywhere     (extT (mkT dropBlankTypeHaddocks) patchContext)@@ -161,8 +165,11 @@           normalizeImports (hsmodImports hsmod),         hsmodDecls =           filter (not . isBlankDocD . unLoc) (hsmodDecls hsmod),-        hsmodHaddockModHeader =-          mfilter (not . isBlankDocString) (hsmodHaddockModHeader hsmod),+        hsmodExt =+          (hsmodExt hsmod)+            { hsmodHaddockModHeader =+                mfilter (not . isBlankDocString) (hsmodHaddockModHeader (hsmodExt hsmod))+            },         hsmodExports =           (fmap . fmap) (filter (not . isBlankDocIE . unLoc)) (hsmodExports hsmod)       }@@ -180,7 +187,7 @@         | isBlankDocString s -> ty       a -> a     patchContext :: LHsContext GhcPs -> LHsContext GhcPs-    patchContext = mapLoc $ \case+    patchContext = fmap $ \case       [x@(L _ (HsParTy _ _))] -> [x]       [x@(L lx _)] -> [L lx (HsParTy EpAnnNotUsed x)]       xs -> xs@@ -221,7 +228,8 @@     LexicalNegation, -- implies NegativeLiterals     LinearTypes, -- steals the (%) type operator in some cases     OverloadedRecordDot, -- f.g parses differently-    OverloadedRecordUpdate -- qualified fields are not supported+    OverloadedRecordUpdate, -- qualified fields are not supported+    OverloadedLabels -- a#b is parsed differently   ]  -- | Run a 'GHC.P' computation.

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

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

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

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

@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}@@ -75,7 +74,7 @@ import Control.Monad import Data.List (intersperse) import Data.Text (Text)-import qualified GHC.Data.Strict as Strict+import GHC.Data.Strict qualified as Strict import GHC.Types.SrcLoc import Ormolu.Printer.Comments import Ormolu.Printer.Internal

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

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

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

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

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

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

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

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

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

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

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

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

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

@@ -1,18 +1,14 @@ {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-}  module Ormolu.Printer.Meat.Declaration.Value   ( p_valDecl,     p_pat,     p_hsExpr,-    p_hsSplice,+    p_hsUntypedSplice,     p_stringLit,     p_hsExpr',     p_hsCmdTop,@@ -30,14 +26,13 @@ import Data.Generics.Schemes (everything) import Data.List (intersperse, sortBy) import Data.List.NonEmpty (NonEmpty (..), (<|))-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Maybe import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import Data.Void import GHC.Data.Bag (bagToList)-import GHC.Data.FastString (FastString, lengthFS)-import qualified GHC.Data.Strict as Strict+import GHC.Data.Strict qualified as Strict import GHC.Hs import GHC.LanguageExtensions.Type (Extension (NegativeLiterals)) import GHC.Parser.CharClass (is_space)@@ -46,6 +41,7 @@ import GHC.Types.Name.Reader import GHC.Types.SourceText import GHC.Types.SrcLoc+import Language.Haskell.Syntax.Basic import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration@@ -70,8 +66,8 @@  p_valDecl :: HsBind GhcPs -> R () p_valDecl = \case-  FunBind _ funId funMatches _ -> p_funBind funId funMatches-  PatBind _ pat grhss _ -> p_match PatternBind False NoSrcStrict [pat] grhss+  FunBind _ funId funMatches -> p_funBind funId funMatches+  PatBind _ pat grhss -> p_match PatternBind False NoSrcStrict [pat] grhss   VarBind {} -> notImplemented "VarBinds" -- introduced by the type checker   PatSynBind _ psb -> p_patSynBind psb @@ -545,21 +541,8 @@       _ -> id  p_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()-p_ldotFieldOcc = located' $ p_lFieldLabelString . dfoLabel-  where-    p_lFieldLabelString (L (locA -> s) fs) = parensIfOp . atom @FastString $ fs-      where-        -- HACK For OverloadedRecordUpdate:-        -- In operator field updates (i.e. `f {(+) = 1}`), we don't have-        -- information whether parens are necessary. As a workaround,-        -- we look if the RealSrcSpan is bigger than the string fs.-        parensIfOp-          | isOneLineSpan s,-            Just realS <- srcSpanToRealSrcSpan s,-            let spanLength = srcSpanEndCol realS - srcSpanStartCol realS,-            lengthFS fs < spanLength =-              parens N-          | otherwise = id+p_ldotFieldOcc =+  located' $ p_rdrName . fmap (mkVarUnqual . field_label) . dfoLabel  p_ldotFieldOccs :: [XRec GhcPs (DotFieldOcc GhcPs)] -> R () p_ldotFieldOccs = sep (txt ".") p_ldotFieldOcc@@ -591,9 +574,9 @@   HsVar _ name -> p_rdrName name   HsUnboundVar _ occ -> atom occ   HsRecSel _ fldOcc -> p_fieldOcc fldOcc-  HsOverLabel _ v -> do+  HsOverLabel _ sourceText _ -> do     txt "#"-    atom v+    p_sourceText sourceText   HsIPVar _ (HsIPName name) -> do     txt "?"     atom name@@ -667,7 +650,7 @@           sep breakpoint (located' p_hsExpr) initp         placeHanging placement . dontUseBraces $           located lastp p_hsExpr-  HsAppType _ e a -> do+  HsAppType _ e _ a -> do     located e p_hsExpr     breakpoint     inci $ do@@ -841,7 +824,8 @@     breakpoint'     txt "||]"   HsUntypedBracket epAnn x -> p_hsQuote epAnn x-  HsSpliceE _ splice -> p_hsSplice splice+  HsTypedSplice _ expr -> p_hsSpliceTH True expr DollarSplice+  HsUntypedSplice _ untySplice -> p_hsUntypedSplice DollarSplice untySplice   HsProc _ p e -> do     txt "proc"     located p $ \x -> do@@ -856,7 +840,7 @@     breakpoint     inci (located e p_hsExpr)   HsPragE _ prag x -> case prag of-    HsPragSCC _ _ name -> do+    HsPragSCC _ name -> do       txt "{-# SCC "       atom name       txt " #-}"@@ -1015,7 +999,7 @@   LazyPat _ pat -> do     txt "~"     located pat p_pat-  AsPat _ name pat -> do+  AsPat _ name _ pat -> do     p_rdrName name     txt "@"     located pat p_pat@@ -1040,7 +1024,7 @@         p_rdrName pat         unless (null tys && null xs) breakpoint         inci . sitcc $-          sep breakpoint (sitcc . either p_hsPatSigType (located' p_pat)) $+          sep breakpoint (sitcc . either p_hsConPatTyArg (located' p_pat)) $             (Left <$> tys) <> (Right <$> xs)       RecCon (HsRecFields fields dotdot) -> do         p_rdrName pat@@ -1051,7 +1035,7 @@         inci . braces N . sep commaDel f $           case dotdot of             Nothing -> Just <$> fields-            Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]+            Just (L _ (RecFieldsDotDot n)) -> (Just <$> take n fields) ++ [Nothing]       InfixCon l r -> do         switchLayout [getLocA l, getLocA r] $ do           located l p_pat@@ -1066,7 +1050,7 @@     txt "->"     breakpoint     inci (located pat p_pat)-  SplicePat _ splice -> p_hsSplice splice+  SplicePat _ splice -> p_hsUntypedSplice DollarSplice splice   LitPat _ p -> atom p   NPat _ v (isJust -> isNegated) _ -> do     when isNegated $ do@@ -1088,6 +1072,9 @@ p_hsPatSigType :: HsPatSigType GhcPs -> R () p_hsPatSigType (HsPS _ ty) = txt "@" *> located ty p_hsType +p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()+p_hsConPatTyArg (HsConPatTyArg _ patSigTy) = p_hsPatSigType patSigTy+ p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R () p_pat_hsFieldBind HsFieldBind {..} = do   located hfbLHS p_fieldOcc@@ -1112,11 +1099,10 @@             space   parensHash s $ sep (txt "|") f args -p_hsSplice :: HsSplice GhcPs -> R ()-p_hsSplice = \case-  HsTypedSplice _ deco _ expr -> p_hsSpliceTH True expr deco-  HsUntypedSplice _ deco _ expr -> p_hsSpliceTH False expr deco-  HsQuasiQuote _ _ quoterName _ str -> do+p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()+p_hsUntypedSplice deco = \case+  HsUntypedSpliceExpr _ expr -> p_hsSpliceTH False expr deco+  HsQuasiQuote _ quoterName str -> do     txt "["     p_rdrName (noLocA quoterName)     txt "|"@@ -1124,7 +1110,6 @@     -- formatting here without potentially breaking someone's code.     atom str     txt "|]"-  HsSpliced {} -> notImplemented "HsSpliced"  p_hsSpliceTH ::   -- | Typed splice?@@ -1275,7 +1260,7 @@ exprPlacement = \case   -- Only hang lambdas with single line parameter lists   HsLam _ mg -> case mg of-    MG _ (L _ [L _ (Match _ _ (x : xs) _)]) _+    MG _ (L _ [L _ (Match _ _ (x : xs) _)])       | isOneLineSpan (combineSrcSpans' $ fmap getLocA (x :| xs)) ->           Hanging     _ -> Normal

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

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

@@ -14,7 +14,6 @@ import GHC.LanguageExtensions.Type import GHC.Types.PkgQual import GHC.Types.SrcLoc-import GHC.Unit.Types import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Utils (RelativePos (..), attachRelativePos)@@ -62,13 +61,12 @@         space         located l atom     space-    case ideclHiding of-      Nothing -> return ()-      Just (hiding, _) ->-        when hiding (txt "hiding")-    case ideclHiding of+    case ideclImportList of       Nothing -> return ()-      Just (_, L _ xs) -> do+      Just (hiding, L _ xs) -> do+        case hiding of+          Exactly -> pure ()+          EverythingBut -> txt "hiding"         breakpoint         parens N $ do           layout <- getLayout

@@ -1,4 +1,3 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -29,10 +28,11 @@   -- | Pragmas and the associated comments   [([RealLocated Comment], Pragma)] ->   -- | AST to print-  HsModule ->+  HsModule GhcPs ->   R () p_hsModule mstackHeader pragmas HsModule {..} = do-  let deprecSpan = maybe [] (pure . getLocA) hsmodDeprecMessage+  let XModulePs {..} = hsmodExt+      deprecSpan = maybe [] (pure . getLocA) hsmodDeprecMessage       exportSpans = maybe [] (pure . getLocA) hsmodExports   switchLayout (deprecSpan <> exportSpans) $ do     forM_ mstackHeader $ \(L spn comment) -> do

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

@@ -1,13 +1,11 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-}  -- | Rendering of types. module Ormolu.Printer.Meat.Type   ( p_hsType,-    p_hsTypePostDoc,     hasDocStrings,     p_hsContext,     p_hsTyVarBndr,@@ -22,31 +20,22 @@   ) where -import GHC.Hs-import GHC.Types.Basic hiding (isPromoted)+import GHC.Hs hiding (isPromoted) import GHC.Types.SourceText import GHC.Types.SrcLoc import GHC.Types.Var import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree (p_tyOpTree, tyOpTree)-import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice, p_stringLit)+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsUntypedSplice, p_stringLit) import Ormolu.Printer.Operators import Ormolu.Utils  p_hsType :: HsType GhcPs -> R ()-p_hsType t = p_hsType' (hasDocStrings t) PipeStyle t--p_hsTypePostDoc :: HsType GhcPs -> R ()-p_hsTypePostDoc t = p_hsType' (hasDocStrings t) CaretStyle t---- | How to render Haddocks associated with a type.-data TypeDocStyle-  = PipeStyle-  | CaretStyle+p_hsType t = p_hsType' (hasDocStrings t) t -p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R ()-p_hsType' multilineArgs docStyle = \case+p_hsType' :: Bool -> HsType GhcPs -> R ()+p_hsType' multilineArgs = \case   HsForAllTy _ tele t -> do     case tele of       HsForAllInvis _ bndrs -> p_forallBndrs ForAllInvis p_hsTyVarBndr bndrs@@ -141,16 +130,10 @@     txt "::"     breakpoint     inci (located k p_hsType)-  HsSpliceTy _ splice -> p_hsSplice splice-  HsDocTy _ t str ->-    case docStyle of-      PipeStyle -> do-        p_hsDoc Pipe True str-        located t p_hsType-      CaretStyle -> do-        located t p_hsType-        newline-        p_hsDoc Caret False str+  HsSpliceTy _ splice -> p_hsUntypedSplice DollarSplice splice+  HsDocTy _ t str -> do+    p_hsDoc Pipe True str+    located t p_hsType   HsBangTy _ (HsSrcBang _ u s) t -> do     case u of       SrcUnpack -> txt "{-# UNPACK #-}" >> space@@ -168,17 +151,17 @@       IsPromoted -> txt "'"       NotPromoted -> return ()     brackets N $ do-      -- If both this list itself and the first element is promoted,-      -- we need to put a space in between or it fails to parse.+      -- If this list is promoted and the first element starts with a single+      -- quote, we need to put a space in between or it fails to parse.       case (p, xs) of-        (IsPromoted, L _ t : _) | isPromoted t -> space+        (IsPromoted, L _ t : _) | startsWithSingleQuote t -> space         _ -> return ()       sep commaDel (sitcc . located' p_hsType) xs   HsExplicitTupleTy _ xs -> do     txt "'"     parens N $ do       case xs of-        L _ t : _ | isPromoted t -> space+        L _ t : _ | startsWithSingleQuote t -> space         _ -> return ()       sep commaDel (located' p_hsType) xs   HsTyLit _ t ->@@ -188,17 +171,18 @@   HsWildCardTy _ -> txt "_"   XHsType t -> atom t   where-    isPromoted = \case-      HsAppTy _ (L _ f) _ -> isPromoted f+    startsWithSingleQuote = \case+      HsAppTy _ (L _ f) _ -> startsWithSingleQuote f       HsTyVar _ IsPromoted _ -> True       HsExplicitTupleTy {} -> True       HsExplicitListTy {} -> True+      HsTyLit _ HsCharTy {} -> True       _ -> False     interArgBreak =       if multilineArgs         then newline         else breakpoint-    p_hsTypeR = p_hsType' multilineArgs docStyle+    p_hsTypeR = p_hsType' multilineArgs  -- | Return 'True' if at least one argument in 'HsType' has a doc string -- attached to it.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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