fourmolu 0.4.0.0 → 0.5.0.0

raw patch · 102 files changed

+1608/−1297 lines, 102 filesdep +arraydep ~Cabaldep ~basedep ~ghc-lib-parserPVP ok

version bump matches the API change (PVP)

Dependencies added: array

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

API changes (from Hackage documentation)

Files

• CHANGELOG.md +57/−0
• README.md +38/−8
• app/Main.hs +90/−34
• data/examples/declaration/data/field-layout/record-four-out.hs +4/−4
• data/examples/declaration/data/record-four-out.hs +10/−10
• data/examples/declaration/data/record-multi-const-four-out.hs +8/−8
• data/examples/declaration/rewrite-rule/never-active-four-out.hs +1/−0
• data/examples/declaration/rewrite-rule/never-active-out.hs +1/−0
• data/examples/declaration/rewrite-rule/never-active.hs +1/−0
• data/examples/declaration/type-families/closed-type-family/injective-four-out.hs +0/−1
• data/examples/declaration/type-families/closed-type-family/multi-line-four-out.hs +0/−2
• data/examples/declaration/type/promotion-1-four-out.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/arrow/proc-do-complex-four-out.hs +2/−1
• data/examples/declaration/value/function/arrow/proc-do-complex-out.hs +2/−1
• data/examples/declaration/value/function/arrow/proc-lambdas-four-out.hs +2/−1
• data/examples/declaration/value/function/arrow/proc-lambdas-out.hs +2/−1
• data/examples/declaration/value/function/case-multi-line-guards-out.hs +2/−2
• data/examples/declaration/value/function/multi-way-if-out.hs +1/−1
• data/examples/declaration/value/function/multiple-guards-out.hs +4/−4
• data/examples/declaration/value/function/multiple-guards.hs +2/−3
• data/examples/declaration/value/function/operators-2-out.hs +1/−1
• data/examples/declaration/value/function/pattern/many-guards-in-singleline-four-out.hs +3/−0
• data/examples/declaration/value/function/pattern/many-guards-in-singleline-out.hs +3/−0
• data/examples/declaration/value/function/pattern/many-guards-in-singleline.hs +3/−0
• data/examples/declaration/value/function/pattern/multiline-guard-statement-four-out.hs +6/−0
• data/examples/declaration/value/function/pattern/multiline-guard-statement-out.hs +6/−0
• data/examples/declaration/value/function/pattern/multiline-guard-statement.hs +5/−0
• data/examples/declaration/value/function/pattern/multiple-guard-statements-four-out.hs +6/−0
• data/examples/declaration/value/function/pattern/multiple-guard-statements-out.hs +6/−0
• data/examples/declaration/value/function/pattern/multiple-guard-statements.hs +4/−0
• data/examples/declaration/value/function/record/dot-multiline-four-out.hs +0/−15
• data/examples/declaration/value/function/record/dot-multiline-out.hs +0/−15
• data/examples/declaration/value/function/record/dot-multiline.hs +0/−10
• data/examples/declaration/value/function/record/dot-singleline-four-out.hs +0/−15
• data/examples/declaration/value/function/record/dot-singleline-out.hs +0/−15
• data/examples/declaration/value/function/record/dot-singleline.hs +0/−14
• data/examples/declaration/value/function/record/record-dot-four-out.hs +16/−0
• data/examples/declaration/value/function/record/record-dot-out.hs +16/−0
• data/examples/declaration/value/function/record/record-dot.hs +16/−0
• data/examples/module-header/empty-haddock-four-out.hs +1/−0
• data/examples/module-header/empty-haddock-out.hs +1/−0
• data/examples/module-header/empty-haddock.hs +3/−0
• data/examples/other/comment-spacing-four-out.hs +7/−0
• data/examples/other/comment-spacing-out.hs +7/−0
• data/examples/other/comment-spacing.hs +7/−0
• data/examples/other/empty-haddock-four-out.hs +5/−4
• data/examples/other/empty-haddock-out.hs +6/−4
• data/examples/other/empty-haddock.hs +9/−4
• data/examples/other/invalid-haddock-four-out.hs +17/−0
• data/examples/other/invalid-haddock-out.hs +17/−0
• data/examples/other/invalid-haddock-weird-four-out.hs +3/−0
• data/examples/other/invalid-haddock-weird-out.hs +3/−0
• data/examples/other/invalid-haddock-weird.hs +3/−0
• data/examples/other/invalid-haddock.hs +17/−0
• data/examples/other/no-linear-arrows-four-out.hs +0/−4
• data/examples/other/no-linear-arrows-out.hs +0/−5
• data/examples/other/no-linear-arrows.hs +0/−4
• fourmolu.cabal +9/−12
• src/GHC/DynFlags.hs +7/−8
• src/Ormolu.hs +27/−7
• src/Ormolu/Config.hs +13/−1
• src/Ormolu/Diff/ParseResult.hs +48/−30
• src/Ormolu/Imports.hs +39/−34
• src/Ormolu/Parser.hs +60/−18
• src/Ormolu/Parser/Anns.hs +0/−42
• src/Ormolu/Parser/CommentStream.hs +96/−37
• src/Ormolu/Parser/Pragma.hs +3/−5
• src/Ormolu/Parser/Result.hs +4/−6
• src/Ormolu/Printer.hs +5/−6
• src/Ormolu/Printer/Combinators.hs +13/−38
• src/Ormolu/Printer/Internal.hs +21/−31
• src/Ormolu/Printer/Meat/Common.hs +39/−61
• src/Ormolu/Printer/Meat/Declaration.hs +80/−75
• src/Ormolu/Printer/Meat/Declaration/Annotation.hs +3/−4
• src/Ormolu/Printer/Meat/Declaration/Class.hs +20/−23
• src/Ormolu/Printer/Meat/Declaration/Data.hs +57/−65
• src/Ormolu/Printer/Meat/Declaration/Default.hs +2/−3
• src/Ormolu/Printer/Meat/Declaration/Foreign.hs +4/−6
• src/Ormolu/Printer/Meat/Declaration/Instance.hs +15/−18
• src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs +3/−4
• src/Ormolu/Printer/Meat/Declaration/Rule.hs +8/−10
• src/Ormolu/Printer/Meat/Declaration/Signature.hs +45/−51
• src/Ormolu/Printer/Meat/Declaration/Splice.hs +1/−2
• src/Ormolu/Printer/Meat/Declaration/Type.hs +4/−3
• src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs +17/−14
• src/Ormolu/Printer/Meat/Declaration/Value.hs +327/−335
• src/Ormolu/Printer/Meat/Declaration/Warning.hs +7/−7
• src/Ormolu/Printer/Meat/ImportExport.hs +5/−6
• src/Ormolu/Printer/Meat/Module.hs +6/−5
• src/Ormolu/Printer/Meat/Type.hs +76/−54
• src/Ormolu/Printer/Operators.hs +17/−14
• src/Ormolu/Printer/SpanStream.hs +9/−6
• src/Ormolu/Processing/Common.hs +0/−15
• src/Ormolu/Processing/Cpp.hs +16/−16
• src/Ormolu/Processing/Preprocess.hs +7/−4
• src/Ormolu/Utils.hs +20/−12
• src/Ormolu/Utils/Extensions.hs +8/−8
• src/Ormolu/Utils/IO.hs +12/−1
• tests/Ormolu/Diff/TextSpec.hs +2/−2
• tests/Ormolu/PrinterSpec.hs +23/−7

@@ -1,5 +1,62 @@ ## Fourmolu 0.4.0.0 +* Fixed issue with leading commas in guards ([#123](https://github.com/fourmolu/fourmolu/pull/123))+* Use trailing haddocks for record fields when using leading commas ([#124](https://github.com/fourmolu/fourmolu/pull/124))++### Upstream changes:++#### Ormolu 0.4.0.0++* When a guard is located on its own line, the body associated with this+  guard is indented by one extra level, so that it can easily be+  distinguished from the guard predicate or pattern. [Issue+  806](https://github.com/tweag/ormolu/issues/806).++* Now a space is forced after `--` in line comments. [Issue+  808](https://github.com/tweag/ormolu/issues/808).++* Allow formatting Backpack signature files (`.hsig`). The switch between+  regular module mode and signature mode is based on the file extension by+  default, but can be overridden with the `-t / --source-type` command line+  option. [Issue 600](https://github.com/tweag/ormolu/issues/600).++* Blank Haddock comments are now eliminated. This also fixes issues with+  differing ASTs in some special cases. [Issue+  726](https://github.com/tweag/ormolu/issues/726).++* Rewrite rules that are never active are now formatted correctly.+  [Issue 823](https://github.com/tweag/ormolu/issues/823).++* Promoted infix data constructors are now formatted correctly. [Issue 768](+  https://github.com/tweag/ormolu/issues/768).++* Switched to `ghc-lib-parser-9.2`.+  [Issue 794](https://github.com/tweag/ormolu/issues/794).+   * Support for the new syntax-related language extensions:+     `OverloadedRecordDot` and `OverloadedRecordUpdate`+     (disabled by default).+     [Issue 709](https://github.com/tweag/ormolu/issues/709).+   * Removed support for `record-dot-preprocessor`. For the getter syntax,+     consider using `OverloadedRecordDot` instead. [Issue+     659](https://github.com/tweag/ormolu/issues/659). [Issue+     705](https://github.com/tweag/ormolu/issues/705).+   * Support for the `GHC2021` language.++#### Ormolu 0.3.1.0++* Allow check mode when working with stdin input. [Issue 634](+  https://github.com/tweag/ormolu/issues/634).++* Now guards are printed on a new line if at least one guard is multiline or+  if all guards together occupy more than one line. The body of each guard+  is also indented one level deeper in that case. [Issue+  712](https://github.com/tweag/ormolu/issues/712).++* Invalid Haddock comments are no longer silently deleted, but rather converted+  into regular comments. [Issue 474](https://github.com/tweag/ormolu/issues/474).++## Fourmolu 0.4.0.0+ * Write "Loaded config from" message to `stderr` instead of `stdout` ([#42](https://github.com/fourmolu/fourmolu/pull/42)) * Fixed issue with multiline haddocks in indented contexts ([#64](https://github.com/fourmolu/fourmolu/pull/64)) * Avoid renaming magic comments ([#90](https://github.com/fourmolu/fourmolu/pull/90))

