ormolu 0.5.0.1 → 0.5.1.0

raw patch · 47 files changed

+392/−251 lines, 47 filesdep +Cabal-syntaxdep −Cabaldep ~ghc-lib-parser

Dependencies added: Cabal-syntax

Dependencies removed: Cabal

Dependency ranges changed: ghc-lib-parser

Files

• CHANGELOG.md +29/−0
• data/examples/declaration/data/existential-unicode-out.hs +9/−0
• data/examples/declaration/data/existential-unicode.hs +7/−0
• data/examples/declaration/data/gadt/multiline-out.hs +2/−6
• data/examples/declaration/data/gadt/multiple-declaration-out.hs +2/−4
• data/examples/declaration/signature/inline/noinline-out.hs +4/−0
• data/examples/declaration/signature/inline/noinline.hs +4/−0
• data/examples/declaration/splice/bracket-unicode-out.hs +6/−0
• data/examples/declaration/splice/bracket-unicode.hs +6/−0
• data/examples/declaration/value/function/lambda-case-out.hs +8/−0
• data/examples/declaration/value/function/lambda-case.hs +8/−0
• data/examples/declaration/value/function/pragmas-out.hs +5/−0
• data/examples/declaration/value/function/pragmas.hs +4/−0
• data/examples/declaration/value/function/type-applications-out.hs +8/−0
• data/examples/declaration/value/function/type-applications.hs +6/−0
• data/examples/declaration/value/function/unboxed-sums-out.hs +2/−0
• data/examples/declaration/value/function/unboxed-sums.hs +2/−0
• data/examples/import/sorted-package-imports-out.hs +7/−0
• data/examples/import/sorted-package-imports.hs +7/−0
• data/examples/other/invalid-haddock-weird-out.hs +3/−1
• data/examples/other/pragma-sorting-out.hs +2/−0
• data/examples/other/pragma-sorting.hs +2/−0
• ormolu.cabal +6/−6
• src/GHC/DynFlags.hs +1/−0
• src/Ormolu/Diff/ParseResult.hs +7/−3
• src/Ormolu/Imports.hs +6/−2
• src/Ormolu/Parser.hs +27/−40
• src/Ormolu/Parser/CommentStream.hs +18/−16
• src/Ormolu/Parser/Pragma.hs +3/−9
• src/Ormolu/Printer/Combinators.hs +2/−1
• src/Ormolu/Printer/Meat/Common.hs +8/−6
• src/Ormolu/Printer/Meat/Declaration.hs +5/−5
• src/Ormolu/Printer/Meat/Declaration/Data.hs +17/−15
• src/Ormolu/Printer/Meat/Declaration/Instance.hs +1/−1
• src/Ormolu/Printer/Meat/Declaration/OpTree.hs +1/−1
• src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs +1/−2
• src/Ormolu/Printer/Meat/Declaration/Rule.hs +1/−1
• src/Ormolu/Printer/Meat/Declaration/Signature.hs +5/−4
• src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs +2/−2
• src/Ormolu/Printer/Meat/Declaration/Value.hs +94/−96
• src/Ormolu/Printer/Meat/Declaration/Warning.hs +5/−5
• src/Ormolu/Printer/Meat/ImportExport.hs +5/−4
• src/Ormolu/Printer/Meat/Module.hs +1/−1
• src/Ormolu/Printer/Meat/Pragma.hs +12/−1
• src/Ormolu/Printer/Meat/Type.hs +19/−16
• src/Ormolu/Utils.hs +11/−2
• tests/Ormolu/CabalInfoSpec.hs +1/−1

@@ -1,3 +1,32 @@+## Ormolu 0.5.1.0++* Imports are now sorted by package qualifier, if one is present.+  [Issue 905](https://github.com/tweag/ormolu/issues/905).++* Extension packs like `GHC2021` and `Haskell2010` are now bumped to the top of+  the list of language pragmas. [Issue+  922](https://github.com/tweag/ormolu/issues/922).++* Fix formatting of `SCC` pragmas in `do` blocks. [Issue+  925](https://github.com/tweag/ormolu/issues/925).++* Support type applications in patterns. [Issue+  930](https://github.com/tweag/ormolu/issues/930).++* Handle `UnicodeSyntax` variants more consistently. [Issue+  934](https://github.com/tweag/ormolu/issues/934).++* Fix an inconsistency in formatting of types in GADT declarations in+  certain cases. [PR 932](https://github.com/tweag/ormolu/pull/932).++* Switched to `ghc-lib-parser-9.4`, which brings support for the following new+  syntactic features:+  * `\cases` via `LambdaCase`+  * `OPAQUE` pragmas+  * Unboxed sum type constructors like `(# | #)`.++* Updated to `Cabal-syntax-3.8`, supporting `cabal-version: 3.8`.+ ## Ormolu 0.5.0.1  * Fixed a bug in the diff printing functionality. [Issue