@@ -4,7 +4,8 @@ [![Hackage](https://img.shields.io/hackage/v/fourmolu.svg?style=flat)](https://hackage.haskell.org/package/fourmolu)  * [Configuration](#configuration)-* [Building and installation](#building-and-installation)+* [Installation](#installation)+* [Building from source](#building-from-source) * [Usage](#usage)     * [Editor integration](#editor-integration)     * [Magic comments](#magic-comments)@@ -50,16 +51,37 @@ newlines-between-decls: 1 # number of newlines between top-level declarations ``` -See [here](fourmolu.yaml) for a config to simulate the behaviour of Ormolu.+A config to simulate the behaviour of Ormolu ([as far as currently possible](https://github.com/fourmolu/fourmolu/issues/38)) would be: +```yaml+indentation: 2+comma-style: trailing+record-brace-space: true+indent-wheres: true+diff-friendly-import-export: false+respectful: false+haddock-style: single-line+newlines-between-decls: 1+```+ These options can also be set on the command line (which takes precedence over config files). Run `fourmolu -h` to see all options. -## Building and installation+## Installation -Simply run `cabal v2-install fourmolu`, to install the latest release from Hackage.+To install the latest release from Hackage, simply install with Cabal or Stack: -You can also clone this repository, then build with Cabal or Stack.+```console+$ cabal install fourmolu+$ stack install fourmolu+``` +## Building from source++```console+$ cabal build+$ stack build+```+ ## Usage  The following will print the formatted output to the standard output.@@ -92,9 +114,17 @@ $ fourmolu --mode check $(find . -name '*.hs') ``` +#### :zap: Beware git's `core.autocrlf` on Windows :zap:+Fourmolu's output always uses LF line endings. In particular,+`fourmolu --mode check` will fail if its input is correctly formatted+*except* that it has CRLF line endings. This situation can happen on Windows+when checking out a git repository without having set [`core.autocrlf`](+https://www.git-scm.com/docs/git-config#Documentation/git-config.txt-coreautocrlf)+to `false`.+ ### Editor integration -Fourmolu can be integrated with your editor via the [Haskell Language Server](https://github.com/haskell/haskell-language-server).+Fourmolu can be integrated with your editor via the [Haskell Language Server](https://haskell-language-server.readthedocs.io/en/latest/index.html). Just set `haskell.formattingProvider` to `fourmolu` ([instructions](https://haskell-language-server.readthedocs.io/en/latest/configuration.html#language-specific-server-options)).  ### Magic comments @@ -146,7 +176,7 @@ 8         | Cabal file parsing failed 9         | Missing input file path when using stdin input and accounting for .cabal files 100       | In checking mode: unformatted files-101       | Inplace and check modes do not work with stdin+101       | Inplace mode does not work with stdin 102       | Other issue (with multiple input files) 400       | Failed to load Fourmolu configuration file @@ -166,7 +196,7 @@  If there are any options you'd like to see, let us know. If it's not too complicated to implement (and especially if you implement it yourself!) then we'll probably add it. -Run `cabal test` and `./format.sh` before submitting any pull requests.+See `DEVELOPER.md` for documentation.  ## License 

@@ -16,6 +16,7 @@ import Data.Functor.Identity (Identity (..)) import Data.List (intercalate, sort) import Data.Maybe (fromMaybe, mapMaybe)+import qualified Data.Text as T import qualified Data.Text.IO as TIO import Data.Version (showVersion) import Development.GitRev@@ -43,7 +44,12 @@     [] -> mkConfigFromCWD opts     ["-"] -> mkConfigFromCWD opts     file : _ -> mkConfig file opts-  let formatOne' = formatOne optCabalDefaultExtensions optMode cfg+  let formatOne' =+        formatOne+          optCabalDefaultExtensions+          optMode+          optSourceType+          cfg    exitCode <- case optInputFiles of     [] -> formatOne' Nothing@@ -71,62 +77,86 @@   CabalDefaultExtensionsOpts ->   -- | Mode of operation   Mode ->+  -- | The 'SourceType' requested by the user+  Maybe SourceType ->   -- | Configuration   Config RegionIndices ->   -- | File to format or stdin as 'Nothing'   Maybe FilePath ->   IO ExitCode-formatOne CabalDefaultExtensionsOpts {..} mode config mpath =-  withPrettyOrmoluExceptions (cfgColorMode config) $+formatOne CabalDefaultExtensionsOpts {..} mode reqSourceType rawConfig mpath =+  withPrettyOrmoluExceptions (cfgColorMode rawConfig) $ do     case FP.normalise <$> mpath of+      -- input source = STDIN       Nothing -> do-        extraDynOptions <--          if optUseCabalDefaultExtensions-            then case optStdinInputFile of-              Just stdinInputFile ->-                getCabalExtensionDynOptions stdinInputFile-              Nothing -> throwIO OrmoluMissingStdinInputFile-            else pure []-        r <- ormoluStdin (configPlus extraDynOptions)+        resultConfig <-+          patchConfig Nothing+            <$> if optUseCabalDefaultExtensions+              then case optStdinInputFile of+                Just stdinInputFile ->+                  getCabalExtensionDynOptions stdinInputFile+                Nothing -> throwIO OrmoluMissingStdinInputFile+              else pure []         case mode of           Stdout -> do-            TIO.putStr r+            ormoluStdin resultConfig >>= TIO.putStr             return ExitSuccess-          _ -> do+          InPlace -> do             hPutStrLn               stderr-              "This feature is not supported when input comes from stdin."+              "In place editing is not supported when input comes from stdin."             -- 101 is different from all the other exit codes we already use.             return (ExitFailure 101)+          Check -> do+            -- ormoluStdin is not used because we need the originalInput+            originalInput <- getContentsUtf8+            let stdinRepr = "<stdin>"+            formattedInput <-+              ormolu resultConfig stdinRepr (T.unpack originalInput)+            handleDiff originalInput formattedInput stdinRepr+      -- input source = a file       Just inputFile -> do-        extraDynOptions <--          if optUseCabalDefaultExtensions-            then getCabalExtensionDynOptions inputFile-            else pure []-        originalInput <- readFileUtf8 inputFile-        formattedInput <- ormoluFile (configPlus extraDynOptions) inputFile+        resultConfig <-+          patchConfig (Just (detectSourceType inputFile))+            <$> if optUseCabalDefaultExtensions+              then getCabalExtensionDynOptions inputFile+              else pure []         case mode of           Stdout -> do-            TIO.putStr formattedInput+            ormoluFile resultConfig inputFile >>= TIO.putStr             return ExitSuccess           InPlace -> do-            -- Only write when the contents have changed, in order to avoid-            -- updating the modified timestamp if the file was already correctly-            -- formatted.+            -- ormoluFile is not used because we need originalInput+            originalInput <- readFileUtf8 inputFile+            formattedInput <-+              ormolu resultConfig inputFile (T.unpack originalInput)             when (formattedInput /= originalInput) $               writeFileUtf8 inputFile formattedInput             return ExitSuccess-          Check ->-            case diffText originalInput formattedInput inputFile of-              Nothing -> return ExitSuccess-              Just diff -> do-                runTerm (printTextDiff diff) (cfgColorMode config) stderr-                -- 100 is different to all the other exit code that are emitted-                -- either from an 'OrmoluException' or from 'error' and-                -- 'notImplemented'.-                return (ExitFailure 100)+          Check -> do+            -- ormoluFile is not used because we need originalInput+            originalInput <- readFileUtf8 inputFile+            formattedInput <-+              ormolu resultConfig inputFile (T.unpack originalInput)+            handleDiff originalInput formattedInput inputFile   where-    configPlus dynOpts = config {cfgDynOptions = cfgDynOptions config ++ dynOpts}+    patchConfig mdetectedSourceType dynOpts =+      rawConfig+        { cfgDynOptions = cfgDynOptions rawConfig ++ dynOpts,+          cfgSourceType =+            fromMaybe+              ModuleSource+              (reqSourceType <|> mdetectedSourceType)+        }+    handleDiff originalInput formattedInput fileRepr =+      case diffText originalInput formattedInput fileRepr of+        Nothing -> return ExitSuccess+        Just diff -> do+          runTerm (printTextDiff diff) (cfgColorMode rawConfig) stderr+          -- 100 is different to all the other exit code that are emitted+          -- either from an 'OrmoluException' or from 'error' and+          -- 'notImplemented'.+          return (ExitFailure 100)  ---------------------------------------------------------------------------- -- Command line options parsing@@ -138,6 +168,8 @@     optConfig :: !(Config RegionIndices),     -- | Options for respecting default-extensions from .cabal files     optCabalDefaultExtensions :: CabalDefaultExtensionsOpts,+    -- | Source type option, where 'Nothing' means autodetection+    optSourceType :: !(Maybe SourceType),     -- | Fourmolu-specific options     optPrinterOpts :: !PrinterOptsPartial,     -- | Haskell source files to format or stdin (when the list is empty)@@ -214,6 +246,7 @@         )     <*> configParser     <*> cabalDefaultExtensionsParser+    <*> sourceTypeParser     <*> printerOptsParser     <*> (many . strArgument . mconcat)       [ metavar "FILE",@@ -257,6 +290,10 @@         short 'c',         help "Fail if formatting is not idempotent"       ]+    -- We cannot parse the source type here, because we might need to do+    -- autodection based on the input file extension (not available here)+    -- before storing the resolved value in the config struct.+    <*> pure ModuleSource     <*> (option parseBoundedEnum . mconcat)       [ long "color",         metavar "WHEN",@@ -349,6 +386,16 @@       ]   pure PrinterOpts {..} +sourceTypeParser :: Parser (Maybe SourceType)+sourceTypeParser =+  (option parseSourceType . mconcat)+    [ long "source-type",+      short 't',+      metavar "TYPE",+      value Nothing,+      help "Set the type of source; TYPE can be 'module', 'sig', or 'auto' (the default)"+    ]+ ---------------------------------------------------------------------------- -- Helpers @@ -469,3 +516,12 @@ mkConfigFromCWD opts = do   cwd <- getCurrentDirectory   mkConfig cwd opts++-- | Parse the 'SourceType'. 'Nothing' means that autodetection based on+-- file extension is requested.+parseSourceType :: ReadM (Maybe SourceType)+parseSourceType = eitherReader $ \case+  "module" -> Right (Just ModuleSource)+  "sig" -> Right (Just SignatureSource)+  "auto" -> Right Nothing+  s -> Left $ "unknown source type: " ++ s

@@ -2,11 +2,11 @@  -- | Foo. data Foo = Foo-    { -- | Something-      foo :: Foo Int Int-    , -- | Something else-      bar ::+    { foo :: Foo Int Int+    -- ^ Something+    , bar ::         Bar             Char             Char+    -- ^ Something else     }

@@ -2,22 +2,22 @@  -- | Something. data Foo = Foo-    { -- | X-      fooX :: Int-    , -- | Y-      fooY :: Int-    , -- | BarBaz-      fooBar, fooBaz :: NonEmpty (Identity Bool)-    , -- | GagGog-      fooGag+    { fooX :: Int+    -- ^ X+    , fooY :: Int+    -- ^ Y+    , fooBar, fooBaz :: NonEmpty (Identity Bool)+    -- ^ BarBaz+    , fooGag       , fooGog ::         NonEmpty             ( Indentity                 Bool             )-    , -- | Huh!-      fooFoo+    -- ^ GagGog+    , fooFoo       , barBar ::         Int+    -- ^ Huh!     }     deriving (Eq, Show)

@@ -3,15 +3,15 @@ -- | Something. data Foo     = Foo-        { -- | X-          fooX :: Int-        , -- | Y-          fooY :: Int+        { fooX :: Int+        -- ^ X+        , fooY :: Int+        -- ^ Y         }     | Bar-        { -- | X-          barX :: Int-        , -- | Y-          barY :: Int+        { barX :: Int+        -- ^ X+        , barY :: Int+        -- ^ Y         }     deriving (Eq, Show)

@@ -0,0 +1,1 @@+{-# RULES "map-loop" [~] forall f. map' f = map' (id . f) #-}

@@ -0,0 +1,1 @@+{-# RULES "map-loop" [~] forall f. map' f = map' (id . f) #-}

@@ -0,0 +1,1 @@+{-# RULES "map-loop" [ ~  ]  forall f . map' f = map' (id . f) #-}

@@ -1,5 +1,4 @@ type family Id a = result | result -> a where     Id a = a- type family G (a :: k) b c = foo | foo -> k b where     G a b c = (a, b)

@@ -4,7 +4,6 @@     where     Id a =         a- type family     G         (a :: k)@@ -14,7 +13,6 @@     where     G a b c =         (a, b)- type family     F a ::         * -> *

@@ -7,3 +7,5 @@  type E = TypeError ( 'Text "Some text") type G = '[ '( 'Just, 'Bool)]++type X = () '`PromotedInfix` ()

@@ -13,3 +13,5 @@ type E = TypeError ( 'Text "Some text")  type G = '[ '( 'Just, 'Bool)]++type X = () '`PromotedInfix` ()

@@ -7,3 +7,5 @@  type E = TypeError ('Text "Some text") type G = '[ '( 'Just, 'Bool) ]++type X = () '`PromotedInfix` ()

@@ -29,7 +29,8 @@                     Left                         ( z                             , w-                            ) -> \u -> -- Procs can have lambdas+                            ) -> \u ->+                            -- Procs can have lambdas                             let v =                                     u -- Actually never used                                         ^ 2

@@ -29,7 +29,8 @@           Left             ( z,               w-              ) -> \u -> -- Procs can have lambdas+              ) -> \u ->+              -- Procs can have lambdas               let v =                     u -- Actually never used                       ^ 2

@@ -5,5 +5,6 @@ bar =     proc x -> \f g h ->         \() ->-            \(Left (x, y)) -> -- Tuple value+            \(Left (x, y)) ->+                -- Tuple value                 f (g (h x)) -< y

@@ -5,5 +5,6 @@ bar =   proc x -> \f g h ->     \() ->-      \(Left (x, y)) -> -- Tuple value+      \(Left (x, y)) ->+        -- Tuple value         f (g (h x)) -< y

@@ -3,8 +3,8 @@   case x of     x       | x > 10 ->-        foo-          + bar+          foo+            + bar     x | x > 5 -> 10     _ -> 20 

@@ -6,7 +6,7 @@   if       | x > y -> x       | x < y ->-        y+          y       | otherwise -> x  baz =

@@ -6,9 +6,9 @@ bar :: Int -> Int bar x   | x == 5 =-    foo x-      + foo 10+      foo x+        + foo 10   | x == 6 =-    foo x-      + foo 20+      foo x+        + foo 20   | otherwise = foo 100

@@ -1,7 +1,6 @@ foo :: Int -> Int-foo x-  | x == 5 = 10-  | otherwise = 12+foo x | x == 5 = 10+      | otherwise = 12  bar :: Int -> Int bar x

@@ -1,4 +1,4 @@ foo n   | x || y && z || n ** x       || x && n =-    42+      42

@@ -0,0 +1,3 @@+foobar x | x <- 5 = 5 | x <- 6 = 6 | otherwise = 7++foobaz | x <- 5 = 5 | x <- 6 = 6 | otherwise = 7

@@ -0,0 +1,3 @@+foobar x | x <- 5 = 5 | x <- 6 = 6 | otherwise = 7++foobaz | x <- 5 = 5 | x <- 6 = 6 | otherwise = 7

@@ -0,0 +1,3 @@+foobar x | x <- 5 = 5 | x <- 6 = 6 | otherwise = 7++foobaz | x <- 5 = 5 | x <- 6 = 6 | otherwise = 7

@@ -0,0 +1,6 @@+foobarbar :: Int -> Bool+foobarbar+    | x <-+        5 = case x of+        5 -> True+        _ -> False

@@ -0,0 +1,6 @@+foobarbar :: Int -> Bool+foobarbar+  | x <-+      5 = case x of+      5 -> True+      _ -> False

@@ -0,0 +1,5 @@+foobarbar :: Int -> Bool+foobarbar | x <-+    5 = case x of+  5 -> True+  _ -> False

@@ -0,0 +1,6 @@+foobarbar :: Int -> Bool+foobarbar+    | x <- 5+    , y <- 6 = case x of+        5 -> True+        _ -> False

@@ -0,0 +1,6 @@+foobarbar :: Int -> Bool+foobarbar+  | x <- 5,+    y <- 6 = case x of+      5 -> True+      _ -> False

@@ -0,0 +1,4 @@+foobarbar :: Int -> Bool+foobarbar | x <- 5, y <- 6 = case x of+  5 -> True+  _ -> False

@@ -1,15 +0,0 @@-{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}--bar' =-    (Foo 1){bar = 2-           }--fooplus'''' f n =-    f{foo = n-      , bar = n-     }--fooplus''''' f n =-    f-        { foo = n-        }

@@ -1,15 +0,0 @@-{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}--bar' =-  (Foo 1){bar = 2-         }--fooplus'''' f n =-  f{foo = n,-    bar = n-   }--fooplus''''' f n =-  f-    { foo = n-    }

@@ -1,10 +0,0 @@-{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}-bar' = (Foo 1){bar = 2-              }--fooplus'''' f n = f{foo = n,-                    bar = n-                   }--fooplus''''' f n = f-                   { foo = n }

@@ -1,15 +0,0 @@-{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}--data Foo = Foo {bar :: Int}--mfoo = fmap (.bar) $ Nothing--bar = (Foo 1).bar--fooplus f n = f{foo = f.bar + n}--fooplus' f n = f{foo = f.bar + n}--fooplus'' f n = f{foo = f.bar + n}--fooplus''' f n = f{foo = f.bar + n}

@@ -1,15 +0,0 @@-{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}--data Foo = Foo {bar :: Int}--mfoo = fmap (.bar) $ Nothing--bar = (Foo 1).bar--fooplus f n = f{foo = f.bar + n}--fooplus' f n = f {foo = f.bar + n}--fooplus'' f n = f {foo = f.bar + n}--fooplus''' f n = f {foo = f.bar + n}

@@ -1,14 +0,0 @@-{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}-data Foo = Foo { bar :: Int }--mfoo = fmap (.bar)   $ Nothing--bar = (  Foo 1).bar--fooplus f n = f{foo = f.bar + n}--fooplus' f n = f { foo = f.bar + n}--fooplus'' f n = f {foo = f.bar + n}--fooplus''' f n = f{ foo = f.bar + n}

@@ -0,0 +1,16 @@+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedRecordUpdate #-}++data Foo = Foo {bar :: Foo}++mfoo = fmap (.bar) $ Nothing++bar = (Foo 1).bar++fooplus f n = f{foo = f.bar + n}++nestedFoo f = f.bar.bar.bar.bar.bar++nestedFooUpdate f = f{bar.bar = f.bar} <> f{bar.bar.bar.bar}++operatorUpdate f = f{(+) = 1}

@@ -0,0 +1,16 @@+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedRecordUpdate #-}++data Foo = Foo {bar :: Foo}++mfoo = fmap (.bar) $ Nothing++bar = (Foo 1).bar++fooplus f n = f {foo = f.bar + n}++nestedFoo f = f.bar.bar.bar.bar.bar++nestedFooUpdate f = f {bar.bar = f.bar} <> f {bar.bar.bar.bar}++operatorUpdate f = f {(+) = 1}

@@ -0,0 +1,16 @@+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedRecordUpdate #-}++data Foo = Foo { bar :: Foo }++mfoo = fmap (.bar)   $ Nothing++bar = (  Foo 1).bar++fooplus f n = f{foo = f.bar + n}++nestedFoo f = f.bar.bar.bar.bar.bar++nestedFooUpdate f = f {bar.bar = f.bar } <> f {bar.bar.bar.bar}++operatorUpdate f = f { (+) = 1 }

@@ -0,0 +1,1 @@+module Test where

@@ -0,0 +1,1 @@+module Test where

@@ -0,0 +1,3 @@+-- |+--+module Test where

@@ -0,0 +1,7 @@+-- |Something.+foo ::+    -- |Foo.+    Int ->+    -- |Bar.+    IO ()+foo _ = pure () -- comment

@@ -0,0 +1,7 @@+-- |Something.+foo ::+  -- |Foo.+  Int ->+  -- |Bar.+  IO ()+foo _ = pure () -- comment

@@ -0,0 +1,7 @@+-- |Something.+foo ::+  -- |Foo.+  Int ->+  -- |Bar.+  IO ()+foo _ = pure () --comment

@@ -1,5 +1,6 @@-module Main where+module Test (+    test,+) where --- |-foo :: Int-foo = 5+test ::+    test

@@ -1,5 +1,7 @@-module Main where+module Test+  ( test,+  )+where --- |-foo :: Int-foo = 5+test ::+  test

@@ -1,6 +1,11 @@-module Main where- -- |+module Test+  ( -- |+    test,+  )+where -foo :: Int-foo = 5+-- |+test ::+  -- |+  test

@@ -0,0 +1,17 @@+test = undefined+  where+    a ::+        -- foo+        Int ->+        -- misplaced+        Int+    a = undefined++test = undefined+  where+    -- Comment+    a = undefined++    -- A multiline+    -- comment+    b = b

@@ -0,0 +1,17 @@+test = undefined+  where+    a ::+      -- foo+      Int ->+      -- misplaced+      Int+    a = undefined++test = undefined+  where+    -- Comment+    a = undefined++    -- A multiline+    -- comment+    b = b

@@ -0,0 +1,3 @@+{-# LANGUAGE TemplateHaskell #-}++foo = foo -- # ${

@@ -0,0 +1,3 @@+{-# LANGUAGE TemplateHaskell #-}++foo = foo -- # ${

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

@@ -0,0 +1,17 @@+test = undefined+  where+    a ::+      -- ** foo+      Int ->+      -- | misplaced+      Int+    a = undefined++test = undefined+  where+    -- | Comment+    a = undefined++    -- | A multiline+    -- comment+    b = b

@@ -1,4 +0,0 @@-type a % b = (a, b)--type Foo a m b = a % m -> b-type Bar a m b = a % m -> b

@@ -1,5 +0,0 @@-type a % b = (a, b)--type Foo a m b = a % m -> b--type Bar a m b = a % m -> b

@@ -1,4 +0,0 @@-type a % b = (a,b)--type Foo a m b = a % m -> b-type Bar a m b = a %m -> b

@@ -1,12 +1,12 @@ cabal-version:      2.4 name:               fourmolu-version:            0.4.0.0+version:            0.5.0.0 license:            BSD-3-Clause license-file:       LICENSE.md maintainer:     Matt Parsons <parsonsmatt@gmail.com>     George Thomas <georgefsthomas@gmail.com>-tested-with:        ghc ==8.8.4 ghc ==8.10.7 ghc ==9.0.1+tested-with:        ghc ==8.10.7 ghc ==9.0.1 ghc ==9.2.1 homepage:           https://github.com/parsonsmatt/fourmolu bug-reports:        https://github.com/parsonsmatt/fourmolu/issues synopsis:           A formatter for Haskell source code@@ -39,7 +39,6 @@         Ormolu.Exception         Ormolu.Imports         Ormolu.Parser-        Ormolu.Parser.Anns         Ormolu.Parser.CommentStream         Ormolu.Parser.Pragma         Ormolu.Parser.Result@@ -82,16 +81,17 @@     default-language: Haskell2010     build-depends:         Diff >=0.4 && <1.0,-        aeson >=1.4.0.0 && <1.6,+        aeson >=1.4.0.0 && <2.1,         ansi-terminal >=0.10 && <1.0,-        base >=4.12 && <5.0,+        base >=4.14 && <5.0,         bytestring >=0.2 && <0.12,         containers >=0.5 && <0.7,         directory >=1.3.3 && <1.4,         dlist >=0.8 && <2.0,+        array >=0.5 && <0.6,         exceptions >=0.6 && <0.11,         filepath >=1.4.2.1 && <1.5,-        ghc-lib-parser >=9.0 && <9.1,+        ghc-lib-parser >=9.2 && <9.3,         HsYAML >=0.2 && <0.3,         HsYAML-aeson >=0.2 && <0.3,         mtl >=2.0 && <3.0,@@ -99,7 +99,7 @@         text >=0.2 && <1.3,         filepath >=1.2 && <1.5,         directory ^>=1.3,-        Cabal ^>=3.4+        Cabal >=3.6 && <3.7      if flag(dev)         ghc-options:@@ -110,9 +110,6 @@     else         ghc-options: -O2 -Wall -    if impl(ghc <8.10.0)-        ghc-options: -fmax-pmcheck-iterations=3000000- executable fourmolu     main-is:          Main.hs     hs-source-dirs:   app@@ -124,7 +121,7 @@         base >=4.12 && <5.0,         directory >=1.3.3 && <1.4,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.0 && <9.1,+        ghc-lib-parser >=9.2 && <9.3,         gitrev >=1.3 && <1.4,         optparse-applicative >=0.14 && <0.17,         text >=0.2 && <1.3@@ -154,7 +151,7 @@     default-language:   Haskell2010     build-depends:         fourmolu,-        base >=4.12 && <5.0,+        base >=4.14 && <5.0,         containers >=0.5 && <0.7,         directory ^>=1.3,         filepath >=1.2 && <1.5,

@@ -24,12 +24,12 @@       sFileSettings = FileSettings {},       sTargetPlatform =         Platform-          { platformWordSize = PW8,-            platformMini =-              PlatformMini-                { platformMini_arch = ArchUnknown,-                  platformMini_os = OSUnknown+          { platformArchOS =+              ArchOS+                { archOS_arch = ArchUnknown,+                  archOS_OS = OSUnknown                 },+            platformWordSize = PW8,             platformUnregisterised = True,             platformByteOrder = LittleEndian,             platformHasGnuNonexecStack = False,@@ -37,11 +37,10 @@             platformHasSubsectionsViaSymbols = False,             platformIsCrossCompiling = False,             platformLeadingUnderscore = False,-            platformTablesNextToCode = False+            platformTablesNextToCode = False,+            platform_constants = Nothing           },       sPlatformMisc = PlatformMisc {},-      sPlatformConstants =-        PlatformConstants {pc_DYNAMIC_BY_DEFAULT = False, pc_WORD_SIZE = 8},       sToolSettings =         ToolSettings           { toolSettings_opt_P_fingerprint = fingerprint0,

@@ -9,7 +9,9 @@     Config (..),     ColorMode (..),     RegionIndices (..),+    SourceType (..),     defaultConfig,+    detectSourceType,     DynOption (..),     PrinterOpts (..),     PrinterOptsPartial,@@ -37,10 +39,12 @@ import Ormolu.Diff.Text import Ormolu.Exception import Ormolu.Parser+import Ormolu.Parser.CommentStream (showCommentStream) import Ormolu.Parser.Result import Ormolu.Printer import Ormolu.Utils (showOutputable) import Ormolu.Utils.IO+import System.FilePath  -- | Format a 'String', return formatted version as 'Text'. --@@ -52,6 +56,10 @@ --       side-effects though. --     * Takes file name just to use it in parse error messages. --     * Throws 'OrmoluException'.+--+-- __NOTE__: The caller is responsible for setting the appropriate value in+-- the 'cfgSourceType' field. Autodetection of source type won't happen+-- here, see 'detectSourceType'. ormolu ::   MonadIO m =>   -- | Ormolu configuration@@ -69,11 +77,14 @@   when (cfgDebug cfg) $ do     traceM "warnings:\n"     traceM (concatMap showWarn warnings)+    forM_ result0 $ \case+      ParsedSnippet r -> traceM . showCommentStream . prCommentStream $ r+      _ -> pure ()   -- We're forcing 'txt' here because otherwise errors (such as messages   -- about not-yet-supported functionality) will be thrown later when we try   -- to parse the rendered code back, inside of GHC monad wrapper which will   -- lead to error messages presenting the exceptions as GHC bugs.-  let !txt = printModule result0 $ cfgPrinterOpts cfgWithIndices+  let !txt = printSnippets result0 $ cfgPrinterOpts cfgWithIndices   when (not (cfgUnsafe cfg) || cfgCheckIdempotence cfg) $ do     -- Parse the result of pretty-printing again and make sure that AST     -- is the same as AST of original snippet module span positions.@@ -95,7 +106,7 @@     -- Try re-formatting the formatted result to check if we get exactly     -- the same output.     when (cfgCheckIdempotence cfg) $-      let txt2 = printModule result1 $ cfgPrinterOpts cfgWithIndices+      let txt2 = printSnippets result1 $ cfgPrinterOpts cfgWithIndices        in case diffText txt txt2 path of             Nothing -> return ()             Just diff ->@@ -106,8 +117,9 @@ -- | Load a file and format it. The file stays intact and the rendered -- version is returned as 'Text'. ----- > ormoluFile cfg path =--- >   liftIO (readFile path) >>= ormolu cfg path+-- __NOTE__: The caller is responsible for setting the appropriate value in+-- the 'cfgSourceType' field. Autodetection of source type won't happen+-- here, see 'detectSourceType'. ormoluFile ::   MonadIO m =>   -- | Ormolu configuration@@ -121,8 +133,9 @@  -- | Read input from stdin and format it. ----- > ormoluStdin cfg =--- >   liftIO (hGetContents stdin) >>= ormolu cfg "<stdin>"+-- __NOTE__: The caller is responsible for setting the appropriate value in+-- the 'cfgSourceType' field. Autodetection of source type won't happen+-- here, see 'detectSourceType'. ormoluStdin ::   MonadIO m =>   -- | Ormolu configuration@@ -130,7 +143,7 @@   -- | Resulting rendition   m Text ormoluStdin cfg =-  liftIO getContents >>= ormolu cfg "<stdin>"+  getContentsUtf8 >>= ormolu cfg "<stdin>" . T.unpack  ---------------------------------------------------------------------------- -- Helpers@@ -160,3 +173,10 @@     [ showOutputable reason,       showOutputable l     ]++-- | Detect 'SourceType' based on the file extension.+detectSourceType :: FilePath -> SourceType+detectSourceType mpath =+  if takeExtension mpath == ".hsig"+    then SignatureSource+    else ModuleSource

@@ -13,6 +13,7 @@     ColorMode (..),     RegionIndices (..),     RegionDeltas (..),+    SourceType (..),     defaultConfig,     PrinterOpts (..),     PrinterOptsPartial,@@ -54,6 +55,14 @@   ) import System.FilePath (splitPath, (</>)) +-- | Type of sources that can be formatted by Ormolu.+data SourceType+  = -- | Consider the input as a regular Haskell module+    ModuleSource+  | -- | Consider the input as a Backpack module signature+    SignatureSource+  deriving (Eq, Show)+ -- | Ormolu configuration. data Config region = Config   { -- | Dynamic options to pass to GHC parser@@ -64,13 +73,15 @@     cfgDebug :: !Bool,     -- | Checks if re-formatting the result is idempotent     cfgCheckIdempotence :: !Bool,+    -- | How to parse the input (regular haskell module or Backpack file)+    cfgSourceType :: !SourceType,     -- | Whether to use colors and other features of ANSI terminals     cfgColorMode :: !ColorMode,     -- | Region selection     cfgRegion :: !region,     cfgPrinterOpts :: !PrinterOptsTotal   }-  deriving (Eq, Show, Functor)+  deriving (Eq, Show, Functor, Generic)  -- | Region selection as the combination of start and end line numbers. data RegionIndices = RegionIndices@@ -99,6 +110,7 @@       cfgUnsafe = False,       cfgDebug = False,       cfgCheckIdempotence = False,+      cfgSourceType = ModuleSource,       cfgColorMode = Auto,       cfgRegion =         RegionIndices

@@ -16,9 +16,10 @@ where  import Data.ByteString (ByteString)+import Data.Foldable import Data.Generics import GHC.Hs-import GHC.Types.Basic+import GHC.Types.SourceText import GHC.Types.SrcLoc import Ormolu.Imports (normalizeImports) import Ormolu.Parser.CommentStream@@ -31,6 +32,7 @@     Same   | -- | Two parse results differ     Different [SrcSpan]+  deriving (Show)  instance Semigroup ParseResultDiff where   Same <> a = a@@ -54,17 +56,26 @@     { prCommentStream = cstream1,       prParsedSource = hs1     } =-    matchIgnoringSrcSpans cstream0 cstream1+    diffCommentStream cstream0 cstream1       <> matchIgnoringSrcSpans         hs0 {hsmodImports = concat . normalizeImports False $ hsmodImports hs0}         hs1 {hsmodImports = concat . normalizeImports False $ hsmodImports hs1} +diffCommentStream :: CommentStream -> CommentStream -> ParseResultDiff+diffCommentStream (CommentStream cs) (CommentStream cs')+  | commentLines cs == commentLines cs' = Same+  | otherwise = Different []+  where+    commentLines = concatMap (toList . unComment . unLoc)+ -- | Compare two values for equality disregarding the following aspects: -- --     * 'SrcSpan's --     * ordering of import lists --     * style (ASCII vs Unicode) of arrows --     * LayoutInfo (brace style) in extension fields+--     * Empty contexts in type classes+--     * Parens around derived type classes matchIgnoringSrcSpans :: Data a => a -> a -> ParseResultDiff matchIgnoringSrcSpans a = genericQuery a   where@@ -74,36 +85,33 @@       -- implement 'toConstr', so we have to deal with it in a special way.       | Just x' <- cast x,         Just y' <- cast y =-        if x' == (y' :: ByteString)-          then Same-          else Different []+          if x' == (y' :: ByteString)+            then Same+            else Different []       | typeOf x == typeOf y,         toConstr x == toConstr y =-        mconcat $-          gzipWithQ-            ( genericQuery-                `extQ` srcSpanEq-                `extQ` commentEq-                `extQ` sourceTextEq-                `extQ` hsDocStringEq-                `extQ` importDeclQualifiedStyleEq-                `extQ` unicodeArrowStyleEq-                `extQ` layoutInfoEq-                `ext2Q` forLocated-            )-            x-            y+          mconcat $+            gzipWithQ+              ( genericQuery+                  `extQ` srcSpanEq+                  `ext1Q` epAnnEq+                  `extQ` sourceTextEq+                  `extQ` hsDocStringEq+                  `extQ` importDeclQualifiedStyleEq+                  `extQ` unicodeArrowStyleEq+                  `extQ` layoutInfoEq+                  `extQ` classDeclCtxEq+                  `extQ` derivedTyClsParensEq+                  `extQ` epaCommentsEq+                  `ext2Q` forLocated+              )+              x+              y       | otherwise = Different []     srcSpanEq :: SrcSpan -> GenericQ ParseResultDiff     srcSpanEq _ _ = Same-    commentEq :: Comment -> GenericQ ParseResultDiff-    commentEq (Comment _ x) d =-      case cast d :: Maybe Comment of-        Nothing -> Different []-        Just (Comment _ y) ->-          if x == y-            then Same-            else Different []+    epAnnEq :: EpAnn a -> GenericQ ParseResultDiff+    epAnnEq _ _ = Same     sourceTextEq :: SourceText -> GenericQ ParseResultDiff     sourceTextEq _ _ = Same     importDeclQualifiedStyleEq ::@@ -128,7 +136,7 @@       GenLocated e0 e1 ->       GenericQ ParseResultDiff     forLocated x@(L mspn _) y =-      maybe id appendSpan (cast mspn) (genericQuery x y)+      maybe id appendSpan (cast `ext1Q` (Just . locA) $ mspn) (genericQuery x y)     appendSpan :: SrcSpan -> ParseResultDiff -> ParseResultDiff     appendSpan s (Different ss) | fresh && helpful = Different (s : ss)       where@@ -138,8 +146,8 @@     -- 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 (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@@ -147,3 +155,13 @@     layoutInfoEq :: LayoutInfo -> GenericQ ParseResultDiff     layoutInfoEq _ (cast -> Just (_ :: LayoutInfo)) = Same     layoutInfoEq _ _ = 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,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}  -- | Manipulations on import lists. module Ormolu.Imports@@ -15,17 +16,21 @@ import Data.List (foldl', nubBy, sortBy, sortOn) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M-import GHC.Data.FastString (FastString)-import GHC.Hs.Extension+import GHC.Data.FastString+import GHC.Hs import GHC.Hs.ImpExp as GHC-import GHC.Types.Basic import GHC.Types.Name.Reader+import GHC.Types.SourceText import GHC.Types.SrcLoc import GHC.Unit.Module.Name import GHC.Unit.Types import Ormolu.Utils (groupBy', notImplemented, separatedByBlank, showOutputable) --- | Sort, group and normalize imports. Assumes input list is sorted by source location.+-- | Sort, group and normalize imports.+--+-- Assumes input list is sorted by source location. Output list is not necessarily+-- sorted by source location, so this function should be called at most once on a+-- given input list. normalizeImports :: Bool -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]] normalizeImports preserveGroups =   map@@ -35,9 +40,10 @@         . fmap (\x -> (importId x, g x))     )     . if preserveGroups-      then map toList . groupBy' (\x y -> not $ separatedByBlank getLoc x y)+      then map toList . groupBy' (\x y -> not $ separatedByBlank getLocA x y)       else pure   where+    g :: LImportDecl GhcPs -> LImportDecl GhcPs     g (L l ImportDecl {..}) =       L         l@@ -69,7 +75,7 @@ data ImportId = ImportId   { importIsPrelude :: Bool,     importIdName :: ModuleName,-    importPkgQual :: Maybe FastString,+    importPkgQual :: Maybe LexicalFastString,     importSource :: IsBootInterface,     importSafe :: Bool,     importQualified :: Bool,@@ -85,7 +91,7 @@   ImportId     { importIsPrelude = isPrelude,       importIdName = moduleName,-      importPkgQual = sl_fs <$> ideclPkgQual,+      importPkgQual = LexicalFastString . sl_fs <$> ideclPkgQual,       importSource = ideclSource,       importSafe = ideclSafe,       importQualified = case ideclQualified of@@ -115,39 +121,38 @@           alter = \case             Nothing -> Just . L new_l $               case new of-                IEThingWith NoExtField n wildcard g flbl ->-                  IEThingWith NoExtField n wildcard (normalizeWNames g) flbl+                IEThingWith _ n wildcard g ->+                  IEThingWith EpAnnNotUsed n wildcard (normalizeWNames g)                 other -> other             Just old ->               let f = \case-                    IEVar NoExtField n -> IEVar NoExtField n-                    IEThingAbs NoExtField _ -> new-                    IEThingAll NoExtField n -> IEThingAll NoExtField n-                    IEThingWith NoExtField n wildcard g flbl ->+                    IEVar _ n -> IEVar NoExtField n+                    IEThingAbs _ _ -> new+                    IEThingAll _ n -> IEThingAll EpAnnNotUsed n+                    IEThingWith _ n wildcard g ->                       case new of                         IEVar NoExtField _ ->                           error "Ormolu.Imports broken presupposition"-                        IEThingAbs NoExtField _ ->-                          IEThingWith NoExtField n wildcard g flbl-                        IEThingAll NoExtField n' ->-                          IEThingAll NoExtField n'-                        IEThingWith NoExtField n' wildcard' g' flbl' ->+                        IEThingAbs _ _ ->+                          IEThingWith EpAnnNotUsed n wildcard g+                        IEThingAll _ n' ->+                          IEThingAll EpAnnNotUsed n'+                        IEThingWith _ n' wildcard' g' ->                           let combinedWildcard =                                 case (wildcard, wildcard') of                                   (IEWildcard _, _) -> IEWildcard 0                                   (_, IEWildcard _) -> IEWildcard 0                                   _ -> NoIEWildcard                            in IEThingWith-                                NoExtField+                                EpAnnNotUsed                                 n'                                 combinedWildcard                                 (normalizeWNames (g <> g'))-                                flbl'-                        IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"+                        IEModuleContents _ _ -> notImplemented "IEModuleContents"                         IEGroup NoExtField _ _ -> notImplemented "IEGroup"                         IEDoc NoExtField _ -> notImplemented "IEDoc"                         IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"-                    IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"+                    IEModuleContents _ _ -> notImplemented "IEModuleContents"                     IEGroup NoExtField _ _ -> notImplemented "IEGroup"                     IEDoc NoExtField _ -> notImplemented "IEDoc"                     IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"@@ -166,10 +171,10 @@ getIewn :: IE GhcPs -> IEWrappedNameOrd getIewn = \case   IEVar NoExtField x -> IEWrappedNameOrd (unLoc x)-  IEThingAbs NoExtField x -> IEWrappedNameOrd (unLoc x)-  IEThingAll NoExtField x -> IEWrappedNameOrd (unLoc x)-  IEThingWith NoExtField x _ _ _ -> IEWrappedNameOrd (unLoc x)-  IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"+  IEThingAbs _ x -> IEWrappedNameOrd (unLoc x)+  IEThingAll _ x -> IEWrappedNameOrd (unLoc x)+  IEThingWith _ x _ _ -> IEWrappedNameOrd (unLoc x)+  IEModuleContents _ _ -> notImplemented "IEModuleContents"   IEGroup NoExtField _ _ -> notImplemented "IEGroup"   IEDoc NoExtField _ -> notImplemented "IEDoc"   IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"@@ -181,14 +186,14 @@ -- | 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-compareIewn (IEPattern x) (IEPattern y) = unLoc x `compareRdrName` unLoc y-compareIewn (IEPattern _) (IEType _) = LT-compareIewn (IEType _) (IEName _) = GT-compareIewn (IEType _) (IEPattern _) = GT-compareIewn (IEType x) (IEType 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 _ _) (IEPattern _ _) = GT+compareIewn (IEType _ x) (IEType _ y) = unLoc x `compareRdrName` unLoc y  compareRdrName :: RdrName -> RdrName -> Ordering compareRdrName x y =

@@ -1,6 +1,8 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  -- | Parser for Haskell source code.@@ -12,7 +14,9 @@  import Control.Exception import Control.Monad.Except+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.Ord (Down (Down))@@ -22,19 +26,19 @@ import qualified GHC.Data.StringBuffer as GHC import qualified GHC.Driver.CmdLine as GHC import GHC.Driver.Session as GHC-import qualified GHC.Driver.Types 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 qualified GHC.Types.SourceError as GHC (handleSourceError) import GHC.Types.SrcLoc-import GHC.Unit.Module.Name import GHC.Utils.Error (Severity (..), errMsgSeverity, errMsgSpan) import qualified GHC.Utils.Panic as GHC import Ormolu.Config import Ormolu.Exception-import Ormolu.Parser.Anns import Ormolu.Parser.CommentStream import Ormolu.Parser.Result import Ormolu.Processing.Common@@ -89,25 +93,23 @@   m (Either (SrcSpan, String) ParseResult) parseModuleSnippet Config {..} dynFlags path rawInput = liftIO $ do   let (input, indent) = removeIndentation . linesInRegion cfgRegion $ rawInput-  let useRecordDot =-        "record-dot-preprocessor" == pgm_F dynFlags-          || any-            (("RecordDotPreprocessor" ==) . moduleNameString)-            (pluginModNames dynFlags)-      pStateErrors = \pstate ->-        let errs = bagToList $ GHC.getErrorMessages pstate dynFlags+  let pStateErrors = \pstate ->+        let errs = fmap pprError . bagToList $ GHC.getErrorMessages pstate             fixupErrSpan = incSpanLine (regionPrefixLength cfgRegion)          in case L.sortOn (Down . SeverityOrd . errMsgSeverity) errs of               [] -> Nothing               err : _ ->                 -- Show instance returns a short error message                 Just (fixupErrSpan (errMsgSpan err), show err)-      r = case runParser GHC.parseModule dynFlags path input of+      parser = case cfgSourceType of+        ModuleSource -> GHC.parseModule+        SignatureSource -> GHC.parseSignature+      r = case runParser parser dynFlags path input of         GHC.PFailed pstate ->           case pStateErrors pstate of             Just err -> Left err             Nothing -> error "PFailed does not have an error"-        GHC.POk pstate (L _ hsModule) ->+        GHC.POk pstate (L _ (normalizeModule -> hsModule)) ->           case pStateErrors pstate of             -- Some parse errors (pattern/arrow syntax in expr context)             -- do not cause a parse error, but they are replaced with "_"@@ -116,24 +118,54 @@             Just err -> Left err             Nothing ->               let (stackHeader, pragmas, comments) =-                    mkCommentStream input pstate+                    mkCommentStream input hsModule                in Right                     ParseResult                       { prParsedSource = hsModule,-                        prAnns = mkAnns pstate,+                        prSourceType = cfgSourceType,                         prStackHeader = stackHeader,                         prPragmas = pragmas,                         prCommentStream = comments,-                        prUseRecordDot = useRecordDot,                         prExtensions = GHC.extensionFlags dynFlags,                         prIndent = indent                       }   return r +-- | Normalize a 'HsModule' by sorting its export lists, dropping+-- blank comments, etc.+normalizeModule :: HsModule -> HsModule+normalizeModule hsmod =+  everywhere+    (mkT dropBlankTypeHaddocks)+    hsmod+      { hsmodImports =+          hsmodImports hsmod,+        hsmodDecls =+          filter (not . isBlankDocD . unLoc) (hsmodDecls hsmod),+        hsmodHaddockModHeader =+          mfilter (not . isBlankDocString . unLoc) (hsmodHaddockModHeader hsmod),+        hsmodExports =+          (fmap . fmap) (filter (not . isBlankDocIE . unLoc)) (hsmodExports hsmod)+      }+  where+    isBlankDocString = all isSpace . unpackHDS+    isBlankDocD = \case+      DocD _ s -> isBlankDocString $ docDeclDoc s+      _ -> False+    isBlankDocIE = \case+      IEGroup _ _ s -> isBlankDocString s+      IEDoc _ s -> isBlankDocString s+      _ -> False++    dropBlankTypeHaddocks = \case+      L _ (HsDocTy _ ty (L _ ds)) :: LHsType GhcPs+        | isBlankDocString ds -> ty+      a -> a+ -- | Enable all language extensions that we think should be enabled by -- default for ease of use. setDefaultExts :: DynFlags -> DynFlags-setDefaultExts flags = L.foldl' xopt_set flags autoExts+setDefaultExts flags = L.foldl' xopt_set (lang_set flags (Just Haskell2010)) autoExts   where     autoExts = allExts L.\\ manualExts     allExts = [minBound .. maxBound]@@ -164,7 +196,9 @@     -- decision of enabling this style is left to the user     NegativeLiterals, -- with this, `- 1` and `-1` have differing AST     LexicalNegation, -- implies NegativeLiterals-    LinearTypes -- steals the (%) type operator in some cases+    LinearTypes, -- steals the (%) type operator in some cases+    OverloadedRecordDot, -- f.g parses differently+    OverloadedRecordUpdate -- qualified fields are not supported   ]  -- | Run a 'GHC.P' computation.@@ -183,7 +217,15 @@   where     location = mkRealSrcLoc (GHC.mkFastString filename) 1 1     buffer = GHC.stringToStringBuffer input-    parseState = GHC.mkPState flags buffer location+    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

@@ -1,42 +0,0 @@--- | Ormolu-specific representation of GHC annotations.-module Ormolu.Parser.Anns-  ( Anns (..),-    emptyAnns,-    mkAnns,-    lookupAnns,-  )-where--import Data.Map.Strict (Map)-import qualified Data.Map.Strict as M-import GHC.Parser.Annotation-import GHC.Parser.Lexer-import GHC.Types.SrcLoc---- | Ormolu-specific representation of GHC annotations.-newtype Anns = Anns (Map RealSrcSpan [AnnKeywordId])-  deriving (Eq)---- | Empty 'Anns'.-emptyAnns :: Anns-emptyAnns = Anns M.empty---- | Create 'Anns' from 'PState'.-mkAnns ::-  PState ->-  Anns-mkAnns pstate =-  Anns $-    M.fromListWith (++) (f <$> annotations pstate)-  where-    f ((rspn, kid), _) = (rspn, [kid])---- | Lookup 'AnnKeywordId's corresponding to a given 'SrcSpan'.-lookupAnns ::-  -- | Span to lookup with-  SrcSpan ->-  -- | Collection of annotations-  Anns ->-  [AnnKeywordId]-lookupAnns (RealSrcSpan rspn _) (Anns m) = M.findWithDefault [] rspn m-lookupAnns (UnhelpfulSpan _) _ = []

@@ -1,6 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  -- | Functions for working with comment stream. module Ormolu.Parser.CommentStream@@ -17,14 +19,23 @@   ) where +import Control.Monad ((<=<)) import Data.Char (isSpace) import Data.Data (Data)+import Data.Generics.Schemes import qualified Data.List as L import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE-import Data.Maybe (mapMaybe)+import qualified Data.Map.Lazy as M+import Data.Maybe+import qualified Data.Set as S+import GHC.Hs (HsModule)+import GHC.Hs.Decls (HsDecl (..), LDocDecl, LHsDecl)+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 qualified GHC.Parser.Lexer as GHC import GHC.Types.SrcLoc import Ormolu.Parser.Pragma import Ormolu.Utils (onTheSameLine, showOutputable)@@ -37,19 +48,19 @@ newtype CommentStream = CommentStream [RealLocated Comment]   deriving (Eq, Data, Semigroup, Monoid) --- | Create 'CommentStream' from 'GHC.PState'. The pragmas are+-- | Create 'CommentStream' from 'HsModule'. The pragmas are -- removed from the 'CommentStream'. mkCommentStream ::   -- | Original input   String ->-  -- | Parser state to use for comment extraction-  GHC.PState ->+  -- | Module to use for comment extraction+  HsModule ->   -- | Stack header, pragmas, and comment stream   ( Maybe (RealLocated Comment),     [([RealLocated Comment], Pragma)],     CommentStream   )-mkCommentStream input pstate =+mkCommentStream input hsModule =   ( mstackHeader,     pragmas,     CommentStream comments@@ -57,12 +68,49 @@   where     (comments, pragmas) = extractPragmas input rawComments1     (rawComments1, mstackHeader) = extractStackHeader rawComments0++    -- We want to extract all comments except _valid_ Haddock comments     rawComments0 =-      L.sortOn (realSrcSpanStart . getRealSrcSpan) $-        mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate)-          ++ concatMap-            (mapMaybe (liftMaybe . fmap unAnnotationComment) . snd)-            (GHC.annotations_comments pstate)+      fmap (uncurry L)+        . M.toAscList+        . flip M.withoutKeys validHaddockCommentSpans+        . M.fromList+        . fmap (\(L l a) -> (l, a))+        $ allComments+      where+        -- All comments, including valid and invalid Haddock comments+        allComments =+          mapMaybe unAnnotationComment $+            epAnnCommentsToList =<< listify (only @EpAnnComments) hsModule+          where+            epAnnCommentsToList = \case+              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 getLocA . listify isIEDocLike+              ]+            $ hsModule+          where+            isDocD :: LHsDecl GhcPs -> Bool+            isDocD = \case+              L _ DocD {} -> True+              _ -> False+            isIEDocLike :: LIE GhcPs -> Bool+            isIEDocLike = \case+              L _ IEGroup {} -> True+              L _ IEDoc {} -> True+              L _ IEDocNamed {} -> True+              _ -> False+    only :: a -> Bool+    only _ = True  -- | Pretty-print a 'CommentStream'. showCommentStream :: CommentStream -> String@@ -96,17 +144,16 @@   where     comment =       L l . Comment atomsBefore . removeConseqBlanks . fmap dropTrailing $-        if "{-" `L.isPrefixOf` s-          then case NE.nonEmpty (lines s) of-            Nothing -> s :| []-            Just (x :| xs) ->-              let getIndent y =-                    if all isSpace y-                      then startIndent-                      else length (takeWhile isSpace y)-                  n = minimum (startIndent : fmap getIndent xs)-               in x :| (drop n <$> xs)-          else s :| []+        case NE.nonEmpty (lines s) of+          Nothing -> s :| []+          Just (x :| xs) ->+            let getIndent y =+                  if all isSpace y+                    then startIndent+                    else length (takeWhile isSpace y)+                n = minimum (startIndent : fmap getIndent xs)+                commentPrefix = if "{-" `L.isPrefixOf` s then "" else "-- "+             in x :| ((commentPrefix <>) . drop n <$> xs)     (atomsBefore, ls') =       case dropWhile ((< commentLine) . fst) ls of         [] -> (False, [])@@ -181,21 +228,33 @@                           then go' ls' [y'] ys                           else go' ls [] xs --- | Get a 'String' from 'GHC.AnnotationComment'.-unAnnotationComment :: GHC.AnnotationComment -> Maybe String-unAnnotationComment = \case-  GHC.AnnDocCommentNext _ -> Nothing -- @-- |@-  GHC.AnnDocCommentPrev _ -> Nothing -- @-- ^@-  GHC.AnnDocCommentNamed _ -> Nothing -- @-- $@-  GHC.AnnDocSection _ _ -> Nothing -- @-- *@-  GHC.AnnDocOptions s -> Just s-  GHC.AnnLineComment s -> Just s-  GHC.AnnBlockComment s -> Just s--liftMaybe :: GenLocated l (Maybe a) -> Maybe (GenLocated l a)-liftMaybe = \case-  L _ Nothing -> Nothing-  L l (Just a) -> Just (L l a)+-- | Extract @'RealLocated' 'String'@ from 'GHC.LEpaComment'.+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 _ s -> haddock s -- @-- *@+  GHC.EpaDocOptions s -> mkL s+  GHC.EpaLineComment s -> mkL $+    case take 3 s of+      "-- " -> s+      "---" -> s+      _ -> let s' = insertAt " " s 3 in s'+  GHC.EpaBlockComment s -> mkL s+  GHC.EpaEofComment -> Nothing+  where+    mkL = Just . L anchor+    insertAt x xs n = take (n - 1) xs ++ x ++ drop (n - 1) xs+    haddock = mkL . dashPrefix <=< dropBlank+      where+        dashPrefix s = "--" <> spaceIfNecessary <> s+          where+            spaceIfNecessary = case s of+              c : _ | c /= ' ' -> " "+              _ -> ""+        dropBlank :: String -> Maybe String+        dropBlank s = if all isSpace s then Nothing else Just s  -- | Remove consecutive blank lines. removeConseqBlanks :: NonEmpty String -> NonEmpty String

@@ -16,7 +16,6 @@ import GHC.Data.StringBuffer import qualified GHC.Parser.Lexer as L import GHC.Types.SrcLoc-import GHC.Unit.Module (stringToUnitId)  -- | Ormolu's representation of pragmas. data Pragma@@ -67,12 +66,11 @@   where     location = mkRealSrcLoc (mkFastString "") 1 1     buffer = stringToStringBuffer input-    parseState = L.mkPStatePure parserFlags buffer location-    parserFlags =-      L.mkParserFlags'+    parseState = L.initParserState parserOpts buffer location+    parserOpts =+      L.mkParserOpts         ES.empty         ES.empty-        (stringToUnitId "")         True         True         True

@@ -12,7 +12,7 @@ import GHC.Hs import GHC.LanguageExtensions.Type import GHC.Types.SrcLoc-import Ormolu.Parser.Anns+import Ormolu.Config (SourceType) import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma (Pragma) @@ -21,18 +21,16 @@  -- | A collection of data that represents a parsed module in Ormolu. data ParseResult = ParseResult-  { -- | 'ParsedSource' from GHC+  { -- | Parsed module or signature     prParsedSource :: HsModule,-    -- | Ormolu-specfic representation of annotations-    prAnns :: Anns,+    -- | Either regular module or signature file+    prSourceType :: SourceType,     -- | Stack header     prStackHeader :: Maybe (RealLocated Comment),     -- | Pragmas and the associated comments     prPragmas :: [([RealLocated Comment], Pragma)],     -- | Comment stream     prCommentStream :: CommentStream,-    -- | Whether or not record dot syntax is enabled-    prUseRecordDot :: Bool,     -- | Enabled extensions     prExtensions :: EnumSet Extension,     -- | Indentation level, can be non-zero in case of region formatting

@@ -4,7 +4,7 @@  -- | Pretty-printer for Haskell AST. module Ormolu.Printer-  ( printModule,+  ( printSnippets,     PrinterOpts (..),   ) where@@ -18,14 +18,14 @@ import Ormolu.Printer.SpanStream import Ormolu.Processing.Common --- | Render a module.-printModule ::+-- | Render several source snippets.+printSnippets ::   -- | Result of parsing   [SourceSnippet] ->   PrinterOptsTotal ->   -- | Resulting rendition   Text-printModule snippets printerOpts = T.concat . fmap printSnippet $ snippets+printSnippets snippets printerOpts = T.concat . fmap printSnippet $ snippets   where     printSnippet = \case       ParsedSnippet ParseResult {..} ->@@ -38,8 +38,7 @@             )             (mkSpanStream prParsedSource)             prCommentStream-            prAnns             printerOpts-            prUseRecordDot+            prSourceType             prExtensions       RawSnippet r -> r

@@ -10,7 +10,6 @@   ( -- * The 'R' monad     R,     runR,-    getAnns,     getEnclosingSpan,     isExtensionEnabled, @@ -28,7 +27,6 @@     inciHalf,     located,     located',-    realLocated,     switchLayout,     Layout (..),     vlayout,@@ -50,7 +48,6 @@     backticks,     banana,     braces,-    recordDotBraces,     brackets,     parens,     parensHash,@@ -78,6 +75,7 @@ import Ormolu.Config import Ormolu.Printer.Comments import Ormolu.Printer.Internal+import Ormolu.Utils (HasSrcSpan (..))  ---------------------------------------------------------------------------- -- Basic@@ -91,39 +89,33 @@   R () inciIf b m = if b then inci m else m --- | Enter a 'Located' entity. This combinator handles outputting comments+-- | Enter a 'GenLocated' entity. This combinator handles outputting comments -- and sets layout (single-line vs multi-line) for the inner computation. -- Roughly, the rule for using 'located' is that every time there is a -- 'Located' wrapper, it should be “discharged” with a corresponding -- 'located' invocation. located ::-  -- | Thing to enter-  Located a ->-  -- | How to render inner value-  (a -> R ()) ->-  R ()-located (L (UnhelpfulSpan _) a) f = f a-located (L (RealSrcSpan l _) a) f = realLocated (L l a) f---- | See 'located'-realLocated ::+  HasSrcSpan l =>   -- | Thing to enter-  RealLocated a ->+  GenLocated l a ->   -- | How to render inner value   (a -> R ()) ->   R ()-realLocated (L l a) f = do-  spitPrecedingComments l-  withEnclosingSpan l $-    switchLayout [RealSrcSpan l Nothing] (f a)-  spitFollowingComments l+located (L l' a) f = case loc' l' of+  UnhelpfulSpan _ -> f a+  RealSrcSpan l _ -> do+    spitPrecedingComments l+    withEnclosingSpan l $+      switchLayout [RealSrcSpan l Nothing] (f a)+    spitFollowingComments l  -- | A version of 'located' with arguments flipped. located' ::+  HasSrcSpan l =>   -- | How to render inner value   (a -> R ()) ->   -- | Thing to enter-  Located a ->+  GenLocated l a ->   R () located' = flip located @@ -236,23 +228,6 @@ -- | Surround given entity by curly braces @{@ and  @}@. braces :: BracketStyle -> R () -> R () braces = brackets_ False "{" "}"---- | Surround record update fields which use RecordDot plugin entity by--- curly braces @{@ and @}@.------ @since 0.1.3.1-recordDotBraces :: R () -> R ()-recordDotBraces m = sitcc (vlayout singleLine multiLine)-  where-    singleLine = do-      txt "{"-      m-      txt "}"-    multiLine = do-      txt "{"-      sitcc m-      newline-      txt "}"  -- | Surround given entity by square brackets @[@ and @]@. brackets :: BracketStyle -> R () -> R ()

@@ -19,12 +19,13 @@     space,     newline,     declNewline,-    useRecordDot,+    askSourceType,     inci,     inciBy,     inciByFrac,     inciHalf,     sitcc,+    sitccIfTrailing,     Layout (..),     enterLayout,     vlayout,@@ -53,9 +54,6 @@     setSpanMark,     getSpanMark, -    -- * Annotations-    getAnns,-     -- * Extensions     isExtensionEnabled,   )@@ -74,11 +72,9 @@ import GHC.Data.EnumSet (EnumSet) import qualified GHC.Data.EnumSet as EnumSet import GHC.LanguageExtensions.Type-import GHC.Parser.Annotation import GHC.Types.SrcLoc import GHC.Utils.Outputable (Outputable) import Ormolu.Config-import Ormolu.Parser.Anns import Ormolu.Parser.CommentStream import Ormolu.Printer.SpanStream import Ormolu.Utils (showOutputable)@@ -101,15 +97,13 @@     rcLayout :: Layout,     -- | Spans of enclosing elements of AST     rcEnclosingSpans :: [RealSrcSpan],-    -- | Collection of annotations-    rcAnns :: Anns,     -- | Whether the last expression in the layout can use braces     rcCanUseBraces :: Bool,-    -- | Whether the source could have used the record dot preprocessor-    rcUseRecDot :: Bool,     rcPrinterOpts :: PrinterOptsTotal,     -- | Enabled extensions-    rcExtensions :: EnumSet Extension+    rcExtensions :: EnumSet Extension,+    -- | Whether the source is a signature or a regular module+    rcSourceType :: SourceType   }  -- | State context of 'R'.@@ -173,16 +167,14 @@   SpanStream ->   -- | Comment stream   CommentStream ->-  -- | Annotations-  Anns ->   PrinterOptsTotal ->-  -- | Use Record Dot Syntax-  Bool ->+  -- | Whether the source is a signature or a regular module+  SourceType ->   -- | Enabled extensions   EnumSet Extension ->   -- | Resulting rendition   Text-runR (R m) sstream cstream anns printerOpts recDot extensions =+runR (R m) sstream cstream printerOpts sourceType extensions =   TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc   where     rc =@@ -190,11 +182,10 @@         { rcIndent = 0,           rcLayout = MultiLine,           rcEnclosingSpans = [],-          rcAnns = anns,           rcCanUseBraces = False,-          rcUseRecDot = recDot,           rcPrinterOpts = printerOpts,-          rcExtensions = extensions+          rcExtensions = extensions,+          rcSourceType = sourceType         }     sc =       SC@@ -395,9 +386,9 @@             _ -> AfterNewline         } --- | Return 'True' if we should print record dot syntax.-useRecordDot :: R Bool-useRecordDot = R (asks rcUseRecDot)+-- | Return the source type.+askSourceType :: R SourceType+askSourceType = R (asks rcSourceType)  -- | Like 'inci', but indents by exactly the given number of steps. inciBy :: Int -> R () -> R ()@@ -443,6 +434,14 @@           }   R (local modRC m) +-- | When using trailing commas, same as 'sitcc'; when using leading commas,+-- runs the input action unmodified.+sitccIfTrailing :: R () -> R ()+sitccIfTrailing x =+  getPrinterOpt poCommaStyle >>= \case+    Leading -> id x+    Trailing -> sitcc x+ -- | Set 'Layout' for internal computation. enterLayout :: Layout -> R () -> R () enterLayout l (R m) = R (local modRC m)@@ -595,15 +594,6 @@ -- | Get span of last output comment. getSpanMark :: R (Maybe SpanMark) getSpanMark = R (gets scSpanMark)--------------------------------------------------------------------------------- Annotations---- | For a given span return 'AnnKeywordId's associated with it.-getAnns ::-  SrcSpan ->-  R [AnnKeywordId]-getAnns spn = lookupAnns spn <$> R (asks rcAnns)  ---------------------------------------------------------------------------- -- Helpers for braces

@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}  -- | Rendering of commonly useful bits.@@ -7,7 +8,6 @@     p_hsmodName,     p_ieWrappedName,     p_rdrName,-    doesNotNeedExtraParens,     p_qualName,     p_infixDefHelper,     p_hsDocString,@@ -16,19 +16,19 @@ where  import Control.Monad-import Data.List (intersperse, isPrefixOf)+import Data.List (intersperse) import qualified Data.Text as T import GHC.Hs.Doc import GHC.Hs.ImpExp import GHC.Parser.Annotation-import GHC.Types.Basic-import GHC.Types.Name (nameStableString) import GHC.Types.Name.Occurrence (OccName (..)) import GHC.Types.Name.Reader+import GHC.Types.SourceText import GHC.Types.SrcLoc import GHC.Unit.Module.Name import Ormolu.Config import Ormolu.Printer.Combinators+import Ormolu.Printer.Internal (askSourceType) import Ormolu.Utils  -- | Data and type family style.@@ -38,78 +38,56 @@   | -- | Top-level declarations     Free +-- | Outputs the name of the module-like entity, preceeded by the correct prefix ("module" or "signature"). p_hsmodName :: ModuleName -> R () p_hsmodName mname = do-  txt "module"+  sourceType <- askSourceType+  txt $ case sourceType of+    ModuleSource -> "module"+    SignatureSource -> "signature"   space   atom mname  p_ieWrappedName :: IEWrappedName RdrName -> R () p_ieWrappedName = \case   IEName x -> p_rdrName x-  IEPattern x -> do+  IEPattern _ x -> do     txt "pattern"     space     p_rdrName x-  IEType x -> do+  IEType _ x -> do     txt "type"     space     p_rdrName x --- | Render a @'Located' 'RdrName'@.-p_rdrName :: Located RdrName -> R ()-p_rdrName l@(L spn _) = located l $ \x -> do-  ids <- getAnns spn-  let backticksWrapper =-        if AnnBackquote `elem` ids-          then backticks-          else id-      parensWrapper =-        if AnnOpenP `elem` ids-          then parens N-          else id-      singleQuoteWrapper =-        if AnnSimpleQuote `elem` ids-          then \y -> do-            txt "'"-            y-          else id-      m =-        case x of-          Unqual occName ->-            atom occName-          Qual mname occName ->-            p_qualName mname occName-          Orig _ occName ->-            -- This is used when GHC generates code that will be fed into-            -- the renamer (e.g. from deriving clauses), but where we want-            -- to say that something comes from given module which is not-            -- specified in the source code, e.g. @Prelude.map@.-            ---            -- My current understanding is that the provided module name-            -- serves no purpose for us and can be safely ignored.-            atom occName-          Exact name ->-            atom name-      m' = backticksWrapper (singleQuoteWrapper m)-  if doesNotNeedExtraParens x-    then m'-    else parensWrapper m'---- | Whether given name should not have parentheses around it. This is used--- to detect e.g. tuples for which annotations will indicate parentheses,--- but the parentheses are already part of the symbol, so no extra layer of--- parentheses should be added. It also detects the [] literal.-doesNotNeedExtraParens :: RdrName -> Bool-doesNotNeedExtraParens = \case-  Exact name ->-    let s = nameStableString name-     in -- I'm not sure this "stable string" is stable enough, but it looks-        -- like this is the most robust way to tell if we're looking at-        -- exactly this piece of built-in syntax.-        ("$ghc-prim$GHC.Tuple$" `isPrefixOf` s)-          || ("$ghc-prim$GHC.Types$[]" `isPrefixOf` s)-  _ -> False+-- | Render a @'LocatedN' 'RdrName'@.+p_rdrName :: LocatedN RdrName -> R ()+p_rdrName l = located l $ \x -> do+  let wrapper = \case+        EpAnn {anns} -> case anns of+          NameAnnQuote {nann_quoted} -> tickPrefix . wrapper (ann nann_quoted)+          NameAnn {nann_adornment = NameParens} -> parens N+          NameAnn {nann_adornment = NameBackquotes} -> backticks+          _ -> id+        EpAnnNotUsed -> id+  wrapper (ann . getLoc $ l) $ case x of+    Unqual occName ->+      atom occName+    Qual mname occName ->+      p_qualName mname occName+    Orig _ occName ->+      -- This is used when GHC generates code that will be fed into+      -- the renamer (e.g. from deriving clauses), but where we want+      -- to say that something comes from given module which is not+      -- specified in the source code, e.g. @Prelude.map@.+      --+      -- My current understanding is that the provided module name+      -- serves no purpose for us and can be safely ignored.+      atom occName+    Exact name ->+      atom name+  where+    tickPrefix y = txt "'" *> y  p_qualName :: ModuleName -> OccName -> R () p_qualName mname occName = do

@@ -14,14 +14,13 @@ import Data.List (sort) import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE-import GHC.Hs.Binds-import GHC.Hs.Decls-import GHC.Hs.Extension-import GHC.Hs.Pat+import GHC.Hs import GHC.Types.Name.Occurrence (occNameFS) import GHC.Types.Name.Reader import GHC.Types.SrcLoc+import Ormolu.Config (SourceType (SignatureSource)) import Ormolu.Printer.Combinators+import Ormolu.Printer.Internal (askSourceType) import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Annotation import Ormolu.Printer.Meat.Declaration.Class@@ -59,11 +58,12 @@ p_hsDeclsRespectGrouping = p_hsDecls' Respect  p_hsDecls' :: UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R ()-p_hsDecls' grouping style decls =+p_hsDecls' grouping style decls = do+  isSig <- (== SignatureSource) <$> askSourceType   sepSemi id $     -- Return a list of rendered declarations, adding a newline to separate     -- groups.-    case groupDecls decls of+    case groupDecls isSig decls of       [] -> []       (x : xs) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)   where@@ -75,7 +75,7 @@         Disregard ->           declNewline : renderGroup curr         Respect ->-          if separatedByBlankNE getLoc prev curr+          if separatedByBlankNE getLocA prev curr             || isDocumented prev             || isDocumented curr             then declNewline : renderGroup curr@@ -90,47 +90,52 @@     isHaddock _ = False  -- | Group relevant declarations together.-groupDecls :: [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)]-groupDecls [] = []-groupDecls (l@(L _ DocNext) : xs) =+groupDecls ::+  -- | Is the source a signature file?+  Bool ->+  -- | List of declarations+  [LHsDecl GhcPs] ->+  [NonEmpty (LHsDecl GhcPs)]+groupDecls _ [] = []+groupDecls isSig (l@(L _ DocNext) : xs) =   -- If the first element is a doc string for next element, just include it   -- in the next block:-  case groupDecls xs of+  case groupDecls isSig xs of     [] -> [l :| []]     (x : xs') -> (l <| x) : xs'-groupDecls (header : xs) =+groupDecls isSig (header : xs) =   let (grp, rest) = flip span (zip (header : xs) xs) $ \(previous, current) ->         let relevantToHdr = groupedDecls header current             relevantToPrev = groupedDecls previous current-            isDeclSeries = declSeries previous current+            isDeclSeries = not isSig && declSeries previous current          in isDeclSeries || relevantToHdr || relevantToPrev-   in (header :| map snd grp) : groupDecls (map snd rest)+   in (header :| map snd grp) : groupDecls isSig (map snd rest)  p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R () p_hsDecl style = \case-  TyClD NoExtField x -> p_tyClDecl style x-  ValD NoExtField x -> p_valDecl x-  SigD NoExtField x -> p_sigDecl x-  InstD NoExtField x -> p_instDecl style x-  DerivD NoExtField x -> p_standaloneDerivDecl x-  DefD NoExtField x -> p_defaultDecl x-  ForD NoExtField x -> p_foreignDecl x-  WarningD NoExtField x -> p_warnDecls x-  AnnD NoExtField x -> p_annDecl x-  RuleD NoExtField x -> p_ruleDecls x-  SpliceD NoExtField x -> p_spliceDecl x-  DocD NoExtField docDecl ->+  TyClD _ x -> p_tyClDecl style x+  ValD _ x -> p_valDecl x+  SigD _ x -> p_sigDecl x+  InstD _ x -> p_instDecl style x+  DerivD _ x -> p_standaloneDerivDecl x+  DefD _ x -> p_defaultDecl x+  ForD _ x -> p_foreignDecl x+  WarningD _ x -> p_warnDecls x+  AnnD _ x -> p_annDecl x+  RuleD _ x -> p_ruleDecls x+  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)-  RoleAnnotD NoExtField x -> p_roleAnnot x-  KindSigD NoExtField s -> p_standaloneKindSig s+  RoleAnnotD _ x -> p_roleAnnot x+  KindSigD _ s -> p_standaloneKindSig s  p_tyClDecl :: FamilyStyle -> TyClDecl GhcPs -> R () p_tyClDecl style = \case-  FamDecl NoExtField x -> p_famDecl style x+  FamDecl _ x -> p_famDecl style x   SynDecl {..} -> p_synDecl tcdLName tcdFixity tcdTyVars tcdRhs   DataDecl {..} ->     p_dataDecl@@ -154,16 +159,16 @@  p_instDecl :: FamilyStyle -> InstDecl GhcPs -> R () p_instDecl style = \case-  ClsInstD NoExtField x -> p_clsInstDecl x-  TyFamInstD NoExtField x -> p_tyFamInstDecl style x-  DataFamInstD NoExtField x -> p_dataFamInstDecl style x+  ClsInstD _ x -> p_clsInstDecl x+  TyFamInstD _ x -> p_tyFamInstDecl style x+  DataFamInstD _ x -> p_dataFamInstDecl style x  -- | Determine if these declarations should be grouped together. groupedDecls ::   LHsDecl GhcPs ->   LHsDecl GhcPs ->   Bool-groupedDecls (L l_x x') (L l_y y') =+groupedDecls (L (locA -> l_x) x') (L (locA -> l_y) y') =   case (x', y') of     (TypeSignature ns, FunctionBody ns') -> ns `intersects` ns'     (TypeSignature ns, DefaultSignature ns') -> ns `intersects` ns'@@ -174,11 +179,11 @@     (x, DataDeclaration n) | Just ns <- isPragma x -> n `elem` ns     (DataDeclaration n, x)       | Just ns <- isPragma x ->-        let f = occNameFS . rdrNameOcc in f n `elem` map f ns+          let f = occNameFS . rdrNameOcc in f n `elem` map f ns     (x, y)       | Just ns <- isPragma x,         Just ns' <- isPragma y ->-        ns `intersects` ns'+          ns `intersects` ns'     (x, TypeSignature ns) | Just ns' <- isPragma x -> ns `intersects` ns'     (TypeSignature ns, x) | Just ns' <- isPragma x -> ns `intersects` ns'     (PatternSignature ns, Pattern n) -> n `elem` ns@@ -200,8 +205,8 @@   Bool declSeries (L _ x) (L _ y) =   case (x, y) of-    ( SigD NoExtField (TypeSig NoExtField _ _),-      SigD NoExtField (TypeSig NoExtField _ _)+    ( SigD _ (TypeSig _ _ _),+      SigD _ (TypeSig _ _ _)       ) -> True     _ -> False @@ -231,7 +236,7 @@ -- Declarations that do not refer to names  pattern Splice :: HsDecl GhcPs-pattern Splice <- SpliceD NoExtField (SpliceDecl NoExtField _ _)+pattern Splice <- SpliceD _ (SpliceDecl _ _ _)  -- Declarations referring to a single name @@ -248,17 +253,17 @@   FamilyDeclaration,   TypeSynonym ::     RdrName -> HsDecl GhcPs-pattern InlinePragma n <- SigD NoExtField (InlineSig NoExtField (L _ n) _)-pattern SpecializePragma n <- SigD NoExtField (SpecSig NoExtField (L _ n) _ _)-pattern SCCPragma n <- SigD NoExtField (SCCFunSig NoExtField _ (L _ n) _)-pattern AnnTypePragma n <- AnnD NoExtField (HsAnnotation NoExtField _ (TypeAnnProvenance (L _ n)) _)-pattern AnnValuePragma n <- AnnD NoExtField (HsAnnotation NoExtField _ (ValueAnnProvenance (L _ n)) _)-pattern Pattern n <- ValD NoExtField (PatSynBind NoExtField (PSB _ (L _ n) _ _ _))-pattern DataDeclaration n <- TyClD NoExtField (DataDecl NoExtField (L _ n) _ _ _)-pattern ClassDeclaration n <- TyClD NoExtField (ClassDecl _ _ (L _ n) _ _ _ _ _ _ _ _)-pattern KindSignature n <- KindSigD NoExtField (StandaloneKindSig NoExtField (L _ n) _)-pattern FamilyDeclaration n <- TyClD NoExtField (FamDecl NoExtField (FamilyDecl NoExtField _ (L _ n) _ _ _ _))-pattern TypeSynonym n <- TyClD NoExtField (SynDecl NoExtField (L _ n) _ _ _)+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 Pattern n <- ValD _ (PatSynBind _ (PSB _ (L _ n) _ _ _))+pattern DataDeclaration n <- TyClD _ (DataDecl _ (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) _ _ _)  -- Declarations which can refer to multiple names @@ -276,47 +281,47 @@ pattern WarningPragma n <- (warnSigRdrNames -> Just n)  pattern DocNext, DocPrev :: HsDecl GhcPs-pattern DocNext <- (DocD NoExtField (DocCommentNext _))-pattern DocPrev <- (DocD NoExtField (DocCommentPrev _))+pattern DocNext <- (DocD _ (DocCommentNext _))+pattern DocPrev <- (DocD _ (DocCommentPrev _))  sigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]-sigRdrNames (SigD NoExtField (TypeSig NoExtField ns _)) = Just $ map unLoc ns-sigRdrNames (SigD NoExtField (ClassOpSig NoExtField _ ns _)) = Just $ map unLoc ns-sigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc ns+sigRdrNames (SigD _ (TypeSig _ ns _)) = Just $ map unLoc ns+sigRdrNames (SigD _ (ClassOpSig _ _ ns _)) = Just $ map unLoc ns+sigRdrNames (SigD _ (PatSynSig _ ns _)) = Just $ map unLoc ns sigRdrNames _ = Nothing  defSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]-defSigRdrNames (SigD NoExtField (ClassOpSig NoExtField True ns _)) = Just $ map unLoc ns+defSigRdrNames (SigD _ (ClassOpSig _ True ns _)) = Just $ map unLoc ns defSigRdrNames _ = Nothing  funRdrNames :: HsDecl GhcPs -> Maybe [RdrName]-funRdrNames (ValD NoExtField (FunBind NoExtField (L _ n) _ _)) = Just [n]-funRdrNames (ValD NoExtField (PatBind NoExtField (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]-patSigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc ns+patSigRdrNames (SigD _ (PatSynSig _ ns _)) = Just $ map unLoc ns patSigRdrNames _ = Nothing  warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]-warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $-  flip concatMap ws $ \(L _ (Warning NoExtField ns _)) -> map unLoc ns+warnSigRdrNames (WarningD _ (Warnings _ _ ws)) = Just $+  flip concatMap ws $ \(L _ (Warning _ ns _)) -> map unLoc ns warnSigRdrNames _ = Nothing  patBindNames :: Pat GhcPs -> [RdrName]-patBindNames (TuplePat NoExtField ps _) = concatMap (patBindNames . unLoc) ps-patBindNames (VarPat NoExtField (L _ n)) = [n]-patBindNames (WildPat NoExtField) = []-patBindNames (LazyPat NoExtField (L _ p)) = patBindNames p-patBindNames (BangPat NoExtField (L _ p)) = patBindNames p-patBindNames (ParPat NoExtField (L _ p)) = patBindNames p-patBindNames (ListPat NoExtField ps) = concatMap (patBindNames . unLoc) ps-patBindNames (AsPat NoExtField (L _ n) (L _ p)) = n : patBindNames p-patBindNames (SumPat NoExtField (L _ p) _ _) = patBindNames p-patBindNames (ViewPat NoExtField _ (L _ p)) = patBindNames p-patBindNames (SplicePat NoExtField _) = []-patBindNames (LitPat NoExtField _) = []+patBindNames (TuplePat _ ps _) = concatMap (patBindNames . unLoc) ps+patBindNames (VarPat _ (L _ n)) = [n]+patBindNames (WildPat _) = []+patBindNames (LazyPat _ (L _ p)) = patBindNames p+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 (SumPat _ (L _ p) _ _) = patBindNames p+patBindNames (ViewPat _ _ (L _ p)) = patBindNames p+patBindNames (SplicePat _ _) = []+patBindNames (LitPat _ _) = [] patBindNames (SigPat _ (L _ p) _) = patBindNames p-patBindNames (NPat NoExtField _ _ _) = []-patBindNames (NPlusKPat NoExtField (L _ n) _ _ _ _) = [n]-patBindNames (ConPat NoExtField _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d)+patBindNames (NPat _ _ _ _) = []+patBindNames (NPlusKPat _ (L _ n) _ _ _ _) = [n]+patBindNames (ConPat _ _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d)

@@ -6,20 +6,19 @@   ) where -import GHC.Hs.Decls-import GHC.Hs.Extension+import GHC.Hs import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Value  p_annDecl :: AnnDecl GhcPs -> R ()-p_annDecl (HsAnnotation NoExtField _ annProv expr) =+p_annDecl (HsAnnotation _ _ annProv expr) =   pragma "ANN" . inci $ do     p_annProv annProv     breakpoint     located expr p_hsExpr -p_annProv :: AnnProvenance (IdP GhcPs) -> R ()+p_annProv :: AnnProvenance GhcPs -> R () p_annProv = \case   ValueAnnProvenance name -> p_rdrName name   TypeAnnProvenance name -> txt "type" >> space >> p_rdrName name

@@ -13,12 +13,9 @@ import Data.Foldable import Data.Function (on) import Data.List (sortBy)-import GHC.Core.Class-import GHC.Hs.Binds-import GHC.Hs.Decls-import GHC.Hs.Extension-import GHC.Hs.Type-import GHC.Types.Basic+import Data.Maybe+import GHC.Hs+import GHC.Types.Fixity import GHC.Types.Name.Reader import GHC.Types.SrcLoc import Ormolu.Config@@ -28,32 +25,32 @@ import Ormolu.Printer.Meat.Type  p_classDecl ::-  LHsContext GhcPs ->-  Located RdrName ->+  Maybe (LHsContext GhcPs) ->+  LocatedN RdrName ->   LHsQTyVars GhcPs ->   LexicalFixity ->-  [Located (FunDep (Located RdrName))] ->+  [LHsFunDep GhcPs] ->   [LSig GhcPs] ->   LHsBinds GhcPs ->   [LFamilyDecl GhcPs] ->   [LTyFamDefltDecl GhcPs] ->-  [LDocDecl] ->+  [LDocDecl GhcPs] ->   R () p_classDecl ctx name HsQTvs {..} fixity fdeps csigs cdefs cats catdefs cdocs = do-  let variableSpans = getLoc <$> hsq_explicit-      signatureSpans = getLoc name : variableSpans-      dependencySpans = getLoc <$> fdeps-      combinedSpans = getLoc ctx : (signatureSpans ++ dependencySpans)+  let variableSpans = getLocA <$> hsq_explicit+      signatureSpans = getLocA name : variableSpans+      dependencySpans = getLocA <$> fdeps+      combinedSpans = maybeToList (getLocA <$> ctx) ++ signatureSpans ++ dependencySpans       -- GHC's AST does not necessarily store each kind of element in source       -- location order. This happens because different declarations are stored       -- in different lists. Consequently, to get all the declarations in proper       -- order, they need to be manually sorted.-      sigs = (getLoc &&& fmap (SigD NoExtField)) <$> csigs-      vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cdefs-      tyFams = (getLoc &&& fmap (TyClD NoExtField . FamDecl NoExtField)) <$> cats-      docs = (getLoc &&& fmap (DocD NoExtField)) <$> cdocs+      sigs = (getLocA &&& fmap (SigD NoExtField)) <$> csigs+      vals = (getLocA &&& fmap (ValD NoExtField)) <$> toList cdefs+      tyFams = (getLocA &&& fmap (TyClD NoExtField . FamDecl NoExtField)) <$> cats+      docs = (getLocA &&& fmap (DocD NoExtField)) <$> cdocs       tyFamDefs =-        ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField)+        ( getLocA &&& fmap (InstD NoExtField . TyFamInstD NoExtField)         )           <$> catdefs       allDecls =@@ -62,7 +59,7 @@   switchLayout combinedSpans $ do     breakpoint     inci $ do-      p_classContext ctx+      for_ ctx p_classContext       switchLayout signatureSpans $         p_infixDefHelper           (isInfix fixity)@@ -84,7 +81,7 @@   txt "=>"   breakpoint -p_classFundeps :: [Located (FunDep (Located RdrName))] -> R ()+p_classFundeps :: [LHsFunDep GhcPs] -> R () p_classFundeps fdeps = unless (null fdeps) $ do   breakpoint   txt "|"@@ -96,8 +93,8 @@         Leading -> id x         Trailing -> inci x -p_funDep :: FunDep (Located RdrName) -> R ()-p_funDep (before, after) = do+p_funDep :: FunDep GhcPs -> R ()+p_funDep (FunDep _ before after) = do   sep space p_rdrName before   space   txt "->"

@@ -1,3 +1,4 @@+{-# LANGUAGE BlockArguments #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}@@ -12,11 +13,9 @@ import Control.Monad import Data.Maybe (isJust, maybeToList) import qualified Data.Text as Text-import GHC.Hs.Decls-import GHC.Hs.Extension-import GHC.Hs.Type-import GHC.Parser.Annotation-import GHC.Types.Basic+import Data.Void+import GHC.Hs+import GHC.Types.Fixity import GHC.Types.ForeignCall import GHC.Types.Name.Reader import GHC.Types.SrcLoc@@ -24,13 +23,12 @@ import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type-import Ormolu.Utils  p_dataDecl ::   -- | Whether to format as data family   FamilyStyle ->   -- | Type constructor-  Located RdrName ->+  LocatedN RdrName ->   -- | Type patterns   HsTyPats GhcPs ->   -- | Lexical fixity@@ -54,8 +52,8 @@         Just (Header h _) -> space *> p_sourceText h       p_sourceText type_       txt " #-}"-  let constructorSpans = getLoc name : fmap lhsTypeArgSrcSpan tpats-      sigSpans = maybeToList . fmap getLoc $ dd_kindSig+  let constructorSpans = getLocA name : fmap lhsTypeArgSrcSpan tpats+      sigSpans = maybeToList . fmap getLocA $ dd_kindSig       declHeaderSpans = constructorSpans ++ sigSpans   switchLayout declHeaderSpans $ do     breakpoint@@ -80,7 +78,7 @@           txt "where"         breakpoint         sepSemi (located' (p_conDecl False)) dd_cons-      else switchLayout (getLoc name : (getLoc <$> dd_cons)) . inci $ do+      else switchLayout (getLocA name : (getLocA <$> dd_cons)) . inci $ do         let singleConstRec = isSingleConstRec dd_cons         if singleConstRec           then space@@ -100,9 +98,8 @@                 then id                 else sitcc         sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons-  unless (null $ unLoc dd_derivs) breakpoint-  inci . located dd_derivs $ \xs ->-    sep newline (located' p_hsDerivingClause) xs+  unless (null dd_derivs) breakpoint+  inci $ sep newline (located' p_hsDerivingClause) dd_derivs  p_conDecl ::   Bool ->@@ -112,11 +109,14 @@   ConDeclGADT {..} -> do     mapM_ (p_hsDocString Pipe True) con_doc     let conDeclSpn =-          fmap getLoc con_names-            <> [getLoc con_forall]-            <> fmap getLoc con_qvars-            <> maybeToList (fmap getLoc con_mb_cxt)-            <> conArgsSpans con_args+          fmap getLocA con_names+            <> [getLocA con_bndrs]+            <> maybeToList (fmap getLocA con_mb_cxt)+            <> conArgsSpans+          where+            conArgsSpans = case con_g_args of+              PrefixConGADT xs -> getLocA . hsScaledThing <$> xs+              RecConGADT x -> [getLocA x]     switchLayout conDeclSpn $ do       case con_names of         [] -> return ()@@ -133,52 +133,53 @@                 then newline                 else breakpoint         interArgBreak-        conTy <- case con_args of-          PrefixCon xs ->-            let go (HsScaled a b) t = L (combineLocs t b) (HsFunTy NoExtField a b t)-             in pure $ foldr go con_res_ty xs-          RecCon r@(L l rs) ->-            pure-              . L (combineLocs r con_res_ty)-              $ HsFunTy-                NoExtField-                (HsUnrestrictedArrow NormalSyntax)-                (L l $ HsRecTy NoExtField rs)-                con_res_ty-          InfixCon _ _ -> notImplemented "InfixCon" -- NOTE(amesgen) should be unreachable-        let qualTy = case con_mb_cxt of+        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 ->+                addCLocAA r con_res_ty $+                  HsFunTy+                    EpAnnNotUsed+                    (HsUnrestrictedArrow NormalSyntax)+                    (la2la $ HsRecTy EpAnnNotUsed <$> r)+                    con_res_ty+            qualTy = case con_mb_cxt of               Nothing -> conTy               Just qs ->-                L (combineLocs qs conTy) $-                  HsQualTy NoExtField qs conTy-        let quantifiedTy =-              if unLoc con_forall-                then-                  L (combineLocs con_forall qualTy) $-                    HsForAllTy NoExtField (mkHsForAllInvisTele con_qvars) qualTy-                else qualTy+                addCLocAA qs conTy $+                  HsQualTy NoExtField (Just qs) conTy+            quantifiedTy =+              addCLocAA con_bndrs qualTy $+                hsOuterTyVarBndrsToHsType (unLoc con_bndrs) qualTy         p_hsType (unLoc quantifiedTy)   ConDeclH98 {..} -> do     mapM_ (p_hsDocString Pipe True) con_doc     let conDeclWithContextSpn =-          [getLoc con_forall]-            <> fmap getLoc con_ex_tvs-            <> maybeToList (fmap getLoc con_mb_cxt)+          [RealSrcSpan real Nothing | AddEpAnn AnnForall (EpaSpan real) <- epAnnAnns con_ext]+          <> fmap getLocA con_ex_tvs+            <> maybeToList (fmap getLocA con_mb_cxt)             <> conDeclSpn-        conDeclSpn =-          getLoc con_name : conArgsSpans con_args+        conDeclSpn = getLocA con_name : conArgsSpans+          where+            conArgsSpans = case con_args of+              PrefixCon [] xs -> getLocA . hsScaledThing <$> xs+              PrefixCon (v : _) _ -> absurd v+              RecCon l -> [getLocA l]+              InfixCon x y -> getLocA . hsScaledThing <$> [x, y]     switchLayout conDeclWithContextSpn $ do-      when (unLoc con_forall) $ do+      when con_forall $ do         p_forallBndrs ForAllInvis p_hsTyVarBndr con_ex_tvs         breakpoint         indent <- getPrinterOpt poIndentation         vlayout (pure ()) . txt $ Text.replicate (indent - 2) " "       forM_ con_mb_cxt p_lhsContext       switchLayout conDeclSpn $ case con_args of-        PrefixCon xs -> do+        PrefixCon [] xs -> do           p_rdrName con_name           unless (null xs) breakpoint           inci . sitcc $ sep breakpoint (sitcc . located' p_hsTypePostDoc) (hsScaledThing <$> xs)+        PrefixCon (v : _) _ -> absurd v         RecCon l -> do           p_rdrName con_name           breakpoint@@ -191,15 +192,6 @@             space             located y p_hsType -conArgsSpans :: HsConDeclDetails GhcPs -> [SrcSpan]-conArgsSpans = \case-  PrefixCon xs ->-    getLoc . hsScaledThing <$> xs-  RecCon l ->-    [getLoc l]-  InfixCon x y ->-    getLoc . hsScaledThing <$> [x, y]- p_lhsContext ::   LHsContext GhcPs ->   R ()@@ -222,39 +214,39 @@ p_hsDerivingClause HsDerivingClause {..} = do   txt "deriving"   let derivingWhat = located deriv_clause_tys $ \case-        [] -> txt "()"-        xs ->+        DctSingle NoExtField sigTy -> parens N $ located sigTy p_hsSigType+        DctMulti NoExtField sigTys ->           parens N $             sep               commaDel-              (sitcc . located' p_hsType . hsib_body)-              xs+              (sitcc . located' p_hsSigType)+              sigTys   space   case deriv_clause_strategy of     Nothing -> do       breakpoint       inci derivingWhat     Just (L _ a) -> case a of-      StockStrategy -> do+      StockStrategy _ -> do         txt "stock"         breakpoint         inci derivingWhat-      AnyclassStrategy -> do+      AnyclassStrategy _ -> do         txt "anyclass"         breakpoint         inci derivingWhat-      NewtypeStrategy -> do+      NewtypeStrategy _ -> do         txt "newtype"         breakpoint         inci derivingWhat-      ViaStrategy HsIB {..} -> do+      ViaStrategy (XViaStrategyPs _ sigTy) -> do         breakpoint         inci $ do           derivingWhat           breakpoint           txt "via"           space-          located hsib_body p_hsType+          located sigTy p_hsSigType  ---------------------------------------------------------------------------- -- Helpers

@@ -6,13 +6,12 @@   ) where -import GHC.Hs.Decls-import GHC.Hs.Extension+import GHC.Hs import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Type  p_defaultDecl :: DefaultDecl GhcPs -> R ()-p_defaultDecl (DefaultDecl NoExtField ts) = do+p_defaultDecl (DefaultDecl _ ts) = do   txt "default"   breakpoint   inci . parens N $

@@ -8,9 +8,7 @@ where  import Control.Monad-import GHC.Hs.Decls-import GHC.Hs.Extension-import GHC.Hs.Type+import GHC.Hs import GHC.Types.ForeignCall import GHC.Types.SrcLoc import Ormolu.Printer.Combinators@@ -33,12 +31,12 @@   breakpoint   inci     . switchLayout-      [ getLoc (fd_name fd),-        (getLoc . hsib_body . fd_sig_ty) fd+      [ getLocA (fd_name fd),+        (getLocA . fd_sig_ty) fd       ]     $ do       p_rdrName (fd_name fd)-      p_typeAscription (HsWC NoExtField (fd_sig_ty fd))+      p_typeAscription (fd_sig_ty fd)  -- | Printer for 'ForeignImport'. --

@@ -16,9 +16,7 @@ import Data.Foldable import Data.Function (on) import Data.List (sortBy)-import GHC.Hs.Decls-import GHC.Hs.Extension-import GHC.Hs.Type+import GHC.Hs import GHC.Types.Basic import GHC.Types.SrcLoc import Ormolu.Printer.Combinators@@ -30,7 +28,7 @@  p_standaloneDerivDecl :: DerivDecl GhcPs -> R () p_standaloneDerivDecl DerivDecl {..} = do-  let typesAfterInstance = located (hsib_body (hswc_body deriv_type)) p_hsType+  let typesAfterInstance = located (hswc_body deriv_type) p_hsSigType       instTypes toIndent = inci $ do         txt "instance"         breakpoint@@ -42,47 +40,46 @@     Nothing ->       instTypes False     Just (L _ a) -> case a of-      StockStrategy -> do+      StockStrategy _ -> do         txt "stock "         instTypes False-      AnyclassStrategy -> do+      AnyclassStrategy _ -> do         txt "anyclass "         instTypes False-      NewtypeStrategy -> do+      NewtypeStrategy _ -> do         txt "newtype "         instTypes False-      ViaStrategy HsIB {..} -> do+      ViaStrategy (XViaStrategyPs _ sigTy) -> do         txt "via"         breakpoint-        inci (located hsib_body p_hsType)+        inci (located sigTy p_hsSigType)         breakpoint         instTypes True  p_clsInstDecl :: ClsInstDecl GhcPs -> R () p_clsInstDecl ClsInstDecl {..} = do   txt "instance"-  let HsIB {..} = cid_poly_ty   -- GHC's AST does not necessarily store each kind of element in source   -- location order. This happens because different declarations are stored in   -- different lists. Consequently, to get all the declarations in proper   -- order, they need to be manually sorted.-  let sigs = (getLoc &&& fmap (SigD NoExtField)) <$> cid_sigs-      vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cid_binds+  let sigs = (getLocA &&& fmap (SigD NoExtField)) <$> cid_sigs+      vals = (getLocA &&& fmap (ValD NoExtField)) <$> toList cid_binds       tyFamInsts =-        ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField)+        ( getLocA &&& fmap (InstD NoExtField . TyFamInstD NoExtField)         )           <$> cid_tyfam_insts       dataFamInsts =-        ( getLoc &&& fmap (InstD NoExtField . DataFamInstD NoExtField)+        ( getLocA &&& fmap (InstD NoExtField . DataFamInstD EpAnnNotUsed)         )           <$> cid_datafam_insts       allDecls =         snd <$> sortBy (leftmost_smallest `on` fst) (sigs <> vals <> tyFamInsts <> dataFamInsts)-  located hsib_body $ \x -> do+  located cid_poly_ty $ \sigTy -> do     breakpoint     inci $ do       match_overlap_mode cid_overlap_mode breakpoint-      p_hsType x+      p_hsSigType sigTy       unless (null allDecls) $ do         breakpoint         txt "where"@@ -100,10 +97,10 @@   inci (p_tyFamInstEqn tfid_eqn)  p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R ()-p_dataFamInstDecl style (DataFamInstDecl {dfid_eqn = HsIB {hsib_body = FamEqn {..}}}) =+p_dataFamInstDecl style (DataFamInstDecl {dfid_eqn = FamEqn {..}}) =   p_dataDecl style feqn_tycon feqn_pats feqn_fixity feqn_rhs -match_overlap_mode :: Maybe (Located OverlapMode) -> R () -> R ()+match_overlap_mode :: Maybe (LocatedP OverlapMode) -> R () -> R () match_overlap_mode overlap_mode layoutStrategy =   case unLoc <$> overlap_mode of     Just Overlappable {} -> do

@@ -9,17 +9,16 @@ where  import GHC.Core.Coercion.Axiom-import GHC.Hs.Decls-import GHC.Hs.Extension+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 NoExtField l_name anns) = p_roleAnnot' l_name anns+p_roleAnnot (RoleAnnotDecl _ l_name anns) = p_roleAnnot' l_name anns -p_roleAnnot' :: Located RdrName -> [Located (Maybe Role)] -> R ()+p_roleAnnot' :: LocatedN RdrName -> [Located (Maybe Role)] -> R () p_roleAnnot' l_name anns = do   txt "type role"   breakpoint

@@ -8,11 +8,9 @@ where  import Control.Monad (unless)-import GHC.Hs.Decls-import GHC.Hs.Extension-import GHC.Hs.Lit-import GHC.Hs.Type+import GHC.Hs import GHC.Types.Basic+import GHC.Types.SourceText import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Signature@@ -20,11 +18,11 @@ import Ormolu.Printer.Meat.Type  p_ruleDecls :: RuleDecls GhcPs -> R ()-p_ruleDecls (HsRules NoExtField _ xs) =+p_ruleDecls (HsRules _ _ xs) =   pragma "RULES" $ sep breakpoint (sitcc . located' p_ruleDecl) xs  p_ruleDecl :: RuleDecl GhcPs -> R ()-p_ruleDecl (HsRule NoExtField ruleName activation tyvars ruleBndrs lhs rhs) = do+p_ruleDecl (HsRule _ ruleName activation tyvars ruleBndrs lhs rhs) = do   located ruleName p_ruleName   space   p_activation activation@@ -38,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 ruleBndrs+    p_forallBndrs ForAllInvis p_ruleBndr (reLocA <$> ruleBndrs)   breakpoint   inci $ do     located lhs p_hsExpr@@ -53,7 +51,7 @@  p_ruleBndr :: RuleBndr GhcPs -> R () p_ruleBndr = \case-  RuleBndr NoExtField x -> p_rdrName x-  RuleBndrSig NoExtField x HsPS {..} -> parens N . sitcc $ do+  RuleBndr _ x -> p_rdrName x+  RuleBndrSig _ x HsPS {..} -> parens N . sitcc $ do     p_rdrName x-    p_typeAscription (HsWC NoExtField (HsIB NoExtField hsps_body))+    p_typeAscription (lhsTypeToSigType hsps_body)

@@ -13,12 +13,11 @@  import Control.Monad import GHC.Data.BooleanFormula-import GHC.Hs.Binds-import GHC.Hs.Decls-import GHC.Hs.Extension-import GHC.Hs.Type+import GHC.Hs import GHC.Types.Basic+import GHC.Types.Fixity import GHC.Types.Name.Reader+import GHC.Types.SourceText import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common@@ -27,59 +26,54 @@  p_sigDecl :: Sig GhcPs -> R () p_sigDecl = \case-  TypeSig NoExtField names hswc -> p_typeSig True names hswc-  PatSynSig NoExtField names hsib -> p_patSynSig names hsib-  ClassOpSig NoExtField def names hsib -> p_classOpSig def names hsib-  FixSig NoExtField sig -> p_fixSig sig-  InlineSig NoExtField name inlinePragma -> p_inlineSig name inlinePragma-  SpecSig NoExtField name ts inlinePragma -> p_specSig name ts inlinePragma-  SpecInstSig NoExtField _ hsib -> p_specInstSig hsib-  MinimalSig NoExtField _ booleanFormula -> p_minimalSig booleanFormula-  CompleteMatchSig NoExtField _sourceText cs ty -> p_completeSig cs ty-  SCCFunSig NoExtField _ name literal -> p_sccSig name literal+  TypeSig _ names hswc -> p_typeSig True names (hswc_body hswc)+  PatSynSig _ names sigType -> p_patSynSig names sigType+  ClassOpSig _ def names sigType -> p_classOpSig def names sigType+  FixSig _ sig -> p_fixSig sig+  InlineSig _ name inlinePragma -> p_inlineSig name inlinePragma+  SpecSig _ name ts inlinePragma -> p_specSig name ts inlinePragma+  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"  p_typeSig ::   -- | Should the tail of the names be indented   Bool ->   -- | Names (before @::@)-  [Located RdrName] ->+  [LocatedN RdrName] ->   -- | Type-  LHsSigWcType GhcPs ->+  LHsSigType GhcPs ->   R () p_typeSig _ [] _ = return () -- should not happen though-p_typeSig indentTail (n : ns) hswc = do+p_typeSig indentTail (n : ns) sigType = do   p_rdrName n   if null ns-    then p_typeAscription hswc+    then p_typeAscription sigType     else inciIf indentTail $ do       commaDel       sep commaDel p_rdrName ns-      p_typeAscription hswc+      p_typeAscription sigType  p_typeAscription ::-  LHsSigWcType GhcPs ->+  LHsSigType GhcPs ->   R ()-p_typeAscription HsWC {..} = inci $ do+p_typeAscription sigType = inci $ do   space   txt "::"-  let t = hsib_body hswc_body-  if hasDocStrings (unLoc t)+  if hasDocStrings (unLoc . sig_body . unLoc $ sigType)     then newline     else breakpoint-  located t p_hsType+  located sigType p_hsSigType  p_patSynSig ::-  [Located RdrName] ->-  HsImplicitBndrs GhcPs (LHsType GhcPs) ->+  [LocatedN RdrName] ->+  LHsSigType GhcPs ->   R ()-p_patSynSig names hsib = do+p_patSynSig names sigType = do   txt "pattern"-  let body =-        p_typeSig-          False-          names-          HsWC {hswc_ext = NoExtField, hswc_body = hsib}+  let body = p_typeSig False names sigType   if length names > 1     then breakpoint >> inci body     else space >> body@@ -88,13 +82,13 @@   -- | Whether this is a \"default\" signature   Bool ->   -- | Names (before @::@)-  [Located RdrName] ->+  [LocatedN RdrName] ->   -- | Type-  HsImplicitBndrs GhcPs (LHsType GhcPs) ->+  LHsSigType GhcPs ->   R ()-p_classOpSig def names hsib = do+p_classOpSig def names sigType = do   when def (txt "default" >> space)-  p_typeSig True names HsWC {hswc_ext = NoExtField, hswc_body = hsib}+  p_typeSig True names sigType  p_fixSig ::   FixitySig GhcPs ->@@ -112,7 +106,7 @@  p_inlineSig ::   -- | Name-  Located RdrName ->+  LocatedN RdrName ->   -- | Inline pragma specification   InlinePragma ->   R ()@@ -123,13 +117,13 @@     ConLike -> txt "CONLIKE"     FunLike -> return ()   space-  p_activation inl_act+  when (inl_act /= NeverActive) $ p_activation inl_act   space   p_rdrName name  p_specSig ::   -- | Name-  Located RdrName ->+  LocatedN RdrName ->   -- | The types to specialize to   [LHsSigType GhcPs] ->   -- | For specialize inline@@ -146,18 +140,18 @@   space   txt "::"   breakpoint-  inci $ sep commaDel (located' p_hsType . hsib_body) ts+  inci $ sep commaDel (located' p_hsSigType) ts  p_inlineSpec :: InlineSpec -> R () p_inlineSpec = \case   Inline -> txt "INLINE"   Inlinable -> txt "INLINEABLE"   NoInline -> txt "NOINLINE"-  NoUserInline -> return ()+  NoUserInlinePrag -> return ()  p_activation :: Activation -> R () p_activation = \case-  NeverActive -> return ()+  NeverActive -> txt "[~]"   AlwaysActive -> return ()   ActiveBefore _ n -> do     txt "[~"@@ -170,13 +164,13 @@   FinalActive -> notImplemented "FinalActive" -- NOTE(amesgen) is this unreachable or just not implemented?  p_specInstSig :: LHsSigType GhcPs -> R ()-p_specInstSig hsib =+p_specInstSig sigType =   pragma "SPECIALIZE instance" . inci $-    located (hsib_body hsib) p_hsType+    located sigType p_hsSigType  p_minimalSig ::   -- | Boolean formula-  LBooleanFormula (Located RdrName) ->+  LBooleanFormula (LocatedN RdrName) ->   R () p_minimalSig =   located' $ \booleanFormula ->@@ -184,7 +178,7 @@  p_booleanFormula ::   -- | Boolean formula-  BooleanFormula (Located RdrName) ->+  BooleanFormula (LocatedN RdrName) ->   R () p_booleanFormula = \case   Var name -> p_rdrName name@@ -204,9 +198,9 @@  p_completeSig ::   -- | Constructors\/patterns-  Located [Located RdrName] ->+  Located [LocatedN RdrName] ->   -- | Type-  Maybe (Located RdrName) ->+  Maybe (LocatedN RdrName) ->   R () p_completeSig cs' mty =   located cs' $ \cs ->@@ -218,7 +212,7 @@         breakpoint         inci (p_rdrName ty) -p_sccSig :: Located (IdP GhcPs) -> Maybe (Located StringLiteral) -> R ()+p_sccSig :: LocatedN RdrName -> Maybe (Located StringLiteral) -> R () p_sccSig loc literal = pragma "SCC" . inci $ do   p_rdrName loc   forM_ literal $ \x -> do@@ -226,7 +220,7 @@     atom x  p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()-p_standaloneKindSig (StandaloneKindSig NoExtField name (HsIB NoExtField sig)) = do+p_standaloneKindSig (StandaloneKindSig _ name sigTy) = do   txt "type"   inci $ do     space@@ -234,4 +228,4 @@     space     txt "::"     breakpoint-    located sig p_hsType+    located sigTy p_hsSigType

@@ -5,8 +5,7 @@   ) where -import GHC.Hs.Decls-import GHC.Hs.Extension+import GHC.Hs import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Declaration.Value (p_hsSplice) 

@@ -9,7 +9,8 @@  import GHC.Hs.Extension import GHC.Hs.Type-import GHC.Types.Basic+import GHC.Parser.Annotation+import GHC.Types.Fixity import GHC.Types.Name.Reader import GHC.Types.SrcLoc import Ormolu.Printer.Combinators@@ -18,7 +19,7 @@  p_synDecl ::   -- | Type constructor-  Located RdrName ->+  LocatedN RdrName ->   -- | Fixity   LexicalFixity ->   -- | Type variables@@ -29,7 +30,7 @@ p_synDecl name fixity HsQTvs {..} t = do   txt "type"   space-  switchLayout (getLoc name : map getLoc hsq_explicit) $+  switchLayout (getLocA name : map getLocA hsq_explicit) $     p_infixDefHelper       (case fixity of Infix -> True; _ -> False)       True

@@ -11,10 +11,8 @@  import Control.Monad import Data.Maybe (isNothing)-import GHC.Hs.Decls-import GHC.Hs.Extension-import GHC.Hs.Type-import GHC.Types.Basic+import GHC.Hs+import GHC.Types.Fixity import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common@@ -29,9 +27,11 @@   txt $ case style of     Associated -> mempty     Free -> " family"-  breakpoint-  inci $ do-    switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $+  let headerSpns = getLocA fdLName : (getLocA <$> hsq_explicit)+      headerAndSigSpns = getLoc fdResultSig : headerSpns+  inci . switchLayout headerAndSigSpns $ do+    breakpoint+    switchLayout headerSpns $ do       p_infixDefHelper         (isInfix fdFixity)         True@@ -46,7 +46,7 @@   case mmeqs of     Nothing -> return ()     Just meqs -> do-      inci $ do+      inci . switchLayout headerAndSigSpns $ do         breakpoint         txt "where"       case meqs of@@ -72,7 +72,7 @@     located bndr p_hsTyVarBndr  p_injectivityAnn :: InjectivityAnn GhcPs -> R ()-p_injectivityAnn (InjectivityAnn a bs) = do+p_injectivityAnn (InjectivityAnn _ a bs) = do   txt "|"   space   p_rdrName a@@ -82,14 +82,17 @@   sep space p_rdrName bs  p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()-p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do+p_tyFamInstEqn FamEqn {..} = do   case feqn_bndrs of-    Nothing -> return ()-    Just bndrs -> do+    HsOuterImplicit NoExtField -> return ()+    HsOuterExplicit _ bndrs -> do       p_forallBndrs ForAllInvis p_hsTyVarBndr bndrs       breakpoint-  inciIf (not $ null feqn_bndrs) $ do-    let famLhsSpn = getLoc feqn_tycon : fmap lhsTypeArgSrcSpan feqn_pats+  let atLeastOneBndr = case feqn_bndrs of+        HsOuterImplicit NoExtField -> False+        HsOuterExplicit _ bndrs -> not $ null bndrs+  inciIf atLeastOneBndr $ do+    let famLhsSpn = getLocA feqn_tycon : fmap lhsTypeArgSrcSpan feqn_pats     switchLayout famLhsSpn $       p_infixDefHelper         (isInfix feqn_fixity)

@@ -1,9 +1,11 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-}  module Ormolu.Printer.Meat.Declaration.Value@@ -17,7 +19,7 @@  import Control.Monad import Data.Bool (bool)-import Data.Char (isPunctuation, isSymbol)+import Data.Coerce (coerce) import Data.Data hiding (Infix, Prefix) import Data.Function (on) import Data.Functor ((<&>))@@ -25,26 +27,24 @@ import Data.List (intersperse, sortBy) import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE-import Data.Maybe (isJust)+import Data.Maybe import Data.Text (Text) import qualified Data.Text as Text+import Data.Void import GHC.Data.Bag (bagToList)-import GHC.Hs.Binds-import GHC.Hs.Expr-import GHC.Hs.Extension-import GHC.Hs.Lit-import GHC.Hs.Pat-import GHC.Hs.Type+import GHC.Data.FastString (FastString, lengthFS)+import GHC.Hs import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))-import GHC.Parser.Annotation import GHC.Parser.CharClass (is_space) import GHC.Types.Basic+import GHC.Types.Fixity import GHC.Types.Name.Occurrence (occNameString) import GHC.Types.Name.Reader+import GHC.Types.SourceText import GHC.Types.SrcLoc import Ormolu.Config import Ormolu.Printer.Combinators-import Ormolu.Printer.Internal+import Ormolu.Printer.Internal (inciBy, sitccIfTrailing) import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration import Ormolu.Printer.Meat.Declaration.Signature@@ -54,7 +54,7 @@  -- | Style of a group of equations. data MatchGroupStyle-  = Function (Located RdrName)+  = Function (LocatedN RdrName)   | PatternBind   | Case   | Lambda@@ -80,14 +80,14 @@  p_valDecl :: HsBindLR GhcPs GhcPs -> R () p_valDecl = \case-  FunBind NoExtField funId funMatches _ -> p_funBind funId funMatches-  PatBind NoExtField 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   AbsBinds {} -> notImplemented "AbsBinds" -- introduced by the type checker-  PatSynBind NoExtField psb -> p_patSynBind psb+  PatSynBind _ psb -> p_patSynBind psb  p_funBind ::-  Located RdrName ->+  LocatedN RdrName ->   MatchGroup GhcPs (LHsExpr GhcPs) ->   R () p_funBind name = p_matchGroup (Function name)@@ -99,7 +99,9 @@ p_matchGroup = p_matchGroup' exprPlacement p_hsExpr  p_matchGroup' ::-  Data body =>+  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,+    Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA+  ) =>   -- | How to get body placement   (body -> Placement) ->   -- | How to print body@@ -107,7 +109,7 @@   -- | Style of this group of equations   MatchGroupStyle ->   -- | Match group-  MatchGroup GhcPs (Located body) ->+  MatchGroup GhcPs (LocatedA body) ->   R () p_matchGroup' placer render style mg@MG {..} = do   let ob = case style of@@ -166,7 +168,7 @@ p_match = p_match' exprPlacement p_hsExpr  p_match' ::-  Data body =>+  (Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan) =>   -- | How to get body placement   (body -> Placement) ->   -- | How to print body@@ -180,7 +182,7 @@   -- | Argument patterns   [LPat GhcPs] ->   -- | Equations-  GRHSs GhcPs (Located body) ->+  GRHSs GhcPs (LocatedA body) ->   R () p_match' placer render style isInfix strictness m_pats GRHSs {..} = do   -- Normally, since patterns may be placed in a multi-line layout, it is@@ -201,9 +203,9 @@         _ -> return ()     Just ne_pats -> do       let combinedSpans = case style of-            Function name -> combineSrcSpans (getLoc name) patSpans+            Function name -> combineSrcSpans (getLocA name) patSpans             _ -> patSpans-          patSpans = combineSrcSpans' (getLoc <$> ne_pats)+          patSpans = combineSrcSpans' (getLocA <$> ne_pats)           indentBody = not (isOneLineSpan combinedSpans)       switchLayout [combinedSpans] $ do         let stdCase = sep breakpoint (located' p_pat) m_pats@@ -231,9 +233,9 @@       -- about putting certain constructions in hanging positions.       endOfPats = case NE.nonEmpty m_pats of         Nothing -> case style of-          Function name -> Just (getLoc name)+          Function name -> Just (getLocA name)           _ -> Nothing-        Just pats -> (Just . getLoc . NE.last) pats+        Just pats -> (Just . getLocA . NE.last) pats       isCase = \case         Case -> True         LambdaCase -> True@@ -249,25 +251,32 @@           endOfPats       placement =         case endOfPats of-          Nothing -> blockPlacement placer grhssGRHSs-          Just spn ->-            if onTheSameLine spn grhssSpan-              then blockPlacement placer grhssGRHSs-              else Normal+          Just spn+            | any guardNeedsLineBreak grhssGRHSs+                || not (onTheSameLine spn grhssSpan) ->+                Normal+          _ -> blockPlacement placer grhssGRHSs+      guardNeedsLineBreak :: Located (GRHS GhcPs body) -> Bool+      guardNeedsLineBreak (L _ (GRHS _ guardLStmts _)) = case guardLStmts of+        [] -> False+        [g] -> not . isOneLineSpan . getLocA $ g+        _ -> True       p_body = do         let groupStyle =               if isCase style && hasGuards                 then RightArrow                 else EqualSign-        sep newline (located' (p_grhs' placer render groupStyle)) grhssGRHSs+        sep+          breakpoint+          (located' (p_grhs' placement placer render groupStyle) . reLocA)+          grhssGRHSs       p_where = do-        let whereIsEmpty = eqEmptyLocalBinds (unLoc grhssLocalBinds)-        unless (eqEmptyLocalBinds (unLoc grhssLocalBinds)) $ do+        unless (eqEmptyLocalBinds grhssLocalBinds) $ do           breakpoint           indentWhere <- getPrinterOpt poIndentWheres           bool (inciByFrac $ -2) id indentWhere $ txt "where"-          unless whereIsEmpty breakpoint-          inciIf indentWhere $ located grhssLocalBinds p_hsLocalBinds+          breakpoint+          inciIf indentWhere $ p_hsLocalBinds grhssLocalBinds   inciIf indentBody $ do     unless (length grhssGRHSs > 1) $       case style of@@ -281,41 +290,47 @@     inci p_where  p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()-p_grhs = p_grhs' exprPlacement p_hsExpr+p_grhs = p_grhs' Normal exprPlacement p_hsExpr  p_grhs' ::-  Data body =>+  -- | Placement of the parent RHS construct+  Placement ->   -- | How to get body placement   (body -> Placement) ->   -- | How to print body   (body -> R ()) ->   GroupStyle ->-  GRHS GhcPs (Located body) ->+  GRHS GhcPs (LocatedA body) ->   R ()-p_grhs' placer render style (GRHS NoExtField guards body) =+p_grhs' parentPlacement placer render style (GRHS _ guards body) =   case guards of     [] -> p_body     xs -> do       txt "|"       space-      sitcc (sep commaDel (sitcc . located' p_stmt) xs)+      sitccIfTrailing (sep commaDel (sitcc . located' p_stmt) xs)       space       inci $ case style of         EqualSign -> equals         RightArrow -> txt "->"-      placeHanging placement p_body+      -- If we have a sequence of guards and it is placed in the normal way,+      -- then we indent one level more for readability. Otherwise (all+      -- guards are on the same line) we do not need to indent, as it would+      -- look like double indentation without a good reason.+      indent <- getPrinterOpt poIndentation+      inciIf (indent <= 2 && parentPlacement == Normal) (placeHanging placement p_body)   where     placement =       case endOfGuards of         Nothing -> placer (unLoc body)         Just spn ->-          if onTheSameLine spn (getLoc body)+          if onTheSameLine spn (getLocA body)             then placer (unLoc body)             else Normal     endOfGuards =       case NE.nonEmpty guards of         Nothing -> Nothing-        Just gs -> (Just . getLoc . NE.last) gs+        Just gs -> (Just . getLocA . NE.last) gs     p_body = located body render  p_hsCmd :: HsCmd GhcPs -> R ()@@ -323,7 +338,7 @@  p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R () p_hsCmd' s = \case-  HsCmdArrApp NoExtField body input arrType rightToLeft -> do+  HsCmdArrApp _ body input arrType rightToLeft -> do     let (l, r) = if rightToLeft then (body, input) else (input, body)     located l p_hsExpr     breakpoint@@ -335,35 +350,35 @@         (HsHigherOrderApp, False) -> txt ">>-"       placeHanging (exprPlacement (unLoc input)) $         located r p_hsExpr-  HsCmdArrForm NoExtField form Prefix _ cmds -> banana s $ do+  HsCmdArrForm _ form Prefix _ cmds -> banana s $ do     located form p_hsExpr     unless (null cmds) $ do       breakpoint       inci (sequence_ (intersperse breakpoint (located' p_hsCmdTop <$> cmds)))-  HsCmdArrForm NoExtField form Infix _ [left, right] ->+  HsCmdArrForm _ form Infix _ [left, right] ->     let opTree = OpBranch (cmdOpTree left) form (cmdOpTree right)      in p_cmdOpTree (reassociateOpTree getOpName opTree)-  HsCmdArrForm NoExtField _ Infix _ _ -> notImplemented "HsCmdArrForm"-  HsCmdApp NoExtField cmd expr -> do+  HsCmdArrForm _ _ Infix _ _ -> notImplemented "HsCmdArrForm"+  HsCmdApp _ cmd expr -> do     located cmd (p_hsCmd' s)     space     located expr p_hsExpr-  HsCmdLam NoExtField mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup-  HsCmdPar NoExtField c -> parens N $ sitcc $ located c p_hsCmd-  HsCmdCase NoExtField e mgroup ->+  HsCmdLam _ mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup+  HsCmdPar _ c -> parens N $ sitcc $ located c p_hsCmd+  HsCmdCase _ e mgroup ->     p_case cmdPlacement p_hsCmd e mgroup-  HsCmdLamCase NoExtField mgroup ->+  HsCmdLamCase _ mgroup ->     p_lamcase cmdPlacement p_hsCmd mgroup-  HsCmdIf NoExtField _ if' then' else' ->+  HsCmdIf _ _ if' then' else' ->     p_if cmdPlacement p_hsCmd if' then' else'-  HsCmdLet NoExtField localBinds c ->+  HsCmdLet _ localBinds c ->     p_let p_hsCmd localBinds c-  HsCmdDo NoExtField es -> do+  HsCmdDo _ es -> do     txt "do"     p_stmts cmdPlacement (p_hsCmd' S) es  p_hsCmdTop :: HsCmdTop GhcPs -> R ()-p_hsCmdTop (HsCmdTop NoExtField cmd) = located cmd p_hsCmd+p_hsCmdTop (HsCmdTop _ cmd) = located cmd p_hsCmd  -- | Render an expression preserving blank lines between such consecutive -- expressions found in the original source code.@@ -371,10 +386,10 @@   -- | Rendering function   (a -> R ()) ->   -- | Entity to render-  Located a ->+  LocatedAn ann a ->   R () withSpacing f l = located l $ \x -> do-  case getLoc l of+  case getLocA l of     UnhelpfulSpan _ -> f x     RealSrcSpan currentSpn _ -> do       getSpanMark >>= \case@@ -398,32 +413,34 @@ p_stmt = p_stmt' exprPlacement p_hsExpr  p_stmt' ::-  Data body =>+  ( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,+    Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL+  ) =>   -- | Placer   (body -> Placement) ->   -- | Render   (body -> R ()) ->   -- | Statement to render-  Stmt GhcPs (Located body) ->+  Stmt GhcPs (LocatedA body) ->   R () p_stmt' placer render = \case-  LastStmt NoExtField body _ _ -> located body render-  BindStmt NoExtField p f@(L l x) -> do+  LastStmt _ body _ _ -> located body render+  BindStmt _ p f@(getLocA -> l) -> do     located p p_pat     space     txt "<-"-    let loc = getLoc p+    let loc = getLocA p         placement-          | isOneLineSpan (mkSrcSpan (srcSpanEnd loc) (srcSpanStart l)) = placer x+          | isOneLineSpan (mkSrcSpan (srcSpanEnd loc) (srcSpanStart l)) = placer (unLoc f)           | otherwise = Normal     switchLayout [loc, l] $       placeHanging placement (located f render)   ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer-  BodyStmt NoExtField body _ _ -> located body render-  LetStmt NoExtField binds -> do+  BodyStmt _ body _ _ -> located body render+  LetStmt _ binds -> do     txt "let"     space-    sitcc $ located binds p_hsLocalBinds+    sitcc $ p_hsLocalBinds binds   ParStmt {} ->     -- 'ParStmt' should always be eliminated in 'gatherStmt' already, such     -- that it never occurs in 'p_stmt''. Consequently, handling it here@@ -461,16 +478,18 @@   RecStmt {..} -> do     txt "rec"     space-    sitcc $ sepSemi (withSpacing (p_stmt' placer render)) recS_stmts+    sitcc . located recS_stmts $ sepSemi (withSpacing (p_stmt' placer render))  p_stmts ::-  Data body =>+  ( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,+    Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL+  ) =>   -- | Placer   (body -> Placement) ->   -- | Render   (body -> R ()) ->   -- | Statements to render-  Located [Located (Stmt GhcPs (Located body))] ->+  LocatedL [LocatedA (Stmt GhcPs (LocatedA body))] ->   R () p_stmts placer render es = do   breakpoint@@ -480,7 +499,7 @@       (ub . withSpacing (p_stmt' placer render))  gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]-gatherStmt (L _ (ParStmt NoExtField block _ _)) =+gatherStmt (L _ (ParStmt _ block _ _)) =   foldr ((<>) . gatherStmtBlock) [] block gatherStmt (L s stmt@TransStmt {..}) =   foldr liftAppend [] ((gatherStmt <$> trS_stmts) <> pure [[L s stmt]])@@ -490,9 +509,9 @@ gatherStmtBlock (ParStmtBlock _ stmts _ _) =   foldr (liftAppend . gatherStmt) [] stmts -p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()+p_hsLocalBinds :: HsLocalBinds GhcPs -> R () p_hsLocalBinds = \case-  HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do+  HsValBinds epAnn (ValBinds _ bag lsigs) -> pseudoLocated epAnn $ do     -- When in a single-line layout, there is a chance that the inner     -- elements will also contain semicolons and they will confuse the     -- parser. so we request braces around every element except the last.@@ -509,33 +528,63 @@         p_item' (p, item) =           positionToBracing p $             withSpacing (either p_valDecl p_sigDecl) item-        binds = sortBy (leftmost_smallest `on` getLoc) items+        binds = sortBy (leftmost_smallest `on` getLocA) items     sitcc $ sepSemi p_item' (attachRelativePos binds)-  HsValBinds NoExtField _ -> notImplemented "HsValBinds"-  HsIPBinds NoExtField (IPBinds NoExtField xs) ->+  HsValBinds _ _ -> notImplemented "HsValBinds"+  HsIPBinds epAnn (IPBinds _ xs) -> pseudoLocated epAnn $ do     -- Second argument of IPBind is always Left before type-checking.-    let p_ipBind (IPBind NoExtField (Left name) expr) = do+    let p_ipBind (IPBind _ (Left name) expr) = do           atom name           space           equals           breakpoint           useBraces $ inci $ located expr p_hsExpr-        p_ipBind (IPBind NoExtField (Right _) _) =+        p_ipBind (IPBind _ (Right _) _) =           -- Should only occur after the type checker           notImplemented "IPBind _ (Right _) _"-     in sepSemi (located' p_ipBind) xs-  EmptyLocalBinds NoExtField -> return ()+    sepSemi (located' p_ipBind) xs+  EmptyLocalBinds _ -> return ()+  where+    -- HsLocalBinds is no longer wrapped in a Located (see call sites+    -- of p_hsLocalBinds). Hence, we introduce a manual Located as we+    -- depend on the layout being correctly set.+    pseudoLocated = \case+      EpAnn {anns = AnnList {al_anchor = Just Anchor {anchor}}} ->+        located (L (RealSrcSpan anchor Nothing) ()) . const+      _ -> id +p_lhsFieldLabel :: Located (HsFieldLabel GhcPs) -> R ()+p_lhsFieldLabel = located' $ p_lFieldLabelString . hflLabel+  where+    p_lFieldLabelString (L 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_fieldLabels :: [Located (HsFieldLabel GhcPs)] -> R ()+p_fieldLabels flss =+  sep (txt ".") p_lhsFieldLabel flss+ p_hsRecField ::-  HsRecField' RdrName (LHsExpr GhcPs) ->+  (id -> R ()) ->+  HsRecField' id (LHsExpr GhcPs) ->   R ()-p_hsRecField HsRecField {..} = do-  p_rdrName hsRecFieldLbl+p_hsRecField p_lbl HsRecField {..} = do+  located hsRecFieldLbl p_lbl   unless hsRecPun $ do     space     equals     let placement =-          if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)+          if onTheSameLine (getLoc hsRecFieldLbl) (getLocA hsRecFieldArg)             then exprPlacement (unLoc hsRecFieldArg)             else Normal     placeHanging placement (located hsRecFieldArg p_hsExpr)@@ -545,30 +594,30 @@  p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R () p_hsExpr' s = \case-  HsVar NoExtField name -> p_rdrName name-  HsUnboundVar NoExtField occ -> atom occ-  HsConLikeOut NoExtField _ -> notImplemented "HsConLikeOut"-  HsRecFld NoExtField x ->+  HsVar _ name -> p_rdrName name+  HsUnboundVar _ occ -> atom occ+  HsConLikeOut _ _ -> notImplemented "HsConLikeOut"+  HsRecFld _ x ->     case x of-      Unambiguous NoExtField name -> p_rdrName name-      Ambiguous NoExtField name -> p_rdrName name-  HsOverLabel NoExtField _ v -> do+      Unambiguous _ name -> p_rdrName name+      Ambiguous _ name -> p_rdrName name+  HsOverLabel _ v -> do     txt "#"     atom v-  HsIPVar NoExtField (HsIPName name) -> do+  HsIPVar _ (HsIPName name) -> do     txt "?"     atom name-  HsOverLit NoExtField v -> atom (ol_val v)-  HsLit NoExtField lit ->+  HsOverLit _ v -> atom (ol_val v)+  HsLit _ lit ->     case lit of       HsString (SourceText stxt) _ -> p_stringLit stxt       HsStringPrim (SourceText stxt) _ -> p_stringLit stxt       r -> atom r-  HsLam NoExtField mgroup ->+  HsLam _ mgroup ->     p_matchGroup Lambda mgroup-  HsLamCase NoExtField mgroup ->+  HsLamCase _ mgroup ->     p_lamcase exprPlacement p_hsExpr mgroup-  HsApp NoExtField f x -> do+  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         -- parameters together.@@ -582,7 +631,7 @@         (initp, lastp) = (NE.init args, NE.last args)         initSpan =           combineSrcSpans' $-            getLoc f :| [(srcLocSpan . srcSpanStart . getLoc) lastp]+            getLocA f :| [(srcLocSpan . srcSpanStart . getLocA) lastp]         -- Hang the last argument only if the initial arguments span one         -- line.         placement =@@ -604,14 +653,14 @@             -- Thus, we indent by half of indentStep when the function is             -- a multi line do block or case expression.             indentArg-              | isOneLineSpan (getLoc func) = case unLoc func of-                HsDo {} -> inciBy 2-                _ -> inci+              | isOneLineSpan (getLocA func) = case unLoc func of+                  HsDo {} -> inciBy 2+                  _ -> inci               | otherwise = case unLoc func of-                HsDo {} -> inciHalf-                HsCase {} -> inciHalf-                HsLamCase {} -> inciHalf-                _ -> inci+                  HsDo {} -> inciHalf+                  HsCase {} -> inciHalf+                  HsLamCase {} -> inciHalf+                  _ -> inci         ub <-           getLayout <&> \case             SingleLine -> useBraces@@ -630,7 +679,7 @@           sep breakpoint (located' p_hsExpr) initp         placeHanging placement . dontUseBraces $           located lastp p_hsExpr-  HsAppType NoExtField e a -> do+  HsAppType _ e a -> do     located e p_hsExpr     breakpoint     inci $ do@@ -641,10 +690,10 @@         HsSpliceTy {} -> space         _ -> return ()       located (hswc_body a) p_hsType-  OpApp NoExtField x op y -> do+  OpApp _ x op y -> do     let opTree = OpBranch (exprOpTree x) op (exprOpTree y)     p_exprOpTree s (reassociateOpTree getOpName opTree)-  NegApp NoExtField e NoExtField -> do+  NegApp _ e _ -> do     negativeLiterals <- isExtensionEnabled NegativeLiterals     let isLiteral = case unLoc e of           HsLit {} -> True@@ -655,51 +704,49 @@     -- negated literals, as `- 1` and `-1` have differing AST.     when (negativeLiterals && isLiteral) space     located e p_hsExpr-  HsPar NoExtField e -> do-    parens s $ sitcc $ located e $ dontUseBraces . p_hsExpr-  SectionL NoExtField x op -> do+  HsPar _ e ->+    parens s $ sitcc (located e (dontUseBraces . p_hsExpr))+  SectionL _ x op -> do     located x p_hsExpr     breakpoint     inci (located op p_hsExpr)-  SectionR NoExtField op x -> do+  SectionR _ op x -> do     located op p_hsExpr-    useRecordDot' <- useRecordDot-    let isRecordDot' = isRecordDot (unLoc op) (getLoc x)-    unless (useRecordDot' && isRecordDot') breakpoint+    breakpoint     inci (located x p_hsExpr)-  ExplicitTuple NoExtField args boxity ->-    let isSection = any (isMissing . unLoc) args+  ExplicitTuple _ args boxity -> do+    let isSection = any isMissing args         isMissing = \case-          Missing NoExtField -> True+          Missing _ -> True           _ -> False         p_arg = \case-          Present NoExtField x -> located x p_hsExprListItem-          Missing NoExtField -> pure ()-        p_larg = sitcc . located' p_arg+          Present _ x -> located x p_hsExprListItem+          Missing _ -> pure ()         parens' =           case boxity of             Boxed -> parens             Unboxed -> parensHash-     in if isSection-          then-            switchLayout [] . parens' s $-              sep comma p_larg args-          else-            switchLayout (getLoc <$> args) . parens' s $-              sep commaDel p_larg args-  ExplicitSum NoExtField tag arity e ->+    enclSpan <- fmap (flip RealSrcSpan Nothing) . maybeToList <$> getEnclosingSpan (const True)+    if isSection+      then+        switchLayout [] . parens' s $+          sep comma p_arg args+      else+        switchLayout enclSpan . parens' s $+          sep commaDel p_arg args+  ExplicitSum _ tag arity e ->     p_unboxedSum N tag arity (located e p_hsExpr)-  HsCase NoExtField e mgroup ->+  HsCase _ e mgroup ->     p_case exprPlacement p_hsExpr e mgroup-  HsIf NoExtField if' then' else' ->+  HsIf _ if' then' else' ->     p_if exprPlacement p_hsExpr if' then' else'-  HsMultiIf NoExtField guards -> do+  HsMultiIf _ guards -> do     txt "if"     breakpoint     inci . inci $ sep newline (located' (p_grhs RightArrow)) guards-  HsLet NoExtField localBinds e ->+  HsLet _ localBinds e ->     p_let p_hsExpr localBinds e-  HsDo NoExtField ctx es -> do+  HsDo _ ctx es -> do     let doBody moduleName header = do           forM_ moduleName $ \m -> atom m *> txt "."           txt header@@ -710,14 +757,10 @@                   (breakpoint >> txt "|" >> space)                   p_seqBody               p_seqBody =-                sitcc'+                sitccIfTrailing                   . sep                     commaDel                     (located' (sitcc . p_stmt))-              sitcc' x =-                getPrinterOpt poCommaStyle >>= \case-                  Leading -> id x-                  Trailing -> sitcc x               stmts = init xs               yield = last xs               lists = foldr (liftAppend . gatherStmt) [] stmts@@ -736,19 +779,15 @@       PatGuard _ -> notImplemented "PatGuard"       ParStmtCtxt _ -> notImplemented "ParStmtCtxt"       TransStmtCtxt _ -> notImplemented "TransStmtCtxt"-  ExplicitList _ _ xs ->+  ExplicitList _ xs ->     brackets s $       sep commaDel (sitcc . located' p_hsExprListItem) xs   RecordCon {..} -> do-    located rcon_con_name atom+    located rcon_con atom     breakpointPreRecordBrace     let HsRecFields {..} = rcon_flds-        updName f =-          (f :: HsRecField GhcPs (LHsExpr GhcPs))-            { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of-                FieldOcc _ n -> n-            }-        fields = located' (p_hsRecField . updName) <$> rec_flds+        p_lbl = p_rdrName . rdrNameFieldOcc+        fields = located' (p_hsRecField p_lbl) <$> rec_flds         dotdot =           case rec_dotdot of             Just {} -> [txt ".."]@@ -757,37 +796,32 @@       sep commaDel sitcc (fields <> dotdot)   RecordUpd {..} -> do     located rupd_expr p_hsExpr-    useRecordDot' <- useRecordDot-    let mrs sp = case getLoc sp of-          RealSrcSpan r _ -> Just r-          _ -> Nothing-    let isPluginForm =-          ((1 +) . srcSpanEndCol <$> mrs rupd_expr)-            == (srcSpanStartCol <$> mrs (head rupd_flds))-            && onTheSameLine (getLoc rupd_expr) (getLoc $ head rupd_flds)-    unless (useRecordDot' && isPluginForm) breakpointPreRecordBrace-    let updName f =-          (f :: HsRecUpdField GhcPs)-            { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of-                Ambiguous _ n -> n-                Unambiguous _ n -> n-            }-        updBraces =-          if useRecordDot' && isPluginForm-            then recordDotBraces-            else inci . braces N-    updBraces $-      sep-        commaDel-        (sitcc . located' (p_hsRecField . updName))+    breakpointPreRecordBrace+    let p_updLbl =+          p_rdrName . \case+            Unambiguous NoExtField n -> n+            Ambiguous NoExtField n -> n+        p_recFields p_lbl =+          sep commaDel (sitcc . located' (p_hsRecField p_lbl))+    inci . braces N $+      either+        (p_recFields p_updLbl)+        (p_recFields (p_fieldLabels . coerce))         rupd_flds-  ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do+  HsGetField {..} -> do+    located gf_expr p_hsExpr+    txt "."+    p_lhsFieldLabel gf_field+  HsProjection {..} -> parens N $ do+    txt "."+    p_fieldLabels (NE.toList proj_flds)+  ExprWithTySig _ x HsWC {hswc_body} -> sitcc $ do     located x p_hsExpr     space     txt "::"     breakpoint-    inci $ located hsib_body p_hsType-  ArithSeq NoExtField _ x ->+    inci $ located hswc_body p_hsSigType+  ArithSeq _ _ x ->     case x of       From from -> brackets s $ do         located from p_hsExpr@@ -809,11 +843,11 @@         txt ".."         space         located to p_hsExpr-  HsBracket NoExtField x -> p_hsBracket x+  HsBracket epAnn x -> p_hsBracket epAnn x   HsRnBracketOut {} -> notImplemented "HsRnBracketOut"   HsTcBracketOut {} -> notImplemented "HsTcBracketOut"-  HsSpliceE NoExtField splice -> p_hsSplice splice-  HsProc NoExtField p e -> do+  HsSpliceE _ splice -> p_hsSplice splice+  HsProc _ p e -> do     txt "proc"     located p $ \x -> do       breakpoint@@ -828,14 +862,13 @@     inci (located e p_hsExpr)   HsTick {} -> notImplemented "HsTick"   HsBinTick {} -> notImplemented "HsBinTick"-  HsPragE NoExtField prag x -> case prag of-    HsPragSCC NoExtField _ name -> do+  HsPragE _ prag x -> case prag of+    HsPragSCC _ _ name -> do       txt "{-# SCC "       atom name       txt " #-}"       breakpoint       located x p_hsExpr-    HsPragTick {} -> notImplemented "HsTickPragma"  p_patSynBind :: PatSynBind GhcPs GhcPs -> R () p_patSynBind PSB {..} = do@@ -860,25 +893,26 @@             inci (p_matchGroup (Function psb_id) mgroup)   txt "pattern"   case psb_args of-    PrefixCon xs -> do+    PrefixCon [] xs -> do       space       p_rdrName psb_id       inci $ do-        switchLayout (getLoc <$> xs) $ do+        switchLayout (getLocA <$> xs) $ do           unless (null xs) breakpoint           sitcc (sep breakpoint p_rdrName xs)         rhs+    PrefixCon (v : _) _ -> absurd v     RecCon xs -> do       space       p_rdrName psb_id       inci $ do-        switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do+        switchLayout (getLocA . recordPatSynPatVar <$> xs) $ do           unless (null xs) breakpointPreRecordBrace           braces N $             sep commaDel (p_rdrName . recordPatSynPatVar) xs         rhs     InfixCon l r -> do-      switchLayout [getLoc l, getLoc r] $ do+      switchLayout [getLocA l, getLocA r] $ do         space         p_rdrName l         breakpoint@@ -889,7 +923,9 @@       inci rhs  p_case ::-  Data body =>+  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,+    Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA+  ) =>   -- | Placer   (body -> Placement) ->   -- | Render@@ -897,7 +933,7 @@   -- | Expression   LHsExpr GhcPs ->   -- | Match group-  MatchGroup GhcPs (Located body) ->+  MatchGroup GhcPs (LocatedA body) ->   R () p_case placer render e mgroup = do   txt "case"@@ -909,13 +945,15 @@   inci (p_matchGroup' placer render Case mgroup)  p_lamcase ::-  Data body =>+  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,+    Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA+  ) =>   -- | Placer   (body -> Placement) ->   -- | Render   (body -> R ()) ->   -- | Expression-  MatchGroup GhcPs (Located body) ->+  MatchGroup GhcPs (LocatedA body) ->   R () p_lamcase placer render mgroup = do   txt "\\case"@@ -923,7 +961,6 @@   inci (p_matchGroup' placer render LambdaCase mgroup)  p_if ::-  Data body =>   -- | Placer   (body -> Placement) ->   -- | Render@@ -931,9 +968,9 @@   -- | If   LHsExpr GhcPs ->   -- | Then-  Located body ->+  LocatedA body ->   -- | Else-  Located body ->+  LocatedA body ->   R () p_if placer render if' then' else' = do   txt "if"@@ -952,16 +989,15 @@       placeHanging (placer x) (render x)  p_let ::-  Data body =>   -- | Render   (body -> R ()) ->-  Located (HsLocalBindsLR GhcPs GhcPs) ->-  Located body ->+  HsLocalBinds GhcPs ->+  LocatedA body ->   R () p_let render localBinds e = sitcc $ do   txt "let"   space-  dontUseBraces $ sitcc (located localBinds p_hsLocalBinds)+  dontUseBraces $ sitcc (p_hsLocalBinds localBinds)   vlayout space (newline >> txt " ")   txt "in"   space@@ -969,37 +1005,39 @@  p_pat :: Pat GhcPs -> R () p_pat = \case-  WildPat NoExtField -> txt "_"-  VarPat NoExtField name -> p_rdrName name-  LazyPat NoExtField pat -> do+  WildPat _ -> txt "_"+  VarPat _ name -> p_rdrName name+  LazyPat _ pat -> do     txt "~"     located pat p_pat-  AsPat NoExtField name pat -> do+  AsPat _ name pat -> do     p_rdrName name     txt "@"     located pat p_pat-  ParPat NoExtField pat ->+  ParPat _ pat ->     located pat (parens S . sitcc . p_pat)-  BangPat NoExtField pat -> do+  BangPat _ pat -> do     txt "!"     located pat p_pat-  ListPat NoExtField pats ->+  ListPat _ pats ->     brackets S $ sep commaDel (located' p_pat) pats-  TuplePat NoExtField pats boxing -> do+  TuplePat _ pats boxing -> do     let parens' =           case boxing of             Boxed -> parens S             Unboxed -> parensHash S     parens' $ sep commaDel (sitcc . located' p_pat) pats-  SumPat NoExtField pat tag arity ->+  SumPat _ pat tag arity ->     p_unboxedSum S tag arity (located pat p_pat)-  ConPat NoExtField pat details ->+  ConPat _ pat details ->     case details of-      PrefixCon xs -> sitcc $ do+      PrefixCon [] 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"       RecCon (HsRecFields fields dotdot) -> do         p_rdrName pat         breakpointPreRecordBrace@@ -1011,42 +1049,41 @@             Nothing -> Just <$> fields             Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]       InfixCon l r -> do-        switchLayout [getLoc l, getLoc r] $ do+        switchLayout [getLocA l, getLocA r] $ do           located l p_pat           breakpoint           inci $ do             p_rdrName pat             space             located r p_pat-  ViewPat NoExtField expr pat -> sitcc $ do+  ViewPat _ expr pat -> sitcc $ do     located expr p_hsExpr     space     txt "->"     breakpoint     inci (located pat p_pat)-  SplicePat NoExtField splice -> p_hsSplice splice-  LitPat NoExtField p -> atom p-  NPat NoExtField v (isJust -> isNegated) NoExtField -> do+  SplicePat _ splice -> p_hsSplice splice+  LitPat _ p -> atom p+  NPat _ v (isJust -> isNegated) _ -> do     when isNegated $ do       txt "-"       negativeLiterals <- isExtensionEnabled NegativeLiterals       when negativeLiterals space     located v (atom . ol_val)-  NPlusKPat NoExtField n k _ _ _ -> sitcc $ do+  NPlusKPat _ n k _ _ _ -> sitcc $ do     p_rdrName n     breakpoint     inci $ do       txt "+"       space       located k (atom . ol_val)-  SigPat NoExtField pat HsPS {..} -> do+  SigPat _ pat HsPS {..} -> do     located pat p_pat-    p_typeAscription (HsWC NoExtField (HsIB NoExtField hsps_body))+    p_typeAscription (lhsTypeToSigType hsps_body)  p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R () p_pat_hsRecField HsRecField {..} = do-  located hsRecFieldLbl $ \x ->-    p_rdrName (rdrNameFieldOcc x)+  located hsRecFieldLbl $ p_rdrName . rdrNameFieldOcc   unless hsRecPun $ do     space     equals@@ -1070,11 +1107,11 @@  p_hsSplice :: HsSplice GhcPs -> R () p_hsSplice = \case-  HsTypedSplice NoExtField deco _ expr -> p_hsSpliceTH True expr deco-  HsUntypedSplice NoExtField deco _ expr -> p_hsSpliceTH False expr deco-  HsQuasiQuote NoExtField _ quoterName srcSpan str -> do+  HsTypedSplice _ deco _ expr -> p_hsSpliceTH True expr deco+  HsUntypedSplice _ deco _ expr -> p_hsSpliceTH False expr deco+  HsQuasiQuote _ _ quoterName _ str -> do     txt "["-    p_rdrName (L srcSpan quoterName)+    p_rdrName (noLocA quoterName)     txt "|"     -- QuasiQuoters often rely on precise custom strings. We cannot do any     -- formatting here without potentially breaking someone's code.@@ -1099,34 +1136,21 @@   where     decoSymbol = if isTyped then "$$" else "$" -p_hsBracket :: HsBracket GhcPs -> R ()-p_hsBracket = \case-  ExpBr NoExtField expr -> do-    anns <- getEnclosingAnns-    let name = case anns of-          AnnOpenEQ : _ -> ""-          _ -> "e"+p_hsBracket :: EpAnn [AddEpAnn] -> HsBracket GhcPs -> R ()+p_hsBracket epAnn = \case+  ExpBr _ expr -> do+    let name+          | or [True | AddEpAnn AnnOpenEQ _ <- epAnnAnns epAnn] = ""+          | otherwise = "e"     quote name (located expr p_hsExpr)-  PatBr NoExtField pat -> located pat (quote "p" . p_pat)-  DecBrL NoExtField decls -> quote "d" (handleStarIsType decls (p_hsDecls Free decls))-  DecBrG NoExtField _ -> notImplemented "DecBrG" -- result of renamer-  TypBr NoExtField ty -> quote "t" (located ty (handleStarIsType ty . p_hsType))-  VarBr NoExtField isSingleQuote name -> do+  PatBr _ pat -> located pat (quote "p" . p_pat)+  DecBrL _ decls -> quote "d" (handleStarIsType decls (p_hsDecls Free decls))+  DecBrG _ _ -> notImplemented "DecBrG" -- result of renamer+  TypBr _ ty -> quote "t" (located ty (handleStarIsType ty . p_hsType))+  VarBr _ isSingleQuote name -> do     txt (bool "''" "'" isSingleQuote)-    -- HACK As you can see we use 'noLoc' here to be able to pass name into-    -- 'p_rdrName' since the latter expects a "located" thing. The problem-    -- is that 'VarBr' doesn't provide us with location of the name. This in-    -- turn makes it impossible to detect if there are parentheses around-    -- it, etc. So we have to add parentheses manually assuming they are-    -- necessary for all operators.-    let isOperator =-          all-            (\i -> isPunctuation i || isSymbol i)-            (showOutputable (rdrNameOcc name))-            && not (doesNotNeedExtraParens name)-        wrapper = if isOperator then parens N else id-    wrapper $ p_rdrName (noLoc name)-  TExpBr NoExtField expr -> do+    p_rdrName name+  TExpBr _ expr -> do     txt "[||"     breakpoint'     located expr p_hsExpr@@ -1222,9 +1246,9 @@ liftAppend (x : xs) [] = x : xs liftAppend (x : xs) (y : ys) = x <> y : liftAppend xs ys -getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan-getGRHSSpan (GRHS NoExtField guards body) =-  combineSrcSpans' $ getLoc body :| map getLoc guards+getGRHSSpan :: GRHS GhcPs (LocatedA body) -> SrcSpan+getGRHSSpan (GRHS _ guards body) =+  combineSrcSpans' $ getLocA body :| map getLocA guards  -- | Place a thing that may have a hanging form. This function handles how -- to separate it from preceding expressions and whether to bump indentation@@ -1243,63 +1267,62 @@ -- form. blockPlacement ::   (body -> Placement) ->-  [LGRHS GhcPs (Located body)] ->+  [LGRHS GhcPs (LocatedA body)] ->   Placement-blockPlacement placer [L _ (GRHS NoExtField _ (L _ x))] = placer x+blockPlacement placer [L _ (GRHS _ _ (L _ x))] = placer x blockPlacement _ _ = Normal  -- | Check if given command has a hanging form. cmdPlacement :: HsCmd GhcPs -> Placement cmdPlacement = \case-  HsCmdLam NoExtField _ -> Hanging-  HsCmdCase NoExtField _ _ -> Hanging-  HsCmdLamCase NoExtField _ -> Hanging-  HsCmdDo NoExtField _ -> Hanging+  HsCmdLam _ _ -> Hanging+  HsCmdCase _ _ _ -> Hanging+  HsCmdLamCase _ _ -> Hanging+  HsCmdDo _ _ -> Hanging   _ -> Normal  cmdTopPlacement :: HsCmdTop GhcPs -> Placement-cmdTopPlacement (HsCmdTop NoExtField (L _ x)) = cmdPlacement x+cmdTopPlacement (HsCmdTop _ (L _ x)) = cmdPlacement x  -- | Check if given expression has a hanging form. exprPlacement :: HsExpr GhcPs -> Placement exprPlacement = \case   -- Only hang lambdas with single line parameter lists-  HsLam NoExtField mg -> case mg of-    MG _ (L _ [L _ (Match NoExtField _ (x : xs) _)]) _-      | isOneLineSpan (combineSrcSpans' $ fmap getLoc (x :| xs)) ->-        Hanging+  HsLam _ mg -> case mg of+    MG _ (L _ [L _ (Match _ _ (x : xs) _)]) _+      | isOneLineSpan (combineSrcSpans' $ fmap getLocA (x :| xs)) ->+          Hanging     _ -> Normal-  HsLamCase NoExtField _ -> Hanging-  HsCase NoExtField _ _ -> Hanging-  HsDo NoExtField (DoExpr _) _ -> Hanging-  HsDo NoExtField (MDoExpr _) _ -> Hanging-  OpApp NoExtField _ op y ->+  HsLamCase _ _ -> Hanging+  HsCase _ _ _ -> Hanging+  HsDo _ (DoExpr _) _ -> Hanging+  HsDo _ (MDoExpr _) _ -> Hanging+  OpApp _ _ op y ->     case (fmap getOpNameStr . getOpName . unLoc) op of       Just "$" -> exprPlacement (unLoc y)       _ -> Normal-  HsApp NoExtField _ y -> exprPlacement (unLoc y)-  HsProc NoExtField p _ ->+  HsApp _ _ y -> exprPlacement (unLoc y)+  HsProc _ p _ ->     -- Indentation breaks if pattern is longer than one line and left     -- hanging. Consequently, only apply hanging when it is safe.-    if isOneLineSpan (getLoc p)+    if isOneLineSpan (getLocA p)       then Hanging       else Normal   _ -> Normal -withGuards :: [LGRHS GhcPs (Located body)] -> Bool+withGuards :: [LGRHS GhcPs body] -> Bool withGuards = any (checkOne . unLoc)   where-    checkOne :: GRHS GhcPs (Located body) -> Bool-    checkOne (GRHS NoExtField [] _) = False+    checkOne (GRHS _ [] _) = False     checkOne _ = True  exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)-exprOpTree (L _ (OpApp NoExtField x op y)) = OpBranch (exprOpTree x) op (exprOpTree y)+exprOpTree (L _ (OpApp _ x op y)) = OpBranch (exprOpTree x) op (exprOpTree y) exprOpTree n = OpNode n  getOpName :: HsExpr GhcPs -> Maybe RdrName getOpName = \case-  HsVar NoExtField (L _ a) -> Just a+  HsVar _ (L _ a) -> Just a   _ -> Nothing  getOpNameStr :: RdrName -> String@@ -1316,71 +1339,60 @@       -- Distinguish holes used in infix notation.       -- eg. '1 _foo 2' and '1 `_foo` 2'       opWrapper = case unLoc op of-        HsUnboundVar NoExtField _ -> backticks+        HsUnboundVar _ _ -> backticks         _ -> id   ub <- opBranchBraceStyle placement   let opNameStr = (fmap getOpNameStr . getOpName . unLoc) op       gotDollar = opNameStr == Just "$"       gotColon = opNameStr == Just ":"-      gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)       lhs =         switchLayout [opTreeLoc x] $           p_exprOpTree s x       p_op = located op (opWrapper . p_hsExpr)       p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y)-      isSection = case (opTreeLoc x, getLoc op) of-        (RealSrcSpan treeSpan _, RealSrcSpan opSpan _) ->-          srcSpanEndCol treeSpan /= srcSpanStartCol opSpan-        _ -> False       isDoBlock = \case         OpNode (L _ HsDo {}) -> True         _ -> False-  useRecordDot' <- useRecordDot   if       | gotColon -> do-        ub lhs-        space-        p_op-        case placement of-          Hanging -> do-            space-            p_y-          Normal -> do-            breakpoint-            inciIf (isDoBlock y) p_y+          ub lhs+          space+          p_op+          case placement of+            Hanging -> do+              space+              p_y+            Normal -> do+              breakpoint+              inciIf (isDoBlock y) p_y       | gotDollar           && isOneLineSpan (opTreeLoc x)           && placement == Normal -> do-        useBraces lhs-        space-        p_op-        breakpoint-        inci p_y-      | useRecordDot' && gotRecordDot -> do-        lhs-        when isSection space-        p_op-        p_y+          useBraces lhs+          space+          p_op+          breakpoint+          inci p_y       | otherwise -> do-        ub lhs-        let opAndRhs = do-              p_op-              space-              p_y-        case x of-          -- This case prevents an operator from being indented past the start of a `do` block-          -- constituting its left operand, thus altering the AST.-          -- This is only relevant when the `do` block is on one line, as otherwise we will-          -- insert a newline after `do` anyway.-          OpNode (unLoc -> HsDo _ _ _) | isOneLineSpan (opTreeLoc x) -> breakpoint >> opAndRhs-          _ -> placeHanging placement opAndRhs+          ub lhs+          let opAndRhs = do+                p_op+                space+                p_y+          case x of+            -- This case prevents an operator from being indented past the start of a `do` block+            -- constituting its left operand, thus altering the AST.+            -- This is only relevant when the `do` block is on one line, as otherwise we will+            -- insert a newline after `do` anyway.+            OpNode (unLoc -> HsDo _ _ _) | isOneLineSpan (opTreeLoc x) -> breakpoint >> opAndRhs+            _ -> placeHanging placement opAndRhs  pattern CmdTopCmd :: HsCmd GhcPs -> LHsCmdTop GhcPs-pattern CmdTopCmd cmd <- (L _ (HsCmdTop NoExtField (L _ cmd)))+pattern CmdTopCmd cmd <- (L _ (HsCmdTop _ (L _ cmd)))  cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) cmdOpTree = \case-  CmdTopCmd (HsCmdArrForm NoExtField op Infix _ [x, y]) ->+  CmdTopCmd (HsCmdArrForm _ op Infix _ [x, y]) ->     OpBranch (cmdOpTree x) op (cmdOpTree y)   n -> OpNode n @@ -1397,12 +1409,13 @@       p_cmdOpTree y  opBranchPlacement ::+  HasSrcSpan l =>   -- | Placement of nodes   (ty -> Placement) ->   -- | Left branch-  OpTree (Located ty) op ->+  OpTree (GenLocated l ty) op ->   -- | Right branch-  OpTree (Located ty) op ->+  OpTree (GenLocated l ty) op ->   Placement opBranchPlacement f x y   -- If the beginning of the first argument and the second argument are on@@ -1410,7 +1423,7 @@   -- placement.   | isOneLineSpan (mkSrcSpan (srcSpanStart (opTreeLoc x)) (srcSpanStart (opTreeLoc y))),     OpNode (L _ n) <- y =-    f n+      f n   | otherwise = Normal  opBranchBraceStyle :: Placement -> R (R () -> R ())@@ -1420,27 +1433,6 @@     MultiLine -> case placement of       Hanging -> useBraces       Normal -> dontUseBraces---- | Return 'True' if given expression is a record-dot operator expression.-isRecordDot ::-  -- | Operator expression-  HsExpr GhcPs ->-  -- | Span of the expression on the right-hand side of the operator-  SrcSpan ->-  Bool-isRecordDot op (RealSrcSpan ySpan _) = case op of-  HsVar NoExtField (L (RealSrcSpan opSpan _) opName) ->-    (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)-  _ -> False-isRecordDot _ _ = False---- | Get annotations for the enclosing element.-getEnclosingAnns :: R [AnnKeywordId]-getEnclosingAnns = do-  e <- getEnclosingSpan (const True)-  case e of-    Nothing -> return []-    Just e' -> getAnns (RealSrcSpan e' Nothing)  -- | For use before record braces. Collapse to empty if not 'poRecordBraceSpace'. breakpointPreRecordBrace :: R ()

@@ -9,20 +9,20 @@  import Data.Foldable import Data.Text (Text)-import GHC.Hs.Decls-import GHC.Hs.Extension-import GHC.Types.Basic+import GHC.Hs import GHC.Types.Name.Reader+import GHC.Types.SourceText import GHC.Types.SrcLoc+import GHC.Unit.Module.Warnings import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common  p_warnDecls :: WarnDecls GhcPs -> R ()-p_warnDecls (Warnings NoExtField _ warnings) =+p_warnDecls (Warnings _ _ warnings) =   traverse_ (located' p_warnDecl) warnings  p_warnDecl :: WarnDecl GhcPs -> R ()-p_warnDecl (Warning NoExtField functions warningTxt) =+p_warnDecl (Warning _ functions warningTxt) =   p_topLevelWarning functions warningTxt  p_moduleWarning :: WarningTxt -> R ()@@ -30,10 +30,10 @@   let (pragmaText, lits) = warningText wtxt   inci $ pragma pragmaText $ inci $ p_lits lits -p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()+p_topLevelWarning :: [LocatedN RdrName] -> WarningTxt -> R () p_topLevelWarning fnames wtxt = do   let (pragmaText, lits) = warningText wtxt-  switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $+  switchLayout (fmap getLocA fnames ++ fmap getLoc lits) $     pragma pragmaText . inci $ do       sep commaDel p_rdrName fnames       breakpoint

@@ -12,8 +12,7 @@  import Control.Monad import qualified Data.Text as T-import GHC.Hs.Extension-import GHC.Hs.ImpExp+import GHC.Hs import GHC.LanguageExtensions.Type import GHC.Types.SrcLoc import GHC.Unit.Types@@ -86,15 +85,15 @@   IEVar NoExtField l1 -> do     located l1 p_ieWrappedName     p_comma-  IEThingAbs NoExtField l1 -> do+  IEThingAbs _ l1 -> do     located l1 p_ieWrappedName     p_comma-  IEThingAll NoExtField l1 -> do+  IEThingAll _ l1 -> do     located l1 p_ieWrappedName     space     txt "(..)"     p_comma-  IEThingWith NoExtField l1 w xs _ -> sitcc $ do+  IEThingWith _ l1 w xs -> sitcc $ do     located l1 p_ieWrappedName     breakIfNotDiffFriendly     inci $ do@@ -107,7 +106,7 @@             let (before, after) = splitAt n names              in before ++ [txt ".."] ++ after     p_comma-  IEModuleContents NoExtField l1 -> do+  IEModuleContents _ l1 -> do     located l1 p_hsmodName     p_comma   IEGroup NoExtField n str -> do

@@ -9,7 +9,7 @@ where  import Control.Monad-import GHC.Hs+import GHC.Hs hiding (comment) import GHC.Types.SrcLoc import Ormolu.Config import Ormolu.Imports (normalizeImports)@@ -23,7 +23,8 @@ import Ormolu.Printer.Meat.ImportExport import Ormolu.Printer.Meat.Pragma --- | Render a module.+-- | Render a module-like entity (either a regular module or a backpack+-- signature). p_hsModule ::   -- | Stack header   Maybe (RealLocated Comment) ->@@ -33,8 +34,8 @@   HsModule ->   R () p_hsModule mstackHeader pragmas HsModule {..} = do-  let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage-      exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports+  let deprecSpan = maybe [] (pure . getLocA) hsmodDeprecMessage+      exportSpans = maybe [] (pure . getLocA) hsmodExports   switchLayout (deprecSpan <> exportSpans) $ do     forM_ mstackHeader $ \(L spn comment) -> do       spitCommentNow spn comment@@ -71,7 +72,7 @@       forM_ importGroup (located' p_hsmodImport)       newline     declNewline-    switchLayout (getLoc <$> hsmodDecls) $ do+    switchLayout (getLocA <$> hsmodDecls) $ do       preserveSpacing <- getPrinterOpt poRespectful       (if preserveSpacing then p_hsDeclsRespectGrouping else p_hsDecls) Free hsmodDecls       newline

@@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}  -- | Rendering of types. module Ormolu.Printer.Meat.Type@@ -14,19 +15,22 @@     p_forallBndrs,     p_conDeclFields,     p_lhsTypeArg,-    tyVarsToTypes,+    p_hsSigType,     tyVarsToTyPats,+    hsOuterTyVarBndrsToHsType,+    lhsTypeToSigType,   ) where -import Data.Data (Data)-import GHC.Hs.Decls-import GHC.Hs.Extension-import GHC.Hs.Type+import Control.Monad+import Data.Foldable (for_)+import GHC.Hs import GHC.Types.Basic hiding (isPromoted) import GHC.Types.Name.Reader+import GHC.Types.SourceText import GHC.Types.SrcLoc import GHC.Types.Var+import Ormolu.Config import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice, p_stringLit)@@ -46,22 +50,23 @@  p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R () p_hsType' multilineArgs docStyle = \case-  HsForAllTy NoExtField tele t -> do+  HsForAllTy _ tele t -> do     case tele of-      HsForAllInvis NoExtField bndrs -> p_forallBndrs ForAllInvis p_hsTyVarBndr bndrs-      HsForAllVis NoExtField bndrs -> p_forallBndrs ForAllVis p_hsTyVarBndr bndrs+      HsForAllInvis _ bndrs -> p_forallBndrs ForAllInvis p_hsTyVarBndr bndrs+      HsForAllVis _ bndrs -> p_forallBndrs ForAllVis p_hsTyVarBndr bndrs     interArgBreak     p_hsTypeR (unLoc t)-  HsQualTy NoExtField qs t -> do-    located qs p_hsContext-    space-    txt "=>"-    interArgBreak+  HsQualTy _ qs' t -> do+    for_ qs' $ \qs -> do+      located qs p_hsContext+      space+      txt "=>"+      interArgBreak     case unLoc t of       HsQualTy {} -> p_hsTypeR (unLoc t)       HsFunTy {} -> p_hsTypeR (unLoc t)       _ -> located t p_hsTypeR-  HsTyVar NoExtField p n -> do+  HsTyVar _ p n -> do     case p of       IsPromoted -> do         space@@ -71,7 +76,7 @@           _ -> return ()       NotPromoted -> return ()     p_rdrName n-  HsAppTy NoExtField f x -> do+  HsAppTy _ f x -> do     let -- In order to format type applications with multiple parameters         -- nicer, traverse the AST to gather the function and all the         -- parameters together.@@ -80,7 +85,7 @@             L _ (HsAppTy _ l r) -> gatherArgs l (r : knownArgs)             _ -> (f', knownArgs)         (func, args) = gatherArgs f [x]-    switchLayout (getLoc f : fmap getLoc args) . sitcc $ do+    switchLayout (getLocA f : fmap getLocA args) . sitcc $ do       located func p_hsType       breakpoint       inci $@@ -94,13 +99,13 @@     inci $ do       txt "@"       located kd p_hsType-  HsFunTy NoExtField arrow x y@(L _ y') -> do+  HsFunTy _ arrow x y@(L _ y') -> do     located x p_hsType     space     case arrow of       HsUnrestrictedArrow _ -> txt "->"-      HsLinearArrow _ -> txt "%1 ->"-      HsExplicitMult _ mult -> do+      HsLinearArrow _ _ -> txt "%1 ->"+      HsExplicitMult _ _ mult -> do         txt "%"         p_hsTypeR (unLoc mult)         space@@ -109,40 +114,38 @@     case y' of       HsFunTy {} -> p_hsTypeR y'       _ -> located y p_hsTypeR-  HsListTy NoExtField t ->+  HsListTy _ t ->     located t (brackets N . p_hsType)-  HsTupleTy NoExtField tsort xs ->+  HsTupleTy _ tsort xs ->     let parens' =           case tsort of             HsUnboxedTuple -> parensHash N-            HsBoxedTuple -> parens N-            HsConstraintTuple -> parens N             HsBoxedOrConstraintTuple -> parens N      in parens' $ sep commaDel (sitcc . located' p_hsType) xs-  HsSumTy NoExtField xs ->+  HsSumTy _ xs ->     parensHash N $       sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs-  HsOpTy NoExtField x op y ->+  HsOpTy _ x op y ->     sitcc $       let opTree = OpBranch (tyOpTree x) op (tyOpTree y)        in p_tyOpTree (reassociateOpTree Just opTree)-  HsParTy NoExtField t ->+  HsParTy _ t ->     parens N $ sitcc $ located t p_hsType-  HsIParamTy NoExtField n t -> sitcc $ do+  HsIParamTy _ n t -> sitcc $ do     located n atom     space     txt "::"     breakpoint     inci (located t p_hsType)-  HsStarTy NoExtField _ -> txt "*"-  HsKindSig NoExtField t k -> sitcc $ do+  HsStarTy _ _ -> txt "*"+  HsKindSig _ t k -> sitcc $ do     located t p_hsType     space     txt "::"     breakpoint     inci (located k p_hsType)-  HsSpliceTy NoExtField splice -> p_hsSplice splice-  HsDocTy NoExtField t str ->+  HsSpliceTy _ splice -> p_hsSplice splice+  HsDocTy _ t str ->     case docStyle of       PipeStyle -> do         p_hsDocString Pipe True str@@ -151,7 +154,7 @@         located t p_hsType         newline         p_hsDocString Caret False str-  HsBangTy NoExtField (HsSrcBang _ u s) t -> do+  HsBangTy _ (HsSrcBang _ u s) t -> do     case u of       SrcUnpack -> txt "{-# UNPACK #-}" >> space       SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space@@ -161,9 +164,9 @@       SrcStrict -> txt "!"       NoSrcStrict -> return ()     located t p_hsType-  HsRecTy NoExtField fields ->+  HsRecTy _ fields ->     p_conDeclFields fields-  HsExplicitListTy NoExtField p xs -> do+  HsExplicitListTy _ p xs -> do     case p of       IsPromoted -> txt "'"       NotPromoted -> return ()@@ -174,19 +177,19 @@         (IsPromoted, L _ t : _) | isPromoted t -> space         _ -> return ()       sep commaDel (sitcc . located' p_hsType) xs-  HsExplicitTupleTy NoExtField xs -> do+  HsExplicitTupleTy _ xs -> do     txt "'"     parens N $ do       case xs of         L _ t : _ | isPromoted t -> space         _ -> return ()       sep commaDel (located' p_hsType) xs-  HsTyLit NoExtField t ->+  HsTyLit _ t ->     case t of       HsStrTy (SourceText s) _ -> p_stringLit s       a -> atom a-  HsWildCardTy NoExtField -> txt "_"-  XHsType (NHsCoreTy t) -> atom t+  HsWildCardTy _ -> txt "_"+  XHsType t -> atom t   where     isPromoted = \case       HsAppTy _ (L _ f) _ -> isPromoted f@@ -229,9 +232,9 @@  p_hsTyVarBndr :: IsInferredTyVarBndr flag => HsTyVarBndr flag GhcPs -> R () p_hsTyVarBndr = \case-  UserTyVar NoExtField flag x ->+  UserTyVar _ flag x ->     (if isInferred flag then braces N else id) $ p_rdrName x-  KindedTyVar NoExtField flag l k -> (if isInferred flag then braces else parens) N . sitcc $ do+  KindedTyVar _ flag l k -> (if isInferred flag then braces else parens) N . sitcc $ do     located l atom     space     txt "::"@@ -241,11 +244,11 @@ data ForAllVisibility = ForAllInvis | ForAllVis  -- | Render several @forall@-ed variables.-p_forallBndrs :: Data a => ForAllVisibility -> (a -> R ()) -> [Located a] -> R ()+p_forallBndrs :: ForAllVisibility -> (a -> R ()) -> [LocatedA a] -> R () p_forallBndrs ForAllInvis _ [] = txt "forall." p_forallBndrs ForAllVis _ [] = txt "forall ->" p_forallBndrs vis p tyvars =-  switchLayout (getLoc <$> tyvars) $ do+  switchLayout (getLocA <$> tyvars) $ do     txt "forall"     breakpoint     inci $ do@@ -256,11 +259,13 @@  p_conDeclFields :: [LConDeclField GhcPs] -> R () p_conDeclFields xs =-  braces N $ sep commaDel (sitcc . located' p_conDeclField) xs+  braces N $ sep commaDel (located' p_conDeclField) xs  p_conDeclField :: ConDeclField GhcPs -> R () p_conDeclField ConDeclField {..} = do-  mapM_ (p_hsDocString Pipe True) cd_fld_doc+  commaStyle <- getPrinterOpt poCommaStyle+  when (commaStyle == Trailing) $+    mapM_ (p_hsDocString Pipe True) cd_fld_doc   sitcc $     sep       commaDel@@ -270,13 +275,15 @@   txt "::"   breakpoint   sitcc . inci $ p_hsType (unLoc cd_fld_type)+  when (commaStyle == Leading) $+    mapM_ ((newline >>) . p_hsDocString Caret False) cd_fld_doc -tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)-tyOpTree (L _ (HsOpTy NoExtField l op r)) =+tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (LocatedN RdrName)+tyOpTree (L _ (HsOpTy _ l op r)) =   OpBranch (tyOpTree l) op (tyOpTree r) tyOpTree n = OpNode n -p_tyOpTree :: OpTree (LHsType GhcPs) (Located RdrName) -> R ()+p_tyOpTree :: OpTree (LHsType GhcPs) (LocatedN RdrName) -> R () p_tyOpTree (OpNode n) = located n p_hsType p_tyOpTree (OpBranch l op r) = do   switchLayout [opTreeLoc l] $@@ -296,23 +303,38 @@   -- NOTE(amesgen) is this unreachable or just not implemented?   HsArgPar _ -> notImplemented "HsArgPar" +p_hsSigType :: HsSigType GhcPs -> R ()+p_hsSigType HsSig {..} =+  p_hsType $ hsOuterTyVarBndrsToHsType sig_bndrs sig_body+ ---------------------------------------------------------------------------- -- Conversion functions -tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]-tyVarsToTypes HsQTvs {..} = fmap tyVarToType <$> hsq_explicit- tyVarToType :: HsTyVarBndr () GhcPs -> HsType GhcPs tyVarToType = \case-  UserTyVar NoExtField () tvar -> HsTyVar NoExtField NotPromoted tvar-  KindedTyVar NoExtField () tvar kind ->+  UserTyVar _ () tvar -> HsTyVar EpAnnNotUsed NotPromoted tvar+  KindedTyVar _ () tvar kind ->     -- Note: we always add parentheses because for whatever reason GHC does     -- not use HsParTy for left-hand sides of declarations. Please see     -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as     -- long as 'tyVarToType' does not get applied to right-hand sides of     -- declarations.-    HsParTy NoExtField . noLoc $-      HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind+    HsParTy EpAnnNotUsed . noLocA $+      HsKindSig EpAnnNotUsed (noLocA (HsTyVar EpAnnNotUsed NotPromoted tvar)) kind  tyVarsToTyPats :: LHsQTyVars GhcPs -> HsTyPats GhcPs tyVarsToTyPats HsQTvs {..} = HsValArg . fmap tyVarToType <$> hsq_explicit++-- could be generalized to also handle () instead of Specificity+hsOuterTyVarBndrsToHsType ::+  HsOuterTyVarBndrs Specificity GhcPs ->+  LHsType GhcPs ->+  HsType GhcPs+hsOuterTyVarBndrsToHsType obndrs ty = case obndrs of+  HsOuterImplicit NoExtField -> unLoc ty+  HsOuterExplicit _ bndrs ->+    HsForAllTy NoExtField (mkHsForAllInvisTele EpAnnNotUsed bndrs) ty++lhsTypeToSigType :: LHsType GhcPs -> LHsSigType GhcPs+lhsTypeToSigType ty =+  reLocA . L (getLocA ty) . HsSig NoExtField (HsOuterImplicit NoExtField) $ ty