@@ -0,0 +1,9 @@+{-# LANGUAGE UnicodeSyntax #-}++data Foo+  = forall a.+    Foo++data Bar+  = forall a.+    Bar

@@ -0,0 +1,7 @@+{-# LANGUAGE UnicodeSyntax #-}++data Foo = forall+  a. Foo++data Bar = ∀+  a. Bar

@@ -14,12 +14,8 @@     Foo 'Int   -- | But 'Bar' is also not too bad.   Bar ::-    Int ->-    Maybe Text ->-    Foo 'Bool+    Int -> Maybe Text -> Foo 'Bool   -- | So is 'Baz'.   Baz ::-    forall a.-    a ->-    Foo 'String+    forall a. a -> Foo 'String   (:~>) :: Foo a -> Foo a -> Foo a

@@ -4,12 +4,10 @@ data GADT1 a where   GADT11,     GADT12 ::-    Int ->-    GADT1 a+    Int -> GADT1 a  data GADT2 a where   GADT21,     GADT21,     GADT22 ::-    Int ->-    GADT2 a+    Int -> GADT2 a

@@ -9,3 +9,7 @@ baz :: Int -> Int baz = id {-# NOINLINE [~2] baz #-}++blub :: Int -> Int+blub = baz+{-# OPAQUE blub #-}

@@ -11,3 +11,7 @@ baz = id  {-#   NOINLINE    [~2] baz #-}++blub :: Int -> Int+blub = baz+{-# opaque blub #-}

@@ -0,0 +1,6 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UnicodeSyntax #-}++ascii = [|x|]++unicode = [|x|]

@@ -0,0 +1,6 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UnicodeSyntax   #-}++ascii = [|x|]++unicode = ⟦x⟧

@@ -7,3 +7,11 @@   5 -> 10   i | i > 5 -> 11   _ -> 12++foo :: Maybe a -> Maybe a -> Maybe a -> Int+foo = \cases Nothing Just {} Nothing -> 1; _ _ _ -> 0++foo :: Maybe Int -> Maybe Int -> Int+foo = \cases+  (Just a) (Just a) -> a + a+  _ _ -> 0

@@ -7,3 +7,11 @@   5 -> 10   i  | i > 5 -> 11   _ -> 12++foo :: Maybe a -> Maybe a -> Maybe a -> Int+foo = \cases Nothing Just{} Nothing -> 1;  _ _ _ -> 0++foo :: Maybe Int -> Maybe Int -> Int+foo = \cases+  (Just a) (Just a) -> a + a+  _         _       -> 0

@@ -4,6 +4,11 @@   {-# SCC "barbaz" #-}   "hello" +foo = do+  {-# SCC "foo" #-}+    fmap succ $ do+      {-# SCC "bar" #-} pure 1+ -- CORE pragma got removed in https://gitlab.haskell.org/ghc/ghc/-/commit/12f9035200424ec8104484f154a040d612fee99d  corefoo = {-# CORE "foo"#-} 1

@@ -2,6 +2,10 @@ sccbar = {-# SCC "barbaz"#-}   "hello" +foo = do+  {-# SCC "foo" #-} fmap succ $ do+    {-# SCC "bar" #-} pure 1+ -- CORE pragma got removed in https://gitlab.haskell.org/ghc/ghc/-/commit/12f9035200424ec8104484f154a040d612fee99d  corefoo = {-# CORE "foo"#-}  1

@@ -14,3 +14,11 @@     @(HASH TPraosStandardCrypto)     @ByteString     "And the lamb lies down on Broadway"++test x = case x of+  Foo @t -> show @t 0+  Bar+    @t+    @u+    v ->+      ""

@@ -11,3 +11,9 @@   @(HASH TPraosStandardCrypto)   @ByteString   "And the lamb lies down on Broadway"++test x = case x of+  Foo  @t -> show @t 0+  Bar+   @t @u v+    -> ""

@@ -22,3 +22,5 @@   (#     | | | 10 | | | | |   #)++type UbxPair = (# | #)

@@ -12,3 +12,5 @@ baz = (# |   | | 10 | | | |   | #)++type UbxPair = (# |  #)

@@ -0,0 +1,7 @@+{-# LANGUAGE PackageImports #-}++import D+import "a" Ab+import "b" Aa+import "b" Bb+import "c" Ba

@@ -0,0 +1,7 @@+{-# LANGUAGE PackageImports #-}++import "b" Aa+import "a" Ab+import "c" Ba+import D+import "b" Bb

@@ -1,3 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -foo = foo -- \|# ${+foo = foo++-- \|# ${

@@ -1,3 +1,5 @@+{-# LANGUAGE GHC2021 #-}+{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}

@@ -1,3 +1,5 @@+{-# LANGUAGE ApplicativeDo       #-}+{-# LANGUAGE GHC2021             #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies        #-} {-# LANGUAGE NondecreasingIndentation #-}

@@ -1,10 +1,10 @@ cabal-version:      2.4 name:               ormolu-version:            0.5.0.1+version:            0.5.1.0 license:            BSD-3-Clause license-file:       LICENSE.md maintainer:         Mark Karpov <mark.karpov@tweag.io>-tested-with:        ghc ==8.10.7 ghc ==9.0.2 ghc ==9.2.1+tested-with:        ghc ==9.0.2 ghc ==9.2.4 homepage:           https://github.com/tweag/ormolu bug-reports:        https://github.com/tweag/ormolu/issues synopsis:           A formatter for Haskell source code@@ -92,7 +92,7 @@     other-modules:    GHC.DynFlags     default-language: Haskell2010     build-depends:-        Cabal >=3.6 && <3.7,+        Cabal-syntax >=3.8 && <3.9,         Diff >=0.4 && <1.0,         MemoTrie >=0.6 && <0.7,         aeson >=1.0 && <3.0,@@ -105,7 +105,7 @@         dlist >=0.8 && <2.0,         exceptions >=0.6 && <0.11,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.2 && <9.3,+        ghc-lib-parser >=9.4 && <9.5,         megaparsec >=9.0,         mtl >=2.0 && <3.0,         syb >=0.7 && <0.8,@@ -140,7 +140,7 @@         base >=4.12 && <5.0,         containers >=0.5 && <0.7,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.2 && <9.3,+        ghc-lib-parser >=9.4 && <9.5,         gitrev >=1.3 && <1.4,         optparse-applicative >=0.14 && <0.18,         ormolu,@@ -179,7 +179,7 @@         containers >=0.5 && <0.7,         directory ^>=1.3,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.2 && <9.3,+        ghc-lib-parser >=9.4 && <9.5,         hspec >=2.0 && <3.0,         hspec-megaparsec >=2.2,         megaparsec >=9.0,

@@ -38,6 +38,7 @@             platformIsCrossCompiling = False,             platformLeadingUnderscore = False,             platformTablesNextToCode = False,+            platformHasLibm = False,             platform_constants = Nothing           },       sPlatformMisc = PlatformMisc {},

@@ -1,9 +1,13 @@ {-# LANGUAGE BangPatterns #-}--- needed on GHC 9.0 due to simplified subsumption-{-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-} {-# 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@@ -143,7 +147,7 @@     -- 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 (HsLinearArrow _) (castArrow -> Just (HsLinearArrow _)) = Same     unicodeArrowStyleEq (HsExplicitMult _ _ t) (castArrow -> Just (HsExplicitMult _ _ t')) = genericQuery t t'     unicodeArrowStyleEq _ _ = Different []     castArrow :: Typeable a => a -> Maybe (HsArrow GhcPs)

@@ -19,6 +19,7 @@ import GHC.Hs import GHC.Hs.ImpExp as GHC import GHC.Types.Name.Reader+import GHC.Types.PkgQual import GHC.Types.SourceText import GHC.Types.SrcLoc import GHC.Unit.Module.Name@@ -64,8 +65,8 @@ -- the same 'ImportId' they can be merged. data ImportId = ImportId   { importIsPrelude :: Bool,-    importIdName :: ModuleName,     importPkgQual :: Maybe LexicalFastString,+    importIdName :: ModuleName,     importSource :: IsBootInterface,     importSafe :: Bool,     importQualified :: Bool,@@ -81,7 +82,7 @@   ImportId     { importIsPrelude = isPrelude,       importIdName = moduleName,-      importPkgQual = LexicalFastString . sl_fs <$> ideclPkgQual,+      importPkgQual = rawPkgQualToLFS ideclPkgQual,       importSource = ideclSource,       importSafe = ideclSafe,       importQualified = case ideclQualified of@@ -95,6 +96,9 @@   where     isPrelude = moduleNameString moduleName == "Prelude"     moduleName = unLoc ideclName+    rawPkgQualToLFS = \case+      RawPkgQual fs -> Just . LexicalFastString . sl_fs $ fs+      NoRawPkgQual -> Nothing  -- | Normalize a collection of import\/export items. normalizeLies :: [LIE GhcPs] -> [LIE GhcPs]

@@ -19,23 +19,24 @@ import Data.Generics import qualified Data.List as L import qualified Data.List.NonEmpty as NE-import Data.Ord (Down (Down)) import GHC.Data.Bag (bagToList) import qualified GHC.Data.EnumSet as EnumSet import qualified GHC.Data.FastString as GHC import qualified GHC.Data.StringBuffer as GHC import qualified GHC.Driver.CmdLine 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 GHC.Parser.Errors.Ppr (pprError) 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.Types.SrcLoc-import GHC.Utils.Error (Severity (..), errMsgSeverity, errMsgSpan)+import GHC.Utils.Error+import GHC.Utils.Outputable (defaultSDocContext) import qualified GHC.Utils.Panic as GHC import Ormolu.Config import Ormolu.Exception@@ -45,7 +46,7 @@ import Ormolu.Parser.Result import Ormolu.Processing.Common import Ormolu.Processing.Preprocess-import Ormolu.Utils (incSpanLine)+import Ormolu.Utils (incSpanLine, showOutputable)  -- | Parse a complete module from string. parseModule ::@@ -99,13 +100,22 @@ parseModuleSnippet Config {..} fixityMap dynFlags path rawInput = liftIO $ do   let (input, indent) = removeIndentation . linesInRegion cfgRegion $ rawInput   let pStateErrors pstate =-        let errs = fmap pprError . bagToList $ GHC.getErrorMessages pstate+        let errs = bagToList . getMessages $ GHC.getPsErrorMessages pstate             fixupErrSpan = incSpanLine (regionPrefixLength cfgRegion)-         in case L.sortOn (Down . SeverityOrd . errMsgSeverity) errs of+            rateSeverity = \case+              SevError -> 1 :: Int+              SevWarning -> 2+              SevIgnore -> 3+            showErr =+              showOutputable+                . formatBulleted defaultSDocContext+                . diagnosticMessage+                . errMsgDiagnostic+         in case L.sortOn (rateSeverity . errMsgSeverity) errs of               [] -> Nothing               err : _ ->                 -- Show instance returns a short error message-                Just (fixupErrSpan (errMsgSpan err), show err)+                Just (fixupErrSpan (errMsgSpan err), showErr err)       parser = case cfgSourceType of         ModuleSource -> GHC.parseModule         SignatureSource -> GHC.parseSignature@@ -150,12 +160,12 @@         hsmodDecls =           filter (not . isBlankDocD . unLoc) (hsmodDecls hsmod),         hsmodHaddockModHeader =-          mfilter (not . isBlankDocString . unLoc) (hsmodHaddockModHeader hsmod),+          mfilter (not . isBlankDocString) (hsmodHaddockModHeader hsmod),         hsmodExports =           (fmap . fmap) (filter (not . isBlankDocIE . unLoc)) (hsmodExports hsmod)       }   where-    isBlankDocString = all isSpace . unpackHDS+    isBlankDocString = all isSpace . renderHsDocString . hsDocString . unLoc     isBlankDocD = \case       DocD _ s -> isBlankDocString $ docDeclDoc s       _ -> False@@ -165,8 +175,8 @@       _ -> False      dropBlankTypeHaddocks = \case-      L _ (HsDocTy _ ty (L _ ds)) :: LHsType GhcPs-        | isBlankDocString ds -> ty+      L _ (HsDocTy _ ty s) :: LHsType GhcPs+        | isBlankDocString s -> ty       a -> a  -- | Enable all language extensions that we think should be enabled by@@ -224,34 +234,7 @@   where     location = mkRealSrcLoc (GHC.mkFastString filename) 1 1     buffer = GHC.stringToStringBuffer input-    parseState = GHC.initParserState (opts flags) buffer location-    opts =-      GHC.mkParserOpts-        <$> GHC.warningFlags-        <*> GHC.extensionFlags-        <*> GHC.safeImportsOn-        <*> GHC.gopt GHC.Opt_Haddock-        <*> GHC.gopt GHC.Opt_KeepRawTokenStream-        <*> const True---- | Wrap GHC's 'Severity' to add 'Ord' instance.-newtype SeverityOrd = SeverityOrd Severity--instance Eq SeverityOrd where-  s1 == s2 = compare s1 s2 == EQ--instance Ord SeverityOrd where-  compare (SeverityOrd s1) (SeverityOrd s2) =-    compare (f s1) (f s2)-    where-      f :: Severity -> Int-      f SevOutput = 1-      f SevFatal = 2-      f SevInteractive = 3-      f SevDump = 4-      f SevInfo = 5-      f SevWarning = 6-      f SevError = 7+    parseState = GHC.initParserState (initParserOpts flags) buffer location  ---------------------------------------------------------------------------- -- Helpers taken from HLint@@ -268,7 +251,11 @@   IO (Either String ([GHC.Warn], DynFlags)) parsePragmasIntoDynFlags flags extraOpts filepath str =   catchErrors $ do-    let fileOpts = GHC.getOptions flags (GHC.stringToStringBuffer str) filepath+    let (_warnings, fileOpts) =+          GHC.getOptions+            (initParserOpts flags)+            (GHC.stringToStringBuffer str)+            filepath     (flags', leftovers, warnings) <-       parseDynamicFilePragma flags (extraOpts <> fileOpts)     case NE.nonEmpty leftovers of

@@ -29,8 +29,8 @@ import qualified Data.Map.Lazy as M import Data.Maybe import qualified Data.Set as S+import qualified GHC.Data.Strict as Strict import GHC.Hs (HsModule)-import GHC.Hs.Decls (HsDecl (..), LDocDecl, LHsDecl) import GHC.Hs.Doc import GHC.Hs.Extension import GHC.Hs.ImpExp@@ -87,22 +87,15 @@               EpaComments cs -> cs               EpaCommentsBalanced pcs fcs -> pcs <> fcs         -- All spans of valid Haddock comments-        -- (everywhere where we use p_hsDoc{String,Name})         validHaddockCommentSpans =           S.fromList             . mapMaybe srcSpanToRealSrcSpan             . mconcat-              [ fmap getLoc . listify (only @LHsDocString),-                fmap getLocA . listify (only @(LDocDecl GhcPs)),-                fmap getLocA . listify isDocD,+              [ fmap getLoc . listify (only @(LHsDoc GhcPs)),                 fmap getLocA . listify isIEDocLike               ]             $ hsModule           where-            isDocD :: LHsDecl GhcPs -> Bool-            isDocD = \case-              L _ DocD {} -> True-              _ -> False             isIEDocLike :: LIE GhcPs -> Bool             isIEDocLike = \case               L _ IEGroup {} -> True@@ -231,8 +224,8 @@                   (y : ys) ->                     let (ls', y') = mkComment ls y                      in if onTheSameLine-                          (RealSrcSpan (getRealSrcSpan x) Nothing)-                          (RealSrcSpan (getRealSrcSpan y) Nothing)+                          (RealSrcSpan (getRealSrcSpan x) Strict.Nothing)+                          (RealSrcSpan (getRealSrcSpan y) Strict.Nothing)                           then go' ls' [y'] ys                           else go' ls [] xs @@ -240,10 +233,13 @@ unAnnotationComment :: GHC.LEpaComment -> Maybe (RealLocated String) unAnnotationComment (L (GHC.Anchor anchor _) (GHC.EpaComment eck _)) =   case eck of-    GHC.EpaDocCommentNext s -> haddock "|" s -- @-- |@-    GHC.EpaDocCommentPrev s -> haddock "^" s -- @-- ^@-    GHC.EpaDocCommentNamed s -> haddock "$" s -- @-- $@-    GHC.EpaDocSection k s -> haddock (replicate k '*') s -- @-- *@+    GHC.EpaDocComment s ->+      let trigger = case s of+            MultiLineDocString t _ -> Just t+            NestedDocString t _ -> Just t+            -- should not occur+            GeneratedDocString _ -> Nothing+       in haddock trigger (renderHsDocString s)     GHC.EpaDocOptions s -> mkL s     GHC.EpaLineComment s -> mkL $       case take 3 s of@@ -255,9 +251,15 @@   where     mkL = Just . L anchor     insertAt x xs n = take (n - 1) xs ++ x ++ drop (n - 1) xs-    haddock trigger =+    haddock mtrigger =       mkL . dashPrefix . escapeHaddockTriggers . (trigger <>) <=< dropBlank       where+        trigger = case mtrigger of+          Just HsDocStringNext -> "|"+          Just HsDocStringPrevious -> "^"+          Just (HsDocStringNamed n) -> "$" <> n+          Just (HsDocStringGroup k) -> replicate k '*'+          Nothing -> ""         dashPrefix s = "--" <> spaceIfNecessary <> s           where             spaceIfNecessary = case s of

@@ -11,9 +11,10 @@ import Control.Monad import Data.Char (isSpace, toLower) import qualified Data.List as L-import qualified GHC.Data.EnumSet as ES import GHC.Data.FastString (mkFastString, unpackFS) import GHC.Data.StringBuffer+import GHC.Driver.Config.Parser (initParserOpts)+import GHC.DynFlags (baseDynFlags) import qualified GHC.Parser.Lexer as L import GHC.Types.SrcLoc @@ -67,14 +68,7 @@     location = mkRealSrcLoc (mkFastString "") 1 1     buffer = stringToStringBuffer input     parseState = L.initParserState parserOpts buffer location-    parserOpts =-      L.mkParserOpts-        ES.empty-        ES.empty-        True-        True-        True-        True+    parserOpts = initParserOpts baseDynFlags  -- | Haskell lexer. pLexer :: L.P [L.Token]

@@ -75,6 +75,7 @@ import Control.Monad import Data.List (intersperse) import Data.Text (Text)+import qualified GHC.Data.Strict as Strict import GHC.Types.SrcLoc import Ormolu.Printer.Comments import Ormolu.Printer.Internal@@ -109,7 +110,7 @@   RealSrcSpan l _ -> do     spitPrecedingComments l     withEnclosingSpan l $-      switchLayout [RealSrcSpan l Nothing] (f a)+      switchLayout [RealSrcSpan l Strict.Nothing] (f a)     spitFollowingComments l  -- | A version of 'located' with arguments flipped.

@@ -10,7 +10,7 @@     p_rdrName,     p_qualName,     p_infixDefHelper,-    p_hsDocString,+    p_hsDoc,     p_hsDocName,     p_sourceText,   )@@ -19,6 +19,7 @@ import Control.Monad import qualified Data.Text as T import GHC.Hs.Doc+import GHC.Hs.Extension (GhcPs) import GHC.Hs.ImpExp import GHC.Parser.Annotation import GHC.Types.Name.Occurrence (OccName (..))@@ -131,15 +132,15 @@         inciIf indentArgs $ sitcc (sep breakpoint sitcc args)  -- | Print a Haddock.-p_hsDocString ::+p_hsDoc ::   -- | Haddock style   HaddockStyle ->   -- | Finish the doc string with a newline   Bool ->-  -- | The doc string to render-  LHsDocString ->+  -- | The 'LHsDoc' to render+  LHsDoc GhcPs ->   R ()-p_hsDocString hstyle needsNewline (L l str) = do+p_hsDoc hstyle needsNewline (L l str) = do   let isCommentSpan = \case         HaddockSpan _ _ -> True         CommentSpan _ -> True@@ -147,7 +148,8 @@   goesAfterComment <- maybe False isCommentSpan <$> getSpanMark   -- Make sure the Haddock is separated by a newline from other comments.   when goesAfterComment newline-  forM_ (zip (splitDocString str) (True : repeat False)) $ \(x, isFirst) -> do+  let docStringLines = splitDocString $ hsDocString str+  forM_ (zip docStringLines (True : repeat False)) $ \(x, isFirst) -> do     if isFirst       then case hstyle of         Pipe -> txt "-- |"

@@ -125,10 +125,10 @@   SpliceD _ x -> p_spliceDecl x   DocD _ docDecl ->     case docDecl of-      DocCommentNext str -> p_hsDocString Pipe False (noLoc str)-      DocCommentPrev str -> p_hsDocString Caret False (noLoc str)-      DocCommentNamed name str -> p_hsDocString (Named name) False (noLoc str)-      DocGroup n str -> p_hsDocString (Asterisk n) False (noLoc str)+      DocCommentNext str -> p_hsDoc Pipe False str+      DocCommentPrev str -> p_hsDoc Caret False str+      DocCommentNamed name str -> p_hsDoc (Named name) False str+      DocGroup n str -> p_hsDoc (Asterisk n) False str   RoleAnnotD _ x -> p_roleAnnot x   KindSigD _ s -> p_standaloneKindSig s @@ -314,7 +314,7 @@ 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 (SumPat _ (L _ p) _ _) = patBindNames p

@@ -13,6 +13,7 @@ import Control.Monad import Data.Maybe (isJust, maybeToList) import Data.Void+import qualified GHC.Data.Strict as Strict import GHC.Hs import GHC.Types.Fixity import GHC.Types.ForeignCall@@ -21,6 +22,7 @@ import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type+import Ormolu.Utils (matchAddEpAnn)  p_dataDecl ::   -- | Whether to format as data family@@ -105,7 +107,7 @@   R () p_conDecl singleConstRec = \case   ConDeclGADT {..} -> do-    mapM_ (p_hsDocString Pipe True) con_doc+    mapM_ (p_hsDoc Pipe True) con_doc     let conDeclSpn =           fmap getLocA con_names             <> [getLocA con_bndrs]@@ -114,7 +116,7 @@           where             conArgsSpans = case con_g_args of               PrefixConGADT xs -> getLocA . hsScaledThing <$> xs-              RecConGADT x -> [getLocA x]+              RecConGADT x _ -> [getLocA x]     switchLayout conDeclSpn $ do       case con_names of         [] -> return ()@@ -124,37 +126,37 @@             commaDel             sep commaDel p_rdrName cs       inci $ do-        space-        txt "::"-        let interArgBreak =-              if hasDocStrings (unLoc con_res_ty)-                then newline-                else breakpoint-        interArgBreak         let conTy = case con_g_args of               PrefixConGADT xs ->                 let go (HsScaled a b) t = addCLocAA t b (HsFunTy EpAnnNotUsed a b t)                  in foldr go con_res_ty xs-              RecConGADT r ->+              RecConGADT r _ ->                 addCLocAA r con_res_ty $                   HsFunTy                     EpAnnNotUsed-                    (HsUnrestrictedArrow NormalSyntax)+                    (HsUnrestrictedArrow noHsUniTok)                     (la2la $ HsRecTy EpAnnNotUsed <$> r)                     con_res_ty             qualTy = case con_mb_cxt of               Nothing -> conTy               Just qs ->                 addCLocAA qs conTy $-                  HsQualTy NoExtField (Just qs) conTy+                  HsQualTy NoExtField qs conTy             quantifiedTy =               addCLocAA con_bndrs qualTy $                 hsOuterTyVarBndrsToHsType (unLoc con_bndrs) qualTy-        p_hsType (unLoc quantifiedTy)+        space+        txt "::"+        if hasDocStrings (unLoc con_res_ty)+          then newline+          else breakpoint+        located quantifiedTy p_hsType   ConDeclH98 {..} -> do-    mapM_ (p_hsDocString Pipe True) con_doc+    mapM_ (p_hsDoc Pipe True) con_doc     let conDeclWithContextSpn =-          [RealSrcSpan real Nothing | AddEpAnn AnnForall (EpaSpan real) <- epAnnAnns con_ext]+          [ RealSrcSpan real Strict.Nothing+            | Just (EpaSpan real) <- matchAddEpAnn AnnForall <$> epAnnAnns con_ext+          ]             <> fmap getLocA con_ex_tvs             <> maybeToList (fmap getLocA con_mb_cxt)             <> conDeclSpn

@@ -70,7 +70,7 @@         )           <$> cid_tyfam_insts       dataFamInsts =-        ( getLocA &&& fmap (InstD NoExtField . DataFamInstD EpAnnNotUsed)+        ( getLocA &&& fmap (InstD NoExtField . DataFamInstD NoExtField)         )           <$> cid_datafam_insts       allDecls =

@@ -217,7 +217,7 @@ -- | Convert a LHsType containing an operator tree to the 'OpTree' -- intermediate representation. tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (LocatedN RdrName)-tyOpTree (L _ (HsOpTy NoExtField l op r)) =+tyOpTree (L _ (HsOpTy _ _ l op r)) =   OpBranches [tyOpTree l, tyOpTree r] [op] tyOpTree n = OpNode n 

@@ -11,14 +11,13 @@ import GHC.Core.Coercion.Axiom import GHC.Hs hiding (anns) import GHC.Types.Name.Reader-import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common  p_roleAnnot :: RoleAnnotDecl GhcPs -> R () p_roleAnnot (RoleAnnotDecl _ l_name anns) = p_roleAnnot' l_name anns -p_roleAnnot' :: LocatedN RdrName -> [Located (Maybe Role)] -> R ()+p_roleAnnot' :: LocatedN RdrName -> [XRec GhcPs (Maybe Role)] -> R () p_roleAnnot' l_name anns = do   txt "type role"   breakpoint

@@ -36,7 +36,7 @@   -- in the input or no forall at all. We do not want to add redundant   -- foralls, so let's just skip the empty ones.   unless (null ruleBndrs) $-    p_forallBndrs ForAllInvis p_ruleBndr (reLocA <$> ruleBndrs)+    p_forallBndrs ForAllInvis p_ruleBndr ruleBndrs   breakpoint   inci $ do     located lhs p_hsExpr

@@ -144,9 +144,10 @@  p_inlineSpec :: InlineSpec -> R () p_inlineSpec = \case-  Inline -> txt "INLINE"-  Inlinable -> txt "INLINEABLE"-  NoInline -> txt "NOINLINE"+  Inline _ -> txt "INLINE"+  Inlinable _ -> txt "INLINEABLE"+  NoInline _ -> txt "NOINLINE"+  Opaque _ -> txt "OPAQUE"   NoUserInlinePrag -> return ()  p_activation :: Activation -> R ()@@ -212,7 +213,7 @@         breakpoint         inci (p_rdrName ty) -p_sccSig :: LocatedN RdrName -> Maybe (Located StringLiteral) -> R ()+p_sccSig :: LocatedN RdrName -> Maybe (XRec GhcPs StringLiteral) -> R () p_sccSig loc literal = pragma "SCC" . inci $ do   p_rdrName loc   forM_ literal $ \x -> do

@@ -28,7 +28,7 @@     Associated -> mempty     Free -> " family"   let headerSpns = getLocA fdLName : (getLocA <$> hsq_explicit)-      headerAndSigSpns = getLoc fdResultSig : headerSpns+      headerAndSigSpns = getLocA fdResultSig : headerSpns   inci . switchLayout headerAndSigSpns $ do     breakpoint     switchLayout headerSpns $ do@@ -58,7 +58,7 @@           inci (sep newline (located' p_tyFamInstEqn) eqs)  p_familyResultSigL ::-  Located (FamilyResultSig GhcPs) ->+  LFamilyResultSig GhcPs ->   Maybe (R ()) p_familyResultSigL (L _ a) = case a of   NoSig NoExtField -> Nothing

@@ -2,8 +2,10 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-}  module Ormolu.Printer.Meat.Declaration.Value@@ -35,6 +37,7 @@ import Data.Void import GHC.Data.Bag (bagToList) import GHC.Data.FastString (FastString, lengthFS)+import qualified GHC.Data.Strict as Strict import GHC.Hs import GHC.LanguageExtensions.Type (Extension (NegativeLiterals)) import GHC.Parser.CharClass (is_space)@@ -65,12 +68,11 @@   = EqualSign   | RightArrow -p_valDecl :: HsBindLR GhcPs GhcPs -> R ()+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   VarBind {} -> notImplemented "VarBinds" -- introduced by the type checker-  AbsBinds {} -> notImplemented "AbsBinds" -- introduced by the type checker   PatSynBind _ psb -> p_patSynBind psb  p_funBind ::@@ -86,7 +88,7 @@ p_matchGroup = p_matchGroup' exprPlacement p_hsExpr  p_matchGroup' ::-  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,+  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,     Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA   ) =>   -- | How to get body placement@@ -155,7 +157,7 @@ p_match = p_match' exprPlacement p_hsExpr  p_match' ::-  (Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan) =>+  (Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns) =>   -- | How to get body placement   (body -> Placement) ->   -- | How to print body@@ -243,7 +245,7 @@                 || not (onTheSameLine spn grhssSpan) ->                 Normal           _ -> blockPlacement placer grhssGRHSs-      guardNeedsLineBreak :: Located (GRHS GhcPs body) -> Bool+      guardNeedsLineBreak :: XRec GhcPs (GRHS GhcPs body) -> Bool       guardNeedsLineBreak (L _ (GRHS _ guardLStmts _)) = case guardLStmts of         [] -> False         [g] -> not . isOneLineSpan . getLocA $ g@@ -255,7 +257,7 @@                 else EqualSign         sep           breakpoint-          (located' (p_grhs' placement placer render groupStyle) . reLocA)+          (located' (p_grhs' placement placer render groupStyle))           grhssGRHSs       p_where = do         unless (eqEmptyLocalBinds grhssLocalBinds) $ do@@ -353,14 +355,14 @@     space     located expr p_hsExpr   HsCmdLam _ mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup-  HsCmdPar _ c -> parens N (located c p_hsCmd)+  HsCmdPar _ _ c _ -> parens N (located c p_hsCmd)   HsCmdCase _ e mgroup ->     p_case cmdPlacement p_hsCmd e mgroup-  HsCmdLamCase _ mgroup ->-    p_lamcase cmdPlacement p_hsCmd mgroup+  HsCmdLamCase _ variant mgroup ->+    p_lamcase variant cmdPlacement p_hsCmd mgroup   HsCmdIf _ _ if' then' else' ->     p_if cmdPlacement p_hsCmd if' then' else'-  HsCmdLet _ localBinds c ->+  HsCmdLet _ _ localBinds _ c ->     p_let p_hsCmd localBinds c   HsCmdDo _ es -> do     txt "do"@@ -522,16 +524,12 @@     sitcc $ sepSemi p_item' (attachRelativePos binds)   HsValBinds _ _ -> notImplemented "HsValBinds"   HsIPBinds epAnn (IPBinds _ xs) -> pseudoLocated epAnn $ do-    -- Second argument of IPBind is always Left before type-checking.-    let p_ipBind (IPBind _ (Left name) expr) = do-          atom name+    let p_ipBind (IPBind _ (L _ name) expr) = do+          atom @HsIPName name           space           equals           breakpoint           useBraces $ inci $ located expr p_hsExpr-        p_ipBind (IPBind _ (Right _) _) =-          -- Should only occur after the type checker-          notImplemented "IPBind _ (Right _) _"     sepSemi (located' p_ipBind) xs   EmptyLocalBinds _ -> return ()   where@@ -540,13 +538,13 @@     -- depend on the layout being correctly set.     pseudoLocated = \case       EpAnn {anns = AnnList {al_anchor = Just Anchor {anchor}}} ->-        located (L (RealSrcSpan anchor Nothing) ()) . const+        located (L (RealSrcSpan anchor Strict.Nothing) ()) . const       _ -> id -p_lhsFieldLabel :: Located (HsFieldLabel GhcPs) -> R ()-p_lhsFieldLabel = located' $ p_lFieldLabelString . hflLabel+p_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()+p_ldotFieldOcc = located' $ p_lFieldLabelString . dfoLabel   where-    p_lFieldLabelString (L s fs) = parensIfOp . atom @FastString $ fs+    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@@ -560,24 +558,27 @@               parens N           | otherwise = id -p_fieldLabels :: [Located (HsFieldLabel GhcPs)] -> R ()-p_fieldLabels flss =-  sep (txt ".") p_lhsFieldLabel flss+p_ldotFieldOccs :: [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()+p_ldotFieldOccs = sep (txt ".") p_ldotFieldOcc -p_hsRecField ::-  (id -> R ()) ->-  HsRecField' id (LHsExpr GhcPs) ->+p_fieldOcc :: FieldOcc GhcPs -> R ()+p_fieldOcc FieldOcc {..} = p_rdrName foLabel++p_hsFieldBind ::+  (lhs ~ GenLocated l a, HasSrcSpan l) =>+  (lhs -> R ()) ->+  HsFieldBind lhs (LHsExpr GhcPs) ->   R ()-p_hsRecField p_lbl HsRecField {..} = do-  located hsRecFieldLbl p_lbl-  unless hsRecPun $ do+p_hsFieldBind p_lhs HsFieldBind {..} = do+  p_lhs hfbLHS+  unless hfbPun $ do     space     equals     let placement =-          if onTheSameLine (getLoc hsRecFieldLbl) (getLocA hsRecFieldArg)-            then exprPlacement (unLoc hsRecFieldArg)+          if onTheSameLine (getLoc' hfbLHS) (getLocA hfbRHS)+            then exprPlacement (unLoc hfbRHS)             else Normal-    placeHanging placement (located hsRecFieldArg p_hsExpr)+    placeHanging placement (located hfbRHS p_hsExpr)  p_hsExpr :: HsExpr GhcPs -> R () p_hsExpr = p_hsExpr' N@@ -586,11 +587,7 @@ p_hsExpr' s = \case   HsVar _ name -> p_rdrName name   HsUnboundVar _ occ -> atom occ-  HsConLikeOut _ _ -> notImplemented "HsConLikeOut"-  HsRecFld _ x ->-    case x of-      Unambiguous _ name -> p_rdrName name-      Ambiguous _ name -> p_rdrName name+  HsRecSel _ fldOcc -> p_fieldOcc fldOcc   HsOverLabel _ v -> do     txt "#"     atom v@@ -605,8 +602,8 @@       r -> atom r   HsLam _ mgroup ->     p_matchGroup Lambda mgroup-  HsLamCase _ mgroup ->-    p_lamcase exprPlacement p_hsExpr mgroup+  HsLamCase _ variant mgroup ->+    p_lamcase 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@@ -696,7 +693,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@@ -719,7 +716,9 @@           case boxity of             Boxed -> parens             Unboxed -> parensHash-    enclSpan <- fmap (flip RealSrcSpan Nothing) . maybeToList <$> getEnclosingSpan (const True)+    enclSpan <-+      fmap (flip RealSrcSpan Strict.Nothing) . maybeToList+        <$> getEnclosingSpan (const True)     if isSection       then         switchLayout [] . parens' s $@@ -737,9 +736,9 @@     txt "if"     breakpoint     inci . inci $ sep newline (located' (p_grhs RightArrow)) guards-  HsLet _ localBinds e ->+  HsLet _ _ localBinds _ e ->     p_let p_hsExpr localBinds e-  HsDo _ ctx es -> do+  HsDo _ doFlavor es -> do     let doBody moduleName header = do           forM_ moduleName $ \m -> atom m *> txt "."           txt header@@ -762,52 +761,48 @@           txt "|"           space           p_parBody lists-    case ctx of+    case doFlavor of       DoExpr moduleName -> doBody moduleName "do"       MDoExpr moduleName -> doBody moduleName "mdo"       ListComp -> compBody       MonadComp -> compBody-      ArrowExpr -> notImplemented "ArrowExpr"       GhciStmtCtxt -> notImplemented "GhciStmtCtxt"-      PatGuard _ -> notImplemented "PatGuard"-      ParStmtCtxt _ -> notImplemented "ParStmtCtxt"-      TransStmtCtxt _ -> notImplemented "TransStmtCtxt"   ExplicitList _ xs ->     brackets s $       sep commaDel (sitcc . located' p_hsExpr) xs   RecordCon {..} -> do-    located rcon_con atom+    p_rdrName rcon_con     breakpoint     let HsRecFields {..} = rcon_flds-        p_lbl = p_rdrName . rdrNameFieldOcc-        fields = located' (p_hsRecField p_lbl) <$> rec_flds-        dotdot =-          case rec_dotdot of-            Just {} -> [txt ".."]-            Nothing -> []+        p_lhs = located' $ p_rdrName . foLabel+        fields = located' (p_hsFieldBind p_lhs) <$> rec_flds+        dotdot = case rec_dotdot of+          Just {} -> [txt ".."]+          Nothing -> []     inci . braces N $       sep commaDel sitcc (fields <> dotdot)   RecordUpd {..} -> do     located rupd_expr p_hsExpr     breakpoint     let p_updLbl =-          p_rdrName . \case-            Unambiguous NoExtField n -> n-            Ambiguous NoExtField n -> n+          located' $+            p_rdrName . \case+              (Unambiguous NoExtField n :: AmbiguousFieldOcc GhcPs) -> n+              Ambiguous NoExtField n -> n         p_recFields p_lbl =-          sep commaDel (sitcc . located' (p_hsRecField p_lbl))+          sep commaDel (sitcc . located' (p_hsFieldBind p_lbl))     inci . braces N $       either         (p_recFields p_updLbl)-        (p_recFields (p_fieldLabels . coerce))+        (p_recFields $ located' $ coerce p_ldotFieldOccs)         rupd_flds   HsGetField {..} -> do     located gf_expr p_hsExpr     txt "."-    p_lhsFieldLabel gf_field+    p_ldotFieldOcc gf_field   HsProjection {..} -> parens N $ do     txt "."-    p_fieldLabels (NE.toList proj_flds)+    p_ldotFieldOccs (NE.toList proj_flds)   ExprWithTySig _ x HsWC {hswc_body} -> sitcc $ do     located x p_hsExpr     space@@ -836,9 +831,13 @@         txt ".."         space         located to p_hsExpr-  HsBracket epAnn x -> p_hsBracket epAnn x-  HsRnBracketOut {} -> notImplemented "HsRnBracketOut"-  HsTcBracketOut {} -> notImplemented "HsTcBracketOut"+  HsTypedBracket _ expr -> do+    txt "[||"+    breakpoint'+    located expr p_hsExpr+    breakpoint'+    txt "||]"+  HsUntypedBracket epAnn x -> p_hsQuote epAnn x   HsSpliceE _ splice -> p_hsSplice splice   HsProc _ p e -> do     txt "proc"@@ -853,15 +852,14 @@     txt "static"     breakpoint     inci (located e p_hsExpr)-  HsTick {} -> notImplemented "HsTick"-  HsBinTick {} -> notImplemented "HsBinTick"   HsPragE _ prag x -> case prag of     HsPragSCC _ _ name -> do       txt "{-# SCC "       atom name       txt " #-}"       breakpoint-      located x p_hsExpr+      let inciIfS = case s of N -> id; S -> inci+      inciIfS $ located x p_hsExpr  p_patSynBind :: PatSynBind GhcPs GhcPs -> R () p_patSynBind PSB {..} = do@@ -923,7 +921,7 @@       inci (rhs conSpans)  p_case ::-  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,+  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,     Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA   ) =>   -- | Placer@@ -945,9 +943,11 @@   inci (p_matchGroup' placer render Case mgroup)  p_lamcase ::-  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,+  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,     Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA   ) =>+  -- | Variant (@\\case@ or @\\cases@)+  LamCaseVariant ->   -- | Placer   (body -> Placement) ->   -- | Render@@ -955,8 +955,10 @@   -- | Expression   MatchGroup GhcPs (LocatedA body) ->   R ()-p_lamcase placer render mgroup = do-  txt "\\case"+p_lamcase variant placer render mgroup = do+  txt $ case variant of+    LamCase -> "\\case"+    LamCases -> "\\cases"   breakpoint   inci (p_matchGroup' placer render LambdaCase mgroup) @@ -1014,7 +1016,7 @@     p_rdrName name     txt "@"     located pat p_pat-  ParPat _ pat ->+  ParPat _ _ pat _ ->     located pat (parens S . p_pat)   BangPat _ pat -> do     txt "!"@@ -1031,19 +1033,18 @@     p_unboxedSum S tag arity (located pat p_pat)   ConPat _ pat details ->     case details of-      PrefixCon [] xs -> sitcc $ do+      PrefixCon tys xs -> sitcc $ do         p_rdrName pat-        unless (null xs) $ do-          breakpoint-          inci . sitcc $ sep breakpoint (sitcc . located' p_pat) xs-      -- The first field of PrefixCon is filled in later stages-      PrefixCon {} -> notImplemented "Unexpected types in constructor pattern"+        unless (null tys && null xs) breakpoint+        inci . sitcc $+          sep breakpoint (sitcc . either p_hsPatSigType (located' p_pat)) $+            (Left <$> tys) <> (Right <$> xs)       RecCon (HsRecFields fields dotdot) -> do         p_rdrName pat         breakpoint         let f = \case               Nothing -> txt ".."-              Just x -> located x p_pat_hsRecField+              Just x -> located x p_pat_hsFieldBind         inci . braces N . sep commaDel f $           case dotdot of             Nothing -> Just <$> fields@@ -1081,14 +1082,17 @@     located pat p_pat     p_typeAscription (lhsTypeToSigType hsps_body) -p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()-p_pat_hsRecField HsRecField {..} = do-  located hsRecFieldLbl $ p_rdrName . rdrNameFieldOcc-  unless hsRecPun $ do+p_hsPatSigType :: HsPatSigType GhcPs -> R ()+p_hsPatSigType (HsPS _ ty) = txt "@" *> located ty p_hsType++p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R ()+p_pat_hsFieldBind HsFieldBind {..} = do+  located hfbLHS p_fieldOcc+  unless hfbPun $ do     space     equals     breakpoint-    inci (located hsRecFieldArg p_pat)+    inci (located hfbRHS p_pat)  p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R () p_unboxedSum s tag arity m = do@@ -1136,11 +1140,11 @@   where     decoSymbol = if isTyped then "$$" else "$" -p_hsBracket :: EpAnn [AddEpAnn] -> HsBracket GhcPs -> R ()-p_hsBracket epAnn = \case+p_hsQuote :: EpAnn [AddEpAnn] -> HsQuote GhcPs -> R ()+p_hsQuote epAnn = \case   ExpBr _ expr -> do     let name-          | or [True | AddEpAnn AnnOpenEQ _ <- epAnnAnns epAnn] = ""+          | any isJust (matchAddEpAnn AnnOpenEQ <$> epAnnAnns epAnn) = ""           | otherwise = "e"     quote name (located expr p_hsExpr)   PatBr _ pat -> located pat (quote "p" . p_pat)@@ -1150,12 +1154,6 @@   VarBr _ isSingleQuote name -> do     txt (bool "''" "'" isSingleQuote)     p_rdrName name-  TExpBr _ expr -> do-    txt "[||"-    breakpoint'-    located expr p_hsExpr-    breakpoint'-    txt "||]"   where     quote :: Text -> R () -> R ()     quote name body = do@@ -1261,7 +1259,7 @@ cmdPlacement = \case   HsCmdLam _ _ -> Hanging   HsCmdCase _ _ _ -> Hanging-  HsCmdLamCase _ _ -> Hanging+  HsCmdLamCase _ _ _ -> Hanging   HsCmdDo _ _ -> Hanging   _ -> Normal @@ -1278,7 +1276,7 @@       | isOneLineSpan (combineSrcSpans' $ fmap getLocA (x :| xs)) ->           Hanging     _ -> Normal-  HsLamCase _ _ -> Hanging+  HsLamCase _ _ _ -> Hanging   HsCase _ _ _ -> Hanging   HsDo _ (DoExpr _) _ -> Hanging   HsDo _ (MDoExpr _) _ -> Hanging

@@ -25,12 +25,12 @@ p_warnDecl (Warning _ functions warningTxt) =   p_topLevelWarning functions warningTxt -p_moduleWarning :: WarningTxt -> R ()+p_moduleWarning :: WarningTxt GhcPs -> R () p_moduleWarning wtxt = do   let (pragmaText, lits) = warningText wtxt   inci $ pragma pragmaText $ inci $ p_lits lits -p_topLevelWarning :: [LocatedN RdrName] -> WarningTxt -> R ()+p_topLevelWarning :: [LocatedN RdrName] -> WarningTxt GhcPs -> R () p_topLevelWarning fnames wtxt = do   let (pragmaText, lits) = warningText wtxt   switchLayout (fmap getLocA fnames ++ fmap getLoc lits) $@@ -39,10 +39,10 @@       breakpoint       p_lits lits -warningText :: WarningTxt -> (Text, [Located StringLiteral])+warningText :: WarningTxt GhcPs -> (Text, [Located StringLiteral]) warningText = \case-  WarningTxt _ lits -> ("WARNING", lits)-  DeprecatedTxt _ lits -> ("DEPRECATED", lits)+  WarningTxt _ lits -> ("WARNING", fmap hsDocString <$> lits)+  DeprecatedTxt _ lits -> ("DEPRECATED", fmap hsDocString <$> lits)  p_lits :: [Located StringLiteral] -> R () p_lits = \case

@@ -12,6 +12,7 @@ import Control.Monad import GHC.Hs import GHC.LanguageExtensions.Type+import GHC.Types.PkgQual import GHC.Types.SrcLoc import GHC.Unit.Types import Ormolu.Printer.Combinators@@ -45,8 +46,8 @@     (txt "qualified")   space   case ideclPkgQual of-    Nothing -> return ()-    Just slit -> atom slit+    NoRawPkgQual -> return ()+    RawPkgQual slit -> atom slit   space   inci $ do     located ideclName atom@@ -112,9 +113,9 @@       FirstPos -> return ()       MiddlePos -> newline       LastPos -> newline-    p_hsDocString (Asterisk n) False (noLoc str)+    p_hsDoc (Asterisk n) False str   IEDoc NoExtField str ->-    p_hsDocString Pipe False (noLoc str)+    p_hsDoc Pipe False str   IEDocNamed NoExtField str -> p_hsDocName str   where     p_comma =

@@ -45,7 +45,7 @@       Nothing -> return ()       Just hsmodName' -> do         located hsmodName' $ \name -> do-          forM_ hsmodHaddockModHeader (p_hsDocString Pipe True)+          forM_ hsmodHaddockModHeader (p_hsDoc Pipe True)           p_hsmodName name         breakpoint         forM_ hsmodDeprecMessage $ \w -> do

@@ -11,7 +11,10 @@ import Data.Char (isUpper) import qualified Data.List as L import Data.Maybe (listToMaybe)+import Data.Set (Set)+import qualified Data.Set as Set import qualified Data.Text as T+import GHC.Driver.Flags (Language) import GHC.Types.SrcLoc import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma (Pragma (..))@@ -37,7 +40,9 @@ -- -- See also: <https://github.com/tweag/ormolu/issues/404> data LanguagePragmaClass-  = -- | All other extensions+  = -- | A pack of extensions like @GHC2021@ or @Haskell2010@+    ExtensionPack+  | -- | All other extensions     Normal   | -- | Extensions starting with "No"     Disabling@@ -76,6 +81,7 @@ -- | Classify a 'LanguagePragma'. classifyLanguagePragma :: String -> LanguagePragmaClass classifyLanguagePragma = \case+  str | str `Set.member` extensionPacks -> ExtensionPack   "ImplicitPrelude" -> Final   "CUSKs" -> Final   str ->@@ -88,3 +94,8 @@               then Disabling               else Normal       _ -> Normal++-- | Extension packs, like @GHC2021@ and @Haskell2010@.+extensionPacks :: Set String+extensionPacks =+  Set.fromList $ show <$> [minBound :: Language .. maxBound]

@@ -22,7 +22,6 @@   ) where -import Data.Foldable (for_) import GHC.Hs import GHC.Types.Basic hiding (isPromoted) import GHC.Types.SourceText@@ -54,12 +53,11 @@       HsForAllVis _ bndrs -> p_forallBndrs ForAllVis p_hsTyVarBndr bndrs     interArgBreak     p_hsTypeR (unLoc t)-  HsQualTy _ qs' t -> do-    for_ qs' $ \qs -> do-      located qs p_hsContext-      space-      txt "=>"-      interArgBreak+  HsQualTy _ qs t -> do+    located qs p_hsContext+    space+    txt "=>"+    interArgBreak     case unLoc t of       HsQualTy {} -> p_hsTypeR (unLoc t)       HsFunTy {} -> p_hsTypeR (unLoc t)@@ -101,8 +99,8 @@     space     case arrow of       HsUnrestrictedArrow _ -> txt "->"-      HsLinearArrow _ _ -> txt "%1 ->"-      HsExplicitMult _ _ mult -> do+      HsLinearArrow _ -> txt "%1 ->"+      HsExplicitMult _ mult _ -> do         txt "%"         p_hsTypeR (unLoc mult)         space@@ -122,7 +120,7 @@   HsSumTy _ xs ->     parensHash N $       sep (space >> txt "|" >> breakpoint) (sitcc . located' p_hsType) xs-  HsOpTy _ x op y -> do+  HsOpTy _ _ x op y -> do     fixityOverrides <- askFixityOverrides     fixityMap <- askFixityMap     let opTree = OpBranches [tyOpTree x, tyOpTree y] [op]@@ -147,12 +145,12 @@   HsDocTy _ t str ->     case docStyle of       PipeStyle -> do-        p_hsDocString Pipe True str+        p_hsDoc Pipe True str         located t p_hsType       CaretStyle -> do         located t p_hsType         newline-        p_hsDocString Caret False str+        p_hsDoc Caret False str   HsBangTy _ (HsSrcBang _ u s) t -> do     case u of       SrcUnpack -> txt "{-# UNPACK #-}" >> space@@ -243,11 +241,16 @@ data ForAllVisibility = ForAllInvis | ForAllVis  -- | Render several @forall@-ed variables.-p_forallBndrs :: ForAllVisibility -> (a -> R ()) -> [LocatedA a] -> R ()+p_forallBndrs ::+  HasSrcSpan l =>+  ForAllVisibility ->+  (a -> R ()) ->+  [GenLocated l a] ->+  R () p_forallBndrs ForAllInvis _ [] = txt "forall." p_forallBndrs ForAllVis _ [] = txt "forall ->" p_forallBndrs vis p tyvars =-  switchLayout (getLocA <$> tyvars) $ do+  switchLayout (getLoc' <$> tyvars) $ do     txt "forall"     breakpoint     inci $ do@@ -262,11 +265,11 @@  p_conDeclField :: ConDeclField GhcPs -> R () p_conDeclField ConDeclField {..} = do-  mapM_ (p_hsDocString Pipe True) cd_fld_doc+  mapM_ (p_hsDoc Pipe True) cd_fld_doc   sitcc $     sep       commaDel-      (located' (p_rdrName . rdrNameFieldOcc))+      (located' (p_rdrName . foLabel))       cd_fld_names   space   txt "::"

@@ -16,6 +16,7 @@     onTheSameLine,     HasSrcSpan (..),     getLoc',+    matchAddEpAnn,   ) where @@ -25,6 +26,7 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T+import qualified GHC.Data.Strict as Strict import GHC.Driver.Ppr import GHC.DynFlags (baseDynFlags) import GHC.Hs@@ -76,7 +78,7 @@         . dropWhileEnd T.null         . fmap (T.stripEnd . T.pack)         . lines-        $ unpackHDS docStr+        $ renderHsDocString docStr     -- We cannot have the first character to be a dollar because in that     -- case it'll be a parse error (apparently collides with named docs     -- syntax @-- $name@ somehow).@@ -110,7 +112,7 @@               line = srcLocLine x               col = srcLocCol x            in mkRealSrcLoc file (line + i) col-     in RealSrcSpan (mkRealSrcSpan (incLine start) (incLine end)) Nothing+     in RealSrcSpan (mkRealSrcSpan (incLine start) (incLine end)) Strict.Nothing   UnhelpfulSpan x -> UnhelpfulSpan x  -- | Do two declarations have a blank between them?@@ -141,3 +143,10 @@  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.+matchAddEpAnn :: AnnKeywordId -> AddEpAnn -> Maybe EpaLocation+matchAddEpAnn annId (AddEpAnn annId' loc)+  | annId == annId' || unicodeAnn annId == annId' = Just loc+  | otherwise = Nothing

@@ -38,7 +38,7 @@       ciDynOpts `shouldBe` [DynOption "-XHaskell2010"]     it "extracts correct dependencies from ormolu.cabal (src/Ormolu/Config.hs)" $ do       CabalInfo {..} <- parseCabalInfo "ormolu.cabal" "src/Ormolu/Config.hs"-      ciDependencies `shouldBe` Set.fromList ["Cabal", "Diff", "MemoTrie", "aeson", "ansi-terminal", "array", "base", "bytestring", "containers", "directory", "dlist", "exceptions", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "template-haskell", "text", "th-lift-instances"]+      ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "MemoTrie", "aeson", "ansi-terminal", "array", "base", "bytestring", "containers", "directory", "dlist", "exceptions", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "template-haskell", "text", "th-lift-instances"]     it "extracts correct dependencies from ormolu.cabal (tests/Ormolu/PrinterSpec.hs)" $ do       CabalInfo {..} <- parseCabalInfo "ormolu.cabal" "tests/Ormolu/PrinterSpec.hs"       ciDependencies `shouldBe` Set.fromList ["QuickCheck", "base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "megaparsec", "ormolu", "path", "path-io", "temporary", "text"]