@@ -15,11 +15,12 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, mapMaybe)-import GHC.Types.Basic+import GHC.Types.Fixity import GHC.Types.Name.Occurrence (occNameString) import GHC.Types.Name.Reader+import GHC.Types.SourceText import GHC.Types.SrcLoc-import Ormolu.Utils (unSrcSpan)+import Ormolu.Utils  -- | Intermediate representation of operator trees. It has two type -- parameters: @ty@ is the type of sub-expressions, while @op@ is the type@@ -32,8 +33,8 @@       (OpTree ty op)  -- | Return combined 'SrcSpan's of all elements in this 'OpTree'.-opTreeLoc :: OpTree (Located a) b -> SrcSpan-opTreeLoc (OpNode (L l _)) = l+opTreeLoc :: HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan+opTreeLoc (OpNode n) = getLoc' n opTreeLoc (OpBranch l _ r) = combineSrcSpans (opTreeLoc l) (opTreeLoc r)  -- | Re-associate an 'OpTree' taking into account automagically inferred@@ -41,12 +42,13 @@ -- an initial 'OpTree', then re-associate it using this function before -- printing. reassociateOpTree ::+  (HasSrcSpan l, HasSrcSpan l') =>   -- | How to get name of an operator   (op -> Maybe RdrName) ->   -- | Original 'OpTree'-  OpTree (Located ty) (Located op) ->+  OpTree (GenLocated l ty) (GenLocated l' op) ->   -- | Re-associated 'OpTree'-  OpTree (Located ty) (Located op)+  OpTree (GenLocated l ty) (GenLocated l' op) reassociateOpTree getOpName opTree =   reassociateOpTreeWith     (buildFixityMap getOpName normOpTree)@@ -108,11 +110,12 @@  -- | Build a map of inferred 'Fixity's from an 'OpTree'. buildFixityMap ::-  forall ty op.+  forall ty op l l'.+  (HasSrcSpan l, HasSrcSpan l') =>   -- | How to get the name of an operator   (op -> Maybe RdrName) ->   -- | Operator tree-  OpTree (Located ty) (Located op) ->+  OpTree (GenLocated l ty) (GenLocated l' op) ->   -- | Fixity map   Map String Fixity buildFixityMap getOpName opTree =@@ -133,16 +136,16 @@         ]         `M.union` m     fixity = Fixity NoSourceText-    score :: OpTree (Located ty) (Located op) -> [(String, Score)]+    score :: OpTree (GenLocated l ty) (GenLocated l' op) -> [(String, Score)]     score (OpNode _) = []     score (OpBranch l o r) = fromMaybe (score r) $ do       -- If we fail to get any of these, 'defaultFixity' will be used by       -- 'reassociateOpTreeWith'.-      le <- srcSpanEndLine <$> unSrcSpan (opTreeLoc l) -- left end-      ob <- srcSpanStartLine <$> unSrcSpan (getLoc o) -- operator begin-      oe <- srcSpanEndLine <$> unSrcSpan (getLoc o) -- operator end-      rb <- srcSpanStartLine <$> unSrcSpan (opTreeLoc r) -- right begin-      oc <- srcSpanStartCol <$> unSrcSpan (getLoc o) -- operator column+      le <- srcSpanEndLine <$> srcSpanToRealSrcSpan (opTreeLoc l) -- left end+      ob <- srcSpanStartLine <$> srcSpanToRealSrcSpan (getLoc' o) -- operator begin+      oe <- srcSpanEndLine <$> srcSpanToRealSrcSpan (getLoc' o) -- operator end+      rb <- srcSpanStartLine <$> srcSpanToRealSrcSpan (opTreeLoc r) -- right begin+      oc <- srcSpanStartCol <$> srcSpanToRealSrcSpan (getLoc' o) -- operator column       opName <- occNameString . rdrNameOcc <$> getOpName (unLoc o)       let s             | le < ob = AtBeginning oc

@@ -11,9 +11,11 @@ import Data.DList (DList) import qualified Data.DList as D import Data.Data (Data)-import Data.Generics (everything, ext2Q)+import Data.Generics (everything, ext1Q, ext2Q) import Data.List (sortOn)+import Data.Maybe (maybeToList) import Data.Typeable (cast)+import GHC.Parser.Annotation import GHC.Types.SrcLoc  -- | A stream of 'RealSrcSpan's in ascending order. This allows us to tell@@ -33,14 +35,15 @@   SpanStream     . sortOn realSrcSpanStart     . D.toList-    $ everything mappend (const mempty `ext2Q` queryLocated) a+    $ everything mappend (const mempty `ext2Q` queryLocated `ext1Q` querySrcSpanAnn) a   where     queryLocated ::       (Data e0) =>       GenLocated e0 e1 ->       DList RealSrcSpan     queryLocated (L mspn _) =-      case cast mspn :: Maybe SrcSpan of-        Nothing -> mempty-        Just (UnhelpfulSpan _) -> mempty-        Just (RealSrcSpan spn _) -> D.singleton spn+      maybe mempty srcSpanToRealSrcSpanDList (cast mspn :: Maybe SrcSpan)+    querySrcSpanAnn :: SrcSpanAnn' a -> DList RealSrcSpan+    querySrcSpanAnn = srcSpanToRealSrcSpanDList . locA+    srcSpanToRealSrcSpanDList =+      D.fromList . maybeToList . srcSpanToRealSrcSpan

@@ -7,7 +7,6 @@   ( removeIndentation,     reindent,     linesInRegion,-    regionInbetween,     intSetToRegions,   ) where@@ -40,20 +39,6 @@   where     (_, nonPrefix) = splitAt regionPrefixLength ls     middle = take (length nonPrefix - regionSuffixLength) nonPrefix---- | Get the region after the end of the first and till the end of--- the second region.-regionInbetween ::-  -- | Total number of lines-  Int ->-  RegionDeltas ->-  RegionDeltas ->-  RegionDeltas-regionInbetween total r r' =-  RegionDeltas-    { regionPrefixLength = total - regionSuffixLength r,-      regionSuffixLength = total - regionPrefixLength r'-    }  -- | Convert a set of line indices into disjoint 'RegionDelta's intSetToRegions ::

@@ -29,25 +29,25 @@     go _ [] = []     go state ((line, i) : ls)       | any for ["define ", "include ", "undef "] =-        i : go contState ls+          i : go contState ls       | any for ["ifdef ", "ifndef ", "if "] =-        let state' = case state of-              InConditional nc -> InConditional (nc + 1)-              _ -> InConditional 1-         in i : go state' ls+          let state' = case state of+                InConditional nc -> InConditional (nc + 1)+                _ -> InConditional 1+           in i : go state' ls       | for "endif" =-        let state' = case state of-              InConditional nc | nc > 1 -> InConditional (nc - 1)-              _ -> Outside-         in i : go state' ls+          let state' = case state of+                InConditional nc | nc > 1 -> InConditional (nc - 1)+                _ -> Outside+           in i : go state' ls       | otherwise =-        let is = case state of-              Outside -> []-              _ -> [i]-            state' = case state of-              InContinuation -> contState-              _ -> state-         in is <> go state' ls+          let is = case state of+                Outside -> []+                _ -> [i]+              state' = case state of+                InContinuation -> contState+                _ -> state+           in is <> go state' ls       where         for directive = isJust $ do           s <- dropWhile isSpace <$> L.stripPrefix "#" line

@@ -10,6 +10,7 @@ where  import Control.Monad+import Data.Array as A import Data.Bifunctor (bimap) import Data.Char (isSpace) import Data.Function ((&))@@ -76,13 +77,15 @@       Left r | T.all isSpace r -> True       _ -> False -    rawLines = lines rawInput+    rawLines = A.listArray (0, length rawLines' - 1) rawLines'+      where+        rawLines' = lines rawInput     rawLineLength = length rawLines      interleave [] bs = bs     interleave (a : as) bs = a : interleave bs as -    xs !!? i = if i >= 0 && i < length xs then Just $ xs !! i else Nothing+    xs !!? i = if A.bounds rawLines `A.inRange` i then Just $ xs A.! i else Nothing  -- | All lines we are not supposed to format, and a set of replacements -- for specific lines.@@ -124,10 +127,10 @@     go state ((line, i) : ls)       | Just marker <- disablingMagicComment line,         state == OrmoluEnabled =-        ([i], [(i, marker)]) : go OrmoluDisabled ls+          ([i], [(i, marker)]) : go OrmoluDisabled ls       | Just marker <- enablingMagicComment line,         state == OrmoluDisabled =-        ([i], [(i, marker)]) : go OrmoluEnabled ls+          ([i], [(i, marker)]) : go OrmoluEnabled ls       | otherwise = iIfDisabled : go state ls       where         iIfDisabled = case state of

@@ -10,12 +10,13 @@     notImplemented,     showOutputable,     splitDocString,-    unSrcSpan,     incSpanLine,     separatedByBlank,     separatedByBlankNE,     onTheSameLine,     groupBy',+    HasSrcSpan (..),+    getLoc',   ) where @@ -25,10 +26,11 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T+import GHC.Driver.Ppr import GHC.DynFlags (baseDynFlags) import GHC.Hs import GHC.Types.SrcLoc-import qualified GHC.Utils.Outputable as GHC+import GHC.Utils.Outputable  -- | Relative positions in a list. data RelativePos@@ -58,8 +60,8 @@ notImplemented msg = error $ "not implemented yet: " ++ msg  -- | Pretty-print an 'GHC.Outputable' thing.-showOutputable :: GHC.Outputable o => o -> String-showOutputable = GHC.showSDoc baseDynFlags . GHC.ppr+showOutputable :: Outputable o => o -> String+showOutputable = showSDoc baseDynFlags . ppr  -- | Split and normalize a doc string. The result is a list of lines that -- make up the comment.@@ -84,12 +86,6 @@         _ -> txt     escapeCommentBraces = T.replace "{-" "{\\-" . T.replace "-}" "-\\}" --- | Get 'RealSrcSpan' out of 'SrcSpan' if the span is “helpful”.-unSrcSpan :: SrcSpan -> Maybe RealSrcSpan-unSrcSpan = \case-  RealSrcSpan r _ -> Just r-  UnhelpfulSpan _ -> Nothing- -- | Increment line number in a 'SrcSpan'. incSpanLine :: Int -> SrcSpan -> SrcSpan incSpanLine i = \case@@ -108,8 +104,8 @@ separatedByBlank :: (a -> SrcSpan) -> a -> a -> Bool separatedByBlank loc a b =   fromMaybe False $ do-    endA <- srcSpanEndLine <$> unSrcSpan (loc a)-    startB <- srcSpanStartLine <$> unSrcSpan (loc b)+    endA <- srcSpanEndLine <$> srcSpanToRealSrcSpan (loc a)+    startB <- srcSpanStartLine <$> srcSpanToRealSrcSpan (loc b)     pure (startB - endA >= 2)  -- | Do two declaration groups have a blank between them?@@ -130,3 +126,15 @@     if x `eq` y       then (x :| y : ys) : zs       else pure x : (y :| ys) : zs++class HasSrcSpan l where+  loc' :: l -> SrcSpan++instance HasSrcSpan SrcSpan where+  loc' = id++instance HasSrcSpan (SrcSpanAnn' ann) where+  loc' = locA++getLoc' :: HasSrcSpan l => GenLocated l a -> SrcSpan+getLoc' = loc' . getLoc

@@ -21,6 +21,7 @@ import Distribution.PackageDescription import Distribution.PackageDescription.Parsec import qualified Distribution.Types.CondTree as CT+import Distribution.Utils.Path (getSymbolicPath) import Language.Haskell.Extension import Ormolu.Config import Ormolu.Exception@@ -60,13 +61,12 @@       where         prependSrcDirs f           | null hsSourceDirs = [f]-          | otherwise = (</> f) <$> hsSourceDirs+          | otherwise = (</> f) . getSymbolicPath <$> hsSourceDirs         exts = maybe [] langExt defaultLanguage ++ fmap extToDynOption defaultExtensions         langExt =-          pure . DynOption . \case-            Haskell98 -> "-XHaskell98"-            Haskell2010 -> "-XHaskell2010"-            UnknownLanguage lan -> "-X" ++ lan+          pure . DynOption . ("-X" <>) . \case+            UnknownLanguage lan -> lan+            lan -> show lan         extToDynOption =           DynOption . \case             EnableExtension e -> "-X" ++ show e@@ -108,9 +108,9 @@         [] -> pure Nothing         e : es           | takeExtension e == ".cabal" ->-            doesFileExist (parentDir </> e) >>= \case-              True -> pure $ Just e-              False -> findDotCabal es+              doesFileExist (parentDir </> e) >>= \case+                True -> pure $ Just e+                False -> findDotCabal es         _ : es -> findDotCabal es   findDotCabal dirEntries >>= \case     Just cabalFile -> pure . Just $ parentDir </> cabalFile

@@ -3,11 +3,13 @@ module Ormolu.Utils.IO   ( writeFileUtf8,     readFileUtf8,+    getContentsUtf8,   ) where  import Control.Exception (throwIO) import Control.Monad.IO.Class+import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Text (Text) import qualified Data.Text.Encoding as TE@@ -20,4 +22,13 @@ -- | Read an entire file strictly into a 'Text' using UTF8 and -- ignoring native line ending conventions. readFileUtf8 :: MonadIO m => FilePath -> m Text-readFileUtf8 p = liftIO $ either throwIO pure . TE.decodeUtf8' =<< B.readFile p+readFileUtf8 p = liftIO (B.readFile p) >>= decodeUtf8++-- | Read stdin as UTF8-encoded 'Text' value.+getContentsUtf8 :: MonadIO m => m Text+getContentsUtf8 = liftIO B.getContents >>= decodeUtf8++-- | A helper function for decoding a strict 'ByteString' into 'Text'. It is+-- strict and fails immediately if decoding encounters a problem.+decodeUtf8 :: MonadIO m => ByteString -> m Text+decodeUtf8 = liftIO . either throwIO pure . TE.decodeUtf8'

@@ -25,7 +25,7 @@     stdTest "trimming" "spaced" "spaced-v2"     stdTest "trailing-blank-line" "no-trailing-blank-line" "with-trailing-blank-line" --- | Test diff printig.+-- | Test diff printing. stdTest ::   -- | Name of the test case   String ->@@ -45,7 +45,7 @@   expectedDiffText <-     parseRelFile expectedDiffPath       >>= readFileUtf8 . toFilePath . (diffOutputsDir </>)-  let Just actualDiff = diffText inputA inputB "TEST"+  Just actualDiff <- pure $ diffText inputA inputB "TEST"   actualDiffText <- printDiff actualDiff   actualDiffText `shouldBe` expectedDiffText 

@@ -5,14 +5,18 @@ import Control.Exception import Control.Monad import Data.List (isSuffixOf)+import Data.Maybe (isJust) import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.IO as T import Ormolu import Ormolu.Config import Ormolu.Utils.IO import Path import Path.IO+import System.Environment (lookupEnv) import qualified System.FilePath as F+import System.IO.Unsafe (unsafePerformIO) import Test.Hspec  spec :: Spec@@ -35,22 +39,27 @@ checkExample :: (PrinterOptsTotal, String, String) -> Path Rel File -> Spec checkExample (po, label, suffix) srcPath' = it (fromRelFile srcPath' ++ " works (" ++ label ++ ")") . withNiceExceptions $ do   let srcPath = examplesDir </> srcPath'-      cfg = defaultConfig {cfgPrinterOpts = po}+      inputPath = fromRelFile srcPath+      config =+        defaultConfig+          { cfgPrinterOpts = po,+            cfgSourceType = detectSourceType inputPath+          }   expectedOutputPath <- deriveOutput suffix srcPath   -- 1. Given input snippet of source code parse it and pretty print it.   -- 2. Parse the result of pretty-printing again and make sure that AST   -- is the same as AST of the original snippet. (This happens in   -- 'ormoluFile' automatically.)-  formatted0 <- ormoluFile cfg (fromRelFile srcPath)+  formatted0 <- ormoluFile config inputPath   -- 3. Check the output against expected output. Thus all tests should   -- include two files: input and expected output.-  -- <<< UNCOMMENT NEXT LINE TO REGENERATE OUTPUT FILES >>>-  -- writeFile (fromRelFile expectedOutputPath) (T.unpack formatted0)+  when shouldRegenerateOutput $+    T.writeFile (fromRelFile expectedOutputPath) formatted0   expected <- readFileUtf8 $ fromRelFile expectedOutputPath   shouldMatch False formatted0 expected   -- 4. Check that running the formatter on the output produces the same   -- output again (the transformation is idempotent).-  formatted1 <- ormolu cfg "<formatted>" (T.unpack formatted0)+  formatted1 <- ormolu config "<formatted>" (T.unpack formatted0)   shouldMatch True formatted1 formatted0  -- | Build list of examples for testing.@@ -64,13 +73,15 @@ isInput path =   let s = fromRelFile path       (s', exts) = F.splitExtensions s-   in exts == ".hs" && not ("-out" `isSuffixOf` s')+   in exts `elem` [".hs", ".hsig"] && not ("-out" `isSuffixOf` s')  -- | For given path of input file return expected name of output. deriveOutput :: String -> Path Rel File -> IO (Path Rel File) deriveOutput suffix path =   parseRelFile $-    F.addExtension (F.dropExtensions (fromRelFile path) ++ suffix ++ "-out") "hs"+    F.addExtension (radical ++ suffix ++ "-out") exts+  where+    (radical, exts) = F.splitExtensions (fromRelFile path)  -- | A version of 'shouldBe' that is specialized to comparing 'Text' values. -- It also prints multi-line snippets in a more readable form.@@ -102,3 +113,8 @@   where     h :: OrmoluException -> IO ()     h = expectationFailure . displayException++shouldRegenerateOutput :: Bool+shouldRegenerateOutput =+  unsafePerformIO $ isJust <$> lookupEnv "ORMOLU_REGENERATE_EXAMPLES"+{-# NOINLINE shouldRegenerateOutput #-}