brittany 0.11.0.0 → 0.12.0.0

raw patch · 32 files changed

+2691/−910 lines, 32 filesdep ~basedep ~containersdep ~ghcPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, containers, ghc, ghc-boot-th, ghc-exactprint, hspec, monad-memo, yaml

API changes (from Hackage documentation)

Files

• ChangeLog.md +39/−0
• README.md +49/−23
• brittany.cabal +31/−19
• doc/implementation/theory.md +1/−1
• src-brittany/Main.hs +282/−179
• src-literatetests/10-tests.blt +348/−0
• src-literatetests/14-extensions.blt +64/−0
• src-literatetests/15-regressions.blt +66/−9
• src-literatetests/30-tests-context-free.blt +33/−1
• src-literatetests/Main.hs +3/−1
• src-unittests/TestUtils.hs +1/−0
• src/Language/Haskell/Brittany/Internal.hs +110/−78
• src/Language/Haskell/Brittany/Internal/Backend.hs +55/−36
• src/Language/Haskell/Brittany/Internal/BackendUtils.hs +12/−13
• src/Language/Haskell/Brittany/Internal/Config.hs +5/−2
• src/Language/Haskell/Brittany/Internal/Config/Types.hs +18/−0
• src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +25/−11
• src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +116/−21
• src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +490/−89
• src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +502/−296
• src/Language/Haskell/Brittany/Internal/Layouters/IE.hs +64/−25
• src/Language/Haskell/Brittany/Internal/Layouters/Import.hs +15/−5
• src/Language/Haskell/Brittany/Internal/Layouters/Module.hs +1/−1
• src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs +73/−23
• src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +20/−0
• src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +131/−20
• src/Language/Haskell/Brittany/Internal/Prelude.hs +8/−0
• src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs +77/−17
• src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs +1/−0
• src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs +4/−0
• src/Language/Haskell/Brittany/Internal/Types.hs +43/−37
• src/Language/Haskell/Brittany/Internal/Utils.hs +4/−3

@@ -1,5 +1,44 @@ # Revision history for brittany +## 0.12.0.0 -- June 2019++* Support for ghc-8.6 (basic support, not necessarily all new syntactic+  extensions)+* Support -XExplicitNamespaces and -XPatternSynonyms+* Allow a --dry-run sort of operation via flag "-c/--check-mode"+  (thanks to Doug Beardsley @mightybyte)+* Include file name in errors about unsupported syntax nodes (thanks to @5outh)+* Partially implement layouting class instances: Layouts children, but+  falls back on ghc-exactprint for the instance head+  (thanks to Rupert Horlick @ruhatch)+* Implement layouting for type synonyms (thanks to Rupert Horlick @ruhatch)+* Support -XMagicHash, -XUnboxedTuples (thanks to Sergey Vinokurov @sergv)+* Support -XQuasiQuotes (no formatting applied to the splices; they are simply+  retained without causing the dreaded "Unknown construct: HsSpliceE{}")+    - `lconfig_allowHangingQuasiQuotes` controls whether multi-line+      QuasiQuotes are allowed to start at the end of the current line, or+      whether they are always placed in new lines.+* Bugfixes:+    - Fix rare-case alignment bug with IndentPolicyMultiple (#144)+    - Make inline layout config apply to module header (#151)+    - Fix unaligned import-hiding layout (#150)+    - Fix idempotence violation for comments around if-then-else (#167)+    - Fix comments having an effect on far-away parent node's layout (#159)+    - Fix imports of type operators ("symbolic data types")+      (thanks to Phil Hazelden @ChickenProp)+    - Work around GHC and cabal-install misfeature ".ghc.environment files"+      that could break brittany in unexpected and hard-to-understand ways+    - Stop removing empty lines before `where` keyword in a couple of cases+    - Fix functions with mixing prefix/infix style causing error (#234)+* Changes to layout:+    - Align usage of spaces for record update vs record construction (#126)+    - More indentation to import-hiding-paragraph (follow-up to #150 fix)+    - Record construction and update now are layouted in the same way+      (thanks to Evan Rutledge Borden @eborden)+    - Stop allowing single-line layout when there are comments between+      arguments (#214) (thanks to @matt-noonan)+* Various build-instructions and editor integrations+ ## 0.11.0.0 -- May 2018  * Support for ghc-8.4

@@ -48,7 +48,7 @@  # Other usage notes -- Supports GHC versions `8.0`, `8.2` and `8.4`.+- Supports GHC versions `8.0`, `8.2`, `8.4`, `8.6`. - included in stackage with lts>=10.0 (or nightlies dating to >=2017-11-15) - config (file) documentation is lacking. - some config values can not be configured via commandline yet.@@ -58,37 +58,50 @@  # Installation -- via `cabal` "old-build"+- via `stack`      ~~~~.sh+    stack install brittany # --resolver lts-10.0+    ~~~~++    If you use an lts that includes brittany this should just work; otherwise+    you may want to clone the repo and try again (there are several stack.yamls+    included).++- via `nix`:+    ~~~.sh+    nix build -f release.nix     # or 'nix-build -f release.nix'+    nix-env -i ./result+    ~~~++- via `cabal v1-build`++    ~~~~.sh     # optionally:     # mkdir brittany     # cd brittany     # cabal sandbox init-    cabal install brittany --bindir=$HOME/.cabal/bin # -w $PATH_TO_GHC_8_0+    cabal install brittany --bindir=$HOME/.cabal/bin # -w $PATH_TO_GHC_8_x     ~~~~ -- via `cabal new-build`+- via `cabal v2-install`      ~~~~.sh-    cabal unpack brittany-    cd brittany-0.11.0.0-    # cabal new-configure -w $PATH_TO_GHC_8_0-    cabal new-build exe:brittany-    # and it should be safe to just copy the executable, e.g.-    cp `./find dist-newstyle/build/ -type f -name brittany` $HOME/.cabal/bin/+    cabal v2-install brittany     ~~~~ -- via `stack` using a sufficiently recent stackage snapshot (dated to >= 2017-11-15)+- via `cabal v2-build`, should v2-install not work:      ~~~~.sh-    stack install brittany # --resolver lts-10.0+    cabal unpack brittany+    cd brittany-0.11.0.0+    # cabal new-configure -w $PATH_TO_GHC_8_x+    cabal new-build exe:brittany+    # and it should be safe to just copy the executable, e.g.+    cp `find dist-newstyle/ -name brittany -type f | xargs -x ls -t | head -n1` $HOME/.cabal/bin/     ~~~~ -    (earlier ltss did not include `brittany` yet, but the repo should contain a-    `stack.yaml` that works with ghc-8.0.)--- on ArchLinux via [the britanny AUR package](https://aur.archlinux.org/packages/brittany/)+- on ArchLinux via [the brittany AUR package](https://aur.archlinux.org/packages/brittany/)   using `aura`:     ~~~~.sh     aura -A brittany@@ -109,6 +122,10 @@ #### Neovim / Vim 8   The [Neoformat](https://github.com/sbdchd/neoformat) plugin comes with support for   brittany built in.+#### Atom+  [Atom Beautify](https://atom.io/packages/atom-beautify) supports brittany as a formatter for Haskell. Since the default formatter is set to hindent, you will need to change this setting to brittany, after installing the extension.+#### Emacs+  [format-all](https://github.com/lassik/emacs-format-all-the-code) support brittany as the default formatter for Haskell.  # Usage @@ -145,21 +162,30 @@  # Feature Requests, Contribution, Documentation -This currently is a one-person project in the sense that 90% of the code is-written by one person. And (unfortunately) it is not my job to keep improving-this project. Please forgive that as a consequence my time to invest on new-features is rather limited.+For a long time this project has had a single maintainer, and as a consequence+there have been some mildly large delays for reacting to feature requests+and even PRs. -Nonetheless I consider it "in active development" :)+Sorry about that. -One way of speeding things up is to make your own contributions. There is+The good news is that this project is getting sponsored by PRODA LTD, and two+previous contributors, Evan Borden and Taylor Fausak, have agreed on helping+with organisational aspects. Thanks!++Still, this project has a long queue of very sensible feature requests, so it+may take some time until new ones get our attention. But with the help of+the co-maintainers, at least the reaction-times on PRs and the frequency+of releases should improve significantly.++If you are interested in making your own contributions, there is a good amount of high-level documentation at  [the documentation index](doc/implementation/index.md)  # License -Copyright (C) 2016-2018 Lennart Spitzner+Copyright (C) 2016-2019 Lennart Spitzner\+Copyright (C) 2019      PRODA LTD  This program is free software: you can redistribute it and/or modify it under the terms of the

@@ -1,5 +1,5 @@ name:                 brittany-version:              0.11.0.0+version:              0.12.0.0 synopsis:             Haskell source code formatter description: {   See <https://github.com/lspitzner/brittany/blob/master/README.md the README>.@@ -12,7 +12,8 @@ license-file:         LICENSE author:               Lennart Spitzner maintainer:           Lennart Spitzner <hexagoxel@hexagoxel.de>-copyright:            Copyright (C) 2016-2018 Lennart Spitzner+copyright:            Copyright (C) 2016-2019 Lennart Spitzner+                      Copyright (C) 2019 PRODA LTD category:             Language build-type:           Simple cabal-version:        1.18@@ -25,6 +26,7 @@ } extra-source-files: {   src-literatetests/*.blt+  srcinc/prelude.inc }  source-repository head {@@ -42,9 +44,8 @@     Haskell2010   hs-source-dirs:     src-  install-includes: {-    srcinc/prelude.inc-  }+  include-dirs:+    srcinc   exposed-modules: {     Language.Haskell.Brittany     Language.Haskell.Brittany.Internal@@ -83,12 +84,12 @@     -fno-warn-redundant-constraints   }   build-depends:-    { base >=4.9 && <4.12-    , ghc >=8.0.1 && <8.5+    { base >=4.9 && <4.13+    , ghc >=8.0.1 && <8.7     , ghc-paths >=0.1.0.9 && <0.2-    , ghc-exactprint >=0.5.6.0 && <0.5.7+    , ghc-exactprint >=0.5.8 && <0.6.2     , transformers >=0.5.2.0 && <0.6-    , containers >=0.5.7.1 && <0.6+    , containers >=0.5.7.1 && <0.7     , mtl >=2.2.1 && <2.3     , text >=1.2 && <1.3     , multistate >=0.7.1.1 && <0.9@@ -99,19 +100,19 @@     , bytestring >=0.10.8.1 && <0.11     , directory >=1.2.6.2 && <1.4     , butcher >=1.3.1 && <1.4-    , yaml >=0.8.18 && <0.9-    , aeson >=1.0.1.0 && <1.3+    , yaml >=0.8.18 && <0.12+    , aeson >=1.0.1.0 && <1.5     , extra >=1.4.10 && <1.7     , uniplate >=1.6.12 && <1.7     , strict >=0.3.2 && <0.4-    , monad-memo >=0.4.1 && <0.5+    , monad-memo >=0.4.1 && <0.6     , unsafe >=0.0 && <0.1     , safe >=0.3.9 && <0.4     , deepseq >=1.4.2.0 && <1.5     , semigroups >=0.18.2 && <0.19     , cmdargs >=0.10.14 && <0.11     , czipwith >=1.0.1.0 && <1.1-    , ghc-boot-th >=8.0.1 && <8.5+    , ghc-boot-th >=8.0.1 && <8.7     , filepath >=1.4.1.0 && <1.5     , random >= 1.1 && <1.2     }@@ -130,8 +131,6 @@     MultiWayIf     KindSignatures   }-  include-dirs:-    srcinc }  executable brittany@@ -179,6 +178,7 @@     , filepath >=1.4.1.0 && <1.5     }   hs-source-dirs:      src-brittany+  include-dirs:        srcinc   default-language:    Haskell2010   default-extensions: {     CPP@@ -243,12 +243,13 @@     , cmdargs     , czipwith     , ghc-boot-th-    , hspec >=2.4.1 && <2.6+    , hspec >=2.4.1 && <2.8     }   main-is:          TestMain.hs   other-modules:    TestUtils                     AsymptoticPerfTests   hs-source-dirs:   src-unittests+  include-dirs:     srcinc   default-extensions: {     CPP @@ -269,6 +270,10 @@     -fno-warn-unused-imports     -rtsopts     -with-rtsopts "-M2G"+    -threaded+    -- ^ threaded is not necessary at all, but our CI trusts on being able+    --   to pass -N1, which is not possible without threaded :-/+    --   (plus -no-threaded is not a thing, afaict)   }  test-suite littests@@ -310,13 +315,14 @@     , cmdargs     , czipwith     , ghc-boot-th-    , hspec >=2.4.1 && <2.6+    , hspec >=2.4.1 && <2.8     , filepath     , parsec >=3.1.11 && <3.2     }   main-is:          Main.hs   other-modules:   hs-source-dirs:   src-literatetests+  include-dirs:     srcinc   default-extensions: {     CPP @@ -335,8 +341,9 @@   ghc-options: {     -Wall     -fno-warn-unused-imports+    -threaded     -rtsopts-    -with-rtsopts "-M2G"+    -with-rtsopts "-M2G -N"   }  test-suite libinterfacetests@@ -352,11 +359,12 @@     , base     , text     , transformers-    , hspec >=2.4.1 && <2.6+    , hspec >=2.4.1 && <2.8     }   main-is:          Main.hs   other-modules:   hs-source-dirs:   src-libinterfacetests+  include-dirs:     srcinc   default-extensions: {     FlexibleContexts     FlexibleInstances@@ -371,4 +379,8 @@     -fno-warn-unused-imports     -rtsopts     -with-rtsopts "-M2G"+    -threaded+    -- ^ threaded is not necessary at all, but our CI trusts on being able+    --   to pass -N1, which is not possible without threaded :-/+    --   (plus -no-threaded is not a thing, afaict)   }

@@ -1,6 +1,6 @@ # Introduction -[The readme](../../master/README.md) mentions a couple of goals for this+[The readme](../../README.md) mentions a couple of goals for this project, including the following two:  - Be clever about using the available horizontal space while not overflowing

@@ -6,22 +6,29 @@  #include "prelude.inc" -import qualified Language.Haskell.GHC.ExactPrint as ExactPrint-import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types+-- brittany { lconfig_importAsColumn: 60, lconfig_importColumn: 60 }+import qualified Language.Haskell.GHC.ExactPrint         as ExactPrint+import qualified Language.Haskell.GHC.ExactPrint.Annotate+                                                         as ExactPrint.Annotate+import qualified Language.Haskell.GHC.ExactPrint.Types   as ExactPrint.Types import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers-import qualified Data.Map as Map+import qualified Data.Map                                as Map import qualified Data.Monoid -import           Text.Read (Read(..))-import qualified Text.ParserCombinators.ReadP as ReadP-import qualified Text.ParserCombinators.ReadPrec as ReadPrec-import qualified Data.Text.Lazy.Builder as Text.Builder+import           GHC                                      ( GenLocated(L) )+import           Outputable                               ( Outputable(..)+                                                          , showSDocUnsafe+                                                          ) -import           Control.Monad (zipWithM)+import           Text.Read                                ( Read(..) )+import qualified Text.ParserCombinators.ReadP            as ReadP+import qualified Text.ParserCombinators.ReadPrec         as ReadPrec+import qualified Data.Text.Lazy.Builder                  as Text.Builder++import           Control.Monad                            ( zipWithM ) import           Data.CZipWith -import qualified Debug.Trace as Trace+import qualified Debug.Trace                             as Trace  import           Language.Haskell.Brittany.Internal.Types import           Language.Haskell.Brittany.Internal@@ -30,21 +37,22 @@ import           Language.Haskell.Brittany.Internal.Utils import           Language.Haskell.Brittany.Internal.Obfuscation -import qualified Text.PrettyPrint as PP+import qualified Text.PrettyPrint                        as PP  import           DataTreePrint import           UI.Butcher.Monadic  import qualified System.Exit-import qualified System.Directory as Directory-import qualified System.FilePath.Posix as FilePath+import qualified System.Directory                        as Directory+import qualified System.FilePath.Posix                   as FilePath -import qualified DynFlags as GHC-import qualified GHC.LanguageExtensions.Type as GHC+import qualified DynFlags                                as GHC+import qualified GHC.LanguageExtensions.Type             as GHC -import Paths_brittany+import           Paths_brittany  + data WriteMode = Display | Inplace  instance Read WriteMode where@@ -73,16 +81,16 @@     ]   , parDoc $ "Example invocations:"   , PP.hang (PP.text "") 2 $ PP.vcat-      [ PP.text "brittany"-      , PP.nest 2 $ PP.text "read from stdin, output to stdout"-      ]+    [ PP.text "brittany"+    , PP.nest 2 $ PP.text "read from stdin, output to stdout"+    ]   , PP.hang (PP.text "") 2 $ PP.vcat-      [ PP.text "brittany --indent=4 --write-mode=inplace *.hs"-      , PP.nest 2 $ PP.vcat-        [ PP.text "run on all modules in current directory (no backup!)"-        , PP.text "4 spaces indentation"-        ]+    [ PP.text "brittany --indent=4 --write-mode=inplace *.hs"+    , PP.nest 2 $ PP.vcat+      [ PP.text "run on all modules in current directory (no backup!)"+      , PP.text "4 spaces indentation"       ]+    ]   , parDocW     [ "This program is written carefully and contains safeguards to ensure"     , "the output is syntactically valid and that no comments are removed."@@ -93,9 +101,14 @@     , "codebase without having backups."     ]   , parDoc $ "There is NO WARRANTY, to the extent permitted by law."-  , parDocW ["This program is free software released under the AGPLv3.", "For details use the --license flag."]+  , parDocW+    [ "This program is free software released under the AGPLv3."+    , "For details use the --license flag."+    ]   , parDoc $ "See https://github.com/lspitzner/brittany"-  , parDoc $ "Please report bugs at" ++ " https://github.com/lspitzner/brittany/issues"+  , parDoc+  $  "Please report bugs at"+  ++ " https://github.com/lspitzner/brittany/issues"   ]  licenseDoc :: PP.Doc@@ -130,29 +143,49 @@   addCmd "license" $ addCmdImpl $ print $ licenseDoc   -- addButcherDebugCommand   reorderStart-  printHelp      <- addSimpleBoolFlag "h" ["help"] mempty-  printVersion   <- addSimpleBoolFlag "" ["version"] mempty-  printLicense   <- addSimpleBoolFlag "" ["license"] mempty-  configPaths    <- addFlagStringParams "" ["config-file"] "PATH" (flagHelpStr "path to config file") -- TODO: allow default on addFlagStringParam ?+  printHelp    <- addSimpleBoolFlag "h" ["help"] mempty+  printVersion <- addSimpleBoolFlag "" ["version"] mempty+  printLicense <- addSimpleBoolFlag "" ["license"] mempty+  configPaths  <- addFlagStringParams ""+                                      ["config-file"]+                                      "PATH"+                                      (flagHelpStr "path to config file") -- TODO: allow default on addFlagStringParam ?   cmdlineConfig  <- cmdlineConfigParser   suppressOutput <- addSimpleBoolFlag     ""     ["suppress-output"]-    (flagHelp $ parDoc "suppress the regular output, i.e. the transformed haskell source")-  _verbosity <- addSimpleCountFlag "v" ["verbose"] (flagHelp $ parDoc "[currently without effect; TODO]")-  writeMode  <- addFlagReadParam+    (flagHelp $ parDoc+      "suppress the regular output, i.e. the transformed haskell source"+    )+  _verbosity <- addSimpleCountFlag+    "v"+    ["verbose"]+    (flagHelp $ parDoc "[currently without effect; TODO]")+  checkMode <- addSimpleBoolFlag+    "c"+    ["check-mode"]+    (flagHelp+        (PP.vcat+          [ PP.text "check for changes but do not write them out"+          , PP.text "exits with code 0 if no changes necessary, 1 otherwise"+          ]+        )+    )+  writeMode <- addFlagReadParam     ""     ["write-mode"]     "(display|inplace)"-    (  flagHelp-        ( PP.vcat+    (              flagHelp+        (PP.vcat           [ PP.text "display: output for any input(s) goes to stdout"           , PP.text "inplace: override respective input file (without backup!)"           ]         )     Data.Monoid.<> flagDefault Display     )-  inputParams <- addParamNoFlagStrings "PATH" (paramHelpStr "paths to input/inout haskell source files")+  inputParams <- addParamNoFlagStrings+    "PATH"+    (paramHelpStr "paths to input/inout haskell source files")   reorderStop   addCmdImpl $ void $ do     when printLicense $ do@@ -165,31 +198,48 @@         putStrLn $ "There is NO WARRANTY, to the extent permitted by law."       System.Exit.exitSuccess     when printHelp $ do-      liftIO $ putStrLn $ PP.renderStyle PP.style { PP.ribbonsPerLine = 1.0 } $ ppHelpShallow helpDesc+      liftIO+        $ putStrLn+        $ PP.renderStyle PP.style { PP.ribbonsPerLine = 1.0 }+        $ ppHelpShallow helpDesc       System.Exit.exitSuccess -    let inputPaths  = if null inputParams then [Nothing] else map Just inputParams+    let inputPaths =+          if null inputParams then [Nothing] else map Just inputParams     let outputPaths = case writeMode of-                      Display -> repeat Nothing-                      Inplace -> inputPaths+          Display -> repeat Nothing+          Inplace -> inputPaths      configsToLoad <- liftIO $ if null configPaths-                                then maybeToList <$> (Directory.getCurrentDirectory >>= findLocalConfigPath)-                                else pure configPaths+      then+        maybeToList <$> (Directory.getCurrentDirectory >>= findLocalConfigPath)+      else pure configPaths -    config <- runMaybeT (readConfigsWithUserConfig cmdlineConfig configsToLoad) >>= \case-      Nothing -> System.Exit.exitWith (System.Exit.ExitFailure 53)-      Just x  -> return x-    when (config & _conf_debug & _dconf_dump_config & confUnpack) $-      trace (showConfigYaml config) $ return ()+    config <-+      runMaybeT (readConfigsWithUserConfig cmdlineConfig configsToLoad)+        >>= \case+              Nothing -> System.Exit.exitWith (System.Exit.ExitFailure 53)+              Just x  -> return x+    when (config & _conf_debug & _dconf_dump_config & confUnpack)+      $ trace (showConfigYaml config)+      $ return () -    results <- zipWithM (coreIO putStrErrLn config suppressOutput) inputPaths outputPaths-    case results of-      xs | all Data.Either.isRight xs -> pure ()-      [Left x] -> System.Exit.exitWith (System.Exit.ExitFailure x)-      _        -> System.Exit.exitWith (System.Exit.ExitFailure 1)+    results <- zipWithM (coreIO putStrErrLn config (suppressOutput || checkMode))+                        inputPaths+                        outputPaths +    if checkMode+      then when (any (==Changes) (Data.Either.rights results)) $+             System.Exit.exitWith (System.Exit.ExitFailure 1)+      else case results of+             xs | all Data.Either.isRight xs -> pure ()+             [Left x] -> System.Exit.exitWith (System.Exit.ExitFailure x)+             _ -> System.Exit.exitWith (System.Exit.ExitFailure 1) ++data ChangeStatus = Changes | NoChanges+  deriving (Eq)+ -- | The main IO parts for the default mode of operation, and after commandline -- and config stuff is processed. coreIO@@ -201,26 +251,33 @@             -- currently not part of program config.   -> Maybe FilePath.FilePath -- ^ input filepath; stdin if Nothing.   -> Maybe FilePath.FilePath -- ^ output filepath; stdout if Nothing.-  -> IO (Either Int ())      -- ^ Either an errorNo, or success.-coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runExceptT $ do-  let putErrorLn         = liftIO . putErrorLnIO :: String -> ExceptT.ExceptT e IO ()-  let ghcOptions         = config & _conf_forward & _options_ghc & runIdentity-  -- there is a good of code duplication between the following code and the-  -- `pureModuleTransform` function. Unfortunately, there are also a good-  -- amount of slight differences: This module is a bit more verbose, and-  -- it tries to use the full-blown `parseModule` function which supports-  -- CPP (but requires the input to be a file..).-  let cppMode            = config & _conf_preprocessor & _ppconf_CPPMode & confUnpack-  -- the flag will do the following: insert a marker string-  -- ("-- BRITANY_INCLUDE_HACK ") right before any lines starting with-  -- "#include" before processing (parsing) input; and remove that marker-  -- string from the transformation output.-  -- The flag is intentionally misspelled to prevent clashing with-  -- inline-config stuff.-  let hackAroundIncludes = config & _conf_preprocessor & _ppconf_hackAroundIncludes & confUnpack-  let exactprintOnly     = (config & _conf_roundtrip_exactprint_only & confUnpack)-                        || (config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack)-  let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags+  -> IO (Either Int ChangeStatus)      -- ^ Either an errorNo, or the change status.+coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =+  ExceptT.runExceptT $ do+    let putErrorLn = liftIO . putErrorLnIO :: String -> ExceptT.ExceptT e IO ()+    let ghcOptions = config & _conf_forward & _options_ghc & runIdentity+    -- there is a good of code duplication between the following code and the+    -- `pureModuleTransform` function. Unfortunately, there are also a good+    -- amount of slight differences: This module is a bit more verbose, and+    -- it tries to use the full-blown `parseModule` function which supports+    -- CPP (but requires the input to be a file..).+    let cppMode    = config & _conf_preprocessor & _ppconf_CPPMode & confUnpack+    -- the flag will do the following: insert a marker string+    -- ("-- BRITANY_INCLUDE_HACK ") right before any lines starting with+    -- "#include" before processing (parsing) input; and remove that marker+    -- string from the transformation output.+    -- The flag is intentionally misspelled to prevent clashing with+    -- inline-config stuff.+    let hackAroundIncludes =+          config & _conf_preprocessor & _ppconf_hackAroundIncludes & confUnpack+    let exactprintOnly = viaGlobal || viaDebug+         where+          viaGlobal = config & _conf_roundtrip_exactprint_only & confUnpack+          viaDebug =+            config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack++    let+      cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags         then case cppMode of           CPPModeAbort -> do             return $ Left "Encountered -XCPP. Aborting."@@ -233,117 +290,163 @@             return $ Right True           CPPModeNowarn -> return $ Right True         else return $ Right False-  parseResult <- case inputPathM of-    Nothing -> do-      -- TODO: refactor this hack to not be mixed into parsing logic-      let hackF s = if "#include" `isPrefixOf` s then "-- BRITANY_INCLUDE_HACK " ++ s else s-      let hackTransform =-            if hackAroundIncludes && not exactprintOnly then List.intercalate "\n" . fmap hackF . lines' else id-      inputString <- liftIO $ System.IO.hGetContents System.IO.stdin-      liftIO $ parseModuleFromString ghcOptions "stdin" cppCheckFunc (hackTransform inputString)-    Just p -> liftIO $ parseModule ghcOptions p cppCheckFunc-  case parseResult of-    Left left -> do-      putErrorLn "parse error:"-      putErrorLn $ show left-      ExceptT.throwE 60-    Right (anns, parsedSource, hasCPP) -> do-      inlineConf <- case extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource) of-        Left (err, input) -> do-          putErrorLn-            $  "Error: parse error in inline configuration:"-          putErrorLn err-          putErrorLn $ "  in the string \"" ++ input ++ "\"."-          ExceptT.throwE 61-        Right c -> -- trace (showTree c) $-          pure c-      when (config & _conf_debug .> _dconf_dump_ast_full .> confUnpack) $ do-        let val = printTreeWithCustom 100 (customLayouterF anns) parsedSource-        trace ("---- ast ----\n" ++ show val) $ return ()-      (errsWarns, outSText) <- do-        if exactprintOnly-          then do-            pure ([], Text.pack $ ExactPrint.exactPrint parsedSource anns)-          else do-            let omitCheck = config & _conf_errorHandling .> _econf_omit_output_valid_check .> confUnpack-            (ews, outRaw) <- if hasCPP || omitCheck-              then return $ pPrintModule config inlineConf anns parsedSource-              else liftIO $ pPrintModuleAndCheck config inlineConf anns parsedSource-            let hackF s = fromMaybe s $ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s-            let out = TextL.toStrict $ if hackAroundIncludes-                  then TextL.intercalate (TextL.pack "\n") $ fmap hackF $ TextL.splitOn (TextL.pack "\n") outRaw+    (parseResult, originalContents) <- case inputPathM of+      Nothing -> do+        -- TODO: refactor this hack to not be mixed into parsing logic+        let hackF s = if "#include" `isPrefixOf` s+              then "-- BRITANY_INCLUDE_HACK " ++ s+              else s+        let hackTransform = if hackAroundIncludes && not exactprintOnly+              then List.intercalate "\n" . fmap hackF . lines'+              else id+        inputString <- liftIO $ System.IO.hGetContents System.IO.stdin+        parseRes <- liftIO $ parseModuleFromString ghcOptions+                                                   "stdin"+                                                   cppCheckFunc+                                                   (hackTransform inputString)+        return (parseRes, Text.pack inputString)+      Just p -> liftIO $ do+        parseRes <- parseModule ghcOptions p cppCheckFunc+        inputText <- Text.IO.readFile p+        -- The above means we read the file twice, but the+        -- GHC API does not really expose the source it+        -- read. Should be in cache still anyways.+        --+        -- We do not use TextL.IO.readFile because lazy IO is evil.+        -- (not identical -> read is not finished ->+        -- handle still open -> write below crashes - evil.)+        return (parseRes, inputText)+    case parseResult of+      Left left -> do+        putErrorLn "parse error:"+        putErrorLn $ show left+        ExceptT.throwE 60+      Right (anns, parsedSource, hasCPP) -> do+        (inlineConf, perItemConf) <-+          case+            extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource)+          of+            Left (err, input) -> do+              putErrorLn $ "Error: parse error in inline configuration:"+              putErrorLn err+              putErrorLn $ "  in the string \"" ++ input ++ "\"."+              ExceptT.throwE 61+            Right c -> -- trace (showTree c) $+              pure c+        let moduleConf = cZipWith fromOptionIdentity config inlineConf+        when (config & _conf_debug & _dconf_dump_ast_full & confUnpack) $ do+          let val = printTreeWithCustom 100 (customLayouterF anns) parsedSource+          trace ("---- ast ----\n" ++ show val) $ return ()+        (errsWarns, outSText) <- do+          if exactprintOnly+            then do+              pure ([], Text.pack $ ExactPrint.exactPrint parsedSource anns)+            else do+              let omitCheck =+                    moduleConf+                      &  _conf_errorHandling+                      .> _econf_omit_output_valid_check+                      .> confUnpack+              (ews, outRaw) <- if hasCPP || omitCheck+                then return+                  $ pPrintModule moduleConf perItemConf anns parsedSource+                else liftIO $ pPrintModuleAndCheck moduleConf+                                                   perItemConf+                                                   anns+                                                   parsedSource+              let hackF s = fromMaybe s $ TextL.stripPrefix+                    (TextL.pack "-- BRITANY_INCLUDE_HACK ")+                    s+              let+                out = TextL.toStrict $ if hackAroundIncludes+                  then+                    TextL.intercalate (TextL.pack "\n")+                    $ fmap hackF+                    $ TextL.splitOn (TextL.pack "\n") outRaw                   else outRaw-            out' <- if config & _conf_obfuscate & confUnpack-              then lift $ obfuscate out-              else pure out-            pure $ (ews, out')-      let customErrOrder ErrorInput{}         = 4-          customErrOrder LayoutWarning{}      = 0 :: Int-          customErrOrder ErrorOutputCheck{}   = 1-          customErrOrder ErrorUnusedComment{} = 2-          customErrOrder ErrorUnknownNode{}   = 3-          customErrOrder ErrorMacroConfig{}   = 5-      when (not $ null errsWarns) $ do-        let groupedErrsWarns = Data.List.Extra.groupOn customErrOrder $ List.sortOn customErrOrder $ errsWarns-        groupedErrsWarns `forM_` \case-          (ErrorOutputCheck{}:_) -> do-            putErrorLn $ "ERROR: brittany pretty printer" ++ " returned syntactically invalid result."-          (ErrorInput str:_) -> do-            putErrorLn $ "ERROR: parse error: " ++ str-          uns@(ErrorUnknownNode{}:_) -> do-            putErrorLn $ "ERROR: encountered unknown syntactical constructs:"-            uns `forM_` \case-              ErrorUnknownNode str ast -> do-                putErrorLn str-                when (config & _conf_debug & _dconf_dump_ast_unknown & confUnpack) $ do-                  putErrorLn $ "  " ++ show (astToDoc ast)-              _ -> error "cannot happen (TM)"-          warns@(LayoutWarning{}:_) -> do-            putErrorLn $ "WARNINGS:"-            warns `forM_` \case-              LayoutWarning str -> putErrorLn str-              _                 -> error "cannot happen (TM)"-          unused@(ErrorUnusedComment{}:_) -> do-            putErrorLn-              $  "Error: detected unprocessed comments."-              ++ " The transformation output will most likely"-              ++ " not contain some of the comments"-              ++ " present in the input haskell source file."-            putErrorLn $ "Affected are the following comments:"-            unused `forM_` \case-              ErrorUnusedComment str -> putErrorLn str-              _                      -> error "cannot happen (TM)"-          (ErrorMacroConfig err input:_) -> do-            putErrorLn-              $  "Error: parse error in inline configuration:"-            putErrorLn err-            putErrorLn $ "  in the string \"" ++ input ++ "\"."-          [] -> error "cannot happen"-      -- TODO: don't output anything when there are errors unless user-      -- adds some override?-      let hasErrors = case config & _conf_errorHandling & _econf_Werror & confUnpack of-            False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)-            True  -> not $ null errsWarns-          outputOnErrs = config & _conf_errorHandling & _econf_produceOutputOnErrors & confUnpack+              out' <- if moduleConf & _conf_obfuscate & confUnpack+                then lift $ obfuscate out+                else pure out+              pure $ (ews, out')+        let customErrOrder ErrorInput{}         = 4+            customErrOrder LayoutWarning{}      = 0 :: Int+            customErrOrder ErrorOutputCheck{}   = 1+            customErrOrder ErrorUnusedComment{} = 2+            customErrOrder ErrorUnknownNode{}   = 3+            customErrOrder ErrorMacroConfig{}   = 5+        when (not $ null errsWarns) $ do+          let groupedErrsWarns =+                Data.List.Extra.groupOn customErrOrder+                  $ List.sortOn customErrOrder+                  $ errsWarns+          groupedErrsWarns `forM_` \case+            (ErrorOutputCheck{} : _) -> do+              putErrorLn+                $  "ERROR: brittany pretty printer"+                ++ " returned syntactically invalid result."+            (ErrorInput str : _) -> do+              putErrorLn $ "ERROR: parse error: " ++ str+            uns@(ErrorUnknownNode{} : _) -> do+              putErrorLn $ "ERROR: encountered unknown syntactical constructs:"+              uns `forM_` \case+                ErrorUnknownNode str ast@(L loc _) -> do+                  putErrorLn $ str <> " at " <> showSDocUnsafe (ppr loc)+                  when+                      ( config+                      & _conf_debug+                      & _dconf_dump_ast_unknown+                      & confUnpack+                      )+                    $ do+                        putErrorLn $ "  " ++ show (astToDoc ast)+                _ -> error "cannot happen (TM)"+            warns@(LayoutWarning{} : _) -> do+              putErrorLn $ "WARNINGS:"+              warns `forM_` \case+                LayoutWarning str -> putErrorLn str+                _                 -> error "cannot happen (TM)"+            unused@(ErrorUnusedComment{} : _) -> do+              putErrorLn+                $  "Error: detected unprocessed comments."+                ++ " The transformation output will most likely"+                ++ " not contain some of the comments"+                ++ " present in the input haskell source file."+              putErrorLn $ "Affected are the following comments:"+              unused `forM_` \case+                ErrorUnusedComment str -> putErrorLn str+                _                      -> error "cannot happen (TM)"+            (ErrorMacroConfig err input : _) -> do+              putErrorLn $ "Error: parse error in inline configuration:"+              putErrorLn err+              putErrorLn $ "  in the string \"" ++ input ++ "\"."+            [] -> error "cannot happen"+        -- TODO: don't output anything when there are errors unless user+        -- adds some override?+        let+          hasErrors =+            case config & _conf_errorHandling & _econf_Werror & confUnpack of+              False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)+              True  -> not $ null errsWarns+          outputOnErrs =+            config+              & _conf_errorHandling+              & _econf_produceOutputOnErrors+              & confUnpack           shouldOutput = not suppressOutput && (not hasErrors || outputOnErrs) -      when shouldOutput $ addTraceSep (_conf_debug config) $ case outputPathM of-        Nothing -> liftIO $ Text.IO.putStr $ outSText-        Just p  -> liftIO $ do-          isIdentical <- case inputPathM of-            Nothing   -> pure False-            Just path -> do-              (== outSText) <$> Text.IO.readFile path-              -- The above means we read the file twice, but the-              -- GHC API does not really expose the source it-              -- read. Should be in cache still anyways.-              ---              -- We do not use TextL.IO.readFile because lazy IO is evil.-              -- (not identical -> read is not finished -> handle still open ->-              -- write below crashes - evil.)-          unless isIdentical $ Text.IO.writeFile p $ outSText+        let noChanges = outSText == originalContents+        when shouldOutput+          $ addTraceSep (_conf_debug config)+          $ case outputPathM of+              Nothing -> liftIO $ Text.IO.putStr $ outSText+              Just p  -> liftIO $ do+                let isIdentical = case inputPathM of+                      Nothing -> False+                      Just _  -> noChanges+                unless isIdentical $ Text.IO.writeFile p $ outSText -      when hasErrors $ ExceptT.throwE 70+        when hasErrors $ ExceptT.throwE 70+        return (if noChanges then NoChanges else Changes)  where   addTraceSep conf =     if or

@@ -516,8 +516,61 @@ func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd   , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd) +#test comment-after-then+foo = if True+  then+      -- iiiiii+    "a                                                                         "+  else+    "b                                                                         " +#test comment-after-if-else-do+func = if cond+  then pure 42+  else do+    -- test+    abc +#test nonempty-case-short+func = case x of+  False -> False+  True  -> True++#test nonempty-case-long+func =+  case+      lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+        lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+    of+      False -> False+      True  -> True++#test nonempty-case-long-do+func = do+  case+      lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+        lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+    of+      False -> False+      True  -> True++#test empty-case-short+func = case x of {}++#test empty-case-long+func =+  case+      lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+        lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+    of {}++#test empty-case-long-do+func = do+  case+      lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+        lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+    of {}+ ############################################################################### ############################################################################### ###############################################################################@@ -727,6 +780,9 @@                                                           , T5(T5, t5)                                                           , T6((<|>))                                                           , (+)+                                                          , (:.)+                                                          , (:.)(..)+                                                          , (:.)(T7, (:.), t7)                                                           )  #test hiding@@ -734,6 +790,21 @@ import           Test                                    as T                                                    hiding ( ) +#test import-hiding-many+import           Prelude                                 as X+                                                   hiding ( head+                                                          , init+                                                          , last+                                                          , maximum+                                                          , minimum+                                                          , pred+                                                          , read+                                                          , readFile+                                                          , succ+                                                          , tail+                                                          , undefined+                                                          )+ #test long-module-name-simple import           TestJustShortEnoughModuleNameLikeThisOne ( ) import           TestJustAbitToLongModuleNameLikeThisOneIs@@ -887,3 +958,280 @@  -- Test import           Test                                     ( test )+++###############################################################################+###############################################################################+###############################################################################+#group type synonyms+###############################################################################+###############################################################################+###############################################################################++#test simple-synonym++type MySynonym = String++#test parameterised-synonym++type MySynonym a = [a]++#test long-function-synonym++-- | Important comment thrown in+type MySynonym b a+  = MySynonym a b -> MySynonym a b -> MyParamType a b -> MyParamType a b++#test overflowing-function-synonym++type MySynonym3 b a+  =  MySynonym a b+  -> MySynonym a b+  -- ^ RandomComment+  -> MyParamType a b+  -> MyParamType a b+  -> MySynonym2 b a++#test synonym-with-kind-sig++type MySynonym (a :: * -> *)+  =  MySynonym a b+  -> MySynonym a b+  -> MyParamType a b+  -> MyParamType a b+  -> MySynonym2 b a++#test synonym-with-constraint++type MySynonym a = Num a => a -> Int++#test synonym-overflowing-with-constraint++type MySynonym a+  =  Num a+  => AReallyLongTypeName+  -> AnotherReallyLongTypeName+  -> AThirdTypeNameToOverflow++#test synonym-forall++{-# LANGUAGE RankNTypes #-}++type MySynonym = forall a . [a]++#test synonym-operator++type (:+:) a b = (a, b)++#test synonym-infix++type a `MySynonym` b = a -> b++#test synonym-infix-operator++type a :+: b = (a, b)++#test synonym-infix-parens++type (a `Foo` b) c = (a, b, c)++#test synonym-comments++type Foo a -- fancy type comment+  = -- strange comment+    Int++#test synonym-type-operators+#pending++type (a :+: b) = (a, b)++#test synonym-multi-parens+#pending++type ((a :+: b) c) = (a, c)+++###############################################################################+###############################################################################+###############################################################################+#group class.instance+###############################################################################+###############################################################################+###############################################################################++#test simple-instance++instance MyClass Int where+  myMethod x = x + 1++#test simple-method-signature++instance MyClass Int where+  myMethod :: Int -> Int+  myMethod x = x + 1++#test simple-long-method-signature++instance MyClass Int where+  myMethod+    :: Int+    -> Int+    -> AReallyLongType+    -> AReallyLongType+    -> AReallyLongType+    -> Int+  myMethod x = x + 1++#test simple-two-methods++instance MyClass Int where+  myMethod x = x + 1+  myMethod2 x = x + 1++#test simple-two-signatures++instance MyClass Int where+  myMethod+    :: Int+    -> Int+    -> AReallyLongType+    -> AReallyLongType+    -> AReallyLongType+    -> Int+  myMethod x = x + 1++  myMethod2 :: Int -> Int+  myMethod2 x = x + 1++#test simple-instance-comment++-- | This instance should be commented on+instance MyClass Int where++  -- | This method is also comment-worthy+  myMethod x = x + 1++#test instance-with-type-family++instance MyClass Int where+  type MyType = Int++  myMethod :: MyType -> Int+  myMethod x = x + 1++#test instance-with-type-family-below-method++instance MyClass Int where++  type MyType = String++  myMethod :: MyType -> Int+  myMethod x = x + 1++  type MyType = Int++#test instance-with-data-family++instance MyClass Int where++  -- | This data is very important+  data MyData = IntData+    { intData  :: String+    , intData2 :: Int+    }++  myMethod :: MyData -> Int+  myMethod = intData2++#test instance-with-data-family-below-method++instance MyClass Int where+  -- | This data is important+  data MyData = Test Int Int++  myMethod :: MyData -> Int+  myMethod = intData2++  -- | This data is also important+  data MyData2 = IntData+    { intData  :: String+    -- ^ Interesting field+    , intData2 :: Int+    }+++###############################################################################+###############################################################################+###############################################################################+#group whitespace-newlines+###############################################################################+###############################################################################+###############################################################################++#test module-import-newlines++module Main where++import           Prelude++firstDecl = True++#test function-where-newlines++func = do++  -- complex first step+  aaa++  -- complex second step+  bbb++ where++  helper :: Helper+  helper = helpful++  other :: Other+  other = True+++###############################################################################+###############################################################################+###############################################################################+#group typefam.instance+###############################################################################+###############################################################################+###############################################################################++#test simple-typefam-instance++type instance MyFam Bool = String++#test simple-typefam-instance-param-type++type instance MyFam (Maybe a) = a -> Bool++#test simple-typefam-instance-parens++type instance (MyFam (String -> Int)) = String++#test simple-typefam-instance-overflow++type instance MyFam ALongishType+  =  AMuchLongerTypeThanThat+  -> AnEvenLongerTypeThanTheLastOne+  -> ShouldDefinitelyOverflow++#test simple-typefam-instance-comments++-- | A happy family+type instance MyFam Bool -- This is an odd one+  = AnotherType -- Here's another++#test simple-typefam-instance-parens-comment++-- | A happy family+type instance (MyFam Bool) -- This is an odd one+  = -- Here's another+    AnotherType

@@ -66,3 +66,67 @@       b <- g a   return (a, b) +###############################################################################+## ExplicitNamespaces + PatternSynonyms+#test explicitnamespaces_patternsynonyms export+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE PatternSynonyms #-}+module Test (type (++), (++), pattern Foo) where++#test explicitnamespaces_patternsynonyms import+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE PatternSynonyms #-}+import           Test                                     ( type (++)+                                                          , (++)+                                                          , pattern Foo+                                                          , pattern (:.)+                                                          )++###############################################################################+## UnboxedTuples + MagicHash+#test unboxed-tuple and vanilla names+{-# LANGUAGE UnboxedTuples #-}+spanKey :: (# Int, Int #) -> (# Int, Int #)+spanKey = case foo of+  (# bar, baz #) -> (# baz, bar #)++#test unboxed-tuple and hashed name+{-# LANGUAGE MagicHash, UnboxedTuples #-}+spanKey :: (# Int#, Int# #) -> (# Int#, Int# #)+spanKey = case foo of+  (# bar#, baz# #) -> (# baz# +# bar#, bar# #)+++###############################################################################+## QuasiQuotes+#test quasi-quotes simple 1+{-# LANGUAGE QuasiQuotes #-}+func = [blub|+  asd+  qwe+  |]++#test quasi-quotes simple 2+{-# LANGUAGE QuasiQuotes #-}+func = [blub|+        asd+  qwe|]++#test quasi-quotes ignoring layouting+{-# LANGUAGE QuasiQuotes #-}+func = do+  let body = [json|+  hello+  |]+  pure True++#test quasi-quotes ignoring layouting, strict mode+-- brittany { lconfig_allowHangingQuasiQuotes: False }+{-# LANGUAGE QuasiQuotes #-}+func = do+  let+    body =+      [json|+  hello+  |]+  pure True

@@ -43,7 +43,7 @@     }  #test record construction 1-func = Foo {_lstate_indent = _lstate_indent state}+func = Foo { _lstate_indent = _lstate_indent state }  #test record construction 2 func = Foo@@ -53,10 +53,9 @@  #test record construction 3 func = do-  Foo-    { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-    , _lstate_foo    = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-    }+  Foo { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+      , _lstate_foo    = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+      }  #test post-indent comment func = do@@ -478,17 +477,17 @@ #test issue 52 a  {-# LANGUAGE RecordWildCards #-}-v = A {a = 1, ..} where b = 2+v = A { a = 1, .. } where b = 2  #test issue 52 b  {-# LANGUAGE RecordWildCards #-}-v = A {..} where b = 2+v = A { .. } where b = 2  #test issue 52 c  {-# LANGUAGE RecordWildCards #-}-v = A {a = 1, b = 2, c = 3}+v = A { a = 1, b = 2, c = 3 }  #test issue 63 a #pending fix does not work on 8.0.2@@ -608,6 +607,64 @@ go _ ((_, IRTypeError ps t1 t2) : _) = Left $ makeError ps t1 t2  #test issue 89 - type-family-instance- type instance (XPure StageParse) = () type Pair a = (a, a)++#test issue 144+-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }+dsfnjKeekbwwbosbOfakxqRsiyix cnehokzozwbVaguvu migbnaRwutbz =+    let+        eyuAfrarIso'+            :: (RveoexdxunuAafalm -> Axlau (Axlau (a, OinejrdCplle)))+            -> Gbodoy+            -> Axlau (Axlau OinejrdCplle, Gbodoy)+        eyuAfrarIso' = ulcPaaekBst cnehokzozwbVaguvu+        amkgoxEhalazJjxunecCuIfaw+            :: Axlau (Axlau OinejrdCplle, Gbodoy) -> Axlau RqlnrluYqednbCiggxi+        amkgoxEhalazJjxunecCuIfaw uKqviuBisjtn = do+            (sEmo, quc) <- uKqviuBisjtn+            pure (xoheccewfWoeyiagOkfodiq sEmo quc)+        xoheccewfWoeyiagOkfodiq+            :: Axlau OinejrdCplle -> Gbodoy -> RqlnrluYqednbCiggxi+        xoheccewfWoeyiagOkfodiq sEmo quc = case migbnaRwutbz of+            Afogmf -> xgeqe (OfBkkuih quc) (Ciitog quc) sEmo+    in QabqyilexuiNizzhsQuxxac migbnaRwutbz (hwaTihhjt lhowvscIiozgqe)++#test issue 159+spec = do+  it "creates a snapshot at the given level" . withGraph runDB $ do+    lift $ do+      studentDiagnosticReadingLevel updatedStudent `shouldBe` Just 10 -- x+      elaSnapshotReadingLevel snapshot `shouldBe` 12++#test non-bottom-specialcase-altsearch+jaicyhHumzo btrKpeyiFej mava = do+  m :: VtohxeRgpmgsu <- qloxIfiq mava+  case m of+    ZumnaoFujayerIswadabo kkecm chlixxag -> do+      imomue <- ozisduRaqiseSBAob btrKpeyiFej $ \s ->+        case MizA.pigevo kkecm (_tc_gulawulu s) of+          Ebocaba ->+            ( s { _tc_gulawulu = MizA.jxariu kkecm rwuRqxzhjo (_tc_gulawulu s) }+            , Gtzvonm+            )+          Xcde{} -> (s, Pioemav)+      pure imomue++#test issue 214+-- brittany { lconfig_indentPolicy: IndentPolicyMultiple }+foo = bar+  arg1 -- this is the first argument+  arg2 -- this is the second argument+  arg3 -- this is the third argument, now I'll skip one comment+  arg4+  arg5 -- this is the fifth argument+  arg6 -- this is the sixth argument++#test issue 234++True `nand` True = False+nand _ _         = True++nor False False = True+_ `nor` _       = False

@@ -736,6 +736,22 @@ import Test hiding () import Test as T hiding () +#test import-hiding-many+import Prelude as X+  hiding+    ( head+    , init+    , last+    , maximum+    , minimum+    , pred+    , read+    , readFile+    , succ+    , tail+    , undefined+    )+ #test long-module-name-simple import TestJustShortEnoughModuleNameLikeThisOne () import TestJustAbitToLongModuleNameLikeThisOneIs ()@@ -931,7 +947,7 @@     }  #test record construction 1-func = Foo {_lstate_indent = _lstate_indent state}+func = Foo { _lstate_indent = _lstate_indent state }  #test record construction 2 func = Foo@@ -1361,6 +1377,22 @@     a = b @1     cccc = ()   in foo++#test issue 176++record :: Record+record = Record+  { rProperties =+    [ "foo" .= "bar"+    , "foo" .= "bar"+    , "foo" .= "bar"+    , "foo" .= "bar"+    , "foo" .= "bar"+    , "foo" .= "bar"+    , "foo" .= "bar"+    , "foo" .= "bar"+    ]+  }   ###############################################################################

@@ -1,12 +1,13 @@ {-# LANGUAGE QuasiQuotes #-} -module Main where+module Main (main) where    #include "prelude.inc"  import Test.Hspec+import Test.Hspec.Runner ( hspecWith, defaultConfig, configConcurrentJobs )  import NeatInterpolation @@ -177,6 +178,7 @@     , _lconfig_hangingTypeSignature      = coerce False     , _lconfig_reformatModulePreamble    = coerce True     , _lconfig_allowSingleLineExportList = coerce True+    , _lconfig_allowHangingQuasiQuotes   = coerce True     }   , _conf_errorHandling             = (_conf_errorHandling staticDefaultConfig)     { _econf_omit_output_valid_check = coerce True

@@ -59,6 +59,7 @@     , _lconfig_hangingTypeSignature      = coerce False     , _lconfig_reformatModulePreamble    = coerce True     , _lconfig_allowSingleLineExportList = coerce True+    , _lconfig_allowHangingQuasiQuotes   = coerce True     }   , _conf_errorHandling             = (_conf_errorHandling staticDefaultConfig)     { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever

@@ -17,8 +17,9 @@  #include "prelude.inc" -import qualified Language.Haskell.GHC.ExactPrint as ExactPrint-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint+-- brittany { lconfig_importAsColumn: 60, lconfig_importColumn: 60 }+import qualified Language.Haskell.GHC.ExactPrint         as ExactPrint+import qualified Language.Haskell.GHC.ExactPrint.Types   as ExactPrint import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers  import           Data.Data@@ -27,9 +28,9 @@ import qualified Data.Yaml import qualified Data.ByteString.Char8 import           Data.CZipWith-import qualified UI.Butcher.Monadic as Butcher+import qualified UI.Butcher.Monadic                      as Butcher -import qualified Data.Text.Lazy.Builder as Text.Builder+import qualified Data.Text.Lazy.Builder                  as Text.Builder  import           Language.Haskell.Brittany.Internal.Types import           Language.Haskell.Brittany.Internal.Config.Types@@ -50,15 +51,19 @@ import           Language.Haskell.Brittany.Internal.Transformations.Columns import           Language.Haskell.Brittany.Internal.Transformations.Indent -import qualified GHC as GHC hiding (parseModule)-import           ApiAnnotation ( AnnKeywordId(..) )-import           GHC ( runGhc, GenLocated(L), moduleNameString )-import           SrcLoc ( SrcSpan )+import qualified GHC                                     as GHC+                                                   hiding ( parseModule )+import           ApiAnnotation                            ( AnnKeywordId(..) )+import           GHC                                      ( runGhc+                                                          , GenLocated(L)+                                                          , moduleNameString+                                                          )+import           SrcLoc                                   ( SrcSpan ) import           HsSyn-import qualified DynFlags as GHC-import qualified GHC.LanguageExtensions.Type as GHC+import qualified DynFlags                                as GHC+import qualified GHC.LanguageExtensions.Type             as GHC -import           Data.Char (isSpace)+import           Data.Char                                ( isSpace )   @@ -71,7 +76,7 @@ extractCommentConfigs   :: ExactPrint.Anns   -> TopLevelDeclNameMap-  -> Either (String, String) InlineConfig+  -> Either (String, String) (CConfig Option, PerItemConfig) extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do   let     commentLiness =@@ -117,7 +122,8 @@         , \s -> "{" `isPrefixOf` dropWhile (== ' ') s         , Butcher.addCmdPart (Butcher.varPartDesc "yaml-config-document")         $ fmap (\lconf -> (mempty { _conf_layout = lconf }, ""))-        . Data.Yaml.decode+        . either (\_ -> Nothing) Just+        . Data.Yaml.decodeEither'         . Data.ByteString.Char8.pack           -- TODO: use some proper utf8 encoder instead?         )@@ -200,11 +206,10 @@         _ -> False       ] -  pure $ InlineConfig-    { _icd_perModule  = perModule-    , _icd_perBinding = perBinding-    , _icd_perKey     = perKey-    }+  pure+    $ ( perModule+      , PerItemConfig { _icd_perBinding = perBinding, _icd_perKey = perKey }+      )   getTopLevelDeclNameMap :: GHC.ParsedSource -> TopLevelDeclNameMap@@ -256,17 +261,20 @@     case parseResult of       Left  err -> throwE [ErrorInput err]       Right x   -> pure x-  inlineConf <- either (throwE . (: []) . uncurry ErrorMacroConfig) pure-    $ extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource)+  (inlineConf, perItemConf) <-+    either (throwE . (: []) . uncurry ErrorMacroConfig) pure+      $ extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource)+  let moduleConfig = cZipWith fromOptionIdentity config inlineConf   (errsWarns, outputTextL) <- do     let omitCheck =-          config+          moduleConfig             & _conf_errorHandling             & _econf_omit_output_valid_check             & confUnpack     (ews, outRaw) <- if hasCPP || omitCheck-      then return $ pPrintModule config inlineConf anns parsedSource-      else lift $ pPrintModuleAndCheck config inlineConf anns parsedSource+      then return $ pPrintModule moduleConfig perItemConf anns parsedSource+      else lift+        $ pPrintModuleAndCheck moduleConfig perItemConf anns parsedSource     let hackF s = fromMaybe s           $ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s     pure $ if hackAroundIncludes@@ -284,7 +292,7 @@       customErrOrder ErrorUnknownNode{}   = 3       customErrOrder ErrorMacroConfig{}   = 5   let hasErrors =-        case config & _conf_errorHandling & _econf_Werror & confUnpack of+        case moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack of           False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)           True  -> not $ null errsWarns   if hasErrors then throwE $ errsWarns else pure $ TextL.toStrict outputTextL@@ -297,35 +305,31 @@ -- can occur. pPrintModule   :: Config-  -> InlineConfig+  -> PerItemConfig   -> ExactPrint.Anns   -> GHC.ParsedSource   -> ([BrittanyError], TextL.Text) pPrintModule conf inlineConf anns parsedModule =-  let-    ((out, errs), debugStrings) =-      runIdentity-        $ MultiRWSS.runMultiRWSTNil-        $ MultiRWSS.withMultiWriterAW-        $ MultiRWSS.withMultiWriterAW-        $ MultiRWSS.withMultiWriterW-        $ MultiRWSS.withMultiReader anns-        $ MultiRWSS.withMultiReader conf-        $ MultiRWSS.withMultiReader inlineConf-        $ MultiRWSS.withMultiReader (extractToplevelAnns parsedModule anns)-        $ do-            traceIfDumpConf "bridoc annotations raw" _dconf_dump_annotations-              $ annsDoc anns-            ppModule parsedModule-    tracer =-      if Seq.null debugStrings-      then-        id-      else-        trace ("---- DEBUGMESSAGES ---- ")-          . foldr (seq . join trace) id debugStrings-  in-    tracer $ (errs, Text.Builder.toLazyText out)+  let ((out, errs), debugStrings) =+        runIdentity+          $ MultiRWSS.runMultiRWSTNil+          $ MultiRWSS.withMultiWriterAW+          $ MultiRWSS.withMultiWriterAW+          $ MultiRWSS.withMultiWriterW+          $ MultiRWSS.withMultiReader anns+          $ MultiRWSS.withMultiReader conf+          $ MultiRWSS.withMultiReader inlineConf+          $ MultiRWSS.withMultiReader (extractToplevelAnns parsedModule anns)+          $ do+              traceIfDumpConf "bridoc annotations raw" _dconf_dump_annotations+                $ annsDoc anns+              ppModule parsedModule+      tracer = if Seq.null debugStrings+        then id+        else+          trace ("---- DEBUGMESSAGES ---- ")+            . foldr (seq . join trace) id debugStrings+  in  tracer $ (errs, Text.Builder.toLazyText out)   -- unless () $ do   --   --   debugStrings `forM_` \s ->@@ -335,7 +339,7 @@ -- if it does not. pPrintModuleAndCheck   :: Config-  -> InlineConfig+  -> PerItemConfig   -> ExactPrint.Anns   -> GHC.ParsedSource   -> IO ([BrittanyError], TextL.Text)@@ -361,18 +365,20 @@   case parseResult of     Left  (_   , s           ) -> return $ Left $ "parsing error: " ++ s     Right (anns, parsedModule) -> runExceptT $ do-      inlineConf <-+      (inlineConf, perItemConf) <-         case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of           Left  err -> throwE $ "error in inline config: " ++ show err           Right x   -> pure x+      let moduleConf = cZipWith fromOptionIdentity conf inlineConf       let omitCheck =             conf               &  _conf_errorHandling               .> _econf_omit_output_valid_check               .> confUnpack       (errs, ltext) <- if omitCheck-        then return $ pPrintModule conf inlineConf anns parsedModule-        else lift $ pPrintModuleAndCheck conf inlineConf anns parsedModule+        then return $ pPrintModule moduleConf perItemConf anns parsedModule+        else lift+          $ pPrintModuleAndCheck moduleConf perItemConf anns parsedModule       if null errs         then pure $ TextL.toStrict $ ltext         else@@ -423,7 +429,8 @@  toLocal :: Config -> ExactPrint.Anns -> PPMLocal a -> PPM a toLocal conf anns m = do-  (x, write) <- lift $ MultiRWSS.runMultiRWSTAW (conf :+: anns :+: HNil) HNil $ m+  (x, write) <-+    lift $ MultiRWSS.runMultiRWSTAW (conf :+: anns :+: HNil) HNil $ m   MultiRWSS.mGetRawW >>= \w -> MultiRWSS.mPutRawW (w `mappend` write)   pure x @@ -434,8 +441,7 @@     let declAnnKey       = ExactPrint.mkAnnKey decl     let declBindingNames = getDeclBindingNames decl     inlineConf <- mAsk-    let inlineModConf = _icd_perModule inlineConf-    let mDeclConf     = Map.lookup declAnnKey $ _icd_perKey inlineConf+    let mDeclConf = Map.lookup declAnnKey $ _icd_perKey inlineConf     let mBindingConfs =           declBindingNames <&> \n -> Map.lookup n $ _icd_perBinding inlineConf     filteredAnns <- mAsk@@ -447,8 +453,8 @@      config <- mAsk -    let config' = cZipWith fromOptionIdentity config $ mconcat-          (inlineModConf : (catMaybes (mBindingConfs ++ [mDeclConf])))+    let config' = cZipWith fromOptionIdentity config+          $ mconcat (catMaybes (mBindingConfs ++ [mDeclConf]))      let exactprintOnly = config' & _conf_roundtrip_exactprint_only & confUnpack     toLocal config' filteredAnns $ do@@ -481,16 +487,24 @@   getDeclBindingNames :: LHsDecl GhcPs -> [String]+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */ getDeclBindingNames (L _ decl) = case decl of+  SigD _ (TypeSig _ ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)+  ValD _ (FunBind _ (L _ n) _ _ _) -> [Text.unpack $ rdrNameToText n]+  _                              -> []+#else+getDeclBindingNames (L _ decl) = case decl of   SigD (TypeSig ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)   ValD (FunBind (L _ n) _ _ _ _) -> [Text.unpack $ rdrNameToText n]-  _ -> []+  _                              -> []+#endif   -- Prints the information associated with the module annotation -- This includes the imports-ppPreamble :: GenLocated SrcSpan (HsModule GhcPs)-           -> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)]+ppPreamble+  :: GenLocated SrcSpan (HsModule GhcPs)+  -> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)] ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do   filteredAnns <- mAsk <&> \annMap ->     Map.findWithDefault Map.empty (ExactPrint.mkAnnKey lmod) annMap@@ -548,8 +562,8 @@    if shouldReformatPreamble     then toLocal config filteredAnns' $ withTransformedAnns lmod $ do-        briDoc <- briDocMToPPM $ layoutModule lmod-        layoutBriDoc briDoc+      briDoc <- briDocMToPPM $ layoutModule lmod+      layoutBriDoc briDoc     else       let emptyModule = L loc m { hsmodDecls = [] }       in  MultiRWSS.withMultiReader filteredAnns' $ processDefault emptyModule@@ -557,22 +571,33 @@  _sigHead :: Sig GhcPs -> String _sigHead = \case+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  TypeSig _ names _ ->+#else   TypeSig names _ ->+#endif     "TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names)   _ -> "unknown sig"  _bindHead :: HsBind GhcPs -> String+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */ _bindHead = \case+  FunBind _ fId _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)+  PatBind _ _pat _ ([], []) -> "PatBind smth"+  _                           -> "unknown bind"+#else+_bindHead = \case   FunBind fId _ _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)   PatBind _pat _ _ _ ([], []) -> "PatBind smth"-  _ -> "unknown bind"+  _                           -> "unknown bind"+#endif    layoutBriDoc :: BriDocNumbered -> PPMLocal () layoutBriDoc briDoc = do   -- first step: transform the briDoc.-  briDoc'                       <- MultiRWSS.withMultiStateS BDEmpty $ do+  briDoc' <- MultiRWSS.withMultiStateS BDEmpty $ do     -- Note that briDoc is BriDocNumbered, but state type is BriDoc.     -- That's why the alt-transform looks a bit special here.     traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw@@ -581,26 +606,33 @@       $ briDoc     -- bridoc transformation: remove alts     transformAlts briDoc >>= mSet-    mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-alt"-                                            _dconf_dump_bridoc_simpl_alt+    mGet+      >>= briDocToDoc+      .>  traceIfDumpConf "bridoc post-alt" _dconf_dump_bridoc_simpl_alt     -- bridoc transformation: float stuff in     mGet >>= transformSimplifyFloating .> mSet-    mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-floating"-                                            _dconf_dump_bridoc_simpl_floating+    mGet+      >>= briDocToDoc+      .>  traceIfDumpConf "bridoc post-floating"+                          _dconf_dump_bridoc_simpl_floating     -- bridoc transformation: par removal     mGet >>= transformSimplifyPar .> mSet-    mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-par"-                                            _dconf_dump_bridoc_simpl_par+    mGet+      >>= briDocToDoc+      .>  traceIfDumpConf "bridoc post-par" _dconf_dump_bridoc_simpl_par     -- bridoc transformation: float stuff in     mGet >>= transformSimplifyColumns .> mSet-    mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-columns"-                                            _dconf_dump_bridoc_simpl_columns+    mGet+      >>= briDocToDoc+      .>  traceIfDumpConf "bridoc post-columns" _dconf_dump_bridoc_simpl_columns     -- bridoc transformation: indent     mGet >>= transformSimplifyIndent .> mSet-    mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-indent"-                                            _dconf_dump_bridoc_simpl_indent-    mGet >>= briDocToDoc .> traceIfDumpConf "bridoc final"-                                            _dconf_dump_bridoc_final+    mGet+      >>= briDocToDoc+      .>  traceIfDumpConf "bridoc post-indent" _dconf_dump_bridoc_simpl_indent+    mGet+      >>= briDocToDoc+      .>  traceIfDumpConf "bridoc final" _dconf_dump_bridoc_final     -- -- convert to Simple type     -- simpl <- mGet <&> transformToSimple     -- return simpl@@ -625,6 +657,6 @@   let remainingComments =         extractAllComments =<< Map.elems (_lstate_comments state')   remainingComments-    `forM_` (fst .> show .> ErrorUnusedComment .> (:[]) .> mTell)+    `forM_` (fst .> show .> ErrorUnusedComment .> (: []) .> mTell)    return $ ()

@@ -19,6 +19,8 @@ import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types import           Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation ) +import GHC ( AnnKeywordId (..) )+ import           Language.Haskell.Brittany.Internal.LayouterBasics import           Language.Haskell.Brittany.Internal.BackendUtils import           Language.Haskell.Brittany.Internal.Utils@@ -149,6 +151,8 @@       mSet $ state         { _lstate_comments = Map.filterWithKey filterF $ _lstate_comments state         }+  BDPlain t -> do+    layoutWriteAppend t   BDAnnotationPrior annKey bd -> do     state <- mGet     let m = _lstate_comments state@@ -170,9 +174,13 @@         priors           `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->                     do-                      -- evil hack for CPP:                       case comment of                         ('#':_) -> layoutMoveToCommentPos y (-999)+                                   --  ^ evil hack for CPP+                        "("     -> pure ()+                        ")"     -> pure ()+                                   --  ^ these two fix the formatting of parens+                                   -- on the lhs of type alias defs                         _       -> layoutMoveToCommentPos y x                       -- fixedX <- fixMoveToLineByIsNewline x                       -- replicateM_ fixedX layoutWriteNewline@@ -229,7 +237,10 @@         { _lstate_comments = Map.adjust           ( \ann -> ann { ExactPrint.annFollowingComments = []                         , ExactPrint.annPriorComments     = []-                        , ExactPrint.annsDP               = []+                        , ExactPrint.annsDP               =+                          flip filter (ExactPrint.annsDP ann) $ \case+                            (ExactPrint.Types.AnnComment{}, _) -> False+                            _                                  -> True                         }           )           annKey@@ -241,16 +252,19 @@       Just comments -> do         comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->           do-      -- evil hack for CPP:             case comment of               ('#':_) -> layoutMoveToCommentPos y (-999)+                         --  ^ evil hack for CPP+              ")"     -> pure ()+                         --  ^ fixes the formatting of parens+                         --    on the lhs of type alias defs               _       -> layoutMoveToCommentPos y x             -- fixedX <- fixMoveToLineByIsNewline x             -- replicateM_ fixedX layoutWriteNewline             -- layoutMoveToIndentCol y             layoutWriteAppendMultiline $ Text.pack $ comment       -- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }-  BDMoveToKWDP annKey keyword bd -> do+  BDMoveToKWDP annKey keyword shouldRestoreIndent bd -> do     mDP <- do       state <- mGet       let m    = _lstate_comments state@@ -260,12 +274,14 @@                      , (ExactPrint.Types.G kw1, dp) <- ann                      , keyword == kw1                      ]+      -- mTell $ Seq.fromList ["KWDP: " ++ show annKey ++ " " ++ show mAnn]       pure $ case relevant of         [] -> Nothing         (dp:_) -> Just dp     case mDP of-      Nothing                           -> pure ()-      Just (ExactPrint.Types.DP (y, x)) -> layoutMoveToCommentPos y x+      Nothing -> pure ()+      Just (ExactPrint.Types.DP (y, x)) ->+        layoutMoveToCommentPos y (if shouldRestoreIndent then x else 0)     layoutBriDocM bd   BDNonBottomSpacing bd -> layoutBriDocM bd   BDSetParSpacing    bd -> layoutBriDocM bd@@ -296,10 +312,11 @@     BDForceSingleline bd    -> rec bd     BDForwardLineMode bd    -> rec bd     BDExternal _ _ _ t      -> return $ Text.length t+    BDPlain t               -> return $ Text.length t     BDAnnotationPrior _ bd  -> rec bd     BDAnnotationKW _ _ bd   -> rec bd     BDAnnotationRest _ bd   -> rec bd-    BDMoveToKWDP _ _ bd     -> rec bd+    BDMoveToKWDP _ _ _ bd   -> rec bd     BDLines ls@(_:_)        -> do       x <- StateS.get       return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x@@ -315,35 +332,37 @@  where   rec :: BriDoc -> Bool   rec = \case-    BDEmpty                 -> False-    BDLit _                 -> False-    BDSeq bds               -> any rec bds-    BDCols _ bds            -> any rec bds-    BDSeparator             -> False-    BDAddBaseY _ bd         -> rec bd-    BDBaseYPushCur       bd -> rec bd-    BDBaseYPop           bd -> rec bd-    BDIndentLevelPushCur bd -> rec bd-    BDIndentLevelPop     bd -> rec bd-    BDPar _ _ _             -> True-    BDAlt{}                 -> error "briDocIsMultiLine BDAlt"-    BDForceMultiline  _     -> True-    BDForceSingleline bd    -> rec bd-    BDForwardLineMode bd    -> rec bd+    BDEmpty                                  -> False+    BDLit _                                  -> False+    BDSeq bds                                -> any rec bds+    BDCols _ bds                             -> any rec bds+    BDSeparator                              -> False+    BDAddBaseY _ bd                          -> rec bd+    BDBaseYPushCur       bd                  -> rec bd+    BDBaseYPop           bd                  -> rec bd+    BDIndentLevelPushCur bd                  -> rec bd+    BDIndentLevelPop     bd                  -> rec bd+    BDPar _ _ _                              -> True+    BDAlt{}                                  -> error "briDocIsMultiLine BDAlt"+    BDForceMultiline  _                      -> True+    BDForceSingleline bd                     -> rec bd+    BDForwardLineMode bd                     -> rec bd     BDExternal _ _ _ t | [_] <- Text.lines t -> False-    BDExternal _ _ _ _      -> True-    BDAnnotationPrior _ bd  -> rec bd-    BDAnnotationKW _ _ bd   -> rec bd-    BDAnnotationRest _ bd   -> rec bd-    BDMoveToKWDP _ _ bd     -> rec bd-    BDLines (_:_:_)         -> True-    BDLines [_    ]         -> False-    BDLines []              -> error "briDocIsMultiLine BDLines []"-    BDEnsureIndent _ bd     -> rec bd-    BDSetParSpacing    bd   -> rec bd-    BDForceParSpacing  bd   -> rec bd-    BDNonBottomSpacing bd   -> rec bd-    BDDebug _ bd            -> rec bd+    BDExternal _ _ _ _                       -> True+    BDPlain t | [_] <- Text.lines t          -> False+    BDPlain _                                -> True+    BDAnnotationPrior _ bd                   -> rec bd+    BDAnnotationKW _ _ bd                    -> rec bd+    BDAnnotationRest _ bd                    -> rec bd+    BDMoveToKWDP _ _ _ bd                    -> rec bd+    BDLines (_ : _ : _)                      -> True+    BDLines [_        ]                      -> False+    BDLines [] -> error "briDocIsMultiLine BDLines []"+    BDEnsureIndent _ bd                      -> rec bd+    BDSetParSpacing    bd                    -> rec bd+    BDForceParSpacing  bd                    -> rec bd+    BDNonBottomSpacing bd                    -> rec bd+    BDDebug _ bd                             -> rec bd  -- In theory -- =========@@ -527,7 +546,7 @@           (BDCols ColGuardedBody        _) -> True           (BDCols ColBindStmt           _) -> True           (BDCols ColDoLet              _) -> True-          (BDCols ColRecUpdate          _) -> False+          (BDCols ColRec                _) -> False           (BDCols ColListComp           _) -> False           (BDCols ColList               _) -> False           (BDCols ColApp{}              _) -> True

@@ -188,19 +188,20 @@     { _lstate_curYOrAddNewline = case _lstate_curYOrAddNewline state of       Left i  -> if y == 0 then Left i else Right y       Right{} -> Right y-    , _lstate_addSepSpace      = if Data.Maybe.isJust (_lstate_commentCol state)-      then Just $ case _lstate_curYOrAddNewline state of-        Left{}  -> if y == 0 then x else _lstate_indLevelLinger state + x-        Right{} -> _lstate_indLevelLinger state + x-      else Just $ if y == 0 then x else _lstate_indLevelLinger state + x-    , _lstate_commentCol       = Just $ case _lstate_commentCol state of-      Just existing -> existing-      Nothing       -> case _lstate_curYOrAddNewline state of-        Left i  -> i + fromMaybe 0 (_lstate_addSepSpace state)-        Right{} -> lstate_baseY state+    , _lstate_addSepSpace      =+      Just $ if Data.Maybe.isJust (_lstate_commentCol state)+        then case _lstate_curYOrAddNewline state of+          Left{}  -> if y == 0 then x else _lstate_indLevelLinger state + x+          Right{} -> _lstate_indLevelLinger state + x+        else if y == 0 then x else _lstate_indLevelLinger state + x+    , _lstate_commentCol       =+      Just $ case _lstate_commentCol state of+        Just existing -> existing+        Nothing -> case _lstate_curYOrAddNewline state of+          Left i  -> i + fromMaybe 0 (_lstate_addSepSpace state)+          Right{} -> lstate_baseY state     } - -- | does _not_ add spaces to again reach the current base column. layoutWriteNewline   :: ( MonadMultiWriter Text.Builder.Builder m@@ -416,13 +417,11 @@         (Right{}, Just j ) -> j         (Right{}, Nothing) -> 0   layoutIndentLevelPushInternal y-  layoutBaseYPushInternal y  layoutIndentLevelPop   :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m () layoutIndentLevelPop = do   traceLocal ("layoutIndentLevelPop")-  layoutBaseYPopInternal   layoutIndentLevelPopInternal   -- why are comment indentations relative to the previous indentation on   -- the first node of an additional indentation, and relative to the outer

@@ -75,6 +75,7 @@     , _lconfig_hangingTypeSignature      = coerce False     , _lconfig_reformatModulePreamble    = coerce True     , _lconfig_allowSingleLineExportList = coerce False+    , _lconfig_allowHangingQuasiQuotes   = coerce True     }   , _conf_errorHandling = ErrorHandlingConfig     { _econf_produceOutputOnErrors   = coerce False@@ -177,6 +178,7 @@       , _lconfig_hangingTypeSignature      = mempty       , _lconfig_reformatModulePreamble    = mempty       , _lconfig_allowSingleLineExportList = mempty+      , _lconfig_allowHangingQuasiQuotes   = mempty       }     , _conf_errorHandling = ErrorHandlingConfig       { _econf_produceOutputOnErrors   = wrapLast $ falseToNothing outputOnErrors@@ -231,18 +233,19 @@ readConfig   :: MonadIO m => System.IO.FilePath -> MaybeT m (Maybe (CConfig Option)) readConfig path = do+  -- TODO: probably should catch IOErrors and then omit the existence check.   exists <- liftIO $ System.Directory.doesFileExist path   if exists     then do       contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.-      fileConf <- case Data.Yaml.decodeEither contents of+      fileConf <- case Data.Yaml.decodeEither' contents of         Left e -> do           liftIO             $  putStrErrLn             $  "error reading in brittany config from "             ++ path             ++ ":"-          liftIO $ putStrErrLn e+          liftIO $ putStrErrLn (Data.Yaml.prettyPrintParseException e)           mzero         Right x -> return x       return $ Just fileConf

@@ -109,6 +109,24 @@     -- >   , def     -- >   )     -- > where+  , _lconfig_allowHangingQuasiQuotes :: f (Last Bool)+    -- if false, the layouter sees any splices as infinitely big and places+    -- them accordingly (in newlines, most likely); This also influences+    -- parent nodes.+    -- if true, the layouter is free to start a quasi-quotation at the end+    -- of a line.+    --+    -- false:+    -- > let+    -- >   body =+    -- >     [json|+    -- >     hello+    -- >     |]+    --+    -- true:+    -- > let body = [json|+    -- >     hello+    -- >     |]   }   deriving (Generic) 

@@ -70,8 +70,14 @@ parseModuleWithCpp cpp opts args fp dynCheck =   ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do     dflags0                       <- lift $ GHC.getSessionDynFlags-    (dflags1, leftover, warnings) <- lift-      $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args)+    (dflags1, leftover, warnings) <- lift $ GHC.parseDynamicFlagsCmdLine+      dflags0+      (GHC.noLoc <$> ("-hide-all-packages" : args))+      -- that we pass -hide-all-packages here is a duplication, because+      -- ExactPrint.initDynFlags also does it, but necessary because of+      -- stupid and careless GHC API design. We explicitly want to pass+      -- our args before calling that, so this is what we do. Should be+      -- harmless. See commit 1b7576dcd1823e1c685a44927b1fcaade1319063.     void $ lift $ GHC.setSessionDynFlags dflags1     dflags2 <- lift $ ExactPrint.initDynFlags fp     when (not $ null leftover)@@ -191,9 +197,17 @@   genF = (\_ -> return ()) `SYB.extQ` exprF   exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform ()   exprF lexpr@(L _ expr) = case expr of-    RecordCon _lname _ _ (HsRecFields fs@(_:_) Nothing) ->+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    RecordCon _ _ (HsRecFields fs@(_:_) Nothing) ->+#else+    RecordCon _ _ _ (HsRecFields fs@(_:_) Nothing) ->+#endif       moveTrailingComments lexpr (List.last fs)-    RecordUpd _lname fs@(_:_) _ _ _ _ ->+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    RecordUpd _ _e fs@(_:_) ->+#else+    RecordUpd _e fs@(_:_) _cons _ _ _ ->+#endif       moveTrailingComments lexpr (List.last fs)     _ -> return () @@ -274,13 +288,13 @@   => ast   -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a   -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a-withTransformedAnns ast m = do-  -- TODO: implement `local` for MultiReader/MultiRWS-  readers@(conf :+: anns :+: HNil) <- MultiRWSS.mGetRawR-  MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)-  x <- m-  MultiRWSS.mPutRawR readers-  pure x+withTransformedAnns ast m = MultiRWSS.mGetRawR >>= \case+  readers@(conf :+: anns :+: HNil) -> do+    -- TODO: implement `local` for MultiReader/MultiRWS+    MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)+    x <- m+    MultiRWSS.mPutRawR readers+    pure x  where   f anns =     let ((), (annsBalanced, _), _) =

@@ -9,6 +9,7 @@   , lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick   , askIndent   , extractAllComments+  , extractRestComments   , filterAnns   , docEmpty   , docLit@@ -50,13 +51,23 @@   , appSep   , docCommaSep   , docParenLSep+  , docParenL   , docParenR+  , docParenHashLSep+  , docParenHashRSep+  , docBracketL+  , docBracketR   , docTick   , spacifyDocs   , briDocMToPPM   , allocateNode   , docSharedWrapper   , hasAnyCommentsBelow+  , hasAnyCommentsConnected+  , hasAnyCommentsPrior+  , hasAnyRegularCommentsConnected+  , hasAnyRegularCommentsRest+  , hasAnnKeywordComment   , hasAnnKeyword   ) where@@ -255,9 +266,13 @@ extractAllComments   :: ExactPrint.Annotation -> [(ExactPrint.Comment, ExactPrint.DeltaPos)] extractAllComments ann =-  ExactPrint.annPriorComments ann-    ++ ExactPrint.annFollowingComments ann-    ++ ( ExactPrint.annsDP ann >>= \case+  ExactPrint.annPriorComments ann ++ extractRestComments ann++extractRestComments+  :: ExactPrint.Annotation -> [(ExactPrint.Comment, ExactPrint.DeltaPos)]+extractRestComments ann =+  ExactPrint.annFollowingComments ann+    ++ (ExactPrint.annsDP ann >>= \case          (ExactPrint.AnnComment com, dp) -> [(com, dp)]          _                               -> []        )@@ -266,28 +281,80 @@ filterAnns ast =   Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast) +-- | True if there are any comments that are+-- a) connected to any node below (in AST sense) the given node AND+-- b) after (in source code order) the node. hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool-hasAnyCommentsBelow ast@(L l _) = do+hasAnyCommentsBelow ast@(L l _) =+  List.any (\(c, _) -> ExactPrint.commentIdentifier c > l)+    <$> astConnectedComments ast++-- | True if there are any comments that are connected to any node below (in AST+--   sense) the given node+hasAnyCommentsConnected :: Data ast => GHC.Located ast -> ToBriDocM Bool+hasAnyCommentsConnected ast = not . null <$> astConnectedComments ast++-- | True if there are any regular comments connected to any node below (in AST+--   sense) the given node+hasAnyRegularCommentsConnected :: Data ast => GHC.Located ast -> ToBriDocM Bool+hasAnyRegularCommentsConnected ast =+  any isRegularComment <$> astConnectedComments ast++-- | Regular comments are comments that are actually "source code comments",+-- i.e. things that start with "--" or "{-". In contrast to comment-annotations+-- used by ghc-exactprint for capturing symbols (and their exact positioning).+--+-- Only the type instance layouter makes use of this filter currently, but+-- it might make sense to apply it more aggressively or make it the default -+-- I believe that most of the time we branch on the existence of comments, we+-- only care about "regular" comments. We simply did not need the distinction+-- because "irregular" comments are not that common outside of type/data decls.+isRegularComment :: (ExactPrint.Comment, ExactPrint.DeltaPos) -> Bool+isRegularComment = (== Nothing) . ExactPrint.Types.commentOrigin . fst++astConnectedComments+  :: Data ast+  => GHC.Located ast+  -> ToBriDocM [(ExactPrint.Types.Comment, ExactPrint.Types.DeltaPos)]+astConnectedComments ast = do   anns <- filterAnns ast <$> mAsk-  return-    $ List.any (\(c, _) -> ExactPrint.commentIdentifier c > l)-    $ (=<<) extractAllComments-    $ Map.elems-    $ anns+  pure $ extractAllComments =<< Map.elems anns +hasAnyCommentsPrior :: Data ast => GHC.Located ast -> ToBriDocM Bool+hasAnyCommentsPrior ast = astAnn ast <&> \case+  Nothing -> False+  Just (ExactPrint.Types.Ann _ priors _ _ _ _) -> not $ null priors++hasAnyRegularCommentsRest :: Data ast => GHC.Located ast -> ToBriDocM Bool+hasAnyRegularCommentsRest ast = astAnn ast <&> \case+  Nothing -> False+  Just ann -> any isRegularComment (extractRestComments ann)++hasAnnKeywordComment+  :: Data ast => GHC.Located ast -> AnnKeywordId -> ToBriDocM Bool+hasAnnKeywordComment ast annKeyword = astAnn ast <&> \case+  Nothing  -> False+  Just ann -> any hasK (extractAllComments ann)+  where hasK = (== Just annKeyword) . ExactPrint.Types.commentOrigin . fst+ hasAnnKeyword   :: (Data a, MonadMultiReader (Map AnnKey Annotation) m)   => Located a   -> AnnKeywordId   -> m Bool-hasAnnKeyword ast annKeyword = do-  anns <- mAsk-  let hasK (ExactPrint.Types.G x, _) = x == annKeyword-      hasK _                         = False-  pure $ case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of-    Nothing -> False-    Just (ExactPrint.Types.Ann _ _ _ aks _ _) -> any hasK aks+hasAnnKeyword ast annKeyword = astAnn ast <&> \case+  Nothing -> False+  Just (ExactPrint.Types.Ann _ _ _ aks _ _) -> any hasK aks+ where+  hasK (ExactPrint.Types.G x, _) = x == annKeyword+  hasK _                         = False +astAnn+  :: (Data ast, MonadMultiReader (Map AnnKey Annotation) m)+  => GHC.Located ast+  -> m (Maybe Annotation)+astAnn ast = Map.lookup (ExactPrint.Types.mkAnnKey ast) <$> mAsk+ -- new BriDoc stuff  allocateNode@@ -487,9 +554,11 @@ docMoveToKWDP   :: AnnKey   -> AnnKeywordId+  -> Bool   -> ToBriDocM BriDocNumbered   -> ToBriDocM BriDocNumbered-docMoveToKWDP annKey kw bdm = allocateNode . BDFMoveToKWDP annKey kw =<< bdm+docMoveToKWDP annKey kw shouldRestoreIndent bdm =+  allocateNode . BDFMoveToKWDP annKey kw shouldRestoreIndent =<< bdm  docAnnotationRest   :: AnnKey -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered@@ -514,11 +583,33 @@ docCommaSep = appSep $ docLit $ Text.pack ","  docParenLSep :: ToBriDocM BriDocNumbered-docParenLSep = appSep $ docLit $ Text.pack "("+docParenLSep = appSep docParenL +-- TODO: we don't make consistent use of these (yet). However, I think the+-- most readable approach overall might be something else: define+-- `lit = docLit . Text.pack` and `prepSep = docSeq [docSeparator, x]`.+-- I think those two would make the usage most readable.+-- lit "("  and  appSep (lit "(")  are understandable and short without+-- introducing a new top-level binding for all types of parentheses.+docParenL :: ToBriDocM BriDocNumbered+docParenL = docLit $ Text.pack "("+ docParenR :: ToBriDocM BriDocNumbered docParenR = docLit $ Text.pack ")" +docParenHashLSep :: ToBriDocM BriDocNumbered+docParenHashLSep =  docSeq [docLit $ Text.pack "(#", docSeparator]++docParenHashRSep :: ToBriDocM BriDocNumbered+docParenHashRSep = docSeq [docSeparator, docLit $ Text.pack "#)"]++docBracketL :: ToBriDocM BriDocNumbered+docBracketL = docLit $ Text.pack "["++docBracketR :: ToBriDocM BriDocNumbered+docBracketR = docLit $ Text.pack "]"++ docTick :: ToBriDocM BriDocNumbered docTick = docLit $ Text.pack "'" @@ -535,10 +626,11 @@   :: Data.Data.Data ast   => Located ast   -> AnnKeywordId+  -> Bool   -> ToBriDocM BriDocNumbered   -> ToBriDocM BriDocNumbered-docNodeMoveToKWDP ast kw bdm =-  docMoveToKWDP (ExactPrint.Types.mkAnnKey ast) kw bdm+docNodeMoveToKWDP ast kw shouldRestoreIndent bdm =+  docMoveToKWDP (ExactPrint.Types.mkAnnKey ast) kw shouldRestoreIndent bdm  class DocWrapable a where   docWrapNode :: ( Data.Data.Data ast)@@ -678,7 +770,10 @@ docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd  unknownNodeError-  :: Data.Data.Data ast => String -> ast -> ToBriDocM BriDocNumbered+  :: Data.Data.Data ast+  => String+  -> GenLocated GHC.SrcSpan ast+  -> ToBriDocM BriDocNumbered unknownNodeError infoStr ast = do   mTell [ErrorUnknownNode infoStr ast]   docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"

@@ -26,14 +26,24 @@ import           Language.Haskell.Brittany.Internal.ExactPrintUtils import           Language.Haskell.Brittany.Internal.Utils -import           GHC ( runGhc, GenLocated(L), moduleNameString )-import           SrcLoc ( SrcSpan )+import           GHC                            ( runGhc+                                                , GenLocated(L)+                                                , moduleNameString+                                                , AnnKeywordId(..)+                                                )+import           SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc ) import           HsSyn+#if MIN_VERSION_ghc(8,6,0)+import           HsExtension (NoExt (..))+#endif import           Name import           BasicTypes ( InlinePragma(..)                             , Activation(..)                             , InlineSpec(..)                             , RuleMatchInfo(..)+#if MIN_VERSION_ghc(8,2,0)+                            , LexicalFixity(..)+#endif                             ) import           Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey ) @@ -42,39 +52,82 @@ import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt import           Language.Haskell.Brittany.Internal.Layouters.Pattern -import           Bag ( mapBagM )+import           Bag ( mapBagM, bagToList, emptyBag )+import           Data.Char (isUpper)    layoutDecl :: ToBriDoc HsDecl+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */ layoutDecl d@(L loc decl) = case decl of+  SigD _ sig  -> withTransformedAnns d $ layoutSig (L loc sig)+  ValD _ bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case+    Left  ns -> docLines $ return <$> ns+    Right n  -> return n+  TyClD _ tycl           -> withTransformedAnns d $ layoutTyCl (L loc tycl)+  InstD _ (TyFamInstD _ tfid) ->+    withTransformedAnns d $ layoutTyFamInstDecl False (L loc tfid)+  InstD _ (ClsInstD _ inst) ->+    withTransformedAnns d $ layoutClsInst (L loc inst)+  _ -> briDocByExactNoComment d+#else+layoutDecl d@(L loc decl) = case decl of   SigD sig  -> withTransformedAnns d $ layoutSig (L loc sig)   ValD bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case     Left  ns -> docLines $ return <$> ns     Right n  -> return n-  InstD (TyFamInstD{}) -> do-    -- this is a (temporary (..)) workaround for "type instance" decls-    -- that do not round-trip through exactprint properly.-    let fixer s = case List.stripPrefix "type " s of-          Just rest | not ("instance" `isPrefixOf` rest) ->-            "type instance " ++ rest-          _ -> s-    str <- mAsk <&> \anns ->-      intercalate "\n" $ fmap fixer $ lines' $ ExactPrint.exactPrint d anns-    allocateNode $ BDFExternal (ExactPrint.mkAnnKey d)-                               (foldedAnnKeys d)-                               False-                               (Text.pack str)-  _ -> briDocByExactNoComment d+  TyClD tycl -> withTransformedAnns d $ layoutTyCl (L loc tycl)+  InstD (TyFamInstD tfid) ->+    withTransformedAnns d $ layoutTyFamInstDecl False (L loc tfid)+  InstD (ClsInstD inst) -> withTransformedAnns d $ layoutClsInst (L loc inst)+  _                    -> briDocByExactNoComment d+#endif  +--------------------------------------------------------------------------------+-- Sig+--------------------------------------------------------------------------------+ layoutSig :: ToBriDoc Sig layoutSig lsig@(L _loc sig) = case sig of-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */-  TypeSig names (HsWC _ (HsIB _ typ _)) -> docWrapNode lsig $ do+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  TypeSig _ names (HsWC _ (HsIB _ typ)) -> layoutNamesAndType names typ+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */+  TypeSig names (HsWC _ (HsIB _ typ _)) -> layoutNamesAndType names typ #else /* ghc-8.0 */-  TypeSig names (HsIB _ (HsWC _ _ typ)) -> docWrapNode lsig $ do+  TypeSig names (HsIB _ (HsWC _ _ typ)) -> layoutNamesAndType names typ #endif+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  InlineSig _ name (InlinePragma _ spec _arity phaseAct conlike) ->+#else+  InlineSig name (InlinePragma _ spec _arity phaseAct conlike) ->+#endif+    docWrapNode lsig $ do+      nameStr <- lrdrNameToTextAnn name+      specStr <- specStringCompat lsig spec+      let phaseStr = case phaseAct of+            NeverActive      -> "" -- not [] - for NOINLINE NeverActive is+                                   -- in fact the default+            AlwaysActive     -> ""+            ActiveBefore _ i -> "[~" ++ show i ++ "] "+            ActiveAfter  _ i -> "[" ++ show i ++ "] "+      let conlikeStr = case conlike of+            FunLike -> ""+            ConLike -> "CONLIKE "+      docLit+        $  Text.pack ("{-# " ++ specStr ++ conlikeStr ++ phaseStr)+        <> nameStr+        <> Text.pack " #-}"+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */+  ClassOpSig _ False names (HsIB _ typ) -> layoutNamesAndType names typ+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */+  ClassOpSig False names (HsIB _ typ _) -> layoutNamesAndType names typ+#else /* ghc-8.0 */+  ClassOpSig False names (HsIB _ typ) -> layoutNamesAndType names typ+#endif+  _ -> briDocByExactNoComment lsig -- TODO+ where+  layoutNamesAndType names typ = docWrapNode lsig $ do     nameStrs <- names `forM` lrdrNameToTextAnn     let nameStr = Text.intercalate (Text.pack ", ") $ nameStrs     typeDoc     <- docSharedWrapper layoutType typ@@ -94,42 +147,11 @@             ]           ]         ]-      else-        docAlt-          $  [ docSeq-               [ appSep $ docWrapNodeRest lsig $ docLit nameStr-               , appSep $ docLit $ Text.pack "::"-               , docForceSingleline typeDoc-               ]-             | not hasComments-             ]-          ++ [ docAddBaseY BrIndentRegular $ docPar-               (docWrapNodeRest lsig $ docLit nameStr)-               ( docCols-                 ColTyOpPrefix-                 [ docLit $ Text.pack ":: "-                 , docAddBaseY (BrIndentSpecial 3) $ typeDoc-                 ]-               )-             ]-  InlineSig name (InlinePragma _ spec _arity phaseAct conlike) ->-    docWrapNode lsig $ do-      nameStr <- lrdrNameToTextAnn name-      specStr <- specStringCompat lsig spec-      let phaseStr = case phaseAct of-            NeverActive      -> "" -- not [] - for NOINLINE NeverActive is-                                   -- in fact the default-            AlwaysActive     -> ""-            ActiveBefore _ i -> "[~" ++ show i ++ "] "-            ActiveAfter  _ i -> "[" ++ show i ++ "] "-      let conlikeStr = case conlike of-            FunLike -> ""-            ConLike -> "CONLIKE "-      docLit-        $  Text.pack ("{-# " ++ specStr ++ conlikeStr ++ phaseStr)-        <> nameStr-        <> Text.pack " #-}"-  _ -> briDocByExactNoComment lsig -- TODO+      else layoutLhsAndType+        hasComments+        (appSep . docWrapNodeRest lsig $ docLit nameStr)+        "::"+        typeDoc  specStringCompat   :: MonadMultiWriter [BrittanyError] m => LSig GhcPs -> InlineSpec -> m String@@ -149,8 +171,16 @@  layoutGuardLStmt :: ToBriDoc' (Stmt GhcPs (LHsExpr GhcPs)) layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  BodyStmt _ body _ _      -> layoutExpr body+#else   BodyStmt body _ _ _      -> layoutExpr body+#endif+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  BindStmt _ lPat expr _ _ -> do+#else   BindStmt lPat expr _ _ _ -> do+#endif     patDoc <- docSharedWrapper layoutPat lPat     expDoc <- docSharedWrapper layoutExpr expr     docCols ColBindStmt@@ -159,12 +189,21 @@             ]   _                        -> unknownNodeError "" lgstmt -- TODO ++--------------------------------------------------------------------------------+-- HsBind+--------------------------------------------------------------------------------+ layoutBind   :: ToBriDocC        (HsBindLR GhcPs GhcPs)        (Either [BriDocNumbered] BriDocNumbered) layoutBind lbind@(L _ bind) = case bind of+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  FunBind _ fId (MG _ lmatches@(L _ matches) _) _ [] -> do+#else   FunBind fId (MG lmatches@(L _ matches) _ _ _) _ _ [] -> do+#endif     idStr       <- lrdrNameToTextAnn fId     binderDoc   <- docLit $ Text.pack "="     funcPatDocs <-@@ -173,17 +212,22 @@         $      layoutPatternBind (Just idStr) binderDoc         `mapM` matches     return $ Left $ funcPatDocs+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  PatBind _ pat (GRHSs _ grhss whereBinds) ([], []) -> do+#else   PatBind pat (GRHSs grhss whereBinds) _ _ ([], []) -> do+#endif     patDocs    <- colsWrapPat =<< layoutPat pat     clauseDocs <- layoutGrhs `mapM` grhss     mWhereDocs <- layoutLocalBinds whereBinds+    let mWhereArg = mWhereDocs <&> \d -> (mkAnnKey lbind, d) -- TODO: is this the right AnnKey?     binderDoc  <- docLit $ Text.pack "="     hasComments <- hasAnyCommentsBelow lbind     fmap Right $ docWrapNode lbind $ layoutPatternBindFinal Nothing                                                             binderDoc                                                             (Just patDocs)                                                             clauseDocs-                                                            mWhereDocs+                                                            mWhereArg                                                             hasComments   _ -> Right <$> unknownNodeError "" lbind @@ -201,42 +245,75 @@   --   Just . (>>= either id return) . Data.Foldable.toList <$> mapBagM layoutBind lhsBindsLR -- TODO: fix ordering   -- x@(HsValBinds (ValBindsIn{})) ->   --   Just . (:[]) <$> unknownNodeError "HsValBinds (ValBindsIn _ (_:_))" x+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  HsValBinds _ (ValBinds _ bindlrs sigs) -> do+#else   HsValBinds (ValBindsIn bindlrs sigs) -> do-    let-      unordered-        =  [ BagBind b | b <- Data.Foldable.toList bindlrs ]-        ++ [ BagSig s | s <- sigs ]-      ordered = sortBy (comparing bindOrSigtoSrcSpan) unordered+#endif+    let unordered =+          [ BagBind b | b <- Data.Foldable.toList bindlrs ]+            ++ [ BagSig s | s <- sigs ]+        ordered = sortBy (comparing bindOrSigtoSrcSpan) unordered     docs <- docWrapNode lbinds $ join <$> ordered `forM` \case       BagBind b -> either id return <$> layoutBind b       BagSig  s -> return <$> layoutSig s     return $ Just $ docs+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+--  x@(HsValBinds (ValBindsOut _binds _lsigs)) ->+  HsValBinds _ (XValBindsLR{}) -> error "brittany internal error: XValBindsLR"+  XHsLocalBindsLR{} -> error "brittany internal error: XHsLocalBindsLR"+#else   x@(HsValBinds (ValBindsOut _binds _lsigs)) ->     -- i _think_ this case never occurs in non-processed ast-    Just . (:[]) <$> unknownNodeError "HsValBinds ValBindsOut{}" x-  x@(HsIPBinds _ipBinds) -> Just . (:[]) <$> unknownNodeError "HsIPBinds" x-  EmptyLocalBinds        -> return $ Nothing+    Just . (: []) <$> unknownNodeError "HsValBinds ValBindsOut{}"+                                       (L noSrcSpan x)+#endif+  x@(HsIPBinds{}) ->+    Just . (: []) <$> unknownNodeError "HsIPBinds" (L noSrcSpan x)+  EmptyLocalBinds{} -> return $ Nothing  -- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is -- parSpacing stuff.B layoutGrhs   :: LGRHS GhcPs (LHsExpr GhcPs)   -> ToBriDocM ([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs)+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+layoutGrhs lgrhs@(L _ (GRHS _ guards body)) = do+#else layoutGrhs lgrhs@(L _ (GRHS guards body)) = do+#endif   guardDocs <- docWrapNode lgrhs $ layoutStmt `mapM` guards   bodyDoc   <- layoutExpr body   return (guardDocs, bodyDoc, body)+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+layoutGrhs (L _ (XGRHS{})) = error "brittany internal error: XGRHS"+#endif  layoutPatternBind   :: Maybe Text   -> BriDocNumbered   -> LMatch GhcPs (LHsExpr GhcPs)   -> ToBriDocM BriDocNumbered-layoutPatternBind mIdStr binderDoc lmatch@(L _ match) = do+layoutPatternBind funId binderDoc lmatch@(L _ match) = do   let pats                     = m_pats match+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  let (GRHSs _ grhss whereBinds) = m_grhss match+#else   let (GRHSs grhss whereBinds) = m_grhss match+#endif   patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p   let isInfix = isInfixMatch match+  mIdStr <- case match of+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    Match _ (FunRhs matchId _ _) _ _ -> Just <$> lrdrNameToTextAnn matchId+#elif MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */+    Match (FunRhs matchId _ _) _ _ -> Just <$> lrdrNameToTextAnn matchId+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.4 */+    Match (FunRhs matchId _ _) _ _ _ -> Just <$> lrdrNameToTextAnn matchId+#else+    Match (FunBindMatch matchId _) _ _ _ -> Just <$> lrdrNameToTextAnn matchId+#endif+    _ -> pure Nothing   let mIdStr' = fixPatternBindIdentifier match <$> mIdStr   patDoc <- docWrapNodePrior lmatch $ case (mIdStr', patDocs) of     (Just idStr, p1 : pr) | isInfix -> docCols@@ -254,13 +331,14 @@         $ (List.intersperse docSeparator $ docForceSingleline <$> ps)   clauseDocs <- docWrapNodeRest lmatch $ layoutGrhs `mapM` grhss   mWhereDocs <- layoutLocalBinds whereBinds-  let alignmentToken = if null pats then Nothing else mIdStr+  let mWhereArg = mWhereDocs <&> \d -> (mkAnnKey lmatch, d)+  let alignmentToken = if null pats then Nothing else funId   hasComments <- hasAnyCommentsBelow lmatch   layoutPatternBindFinal alignmentToken                          binderDoc                          (Just patDoc)                          clauseDocs-                         mWhereDocs+                         mWhereArg                          hasComments  #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 && ghc-8.4 */@@ -291,7 +369,8 @@   -> BriDocNumbered   -> Maybe BriDocNumbered   -> [([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs)]-  -> Maybe [BriDocNumbered]+  -> Maybe (ExactPrint.AnnKey, [BriDocNumbered])+     -- ^ AnnKey for the node that contains the AnnWhere position annotation   -> Bool   -> ToBriDocM BriDocNumbered layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs hasComments = do@@ -317,30 +396,36 @@   --       be shared between alternatives.   wherePartMultiLine :: [ToBriDocM BriDocNumbered] <- case mWhereDocs of     Nothing  -> return $ []-    Just [w] -> fmap (pure . pure) $ docAlt+    Just (annKeyWhere, [w]) -> fmap (pure . pure) $ docAlt       [ docEnsureIndent BrIndentRegular         $ docSeq             [ docLit $ Text.pack "where"             , docSeparator             , docForceSingleline $ return w             ]-      , docEnsureIndent whereIndent $ docLines-        [ docLit $ Text.pack "where"-        , docEnsureIndent whereIndent-          $ docSetIndentLevel-          $ docNonBottomSpacing-          $ return w-        ]-      ]-    Just ws  -> fmap (pure . pure) $ docEnsureIndent whereIndent $ docLines-      [ docLit $ Text.pack "where"-      , docEnsureIndent whereIndent-        $   docSetIndentLevel-        $   docNonBottomSpacing-        $   docLines-        $   return-        <$> ws+      , docMoveToKWDP annKeyWhere AnnWhere False+        $ docEnsureIndent whereIndent+        $ docLines+          [ docLit $ Text.pack "where"+          , docEnsureIndent whereIndent+            $ docSetIndentLevel+            $ docNonBottomSpacing+            $ return w+          ]       ]+    Just (annKeyWhere, ws) ->+      fmap (pure . pure)+        $ docMoveToKWDP annKeyWhere AnnWhere False+        $ docEnsureIndent whereIndent+        $ docLines+          [ docLit $ Text.pack "where"+          , docEnsureIndent whereIndent+            $   docSetIndentLevel+            $   docNonBottomSpacing+            $   docLines+            $   return+            <$> ws+          ]   let singleLineGuardsDoc guards = appSep $ case guards of         []  -> docEmpty         [g] -> docSeq@@ -352,7 +437,7 @@                )       wherePart = case mWhereDocs of         Nothing  -> Just docEmpty-        Just [w] -> Just $ docSeq+        Just (_, [w]) -> Just $ docSeq           [ docSeparator           , appSep $ docLit $ Text.pack "where"           , docSetIndentLevel $ docForceSingleline $ return w@@ -421,8 +506,8 @@         addAlternative           $ docLines           $  [ docSeq (patPartInline ++ [guardPart, return binderDoc])-             , docEnsureIndent BrIndentRegular-             $ docNonBottomSpacing+             , docNonBottomSpacing+             $ docEnsureIndent BrIndentRegular              $ docAddBaseY BrIndentRegular              $ return body              ]@@ -584,3 +669,319 @@                       ]          ]       ++ wherePartMultiLine+++--------------------------------------------------------------------------------+-- TyClDecl+--------------------------------------------------------------------------------++layoutTyCl :: ToBriDoc TyClDecl+layoutTyCl ltycl@(L _loc tycl) = case tycl of+#if MIN_VERSION_ghc(8,6,0)+  SynDecl _ name vars fixity typ -> do+    let isInfix = case fixity of+          Prefix -> False+          Infix  -> True+#elif MIN_VERSION_ghc(8,2,0)+  SynDecl name vars fixity typ _ -> do+    let isInfix = case fixity of+          Prefix -> False+          Infix  -> True+#else+  SynDecl name vars typ _ -> do+    nameStr <- lrdrNameToTextAnn name+    let isInfixTypeOp = case Text.uncons nameStr of+          Nothing -> False+          Just (c, _) -> not (c == '(' || isUpper c)+    isInfix <- (isInfixTypeOp ||) <$> hasAnnKeyword name AnnBackquote+#endif+    -- hasTrailingParen <- hasAnnKeywordComment ltycl AnnCloseP+    -- let parenWrapper = if hasTrailingParen+    --       then appSep . docWrapNodeRest ltycl+    --       else id+    let wrapNodeRest = docWrapNodeRest ltycl+    docWrapNodePrior ltycl+      $ layoutSynDecl isInfix wrapNodeRest name (hsq_explicit vars) typ+  _ -> briDocByExactNoComment ltycl++layoutSynDecl+  :: Bool+  -> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)+  -> Located (IdP GhcPs)+  -> [LHsTyVarBndr GhcPs]+  -> LHsType GhcPs+  -> ToBriDocM BriDocNumbered+layoutSynDecl isInfix wrapNodeRest name vars typ = do+  nameStr <- lrdrNameToTextAnn name+  let+    lhs = appSep . wrapNodeRest $ if isInfix+      then do+        let (a : b : rest) = vars+        hasOwnParens <- hasAnnKeywordComment a AnnOpenP+        -- This isn't quite right, but does give syntactically valid results+        let needsParens = not $ null rest || hasOwnParens+        docSeq+          $  [ docLit $ Text.pack "type"+             , docSeparator+             ]+          ++ [ docParenL | needsParens ]+          ++ [ layoutTyVarBndr False a+             , docSeparator+             , docLit nameStr+             , docSeparator+             , layoutTyVarBndr False b+             ]+          ++ [ docParenR | needsParens ]+          ++ fmap (layoutTyVarBndr True) rest+      else+        docSeq+        $  [ docLit $ Text.pack "type"+           , docSeparator+           , docWrapNode name $ docLit nameStr+           ]+        ++ fmap (layoutTyVarBndr True) vars+  sharedLhs   <- docSharedWrapper id lhs+  typeDoc     <- docSharedWrapper layoutType typ+  hasComments <- hasAnyCommentsConnected typ+  layoutLhsAndType hasComments sharedLhs "=" typeDoc++layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr+layoutTyVarBndr needsSep lbndr@(L _ bndr) = do+  docWrapNodePrior lbndr $ case bndr of+#if MIN_VERSION_ghc(8,6,0)    /* 8.6 */+    XTyVarBndr{} -> error "brittany internal error: XTyVarBndr"+    UserTyVar _ name -> do+#else                         /* 8.0 8.2 8.4 */+    UserTyVar name -> do+#endif+      nameStr <- lrdrNameToTextAnn name+      docSeq $ [docSeparator | needsSep] ++ [docLit nameStr]+#if MIN_VERSION_ghc(8,6,0)    /* 8.6 */+    KindedTyVar _ name kind -> do+#else                         /* 8.0 8.2 8.4 */+    KindedTyVar name kind -> do+#endif+      nameStr <- lrdrNameToTextAnn name+      docSeq+        $  [ docSeparator | needsSep ]+        ++ [ docLit $ Text.pack "("+           , appSep $ docLit nameStr+           , appSep . docLit $ Text.pack "::"+           , docForceSingleline $ layoutType kind+           , docLit $ Text.pack ")"+           ]+++--------------------------------------------------------------------------------+-- TyFamInstDecl+--------------------------------------------------------------------------------++layoutTyFamInstDecl :: Bool -> ToBriDoc TyFamInstDecl+layoutTyFamInstDecl inClass (L loc tfid) = do+  let+#if MIN_VERSION_ghc(8,6,0)+    linst = L loc (TyFamInstD NoExt tfid)+    feqn@(FamEqn _ name pats _fixity typ) = hsib_body $ tfid_eqn tfid+    lfeqn = L loc feqn+#elif MIN_VERSION_ghc(8,4,0)+    linst = L loc (TyFamInstD tfid)+    feqn@(FamEqn name pats _fixity typ) = hsib_body $ tfid_eqn tfid+    lfeqn = L loc feqn+#elif MIN_VERSION_ghc(8,2,0)+    linst = L loc (TyFamInstD tfid)+    lfeqn@(L _ (TyFamEqn name boundPats _fixity typ)) = tfid_eqn tfid+    pats = hsib_body boundPats+#else+    linst = L loc (TyFamInstD tfid)+    lfeqn@(L _ (TyFamEqn name boundPats typ)) = tfid_eqn tfid+    pats = hsib_body boundPats+#endif+  docWrapNodePrior linst $ do+    nameStr   <- lrdrNameToTextAnn name+    needsParens <- hasAnnKeyword lfeqn AnnOpenP+    let+      instanceDoc = if inClass+        then docLit $ Text.pack "type"+        else docSeq+          [appSep . docLit $ Text.pack "type", docLit $ Text.pack "instance"]+      lhs =+        docWrapNode lfeqn+          .  appSep+          .  docWrapNodeRest linst+          .  docSeq+          $  (appSep instanceDoc :)+          $  [ docParenL | needsParens ]+          ++ [appSep $ docWrapNode name $ docLit nameStr]+          ++ intersperse docSeparator (layoutType <$> pats)+          ++ [ docParenR | needsParens ]+    hasComments <- (||)+      <$> hasAnyRegularCommentsConnected lfeqn+      <*> hasAnyRegularCommentsRest linst+    typeDoc <- docSharedWrapper layoutType typ+    layoutLhsAndType hasComments lhs "=" typeDoc+++--------------------------------------------------------------------------------+-- ClsInstDecl+--------------------------------------------------------------------------------++-- | Layout an @instance@ declaration+--+--   Layout signatures and bindings using the corresponding layouters from the+--   top-level. Layout the instance head, type family instances, and data family+--   instances using ExactPrint.+layoutClsInst :: ToBriDoc ClsInstDecl+layoutClsInst lcid@(L _ cid) = docLines+  [ layoutInstanceHead+  , docEnsureIndent BrIndentRegular+  $  docSortedLines+  $  fmap layoutAndLocateSig          (cid_sigs cid)+  ++ fmap layoutAndLocateBind         (bagToList $ cid_binds cid)+  ++ fmap layoutAndLocateTyFamInsts   (cid_tyfam_insts cid)+  ++ fmap layoutAndLocateDataFamInsts (cid_datafam_insts cid)+  ]+ where+  layoutInstanceHead :: ToBriDocM BriDocNumbered+#if MIN_VERSION_ghc(8,6,0)    /* 8.6 */+  layoutInstanceHead =+    briDocByExactNoComment+      $   InstD NoExt+      .   ClsInstD NoExt+      .   removeChildren+      <$> lcid+#else+  layoutInstanceHead =+    briDocByExactNoComment+      $   InstD+      .   ClsInstD+      .   removeChildren+      <$> lcid+#endif++  removeChildren :: ClsInstDecl p -> ClsInstDecl p+  removeChildren c = c+    { cid_binds         = emptyBag+    , cid_sigs          = []+    , cid_tyfam_insts   = []+    , cid_datafam_insts = []+    }++  -- | Like 'docLines', but sorts the lines based on location+  docSortedLines+    :: [ToBriDocM (Located BriDocNumbered)] -> ToBriDocM BriDocNumbered+  docSortedLines l =+    allocateNode . BDFLines . fmap unLoc . List.sortOn getLoc =<< sequence l++  layoutAndLocateSig :: ToBriDocC (Sig GhcPs) (Located BriDocNumbered)+  layoutAndLocateSig lsig@(L loc _) = L loc <$> layoutSig lsig++  layoutAndLocateBind :: ToBriDocC (HsBind GhcPs) (Located BriDocNumbered)+  layoutAndLocateBind lbind@(L loc _) =+    L loc <$> (joinBinds =<< layoutBind lbind)++  joinBinds+    :: Either [BriDocNumbered] BriDocNumbered -> ToBriDocM BriDocNumbered+  joinBinds = \case+    Left  ns -> docLines $ return <$> ns+    Right n  -> return n++  layoutAndLocateTyFamInsts+    :: ToBriDocC (TyFamInstDecl GhcPs) (Located BriDocNumbered)+  layoutAndLocateTyFamInsts ltfid@(L loc _) =+    L loc <$> layoutTyFamInstDecl True ltfid++  layoutAndLocateDataFamInsts+    :: ToBriDocC (DataFamInstDecl GhcPs) (Located BriDocNumbered)+  layoutAndLocateDataFamInsts ldfid@(L loc _) =+    L loc <$> layoutDataFamInstDecl ldfid++  -- | Send to ExactPrint then remove unecessary whitespace+  layoutDataFamInstDecl :: ToBriDoc DataFamInstDecl+  layoutDataFamInstDecl ldfid =+    fmap stripWhitespace <$> briDocByExactNoComment ldfid++  -- | ExactPrint adds indentation/newlines to @data@/@type@ declarations+  stripWhitespace :: BriDocF f -> BriDocF f+  stripWhitespace (BDFExternal ann anns b t) =+    BDFExternal ann anns b $ stripWhitespace' t+  stripWhitespace b = b++  -- | This fixes two issues of output coming from Exactprinting+  --   associated (data) type decls. Firstly we place the output into docLines,+  --   so one newline coming from Exactprint is superfluous, so we drop the+  --   first (empty) line. The second issue is Exactprint indents the first+  --   member in a strange fashion:+  --+  --   input:+  --+  --   > instance MyClass Int where+  --   >   -- | This data is very important+  --   >   data MyData = IntData+  --   >     { intData  :: String+  --   >     , intData2 :: Int+  --   >     }+  --+  --   output of just exactprinting the associated data type syntax node+  --+  --   >+  --   >   -- | This data is very important+  --   >   data MyData = IntData+  --   >   { intData  :: String+  --   >   , intData2 :: Int+  --   >   }+  --+  --   To fix this, we strip whitespace from the start of the comments and the+  --   first line of the declaration, stopping when we see "data" or "type" at+  --   the start of a line. I.e., this function yields+  --+  --   > -- | This data is very important+  --   > data MyData = IntData+  --   >   { intData  :: String+  --   >   , intData2 :: Int+  --   >   }+  --+  --   Downside apart from being a hacky and brittle fix is that this removes+  --   possible additional indentation from comments before the first member.+  --+  --   But the whole thing is just a temporary measure until brittany learns+  --   to layout data/type decls.+  stripWhitespace' :: Text -> Text+  stripWhitespace' t =+    Text.intercalate (Text.pack "\n") $ go $ List.drop 1 $ Text.lines t+   where+    go []              = []+    go (line1 : lineR) = case Text.stripStart line1 of+      st | isTypeOrData st -> st : lineR+         | otherwise       -> st : go lineR+    isTypeOrData t' =+      (Text.pack "type" `Text.isPrefixOf` t')+        || (Text.pack "data" `Text.isPrefixOf` t')+++--------------------------------------------------------------------------------+-- Common Helpers+--------------------------------------------------------------------------------++layoutLhsAndType+  :: Bool+  -> ToBriDocM BriDocNumbered+  -> String+  -> ToBriDocM BriDocNumbered+  -> ToBriDocM BriDocNumbered+layoutLhsAndType hasComments lhs sep typeDoc = do+  let sepDoc = appSep . docLit $ Text.pack sep+  runFilteredAlternative $ do+    -- (separators probably are "=" or "::")+    -- lhs = type+    -- lhs :: type+    addAlternativeCond (not hasComments)+      $ docSeq [lhs, sepDoc, docForceSingleline typeDoc]+    -- lhs+    --   :: typeA+    --   -> typeB+    -- lhs+    --   =  typeA+    --   -> typeB+    addAlternative $ docAddBaseY BrIndentRegular $ docPar lhs $ docCols+      ColTyOpPrefix+      [sepDoc, docAddBaseY (BrIndentSpecial (length sep + 1)) typeDoc]

@@ -15,7 +15,9 @@ import           Language.Haskell.Brittany.Internal.LayouterBasics import           Language.Haskell.Brittany.Internal.Config.Types -import           GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..), RdrName(..) )+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types++import           GHC ( runGhc, GenLocated(L), SrcSpan, moduleNameString, AnnKeywordId(..), RdrName(..) ) import           HsSyn import           Name import qualified FastString@@ -37,9 +39,17 @@     .>  confUnpack   let allowFreeIndent = indentPolicy == IndentPolicyFree   docWrapNode lexpr $ case expr of+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsVar _ vname -> do+#else     HsVar vname -> do+#endif       docLit =<< lrdrNameToTextAnn vname+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsUnboundVar _ var -> case var of+#else     HsUnboundVar var -> case var of+#endif       OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname       TrueExprHole oname -> docLit $ Text.pack $ occNameString oname     HsRecFld{} -> do@@ -51,15 +61,35 @@     HsIPVar{} -> do       -- TODO       briDocByExactInlineOnly "HsOverLabel{}" lexpr-    HsOverLit (OverLit olit _ _ _) -> do-      allocateNode $ overLitValBriDoc olit+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsOverLit _ olit -> do+#else+    HsOverLit olit -> do+#endif+      allocateNode $ overLitValBriDoc $ ol_val olit+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsLit _ lit -> do+#else     HsLit lit -> do+#endif       allocateNode $ litBriDoc lit+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsLam _ (MG _ (L _ [lmatch@(L _ match)]) _)+#else     HsLam (MG (L _ [lmatch@(L _ match)]) _ _ _)+#endif       |  pats                  <- m_pats match-      ,  GRHSs [lgrhs] llocals <- m_grhss match-      ,  L _ EmptyLocalBinds   <- llocals-      ,  L _ (GRHS [] body)    <- lgrhs+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+      ,  GRHSs _ [lgrhs] llocals <- m_grhss match+#else+      ,  GRHSs [lgrhs] llocals  <- m_grhss match+#endif+      ,  L _ EmptyLocalBinds {} <- llocals+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+      ,  L _ (GRHS _ [] body)     <- lgrhs+#else+      ,  L _ (GRHS [] body)     <- lgrhs+#endif       -> do       patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p       bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body@@ -105,31 +135,60 @@         ]     HsLam{} ->       unknownNodeError "HsLam too complex" lexpr-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsLamCase _ XMatchGroup{} ->+      error "brittany internal error: HsLamCase XMatchGroup"+#endif+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsLamCase _ (MG _ (L _ []) _) -> do+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4*/+    HsLamCase (MG (L _ []) _ _ _) -> do+#else                        /* ghc-8.0 */+    HsLamCase _ (MG (L _ []) _ _ _) -> do+#endif+      docSetParSpacing $ docAddBaseY BrIndentRegular $+        (docLit $ Text.pack "\\case {}")+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsLamCase _ (MG _ lmatches@(L _ matches) _) -> do+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4*/     HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do-#else /* ghc-8.0 */+#else                        /* ghc-8.0 */     HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do #endif       binderDoc   <- docLit $ Text.pack "->"-      funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches+      funcPatDocs <- docWrapNode lmatches+        $ layoutPatternBind Nothing binderDoc `mapM` matches       docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar         (docLit $ Text.pack "\\case")         (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsApp _ exp1@(L _ HsApp{}) exp2 -> do+#else     HsApp exp1@(L _ HsApp{}) exp2 -> do+#endif       let gather :: [LHsExpr GhcPs] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs])           gather list = \case+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+            L _ (HsApp _ l r) -> gather (r:list) l+#else             L _ (HsApp l r) -> gather (r:list) l+#endif             x               -> (x, list)       let (headE, paramEs) = gather [exp2] exp1       let colsOrSequence = case headE of+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+            L _ (HsVar _ (L _ (Unqual occname))) ->+#else             L _ (HsVar (L _ (Unqual occname))) ->+#endif               docCols (ColApp $ Text.pack $ occNameString occname)             _ -> docSeq       headDoc <- docSharedWrapper layoutExpr headE       paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs+      hasComments <- hasAnyCommentsConnected exp2       runFilteredAlternative $ do         -- foo x y-        addAlternative+        addAlternativeCond (not hasComments)           $ colsOrSequence           $ appSep (docForceSingleline headDoc)           : spacifyDocs (docForceSingleline <$> paramDocs)@@ -167,7 +226,11 @@             ( docNonBottomSpacing             $ docLines paramDocs             )+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsApp _ exp1 exp2 -> do+#else     HsApp exp1 exp2 -> do+#endif       -- TODO: if expDoc1 is some literal, we may want to create a docCols here.       expDoc1 <- docSharedWrapper layoutExpr exp1       expDoc2 <- docSharedWrapper layoutExpr exp2@@ -177,10 +240,13 @@         , -- func argline1           --   arglines           -- e.g.-          -- func if x-          --   then 1-          --   else 2-          docSetParSpacing+          -- func Abc+          --   { member1 = True+          --   , member2 = 13+          --   }+          docSetParSpacing -- this is most likely superfluous because+                           -- this is a sequence of a one-line and a par-space+                           -- anyways, so it is _always_ par-spaced.         $ docAddBaseY BrIndentRegular         $ docSeq           [ appSep $ docForceSingleline expDoc1@@ -202,9 +268,13 @@           expDoc1           expDoc2         ]-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsAppType XHsWildCardBndrs{} _ ->+      error "brittany internal error: HsAppType XHsWildCardBndrs"+    HsAppType (HsWC _ ty1) exp1 -> do+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */     HsAppType exp1 (HsWC _ ty1) -> do-#else /* ghc-8.0 */+#else                        /* ghc-8.0 */     HsAppType exp1 (HsWC _ _ ty1) -> do #endif       t <- docSharedWrapper layoutType ty1@@ -220,13 +290,23 @@             e             (docSeq [docLit $ Text.pack "@", t ])         ]+#if !MIN_VERSION_ghc(8,6,0)   /* ghc-8.0 8.2 8.4 */     HsAppTypeOut{} -> do       -- TODO       briDocByExactInlineOnly "HsAppTypeOut{}" lexpr+#endif+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    OpApp _ expLeft@(L _ OpApp{}) expOp expRight -> do+#else     OpApp expLeft@(L _ OpApp{}) expOp _ expRight -> do+#endif       let gather :: [(LHsExpr GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [(LHsExpr GhcPs, LHsExpr GhcPs)])           gather opExprList = \case+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+            (L _ (OpApp _ l1 op1 r1)) -> gather ((op1, r1): opExprList) l1+#else             (L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1+#endif             final -> (final, opExprList)           (leftOperand, appList) = gather [] expLeft       leftOperandDoc <- docSharedWrapper layoutExpr leftOperand@@ -236,14 +316,29 @@                                               ]       opLastDoc   <- docSharedWrapper layoutExpr expOp       expLastDoc  <- docSharedWrapper layoutExpr expRight-      hasComments <- hasAnyCommentsBelow lexpr+      allowSinglelinePar <- do+        hasComLeft <- hasAnyCommentsConnected expLeft+        hasComOp   <- hasAnyCommentsConnected expOp+        pure $ not hasComLeft && not hasComOp+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */       let allowPar = case (expOp, expRight) of+            (L _ (HsVar _ (L _ (Unqual occname))), _)+              | occNameString occname == "$" -> True+            (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False+            _ -> True+#else+      let allowPar = case (expOp, expRight) of             (L _ (HsVar (L _ (Unqual occname))), _)               | occNameString occname == "$" -> True             (_, L _ (HsApp _ (L _ HsVar{}))) -> False             _ -> True+#endif       runFilteredAlternative $ do-        addAlternativeCond (not hasComments)+        -- > one + two + three+        -- or+        -- > one + two + case x of+        -- >   _ -> three+        addAlternativeCond allowSinglelinePar           $ docSeq           [ appSep $ docForceSingleline leftOperandDoc           , docSeq@@ -265,6 +360,9 @@         --      $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])         --       ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]         --     )+        -- > one+        -- >   + two+        -- >   + three         addAlternative $           docPar             leftOperandDoc@@ -272,15 +370,27 @@             $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])               ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]             )+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    OpApp _ expLeft expOp expRight -> do+#else     OpApp expLeft expOp _ expRight -> do+#endif       expDocLeft  <- docSharedWrapper layoutExpr expLeft       expDocOp    <- docSharedWrapper layoutExpr expOp       expDocRight <- docSharedWrapper layoutExpr expRight+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */       let allowPar = case (expOp, expRight) of+            (L _ (HsVar _ (L _ (Unqual occname))), _)+              | occNameString occname == "$" -> True+            (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False+            _ -> True+#else+      let allowPar = case (expOp, expRight) of             (L _ (HsVar (L _ (Unqual occname))), _)               | occNameString occname == "$" -> True             (_, L _ (HsApp _ (L _ HsVar{}))) -> False             _ -> True+#endif       runFilteredAlternative $ do         -- one-line         addAlternative@@ -300,7 +410,10 @@         addAlternative           $ docAddBaseY BrIndentRegular           $ docPar-              expDocLeft+              expDocLeft -- TODO: this is not forced to single-line, which has+                         -- certain.. interesting consequences.+                         -- At least, the "two-line" label is not entirely+                         -- accurate.               ( docForceSingleline               $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]               )@@ -317,12 +430,20 @@           $ docPar               expDocLeft               (docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight])+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    NegApp _ op _ -> do+#else     NegApp op _ -> do+#endif       opDoc <- docSharedWrapper layoutExpr op       docSeq [ docLit $ Text.pack "-"              , opDoc              ]+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsPar _ innerExp -> do+#else     HsPar innerExp -> do+#endif       innerExpDoc <- docSharedWrapper (docWrapNode lexpr . layoutExpr) innerExp       docAlt         [ docSeq@@ -338,25 +459,44 @@           , docLit $ Text.pack ")"           ]         ]+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    SectionL _ left op -> do -- TODO: add to testsuite+#else     SectionL left op -> do -- TODO: add to testsuite+#endif       leftDoc <- docSharedWrapper layoutExpr left       opDoc   <- docSharedWrapper layoutExpr op       docSeq [leftDoc, docSeparator, opDoc]+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    SectionR _ op right -> do -- TODO: add to testsuite+#else     SectionR op right -> do -- TODO: add to testsuite+#endif       opDoc    <- docSharedWrapper layoutExpr op       rightDoc <- docSharedWrapper layoutExpr right       docSeq [opDoc, docSeparator, rightDoc]+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    ExplicitTuple _ args boxity -> do+#else     ExplicitTuple args boxity -> do+#endif+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */       let argExprs = args <&> \arg -> case arg of+            (L _ (Present _ e)) -> (arg, Just e);+            (L _ (Missing NoExt)) -> (arg, Nothing)+            (L _ XTupArg{}) -> error "brittany internal error: XTupArg"+#else+      let argExprs = args <&> \arg -> case arg of             (L _ (Present e)) -> (arg, Just e);             (L _ (Missing PlaceHolder)) -> (arg, Nothing)+#endif       argDocs <- forM argExprs         $ docSharedWrapper         $ \(arg, exprM) -> docWrapNode arg $ maybe docEmpty layoutExpr exprM       hasComments <- hasAnyCommentsBelow lexpr       let (openLit, closeLit) = case boxity of-            Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")")-            Unboxed -> (docLit $ Text.pack "(#", docLit $ Text.pack "#)")+            Boxed   -> (docLit $ Text.pack "(", docLit $ Text.pack ")")+            Unboxed -> (docParenHashLSep, docParenHashRSep)       case splitFirstLast argDocs of         FirstLastEmpty -> docSeq           [ openLit@@ -391,10 +531,38 @@               lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]               end   = closeLit             in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end]+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsCase _ _ XMatchGroup{} ->+      error "brittany internal error: HsCase XMatchGroup"+#endif+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsCase _ cExp (MG _ (L _ []) _) -> do+#else+    HsCase cExp (MG (L _ []) _ _ _) -> do+#endif+      cExpDoc <- docSharedWrapper layoutExpr cExp+      docAlt+        [ docAddBaseY BrIndentRegular+        $ docSeq+            [ appSep $ docLit $ Text.pack "case"+            , appSep $ docForceSingleline cExpDoc+            , docLit $ Text.pack "of {}"+            ]+        , docPar+            ( docAddBaseY BrIndentRegular+            $ docPar (docLit $ Text.pack "case") cExpDoc+            )+            (docLit $ Text.pack "of {}")+        ]+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsCase _ cExp (MG _ lmatches@(L _ matches) _) -> do+#else     HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do+#endif       cExpDoc <- docSharedWrapper layoutExpr cExp       binderDoc <- docLit $ Text.pack "->"-      funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches+      funcPatDocs <- docWrapNode lmatches+        $ layoutPatternBind Nothing binderDoc `mapM` matches       docAlt         [ docSetParSpacing         $ docAddBaseY BrIndentRegular@@ -414,7 +582,11 @@               (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)             )         ]+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsIf _ _ ifExpr thenExpr elseExpr -> do+#else     HsIf _ ifExpr thenExpr elseExpr -> do+#endif       ifExprDoc   <- docSharedWrapper layoutExpr ifExpr       thenExprDoc <- docSharedWrapper layoutExpr thenExpr       elseExprDoc <- docSharedWrapper layoutExpr elseExpr@@ -426,7 +598,7 @@               IndentPolicyFree -> BrIndentSpecial 3       -- TODO: some of the alternatives (especially last and last-but-one)       -- overlap.-      runFilteredAlternative $ do+      docSetIndentLevel $ runFilteredAlternative $ do         -- if _ then _ else _         addAlternativeCond (not hasComments)           $ docSeq@@ -534,7 +706,11 @@       docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar         (docLit $ Text.pack "if")         (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments)+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsLet _ binds exp1 -> do+#else     HsLet binds exp1 -> do+#endif       expDoc1   <- docSharedWrapper layoutExpr exp1       -- We jump through some ugly hoops here to ensure proper sharing.       mBindDocs <- mapM (fmap (fmap return) . docWrapNodeRest lexpr . return)@@ -601,13 +777,14 @@           --  in           --    fooooooooooooooooooo           let noHangingBinds =-                [ docAddBaseY BrIndentRegular+                [ docNonBottomSpacing $ docAddBaseY BrIndentRegular                 $ docPar                   (docLit $ Text.pack "let")                   (docSetBaseAndIndent $ docLines bindDocs)                 , docSeq                   [ docLit $ Text.pack "in "-                  , docAddBaseY BrIndentRegular expDoc1+                  , docAddBaseY BrIndentRegular+                  $ docForceParSpacing expDoc1                   ]                 ]           addAlternative $ case indentPolicy of@@ -636,60 +813,65 @@             ]         _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]       -- docSeq [appSep $ docLit "let in", expDoc1]-    HsDo DoExpr (L _ stmts) _ -> do-      stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts-      docSetParSpacing-        $ docAddBaseY BrIndentRegular-        $ docPar-            (docLit $ Text.pack "do")-            (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)-    HsDo MDoExpr (L _ stmts) _ -> do-      stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts-      docSetParSpacing-        $ docAddBaseY BrIndentRegular-        $ docPar-            (docLit $ Text.pack "mdo")-            (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)-    HsDo x  (L _ stmts) _ | case x of { ListComp -> True-                                      ; MonadComp -> True-                                      ; _ -> False } -> do-      stmtDocs    <- docSharedWrapper layoutStmt `mapM` stmts-      hasComments <- hasAnyCommentsBelow lexpr-      runFilteredAlternative $ do-        addAlternativeCond (not hasComments)-          $ docSeq-          [ docNodeAnnKW lexpr Nothing-          $ appSep-          $ docLit-          $ Text.pack "["-          , docNodeAnnKW lexpr (Just AnnOpenS)-          $ appSep-          $ docForceSingleline-          $ List.last stmtDocs-          , appSep $ docLit $ Text.pack "|"-          , docSeq $ List.intersperse docCommaSep-          $ docForceSingleline <$> List.init stmtDocs-          , docLit $ Text.pack " ]"-          ]-        addAlternative $-          let-            start = docCols ColListComp-                      [ docNodeAnnKW lexpr Nothing-                      $ appSep $ docLit $ Text.pack "["-                      , docSetBaseY-                      $ docNodeAnnKW lexpr (Just AnnOpenS)-                      $ List.last stmtDocs-                      ]-            (s1:sM) = List.init stmtDocs-            line1 = docCols ColListComp-                      [appSep $ docLit $ Text.pack "|", s1]-            lineM = sM <&> \d ->-                    docCols ColListComp [docCommaSep, d]-            end   = docLit $ Text.pack "]"-          in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]-    HsDo{} -> do-      -- TODO-      unknownNodeError "HsDo{} no comp" lexpr+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsDo _ stmtCtx (L _ stmts) -> case stmtCtx of+#else+    HsDo stmtCtx (L _ stmts) _ -> case stmtCtx of+#endif+      DoExpr -> do+        stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts+        docSetParSpacing+          $ docAddBaseY BrIndentRegular+          $ docPar+              (docLit $ Text.pack "do")+              (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)+      MDoExpr -> do+        stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts+        docSetParSpacing+          $ docAddBaseY BrIndentRegular+          $ docPar+              (docLit $ Text.pack "mdo")+              (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)+      x | case x of { ListComp -> True+                    ; MonadComp -> True+                    ; _ -> False } -> do+        stmtDocs    <- docSharedWrapper layoutStmt `mapM` stmts+        hasComments <- hasAnyCommentsBelow lexpr+        runFilteredAlternative $ do+          addAlternativeCond (not hasComments)+            $ docSeq+            [ docNodeAnnKW lexpr Nothing+            $ appSep+            $ docLit+            $ Text.pack "["+            , docNodeAnnKW lexpr (Just AnnOpenS)+            $ appSep+            $ docForceSingleline+            $ List.last stmtDocs+            , appSep $ docLit $ Text.pack "|"+            , docSeq $ List.intersperse docCommaSep+            $ docForceSingleline <$> List.init stmtDocs+            , docLit $ Text.pack " ]"+            ]+          addAlternative $+            let+              start = docCols ColListComp+                        [ docNodeAnnKW lexpr Nothing+                        $ appSep $ docLit $ Text.pack "["+                        , docSetBaseY+                        $ docNodeAnnKW lexpr (Just AnnOpenS)+                        $ List.last stmtDocs+                        ]+              (s1:sM) = List.init stmtDocs+              line1 = docCols ColListComp+                        [appSep $ docLit $ Text.pack "|", s1]+              lineM = sM <&> \d ->+                      docCols ColListComp [docCommaSep, d]+              end   = docLit $ Text.pack "]"+            in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]+      _ -> do+        -- TODO+        unknownNodeError "HsDo{} unknown stmtCtx" lexpr     ExplicitList _ _ elems@(_:_) -> do       elemDocs    <- elems `forM` docSharedWrapper layoutExpr       hasComments <- hasAnyCommentsBelow lexpr@@ -730,237 +912,125 @@             in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]     ExplicitList _ _ [] ->       docLit $ Text.pack "[]"+#if !MIN_VERSION_ghc(8,6,0)  /* ghc-8.0 8.2 8.4 */     ExplicitPArr{} -> do       -- TODO       briDocByExactInlineOnly "ExplicitPArr{}" lexpr-    RecordCon lname _ _ (HsRecFields [] Nothing) -> do-      let t = lrdrNameToText lname-      docWrapNode lname $ docSeq-        [ docNodeAnnKW lexpr (Just AnnOpenC) $ docLit $ t <> Text.pack "{"-        , docLit $ Text.pack "}"-        ]-    RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do-      -- TODO: the layouter for RecordUpd is slightly more clever. Should-      -- probably copy the approach from there.-      let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname-      ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do-        fExpDoc <- if pun-          then return Nothing-          else Just <$> docSharedWrapper layoutExpr fExpr-        return (fieldl, lrdrNameToText lnameF, fExpDoc)-      let line1 appender wrapper =-            [ appender $ docLit $ Text.pack "{"-            , docWrapNodePrior fd1l $ appSep $ docLit fd1n-            , case fd1e of-                Just x -> docSeq-                  [ appSep $ docLit $ Text.pack "="-                  , docWrapNodeRest fd1l $ wrapper x-                  ]-                Nothing -> docEmpty-            ]-      let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->-            [ docCommaSep-            , appSep $ docLit fText-            , case fDoc of-                Just x -> docWrapNode lfield $ docSeq-                  [ appSep $ docLit $ Text.pack "="-                  , wrapper x-                  ]-                Nothing -> docEmpty-            ]-      let lineN =-            [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty-            , docLit $ Text.pack "}"-            ]-      docAlt-        [  docSeq-        $  [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]-        ++ line1 id docForceSingleline-        ++ join (lineR docForceSingleline)-        ++ lineN-        , docSetParSpacing-        $ docAddBaseY BrIndentRegular-        $ docPar-            (docNodeAnnKW lexpr Nothing nameDoc)-            ( docNonBottomSpacing-            $ docLines-            $  [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]-            ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular))-            ++ [docSeq lineN]-            )-        ]-    RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do-      let t = lrdrNameToText lname-      docWrapNode lname $ docLit $ t <> Text.pack " {..}"-    RecordCon lname _ _ (HsRecFields fs@(_:_) (Just dotdoti)) | dotdoti == length fs -> do-      let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname-      ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do-        fExpDoc <- if pun-          then return Nothing-          else Just <$> docSharedWrapper layoutExpr fExpr-        return (fieldl, lrdrNameToText lnameF, fExpDoc)-      let line1 appender wrapper =-            [ appender $ docLit $ Text.pack "{"-            , docWrapNodePrior fd1l $ appSep $ docLit fd1n-            , case fd1e of-                Just x -> docSeq-                  [ appSep $ docLit $ Text.pack "="-                  , docWrapNodeRest fd1l $ wrapper x-                  ]-                Nothing -> docEmpty-            ]-      let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->-            [ docCommaSep-            , appSep $ docLit fText-            , case fDoc of-                Just x -> docWrapNode lfield $ docSeq-                  [ appSep $ docLit $ Text.pack "="-                  , wrapper x-                  ]-                Nothing -> docEmpty-            ]-      let lineDot =-            [ docCommaSep-            , docLit $ Text.pack ".."-            ]-      let lineN =-            [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty-            , docLit $ Text.pack "}"-            ]-      docAlt-        [  docSeq-        $  [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]-        ++ line1 id docForceSingleline-        ++ join (lineR docForceSingleline)-        ++ lineDot-        ++ lineN-        , docSetParSpacing-        $ docAddBaseY BrIndentRegular-        $ docPar-            (docNodeAnnKW lexpr Nothing nameDoc)-            ( docNonBottomSpacing-            $ docLines-            $  [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]-            ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular))-            ++ [docSeq lineDot, docSeq lineN]-            )-        ]-    RecordCon{} ->-      unknownNodeError "RecordCon with puns" lexpr-    RecordUpd rExpr [] _ _ _ _ -> do-      rExprDoc <- docSharedWrapper layoutExpr rExpr-      docSeq [rExprDoc, docLit $ Text.pack "{}"]-    RecordUpd rExpr fields@(_:_) _ _ _ _ -> do-      rExprDoc <- docSharedWrapper layoutExpr rExpr-      rFs@((rF1f, rF1n, rF1e):rFr) <- fields-        `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do-          rFExpDoc <- if pun-            then return Nothing-            else Just <$> docSharedWrapper layoutExpr rFExpr-          return $ case ambName of-            Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)-            Ambiguous   n _ -> (lfield, lrdrNameToText n, rFExpDoc)-      runFilteredAlternative $ do-        -- container { fieldA = blub, fieldB = blub }-        addAlternative-          $ docSeq-          [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc-          , appSep $ docLit $ Text.pack "{"-          , appSep $ docSeq $ List.intersperse docCommaSep-                  $ rFs <&> \case-                    (lfield, fieldStr, Just fieldDoc) ->-                      docWrapNode lfield $ docSeq-                            [ appSep $ docLit fieldStr-                            , appSep $ docLit $ Text.pack "="-                            , docForceSingleline fieldDoc-                            ]-                    (lfield, fieldStr, Nothing) ->-                      docWrapNode lfield $ docLit fieldStr-          , docLit $ Text.pack "}"-          ]-        -- hanging single-line fields-        -- container { fieldA = blub-        --           , fieldB = blub-        --           }-        addAlternativeCond (indentPolicy == IndentPolicyFree)-          $ docSeq-          [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc-          , docSetBaseY $ docLines $ let-              line1 = docCols ColRecUpdate+#endif+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    RecordCon _ lname fields ->+#else+    RecordCon lname _ _ fields ->+#endif+      case fields of+        HsRecFields fs Nothing -> do+          let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname+          rFs <- fs+            `forM` \lfield@(L _ (HsRecField (L _ fieldOcc) rFExpr pun)) -> do+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+              let FieldOcc _ lnameF = fieldOcc+#else+              let FieldOcc lnameF _ = fieldOcc+#endif+              rFExpDoc <- if pun+                then return Nothing+                else Just <$> docSharedWrapper layoutExpr rFExpr+              return $ (lfield, lrdrNameToText lnameF, rFExpDoc)+          recordExpression indentPolicy lexpr nameDoc rFs+        HsRecFields [] (Just 0) -> do+          let t = lrdrNameToText lname+          docWrapNode lname $ docLit $ t <> Text.pack " { .. }"+        HsRecFields fs@(_:_) (Just dotdoti) | dotdoti == length fs -> do+          -- TODO this should be consolidated into `recordExpression`+          let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname+          fieldDocs <- fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+            let FieldOcc _ lnameF = fieldOcc+#else+            let FieldOcc lnameF _ = fieldOcc+#endif+            fExpDoc <- if pun+              then return Nothing+              else Just <$> docSharedWrapper layoutExpr fExpr+            return (fieldl, lrdrNameToText lnameF, fExpDoc)+          let ((fd1l, fd1n, fd1e):fdr) = fieldDocs+          let line1 wrapper =                 [ appSep $ docLit $ Text.pack "{"-                , docWrapNodePrior rF1f $ appSep $ docLit rF1n-                , case rF1e of-                    Just x -> docWrapNodeRest rF1f $ docSeq-                                    [ appSep $ docLit $ Text.pack "="-                                    , docForceSingleline x-                                    ]+                , docWrapNodePrior fd1l $ appSep $ docLit fd1n+                , case fd1e of+                    Just x -> docSeq+                      [ appSep $ docLit $ Text.pack "="+                      , docWrapNodeRest fd1l $ wrapper x+                      ]                     Nothing -> docEmpty                 ]-              lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate+          let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->                 [ docCommaSep                 , appSep $ docLit fText                 , case fDoc of-                    Just x ->  docSeq [ appSep $ docLit $ Text.pack "="-                                      , docForceSingleline x-                                      ]+                    Just x -> docWrapNode lfield $ docSeq+                      [ appSep $ docLit $ Text.pack "="+                      , wrapper x+                      ]                     Nothing -> docEmpty                 ]-              lineN = docSeq+          let lineDot =+                [ docCommaSep+                , docLit $ Text.pack ".."+                ]+          let lineN =                 [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty                 , docLit $ Text.pack "}"                 ]-              in [line1] ++ lineR ++ [lineN]-          ]-        -- non-hanging with expressions placed to the right of the names-        -- container-        -- { fieldA = blub-        -- , fieldB = potentially-        --     multiline-        -- }-        addAlternative-          $ docSetParSpacing-          $ docAddBaseY BrIndentRegular-          $ docPar-              (docNodeAnnKW lexpr Nothing rExprDoc)-              (docNonBottomSpacing $ docLines $ let-                expressionWrapper = case indentPolicy of-                  IndentPolicyLeft -> docForceParSpacing-                  IndentPolicyMultiple -> docForceParSpacing-                  IndentPolicyFree -> docSetBaseY-                line1 = docCols ColRecUpdate-                  [ appSep $ docLit $ Text.pack "{"-                  , docWrapNodePrior rF1f $ appSep $ docLit rF1n-                  , docWrapNodeRest rF1f $ case rF1e of-                      Just x -> docAlt-                        [ docSeq [ appSep $ docLit $ Text.pack "="-                                 , expressionWrapper x-                                 ]-                        , docAddBaseY BrIndentRegular-                        $ docPar (docLit $ Text.pack "=") x-                        ]-                      Nothing -> docEmpty-                  ]-                lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield-                  $ docCols ColRecUpdate-                  [ docCommaSep-                  , appSep $ docLit fText-                  , case fDoc of-                      Just x -> docAlt-                        [ docSeq [ appSep $ docLit $ Text.pack "="-                                 , expressionWrapper x-                                 ]-                        , docAddBaseY BrIndentRegular-                        $ docPar (docLit $ Text.pack "=") x-                        ]-                      Nothing -> docEmpty-                  ]-                lineN = docSeq-                  [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty-                  , docLit $ Text.pack "}"-                  ]-                in [line1] ++ lineR ++ [lineN]-              )-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+          docAlt -- TODO: make this addFilteredAlternative and a hanging layout when Free+            [  docSeq+            $  [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]+            ++ line1 docForceSingleline+            ++ join (lineR docForceSingleline)+            ++ lineDot+            ++ [docSeparator]+            ++ lineN+            , docSetParSpacing+            $ docAddBaseY BrIndentRegular+            $ docPar+                (docNodeAnnKW lexpr Nothing nameDoc)+                ( docNonBottomSpacing+                $ docLines+                $  [docCols ColRec $ line1 (docAddBaseY BrIndentRegular)]+                ++ (docCols ColRec <$> lineR (docAddBaseY BrIndentRegular))+                ++ [docSeq lineDot, docSeq lineN]+                )+            ]+        _ -> unknownNodeError "RecordCon with puns" lexpr+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    RecordUpd _ rExpr fields -> do+#else+    RecordUpd rExpr fields _ _ _ _ -> do+#endif+      rExprDoc <- docSharedWrapper layoutExpr rExpr+      rFs <- fields+        `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do+          rFExpDoc <- if pun+            then return Nothing+            else Just <$> docSharedWrapper layoutExpr rFExpr+          return $ case ambName of+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+            Unambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc)+            Ambiguous   _ n -> (lfield, lrdrNameToText n, rFExpDoc)+            XAmbiguousFieldOcc{} ->+              error "brittany internal error: XAmbiguousFieldOcc"+#else+            Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)+            Ambiguous   n _ -> (lfield, lrdrNameToText n, rFExpDoc)+#endif+      recordExpression indentPolicy lexpr rExprDoc rFs+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    ExprWithTySig (HsWC _ XHsImplicitBndrs{}) _ ->+      error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs"+    ExprWithTySig XHsWildCardBndrs{} _ ->+      error "brittany internal error: ExprWithTySig XHsWildCardBndrs"+    ExprWithTySig (HsWC _ (HsIB _ typ1)) exp1 -> do+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8,4 */     ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do #else /* ghc-8.0 */     ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do@@ -972,9 +1042,11 @@         , appSep $ docLit $ Text.pack "::"         , typDoc         ]+#if !MIN_VERSION_ghc(8,6,0)  /* ghc-8.0 8.2 8.4 */     ExprWithTySigOut{} -> do       -- TODO       briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr+#endif     ArithSeq _ Nothing info ->       case info of         From e1 -> do@@ -1019,9 +1091,11 @@             ]     ArithSeq{} ->       briDocByExactInlineOnly "ArithSeq" lexpr+#if !MIN_VERSION_ghc(8,6,0)  /* ghc-8.0 8.2 8.4 */     PArrSeq{} -> do       -- TODO       briDocByExactInlineOnly "PArrSeq{}" lexpr+#endif     HsSCC{} -> do       -- TODO       briDocByExactInlineOnly "HsSCC{}" lexpr@@ -1037,6 +1111,18 @@     HsTcBracketOut{} -> do       -- TODO       briDocByExactInlineOnly "HsTcBracketOut{}" lexpr+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    HsSpliceE _ (HsQuasiQuote _ _ quoter _loc content) -> do+#else+    HsSpliceE (HsQuasiQuote _ quoter _loc content) -> do+#endif+      allocateNode $ BDFPlain+        (Text.pack+          $  "["+          ++ showOutputable quoter+          ++ "|"+          ++ showOutputable content+          ++ "|]")     HsSpliceE{} -> do       -- TODO       briDocByExactInlineOnly "HsSpliceE{}" lexpr@@ -1063,7 +1149,11 @@       briDocByExactInlineOnly "HsTickPragma{}" lexpr     EWildPat{} -> do       docLit $ Text.pack "_"+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    EAsPat _ asName asExpr -> do+#else     EAsPat asName asExpr -> do+#endif       docSeq         [ docLit $ lrdrNameToText asName <> Text.pack "@"         , layoutExpr asExpr@@ -1085,7 +1175,123 @@       -- TODO       briDocByExactInlineOnly "ExplicitSum{}" lexpr #endif+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    XExpr{} -> error "brittany internal error: XExpr"+#endif +recordExpression+  :: (Data.Data.Data lExpr, Data.Data.Data name)+  => IndentPolicy+  -> GenLocated SrcSpan lExpr+  -> ToBriDocM BriDocNumbered+  -> [(GenLocated SrcSpan name, Text, Maybe (ToBriDocM BriDocNumbered))]+  -> ToBriDocM BriDocNumbered+recordExpression _ lexpr nameDoc [] =+  docSeq+    [ docNodeAnnKW lexpr (Just AnnOpenC) $ docSeq [nameDoc, docLit $ Text.pack "{"]+    , docLit $ Text.pack "}"+    ]+recordExpression indentPolicy lexpr nameDoc rFs@((rF1f, rF1n, rF1e):rFr) =+  runFilteredAlternative $ do+    -- container { fieldA = blub, fieldB = blub }+    addAlternative+      $ docSeq+      [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline nameDoc+      , appSep $ docLit $ Text.pack "{"+      , appSep $ docSeq $ List.intersperse docCommaSep+              $ rFs <&> \case+                (lfield, fieldStr, Just fieldDoc) ->+                  docWrapNode lfield $ docSeq+                        [ appSep $ docLit fieldStr+                        , appSep $ docLit $ Text.pack "="+                        , docForceSingleline fieldDoc+                        ]+                (lfield, fieldStr, Nothing) ->+                  docWrapNode lfield $ docLit fieldStr+      , docLit $ Text.pack "}"+      ]+    -- hanging single-line fields+    -- container { fieldA = blub+    --           , fieldB = blub+    --           }+    addAlternativeCond (indentPolicy == IndentPolicyFree)+      $ docSeq+      [ docNodeAnnKW lexpr Nothing $ appSep nameDoc+      , docSetBaseY $ docLines $ let+          line1 = docCols ColRec+            [ appSep $ docLit $ Text.pack "{"+            , docWrapNodePrior rF1f $ appSep $ docLit rF1n+            , case rF1e of+                Just x -> docWrapNodeRest rF1f $ docSeq+                                [ appSep $ docLit $ Text.pack "="+                                , docForceSingleline x+                                ]+                Nothing -> docEmpty+            ]+          lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRec+            [ docCommaSep+            , appSep $ docLit fText+            , case fDoc of+                Just x ->  docSeq [ appSep $ docLit $ Text.pack "="+                                  , docForceSingleline x+                                  ]+                Nothing -> docEmpty+            ]+          lineN = docSeq+            [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty+            , docLit $ Text.pack "}"+            ]+          in [line1] ++ lineR ++ [lineN]+      ]+    -- non-hanging with expressions placed to the right of the names+    -- container+    -- { fieldA = blub+    -- , fieldB = potentially+    --     multiline+    -- }+    addAlternative+      $ docSetParSpacing+      $ docAddBaseY BrIndentRegular+      $ docPar+          (docNodeAnnKW lexpr Nothing nameDoc)+          (docNonBottomSpacing $ docLines $ let+            expressionWrapper = case indentPolicy of+              IndentPolicyLeft -> docForceParSpacing+              IndentPolicyMultiple -> docForceParSpacing+              IndentPolicyFree -> docSetBaseY+            line1 = docCols ColRec+              [ appSep $ docLit $ Text.pack "{"+              , docWrapNodePrior rF1f $ appSep $ docLit rF1n+              , docWrapNodeRest rF1f $ case rF1e of+                  Just x -> docAlt+                    [ docSeq [ appSep $ docLit $ Text.pack "="+                             , expressionWrapper x+                             ]+                    , docAddBaseY BrIndentRegular+                    $ docPar (docLit $ Text.pack "=") x+                    ]+                  Nothing -> docEmpty+              ]+            lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield+              $ docCols ColRec+              [ docCommaSep+              , appSep $ docLit fText+              , case fDoc of+                  Just x -> docAlt+                    [ docSeq [ appSep $ docLit $ Text.pack "="+                             , expressionWrapper x+                             ]+                    , docAddBaseY BrIndentRegular+                    $ docPar (docLit $ Text.pack "=") x+                    ]+                  Nothing -> docEmpty+              ]+            lineN = docSeq+              [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty+              , docLit $ Text.pack "}"+              ]+            in [line1] ++ lineR ++ [lineN]+          )  #if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */ litBriDoc :: HsLit GhcPs -> BriDocFInt

@@ -39,46 +39,85 @@  layoutIE :: ToBriDoc IE layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of-  IEVar      _                     -> ien-  IEThingAbs _                     -> ien-  IEThingAll _                     -> docSeq [ien, docLit $ Text.pack "(..)"]-  IEThingWith _ (IEWildcard _) _ _ -> docSeq [ien, docLit $ Text.pack "(..)"]-  IEThingWith _ _ ns _ -> do+#if MIN_VERSION_ghc(8,6,0)+  IEVar _ x -> layoutWrapped lie x+#else+  IEVar x -> layoutWrapped lie x+#endif+#if MIN_VERSION_ghc(8,6,0)+  IEThingAbs _ x -> layoutWrapped lie x+#else+  IEThingAbs x -> layoutWrapped lie x+#endif+#if MIN_VERSION_ghc(8,6,0)+  IEThingAll _ x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]+#else+  IEThingAll x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]+#endif+#if MIN_VERSION_ghc(8,6,0)+  IEThingWith _ x (IEWildcard _) _ _ ->+#else+  IEThingWith x (IEWildcard _) _ _ ->+#endif+    docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]+#if MIN_VERSION_ghc(8,6,0)+  IEThingWith _ x _ ns _ -> do+#else+  IEThingWith x _ ns _ -> do+#endif     hasComments <- hasAnyCommentsBelow lie     runFilteredAlternative $ do       addAlternativeCond (not hasComments)         $  docSeq-        $  [ien, docLit $ Text.pack "("]+        $  [layoutWrapped lie x, docLit $ Text.pack "("]         ++ intersperse docCommaSep (map nameDoc ns)         ++ [docParenR]-      addAlternative-        $ docAddBaseY BrIndentRegular-        $ docPar ien (layoutItems (splitFirstLast ns))+      addAlternative $ docAddBaseY BrIndentRegular $ docPar+        (layoutWrapped lie x)+        (layoutItems (splitFirstLast ns))    where     nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName     layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n]-    layoutItems FirstLastEmpty =-      docSetBaseY $-        docLines [docSeq [docParenLSep, docWrapNodeRest lie docEmpty]-                 ,docParenR-                 ]-    layoutItems (FirstLastSingleton n) =-      docSetBaseY $ docLines-        [docSeq [docParenLSep, docWrapNodeRest lie $ nameDoc n], docParenR]-    layoutItems (FirstLast n1 nMs nN)  =-      docSetBaseY $ docLines $-         [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]]-         ++ map layoutItem nMs-         ++ [ docSeq [docCommaSep, docWrapNodeRest lie $ nameDoc nN]-            , docParenR-            ]+    layoutItems FirstLastEmpty = docSetBaseY $ docLines+      [docSeq [docParenLSep, docWrapNodeRest lie docEmpty], docParenR]+    layoutItems (FirstLastSingleton n) = docSetBaseY $ docLines+      [docSeq [docParenLSep, docWrapNodeRest lie $ nameDoc n], docParenR]+    layoutItems (FirstLast n1 nMs nN) =+      docSetBaseY+        $  docLines+        $  [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]]+        ++ map layoutItem nMs+        ++ [docSeq [docCommaSep, docWrapNodeRest lie $ nameDoc nN], docParenR]+#if MIN_VERSION_ghc(8,6,0)+  IEModuleContents _ n -> docSeq+#else   IEModuleContents n -> docSeq+#endif     [ docLit $ Text.pack "module"     , docSeparator     , docLit . Text.pack . moduleNameString $ unLoc n     ]   _ -> docEmpty-  where ien = docLit =<< lrdrNameToTextAnn (ieName <$> lie)+ where+#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2, 8.4, .. */+  layoutWrapped _ = \case+    L _ (IEName    n) -> docLit =<< lrdrNameToTextAnn n+    L _ (IEPattern n) -> do+      name <- lrdrNameToTextAnn n+      docLit $ Text.pack "pattern " <> name+    L _ (IEType n) -> do+      name <- lrdrNameToTextAnn n+      docLit $ Text.pack "type " <> name+#else                      /* ghc-8.0 */+  layoutWrapped outer n = do+    name <- lrdrNameToTextAnn n+    hasType <- hasAnnKeyword n AnnType+    hasPattern <- hasAnnKeyword outer AnnPattern+    docLit $ if+      | hasType    -> Text.pack "type (" <> name <> Text.pack ")"+      | hasPattern -> Text.pack "pattern " <> name+      | otherwise  -> name+#endif  -- Helper function to deal with Located lists of LIEs. -- In particular this will also associate documentation

@@ -43,7 +43,11 @@  layoutImport :: ToBriDoc ImportDecl layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of+#if MIN_VERSION_ghc(8,6,0)+  ImportDecl _ _ (L _ modName) pkg src safe q False mas mllies -> do+#else   ImportDecl _ (L _ modName) pkg src safe q False mas mllies -> do+#endif     importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack     importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack     indentPolicy <- mAsk <&>  _conf_layout .> _lconfig_indentPolicy .> confUnpack@@ -87,7 +91,13 @@         Just (_, llies) -> do           hasComments <- hasAnyCommentsBelow llies           if compact-          then docSeq [hidDoc, layoutLLIEs True llies]+          then docAlt+            [ docSeq [hidDoc, docForceSingleline $ layoutLLIEs True llies]+            , let makeParIfHiding = if hiding+                    then docAddBaseY BrIndentRegular . docPar hidDoc+                    else id+              in makeParIfHiding (layoutLLIEs True llies)+            ]           else do             ieDs <- layoutAnnAndSepLLIEs llies             docWrapNodeRest llies@@ -99,7 +109,7 @@                     (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty])                     (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)                   else docSeq [hidDoc, docParenLSep, docSeparator, docParenR]-                  -- ..[hiding].( b )+                -- ..[hiding].( b )                 [ieD] -> runFilteredAlternative $ do                   addAlternativeCond (not hasComments)                     $ docSeq@@ -112,9 +122,9 @@                   addAlternative $ docPar                     (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])                     (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)-                  -- ..[hiding].( b-                  --            , b'-                  --            )+                -- ..[hiding].( b+                --            , b'+                --            )                 (ieD:ieDs') ->                   docPar                     (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]])

@@ -40,7 +40,7 @@           [ docNodeAnnKW lmod Nothing docEmpty              -- A pseudo node that serves merely to force documentation              -- before the node-          , docNodeMoveToKWDP lmod AnnModule $ runFilteredAlternative $ do+          , docNodeMoveToKWDP lmod AnnModule True $ runFilteredAlternative $ do             addAlternativeCond allowSingleLine $               docForceSingleline                 $ docSeq

@@ -13,7 +13,7 @@ import           Language.Haskell.Brittany.Internal.Types import           Language.Haskell.Brittany.Internal.LayouterBasics -import           GHC ( Located, runGhc, GenLocated(L), moduleNameString )+import           GHC ( Located, runGhc, GenLocated(L), moduleNameString, ol_val ) import           HsSyn import           Name import           BasicTypes@@ -37,11 +37,25 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of   WildPat _  -> fmap Seq.singleton $ docLit $ Text.pack "_"     -- _ -> expr-  VarPat n   -> fmap Seq.singleton $ docLit $ lrdrNameToText n+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  VarPat _ n ->+#else                        /* ghc-8.0 8.2 8.4 */+  VarPat   n ->+#endif+    fmap Seq.singleton $ docLit $ lrdrNameToText n     -- abc -> expr-  LitPat lit -> fmap Seq.singleton $ allocateNode $ litBriDoc lit+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  LitPat _ lit ->+#else                        /* ghc-8.0 8.2 8.4 */+  LitPat lit ->+#endif+    fmap Seq.singleton $ allocateNode $ litBriDoc lit     -- 0 -> expr+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  ParPat _ inner -> do+#else                        /* ghc-8.0 8.2 8.4 */   ParPat inner -> do+#endif     -- (nestedpat) -> expr     left  <- docLit $ Text.pack "("     right <- docLit $ Text.pack ")"@@ -89,7 +103,12 @@     -- Abc { a = locA, b = locB, c = locC } -> expr1     -- Abc { a, b, c } -> expr2     let t = lrdrNameToText lname-    fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do+    fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+      let FieldOcc _ lnameF = fieldOcc+#else+      let FieldOcc lnameF _ = fieldOcc+#endif       fExpDoc <- if pun         then return Nothing         else Just <$> docSharedWrapper layoutPat fPat@@ -118,7 +137,12 @@   ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do     -- Abc { a = locA, .. }     let t = lrdrNameToText lname-    fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do+    fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+      let FieldOcc _ lnameF = fieldOcc+#else+      let FieldOcc lnameF _ = fieldOcc+#endif       fExpDoc <- if pun         then return Nothing         else Just <$> docSharedWrapper layoutPat fPat@@ -136,18 +160,28 @@           (fieldName, Nothing) -> [docLit fieldName, docCommaSep]       , docLit $ Text.pack "..}"       ]+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  TuplePat _ args boxity -> do+#else   TuplePat args boxity _ -> do+#endif     -- (nestedpat1, nestedpat2, nestedpat3) -> expr     -- (#nestedpat1, nestedpat2, nestedpat3#) -> expr     case boxity of-      Boxed   -> wrapPatListy args "(" ")"-      Unboxed -> wrapPatListy args "(#" "#)"+      Boxed   -> wrapPatListy args "()" docParenL docParenR+      Unboxed -> wrapPatListy args "(##)" docParenHashLSep docParenHashRSep+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  AsPat _ asName asPat -> do+#else   AsPat asName asPat -> do+#endif     -- bind@nestedpat -> expr     wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@")-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  SigPat (HsWC _ (HsIB _ ty1)) pat1 -> do+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */   SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do-#else /* ghc-8.0 */+#else                        /* ghc-8.0 */   SigPatIn pat1 (HsIB _ (HsWC _ _ ty1)) -> do #endif     -- i :: Int -> expr@@ -169,19 +203,35 @@           , docForceSingleline tyDoc           ]         return $ xR Seq.|> xN'+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  ListPat _ elems ->+#else   ListPat elems _ _ ->+#endif     -- [] -> expr1     -- [nestedpat1, nestedpat2, nestedpat3] -> expr2-    wrapPatListy elems "[" "]"+    wrapPatListy elems "[]" docBracketL docBracketR+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  BangPat _ pat1 -> do+#else   BangPat pat1 -> do+#endif     -- !nestedpat -> expr     wrapPatPrepend pat1 (docLit $ Text.pack "!")+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  LazyPat _ pat1 -> do+#else   LazyPat pat1 -> do+#endif     -- ~nestedpat -> expr     wrapPatPrepend pat1 (docLit $ Text.pack "~")-  NPat llit@(L _ (OverLit olit _ _ _)) mNegative _ _ -> do+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  NPat _ llit@(L _ ol) mNegative _ -> do+#else+  NPat llit@(L _ ol) mNegative _ _ -> do+#endif     -- -13 -> expr-    litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc olit+    litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc $ GHC.ol_val ol     negDoc <- docLit $ Text.pack "-"     pure $ case mNegative of       Just{}  -> Seq.fromList [negDoc, litDoc]@@ -212,18 +262,18 @@ wrapPatListy   :: [Located (Pat GhcPs)]   -> String-  -> String+  -> ToBriDocM BriDocNumbered+  -> ToBriDocM BriDocNumbered   -> ToBriDocM (Seq BriDocNumbered)-wrapPatListy elems start end = do+wrapPatListy elems both start end = do   elemDocs <- Seq.fromList elems `forM` (layoutPat >=> colsWrapPat)-  sDoc <- docLit $ Text.pack start-  eDoc <- docLit $ Text.pack end   case Seq.viewl elemDocs of-    Seq.EmptyL -> fmap Seq.singleton $ docLit $ Text.pack $ start ++ end+    Seq.EmptyL -> fmap Seq.singleton $ docLit $ Text.pack both     x1 Seq.:< rest -> do-        rest' <- rest `forM` \bd -> docSeq-          [ docLit $ Text.pack ","-          , docSeparator-          , return bd-          ]-        return $ (sDoc Seq.<| x1 Seq.<| rest') Seq.|> eDoc+      sDoc <- start+      eDoc <- end+      rest' <- rest `forM` \bd -> docSeq+        [ docCommaSep+        , return bd+        ]+      return $ (sDoc Seq.<| x1 Seq.<| rest') Seq.|> eDoc

@@ -34,9 +34,17 @@   indentAmount :: Int <-     mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack   docWrapNode lstmt $ case stmt of+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    LastStmt _ body False _ -> do+#else     LastStmt body False _ -> do+#endif       layoutExpr body+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    BindStmt _ lPat expr _ _ -> do+#else     BindStmt lPat expr _ _ _ -> do+#endif       patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat       expDoc <- docSharedWrapper layoutExpr expr       docAlt@@ -52,7 +60,11 @@             $ docPar (docLit $ Text.pack "<-") (expDoc)           ]         ]+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    LetStmt _ binds -> do+#else     LetStmt binds -> do+#endif       let isFree         = indentPolicy == IndentPolicyFree       let indentFourPlus = indentAmount >= 4       layoutLocalBinds binds >>= \case@@ -97,7 +109,11 @@             $ docAddBaseY BrIndentRegular             $ docPar (docLit $ Text.pack "let")                      (docSetBaseAndIndent $ docLines $ return <$> bindDocs)+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    RecStmt _ stmts _ _ _ _ _ -> runFilteredAlternative $ do+#else     RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do+#endif       -- rec stmt1       --     stmt2       --     stmt3@@ -113,7 +129,11 @@       addAlternative $ docAddBaseY BrIndentRegular $ docPar         (docLit (Text.pack "rec"))         (docLines $ layoutStmt <$> stmts)+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+    BodyStmt _ expr _ _ -> do+#else     BodyStmt expr _ _ _ -> do+#endif       expDoc <- docSharedWrapper layoutExpr expr       docAddBaseY BrIndentRegular $ expDoc     _ -> briDocByExactInlineOnly "some unknown statement" lstmt

@@ -23,6 +23,7 @@ import           Name import           Outputable ( ftext, showSDocUnsafe ) import           BasicTypes+import qualified SrcLoc  import           DataTreePrint @@ -31,7 +32,17 @@ layoutType :: ToBriDoc HsType layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of   -- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible"-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+#if MIN_VERSION_ghc(8,6,0)+  HsTyVar _ promoted name -> do+    t <- lrdrNameToTextAnn name+    case promoted of+      Promoted -> docSeq+        [ docSeparator+        , docTick+        , docWrapNode name $ docLit t+        ]+      NotPromoted -> docWrapNode name $ docLit t+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */   HsTyVar promoted name -> do     t <- lrdrNameToTextAnn name     case promoted of@@ -46,13 +57,25 @@     t <- lrdrNameToTextAnn name     docWrapNode name $ docLit t #endif+#if MIN_VERSION_ghc(8,6,0)+  HsForAllTy _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do+#else   HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts) typ2)) -> do+#endif     typeDoc <- docSharedWrapper layoutType typ2     tyVarDocs <- bndrs `forM` \case+#if MIN_VERSION_ghc(8,6,0)+      (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing)+      (L _ (KindedTyVar _ lrdrName kind)) -> do+        d <- docSharedWrapper layoutType kind+        return $ (lrdrNameToText lrdrName, Just $ d)+      (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr"+#else       (L _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing)       (L _ (KindedTyVar lrdrName kind)) -> do         d <- docSharedWrapper layoutType kind         return $ (lrdrNameToText lrdrName, Just $ d)+#endif     cntxtDocs <- cntxts `forM` docSharedWrapper layoutType     let maybeForceML = case typ2 of           (L _ HsFunTy{}) -> docForceMultiline@@ -143,13 +166,25 @@             ]           )       ]+#if MIN_VERSION_ghc(8,6,0)+  HsForAllTy _ bndrs typ2 -> do+#else   HsForAllTy bndrs typ2 -> do+#endif     typeDoc <- layoutType typ2     tyVarDocs <- bndrs `forM` \case+#if MIN_VERSION_ghc(8,6,0)+      (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing)+      (L _ (KindedTyVar _ lrdrName kind)) -> do+        d <- layoutType kind+        return $ (lrdrNameToText lrdrName, Just $ return d)+      (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr"+#else       (L _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing)       (L _ (KindedTyVar lrdrName kind)) -> do         d <- layoutType kind         return $ (lrdrNameToText lrdrName, Just $ return d)+#endif     let maybeForceML = case typ2 of           (L _ HsFunTy{}) -> docForceMultiline           _               -> id@@ -210,7 +245,11 @@             ]           )       ]+#if MIN_VERSION_ghc(8,6,0)+  HsQualTy _ lcntxts@(L _ cntxts) typ1 -> do+#else   HsQualTy lcntxts@(L _ cntxts) typ1 -> do+#endif     typeDoc <- docSharedWrapper layoutType typ1     cntxtDocs <- cntxts `forM` docSharedWrapper layoutType     let@@ -234,7 +273,7 @@               list = List.tail cntxtDocs <&> \cntxtDoc ->                      docCols ColTyOpPrefix                       [ docCommaSep-                      , docAddBaseY (BrIndentSpecial 2) +                      , docAddBaseY (BrIndentSpecial 2)                       $ cntxtDoc                       ]             in docPar open $ docLines $ list ++ [close]@@ -260,7 +299,11 @@             ]           )       ]+#if MIN_VERSION_ghc(8,6,0)+  HsFunTy _ typ1 typ2 -> do+#else   HsFunTy typ1 typ2 -> do+#endif     typeDoc1 <- docSharedWrapper layoutType typ1     typeDoc2 <- docSharedWrapper layoutType typ2     let maybeForceML = case typ2 of@@ -284,7 +327,11 @@           ]         )       ]+#if MIN_VERSION_ghc(8,6,0)+  HsParTy _ typ1 -> do+#else   HsParTy typ1 -> do+#endif     typeDoc1 <- docSharedWrapper layoutType typ1     docAlt       [ docSeq@@ -299,6 +346,35 @@             ])           (docLit $ Text.pack ")")       ]+#if MIN_VERSION_ghc(8,6,0)+  HsAppTy _ typ1@(L _ HsAppTy{}) typ2 -> do+    let gather :: [LHsType GhcPs] -> LHsType GhcPs -> (LHsType GhcPs, [LHsType GhcPs])+        gather list = \case+          L _ (HsAppTy _ ty1 ty2) -> gather (ty2:list) ty1+          final -> (final, list)+    let (typHead, typRest) = gather [typ2] typ1+    docHead <- docSharedWrapper layoutType typHead+    docRest <- docSharedWrapper layoutType `mapM` typRest+    docAlt+      [ docSeq+      $ docForceSingleline docHead : (docRest >>= \d ->+        [ docSeparator, docForceSingleline d ])+      , docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest)+      ]+  HsAppTy _ typ1 typ2 -> do+    typeDoc1 <- docSharedWrapper layoutType typ1+    typeDoc2 <- docSharedWrapper layoutType typ2+    docAlt+      [ docSeq+        [ docForceSingleline typeDoc1+        , docSeparator+        , docForceSingleline typeDoc2+        ]+      , docPar+          typeDoc1+          (docEnsureIndent BrIndentRegular typeDoc2)+      ]+#else   HsAppTy typ1 typ2 -> do     typeDoc1 <- docSharedWrapper layoutType typ1     typeDoc2 <- docSharedWrapper layoutType typ2@@ -351,7 +427,12 @@       layoutAppType (L _ (HsAppPrefix t)) = layoutType t       layoutAppType lt@(L _ (HsAppInfix t)) =         docLit =<< lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lt t+#endif+#if MIN_VERSION_ghc(8,6,0)+  HsListTy _ typ1 -> do+#else   HsListTy typ1 -> do+#endif     typeDoc1 <- docSharedWrapper layoutType typ1     docAlt       [ docSeq@@ -366,6 +447,8 @@             ])           (docLit $ Text.pack "]")       ]+#if MIN_VERSION_ghc(8,6,0)+#else   HsPArrTy typ1 -> do     typeDoc1 <- docSharedWrapper layoutType typ1     docAlt@@ -381,43 +464,49 @@             ])           (docLit $ Text.pack ":]")       ]+#endif+#if MIN_VERSION_ghc(8,6,0)+  HsTupleTy _ tupleSort typs -> case tupleSort of+#else   HsTupleTy tupleSort typs -> case tupleSort of+#endif     HsUnboxedTuple           -> unboxed     HsBoxedTuple             -> simple     HsConstraintTuple        -> simple     HsBoxedOrConstraintTuple -> simple    where-    unboxed = if null typs then error "unboxed unit?" else unboxedL+    unboxed = if null typs then error "brittany internal error: unboxed unit"+                           else unboxedL     simple = if null typs then unitL else simpleL     unitL = docLit $ Text.pack "()"     simpleL = do       docs <- docSharedWrapper layoutType `mapM` typs+      let end = docLit $ Text.pack ")"+          lines = List.tail docs <&> \d ->+                  docCols ColTyOpPrefix [docCommaSep, d]       docAlt         [ docSeq $ [docLit $ Text.pack "("]                ++ List.intersperse docCommaSep (docForceSingleline <$> docs)-               ++ [docLit $ Text.pack ")"]-        , let-            start = docCols ColTyOpPrefix [docParenLSep, head docs]-            lines = List.tail docs <&> \d ->-                    docCols ColTyOpPrefix [docCommaSep, d]-            end   = docLit $ Text.pack ")"+               ++ [end]+        , let line1 = docCols ColTyOpPrefix [docParenLSep, head docs]           in docPar-            (docAddBaseY (BrIndentSpecial 2) $ start)+            (docAddBaseY (BrIndentSpecial 2) $ line1)             (docLines $ (docAddBaseY (BrIndentSpecial 2) <$> lines) ++ [end])         ]     unboxedL = do       docs <- docSharedWrapper layoutType `mapM` typs+      let start = docParenHashLSep+          end   = docParenHashRSep       docAlt-        [ docSeq $ [docLit $ Text.pack "(#"]-               ++ List.intersperse docCommaSep docs-               ++ [docLit $ Text.pack "#)"]+        [ docSeq $ [start]+                ++ List.intersperse docCommaSep docs+                ++ [end]         , let-            start = docCols ColTyOpPrefix [docLit $ Text.pack "(#", head docs]-            lines = List.tail docs <&> \d ->-                    docCols ColTyOpPrefix [docCommaSep, d]-            end   = docLit $ Text.pack "#)"+            line1 = docCols ColTyOpPrefix [start, head docs]+            lines  = List.tail docs <&> \d ->+                     docCols ColTyOpPrefix [docCommaSep, d]           in docPar-            (docAddBaseY (BrIndentSpecial 2) start)+            (docAddBaseY (BrIndentSpecial 2) line1)             (docLines $ (docAddBaseY (BrIndentSpecial 2) <$> lines) ++ [end])         ]   HsOpTy{} -> -- TODO@@ -480,9 +569,11 @@   --               }   --     , _layouter_ast = ltype   --     }-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */+  HsIParamTy _ (L _ (HsIPName ipName)) typ1 -> do+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */   HsIParamTy (L _ (HsIPName ipName)) typ1 -> do-#else /* ghc-8.0 */+#else                        /* ghc-8.0 */   HsIParamTy (HsIPName ipName) typ1 -> do #endif     typeDoc1 <- docSharedWrapper layoutType typ1@@ -503,6 +594,8 @@             , docAddBaseY (BrIndentSpecial 2) typeDoc1             ])       ]+#if MIN_VERSION_ghc(8,6,0)+#else   HsEqTy typ1 typ2 -> do     typeDoc1 <- docSharedWrapper layoutType typ1     typeDoc2 <- docSharedWrapper layoutType typ2@@ -521,8 +614,13 @@               , docAddBaseY (BrIndentSpecial 2) typeDoc2               ])       ]+#endif   -- TODO: test KindSig+#if MIN_VERSION_ghc(8,6,0)+  HsKindSig _ typ1 kind1 -> do+#else   HsKindSig typ1 kind1 -> do+#endif     typeDoc1 <- docSharedWrapper layoutType typ1     kindDoc1 <- docSharedWrapper layoutType kind1     hasParens <- hasAnnKeyword ltype AnnOpenP@@ -640,7 +738,11 @@       ]   HsExplicitTupleTy{} -> -- TODO     briDocByExactInlineOnly "HsExplicitTupleTy{}" ltype+#if MIN_VERSION_ghc(8,6,0)+  HsTyLit _ lit -> case lit of+#else   HsTyLit lit -> case lit of+#endif #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */     HsNumTy (SourceText srctext) _ -> docLit $ Text.pack srctext     HsNumTy NoSourceText _ ->@@ -652,11 +754,20 @@     HsNumTy srctext _ -> docLit $ Text.pack srctext     HsStrTy srctext _ -> docLit $ Text.pack srctext #endif+#if !MIN_VERSION_ghc(8,6,0)   HsCoreTy{} -> -- TODO     briDocByExactInlineOnly "HsCoreTy{}" ltype+#endif   HsWildCardTy _ ->     docLit $ Text.pack "_" #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */   HsSumTy{} -> -- TODO     briDocByExactInlineOnly "HsSumTy{}" ltype+#endif+#if MIN_VERSION_ghc(8,6,0)+  HsStarTy _ isUnicode -> do+    if isUnicode+      then docLit $ Text.pack "\x2605" -- Unicode star+      else docLit $ Text.pack "*"+  XHsType{} -> error "brittany internal error: XHsType" #endif

@@ -1,3 +1,8 @@+#if !MIN_VERSION_ghc(8,4,0) /* ghc-8.0, ghc-8.2 */+{-# LANGUAGE TypeFamilies #-}+#endif++ module Language.Haskell.Brittany.Internal.Prelude   ( module E   , module Language.Haskell.Brittany.Internal.Prelude@@ -400,5 +405,8 @@   #if !MIN_VERSION_ghc(8,4,0) /* ghc-8.0, ghc-8.2 */+type family IdP p+type instance IdP GhcPs = RdrName+ type GhcPs = RdrName #endif

@@ -203,6 +203,7 @@                       AltLineModeStateForceSL{} -> p == VerticalSpacingParNone                       AltLineModeStateForceML{} -> p /= VerticalSpacingParNone                       AltLineModeStateContradiction -> False+                  -- TODO: use COMPLETE pragma instead?                   lineCheck _ = error "ghc exhaustive check is insufficient"               lconf <- _conf_layout <$> mAsk #if INSERTTRACESALT@@ -287,6 +288,7 @@           mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }           return $ x         BDFExternal{} -> processSpacingSimple bdX $> bdX+        BDFPlain{}    -> processSpacingSimple bdX $> bdX         BDFAnnotationPrior annKey bd -> do           acp <- mGet           mSet $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp }@@ -296,8 +298,8 @@           reWrap . BDFAnnotationRest annKey <$> rec bd         BDFAnnotationKW annKey kw bd ->           reWrap . BDFAnnotationKW annKey kw <$> rec bd-        BDFMoveToKWDP annKey kw bd ->-          reWrap . BDFMoveToKWDP annKey kw <$> rec bd+        BDFMoveToKWDP annKey kw b bd ->+          reWrap . BDFMoveToKWDP annKey kw b <$> rec bd         BDFLines [] -> return $ reWrap BDFEmpty -- evil transformation. or harmless.         BDFLines (l:lr) -> do           ind <- _acp_indent <$> mGet@@ -336,9 +338,13 @@           acp :: AltCurPos <- mGet           tellDebugMess $ "transformAlts: BDFDEBUG " ++ s ++ " (node-id=" ++ show brDcId ++ "): acp=" ++ show acp           reWrap . BDFDebug s <$> rec bd-    processSpacingSimple :: (MonadMultiReader-                                                     Config m,-                                                   MonadMultiState AltCurPos m, MonadMultiWriter (Seq String) m) => BriDocNumbered -> m ()+    processSpacingSimple+      :: ( MonadMultiReader Config m+         , MonadMultiState AltCurPos m+         , MonadMultiWriter (Seq String) m+         )+      => BriDocNumbered+      -> m ()     processSpacingSimple bd = getSpacing bd >>= \case       LineModeInvalid                           -> error "processSpacingSimple inv"       LineModeValid (VerticalSpacing i VerticalSpacingParNone _) -> do@@ -440,7 +446,11 @@       BDFPar{} -> error "BDPar with indent in getSpacing"       BDFAlt [] -> error "empty BDAlt"       BDFAlt (alt:_) -> rec alt-      BDFForceMultiline  bd -> rec bd+      BDFForceMultiline  bd -> do+        mVs <- rec bd+        return $ mVs >>= _vs_paragraph .> \case+          VerticalSpacingParNone -> LineModeInvalid+          _  -> mVs       BDFForceSingleline bd -> do         mVs <- rec bd         return $ mVs >>= _vs_paragraph .> \case@@ -450,15 +460,19 @@       BDFExternal _ _ _ txt -> return $ LineModeValid $ case Text.lines txt of         [t] -> VerticalSpacing (Text.length t) VerticalSpacingParNone False         _   -> VerticalSpacing 999 VerticalSpacingParNone False+      BDFPlain txt -> return $ LineModeValid $ case Text.lines txt of+        [t] -> VerticalSpacing (Text.length t) VerticalSpacingParNone False+        _   -> VerticalSpacing 999 VerticalSpacingParNone False       BDFAnnotationPrior _annKey bd -> rec bd       BDFAnnotationKW _annKey _kw bd -> rec bd       BDFAnnotationRest  _annKey bd -> rec bd-      BDFMoveToKWDP _annKey _kw bd -> rec bd+      BDFMoveToKWDP _annKey _kw _b bd -> rec bd       BDFLines [] -> return         $ LineModeValid         $ VerticalSpacing 0 VerticalSpacingParNone False       BDFLines ls@(_:_) -> do-        lSps@(mVs:_) <- rec `mapM` ls+        lSps <- rec `mapM` ls+        let (mVs:_) = lSps -- separated into let to avoid MonadFail         return $ [ VerticalSpacing lsp (VerticalSpacingParSome $ lineMax) False                  | VerticalSpacing lsp _ _ <- mVs                  , lineMax <- getMaxVS $ maxVs $ lSps@@ -541,6 +555,8 @@     VerticalSpacingParNone -> 0     VerticalSpacingParAlways i -> i +data SpecialCompare = Unequal | Smaller | Bigger+ getSpacings   :: forall m    . (MonadMultiReader Config m, MonadMultiWriter (Seq String) m)@@ -567,6 +583,34 @@               VerticalSpacingParNone -> True               VerticalSpacingParSome i -> i <= colMax               VerticalSpacingParAlways{} -> True+      let specialCompare vs1 vs2 =+            if (  (_vs_sameLine vs1 == _vs_sameLine vs2)+               && (_vs_parFlag vs1 == _vs_parFlag vs2)+               )+              then case (_vs_paragraph vs1, _vs_paragraph vs2) of+                (VerticalSpacingParAlways i1, VerticalSpacingParAlways i2) ->+                  if i1 < i2 then Smaller else Bigger+                (p1, p2) -> if p1 == p2 then Smaller else Unequal+              else Unequal+      let allowHangingQuasiQuotes =+            config+              & _conf_layout+              & _lconfig_allowHangingQuasiQuotes+              & confUnpack+      let -- this is like List.nub, with one difference: if two elements+          -- are unequal only in _vs_paragraph, with both ParAlways, we+          -- treat them like equals and replace the first occurence with the+          -- smallest member of this "equal group".+          specialNub :: [VerticalSpacing] -> [VerticalSpacing]+          specialNub [] = []+          specialNub (x1 : xr) = case go x1 xr of+            (r, xs') -> r : specialNub xs'+           where+            go y1 []        = (y1, [])+            go y1 (y2 : yr) = case specialCompare y1 y2 of+              Unequal -> let (r, yr') = go y1 yr in (r, y2 : yr')+              Smaller -> go y1 yr+              Bigger  -> go y2 yr       let -- the standard function used to enforce a constant upper bound           -- on the number of elements returned for each node. Should be           -- applied whenever in a parent the combination of spacings from@@ -575,11 +619,7 @@           filterAndLimit = take limit                            -- prune so we always consider a constant                            -- amount of spacings per node of the BriDoc.-                         . filter hasOkColCount-                           -- throw out any spacings (i.e. children) that-                           -- already use more columns than available in-                           -- total.-                         . List.nub+                         . specialNub                            -- In the end we want to know if there is at least                            -- one valid spacing for any alternative.                            -- If there are duplicates in the list, then these@@ -601,6 +641,10 @@                            -- layouts when we can than take non-optimal layouts                            -- just to be consistent with other cases where                            -- we'd choose non-optimal layouts.+                         . filter hasOkColCount+                           -- throw out any spacings (i.e. children) that+                           -- already use more columns than available in+                           -- total.                          . preFilterLimit       result <- case brdc of         -- BDWrapAnnKey _annKey bd -> rec bd@@ -686,7 +730,9 @@         BDFAlt alts -> do           r <- rec `mapM` alts           return $ filterAndLimit =<< r-        BDFForceMultiline  bd -> rec bd+        BDFForceMultiline  bd -> do+          mVs <- filterAndLimit <$> rec bd+          return $ filter ((/=VerticalSpacingParNone) . _vs_paragraph) mVs         BDFForceSingleline bd -> do           mVs <- filterAndLimit <$> rec bd           return $ filter ((==VerticalSpacingParNone) . _vs_paragraph) mVs@@ -696,10 +742,23 @@         BDFExternal{} ->           return $ [] -- yes, we just assume that we cannot properly layout                       -- this.+        BDFPlain t -> return+          [ case Text.lines t of+              []       -> VerticalSpacing 0 VerticalSpacingParNone False+              [t1    ] -> VerticalSpacing+                (Text.length t1)+                VerticalSpacingParNone+                False+              (t1 : _) -> VerticalSpacing+                (Text.length t1)+                (VerticalSpacingParAlways 0)+                True+          | allowHangingQuasiQuotes+          ]         BDFAnnotationPrior _annKey bd -> rec bd         BDFAnnotationKW _annKey _kw bd -> rec bd         BDFAnnotationRest  _annKey bd -> rec bd-        BDFMoveToKWDP _annKey _kw bd -> rec bd+        BDFMoveToKWDP _annKey _kw _b bd -> rec bd         BDFLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]         BDFLines ls@(_:_) -> do           -- we simply assume that lines is only used "properly", i.e. in@@ -707,7 +766,7 @@           -- paragraph". That most importantly means that Lines should never           -- be inserted anywhere but at the start of the line. A           -- counterexample would be anything like Seq[Lit "foo", Lines].-          lSpss <- fmap filterAndLimit <$> rec `mapM` ls+          lSpss <- map filterAndLimit <$> rec `mapM` ls           let worbled = fmap reverse                       $ sequence                       $ reverse@@ -745,7 +804,8 @@           return $ if null mVs             then [VerticalSpacing 0 (VerticalSpacingParAlways colMax) False]             else mVs <&> \vs -> vs-              { _vs_paragraph = case _vs_paragraph vs of+              { _vs_sameLine = min colMax (_vs_sameLine vs)+              , _vs_paragraph = case _vs_paragraph vs of                   VerticalSpacingParNone -> VerticalSpacingParNone                   VerticalSpacingParAlways i -> VerticalSpacingParAlways i                   VerticalSpacingParSome i -> VerticalSpacingParAlways i

@@ -125,6 +125,7 @@   BDForceSingleline{} -> Nothing   BDForwardLineMode{} -> Nothing   BDExternal{}        -> Nothing+  BDPlain{}           -> Nothing   BDLines{}           -> Nothing   BDAnnotationPrior{} -> Nothing   BDAnnotationKW{}    -> Nothing

@@ -128,6 +128,10 @@         Just $ BDBaseYPop (BDAddBaseY ind x)       BDAddBaseY ind (BDDebug s x) ->         Just $ BDDebug s (BDAddBaseY ind x)+      BDAddBaseY ind (BDIndentLevelPop x) ->+        Just $ BDIndentLevelPop (BDAddBaseY ind x)+      BDAddBaseY ind (BDIndentLevelPushCur x) ->+        Just $ BDIndentLevelPushCur (BDAddBaseY ind x)       _ -> Nothing     stepBO :: BriDoc -> BriDoc     stepBO = -- traceFunctionWith "stepBO" (show . briDocToDocWithAnns) (show . briDocToDocWithAnns) $

@@ -17,7 +17,7 @@  import qualified Data.Text.Lazy.Builder as Text.Builder -import           GHC ( Located, runGhc, GenLocated(L), moduleNameString, AnnKeywordId )+import           GHC ( Located, runGhc, GenLocated(L), moduleNameString, AnnKeywordId, SrcSpan )  import           Language.Haskell.GHC.ExactPrint ( AnnKey, Comment ) import           Language.Haskell.GHC.ExactPrint.Types ( KeywordId, Anns, DeltaPos, mkAnnKey )@@ -28,9 +28,8 @@   -data InlineConfig = InlineConfig-  { _icd_perModule :: CConfig Option-  , _icd_perBinding :: Map String (CConfig Option)+data PerItemConfig = PerItemConfig+  { _icd_perBinding :: Map String (CConfig Option)   , _icd_perKey :: Map ExactPrint.Types.AnnKey (CConfig Option)   } #if MIN_VERSION_ghc(8,2,0)@@ -38,7 +37,7 @@ #endif  type PPM = MultiRWSS.MultiRWS-  '[Map ExactPrint.AnnKey ExactPrint.Anns, InlineConfig, Config, ExactPrint.Anns]+  '[Map ExactPrint.AnnKey ExactPrint.Anns, PerItemConfig, Config, ExactPrint.Anns]   '[Text.Builder.Builder, [BrittanyError], Seq String]   '[] @@ -135,7 +134,7 @@     --   output and second the corresponding, ill-formed input.   | LayoutWarning String     -- ^ some warning-  | forall ast . Data.Data.Data ast => ErrorUnknownNode String ast+  | forall ast . Data.Data.Data ast => ErrorUnknownNode String (GenLocated SrcSpan ast)     -- ^ internal error: pretty-printing is not implemented for type of node     --   in the syntax-tree   | ErrorOutputCheck@@ -185,7 +184,7 @@     -- expected to have exactly two columns   | ColBindStmt   | ColDoLet -- the non-indented variant-  | ColRecUpdate -- used for both RecCon and RecUpd. TODO: refactor to reflect?+  | ColRec   | ColListComp   | ColList   | ColApp Text@@ -244,10 +243,12 @@                             -- to be printed via exactprint                Bool -- should print extra comment ?                Text+  | BDPlain !Text -- used for QuasiQuotes, content can be multi-line+                  -- (contrast to BDLit)   | BDAnnotationPrior AnnKey BriDoc   | BDAnnotationKW AnnKey (Maybe AnnKeywordId) BriDoc   | BDAnnotationRest  AnnKey BriDoc-  | BDMoveToKWDP AnnKey AnnKeywordId BriDoc+  | BDMoveToKWDP AnnKey AnnKeywordId Bool BriDoc -- True if should respect x offset   | BDLines [BriDoc]   | BDEnsureIndent BrIndent BriDoc   -- the following constructors are only relevant for the alt transformation@@ -290,10 +291,12 @@                             -- to be printed via exactprint                Bool -- should print extra comment ?                Text+  | BDFPlain !Text -- used for QuasiQuotes, content can be multi-line+                   -- (contrast to BDLit)   | BDFAnnotationPrior AnnKey (f (BriDocF f))   | BDFAnnotationKW AnnKey (Maybe AnnKeywordId) (f (BriDocF f))   | BDFAnnotationRest  AnnKey (f (BriDocF f))-  | BDFMoveToKWDP AnnKey AnnKeywordId (f (BriDocF f))+  | BDFMoveToKWDP AnnKey AnnKeywordId Bool (f (BriDocF f)) -- True if should respect x offset   | BDFLines [(f (BriDocF f))]   | BDFEnsureIndent BrIndent (f (BriDocF f))   | BDFForceMultiline (f (BriDocF f))@@ -324,10 +327,11 @@   uniplate (BDAlt             alts)      = plate BDAlt ||* alts   uniplate (BDForwardLineMode bd  )      = plate BDForwardLineMode |* bd   uniplate x@BDExternal{}                = plate x+  uniplate x@BDPlain{}                = plate x   uniplate (BDAnnotationPrior annKey bd) = plate BDAnnotationPrior |- annKey |* bd   uniplate (BDAnnotationKW annKey kw bd) = plate BDAnnotationKW |- annKey |- kw |* bd   uniplate (BDAnnotationRest annKey bd)  = plate BDAnnotationRest |- annKey |* bd-  uniplate (BDMoveToKWDP annKey kw bd)   = plate BDMoveToKWDP |- annKey |- kw |* bd+  uniplate (BDMoveToKWDP annKey kw b bd) = plate BDMoveToKWDP |- annKey |- kw |- b |* bd   uniplate (BDLines lines)               = plate BDLines ||* lines   uniplate (BDEnsureIndent ind bd)       = plate BDEnsureIndent |- ind |* bd   uniplate (BDForceMultiline   bd)       = plate BDForceMultiline |* bd@@ -356,10 +360,11 @@   BDFAlt             alts      -> BDAlt $ rec <$> alts -- not that this will happen   BDFForwardLineMode bd        -> BDForwardLineMode $ rec bd   BDFExternal k ks c t         -> BDExternal k ks c t+  BDFPlain t                   -> BDPlain t   BDFAnnotationPrior annKey bd -> BDAnnotationPrior annKey $ rec bd   BDFAnnotationKW annKey kw bd -> BDAnnotationKW annKey kw $ rec bd   BDFAnnotationRest annKey bd  -> BDAnnotationRest annKey $ rec bd-  BDFMoveToKWDP annKey kw bd   -> BDMoveToKWDP annKey kw $ rec bd+  BDFMoveToKWDP annKey kw b bd -> BDMoveToKWDP annKey kw b $ rec bd   BDFLines lines               -> BDLines $ rec <$> lines   BDFEnsureIndent ind bd       -> BDEnsureIndent ind $ rec bd   BDFForceMultiline   bd       -> BDForceMultiline $ rec bd@@ -378,32 +383,33 @@ -- this might not work. is not used anywhere either. briDocSeqSpine :: BriDoc -> () briDocSeqSpine = \case-  BDEmpty                       -> ()-  BDLit _t                      -> ()-  BDSeq list                    -> foldl' ((briDocSeqSpine.) . seq) () list-  BDCols _sig list              -> foldl' ((briDocSeqSpine.) . seq) () list-  BDSeparator                   -> ()-  BDAddBaseY _ind bd            -> briDocSeqSpine bd-  BDBaseYPushCur       bd       -> briDocSeqSpine bd-  BDBaseYPop           bd       -> briDocSeqSpine bd-  BDIndentLevelPushCur bd       -> briDocSeqSpine bd-  BDIndentLevelPop     bd       -> briDocSeqSpine bd+  BDEmpty                        -> ()+  BDLit _t                       -> ()+  BDSeq list                     -> foldl' ((briDocSeqSpine .) . seq) () list+  BDCols _sig list               -> foldl' ((briDocSeqSpine .) . seq) () list+  BDSeparator                    -> ()+  BDAddBaseY _ind bd             -> briDocSeqSpine bd+  BDBaseYPushCur       bd        -> briDocSeqSpine bd+  BDBaseYPop           bd        -> briDocSeqSpine bd+  BDIndentLevelPushCur bd        -> briDocSeqSpine bd+  BDIndentLevelPop     bd        -> briDocSeqSpine bd   BDPar _ind line indented -> briDocSeqSpine line `seq` briDocSeqSpine indented-  BDAlt             alts        -> foldl' (\(!()) -> briDocSeqSpine) () alts-  BDForwardLineMode bd          -> briDocSeqSpine bd-  BDExternal{}                  -> ()-  BDAnnotationPrior _annKey bd  -> briDocSeqSpine bd-  BDAnnotationKW _annKey _kw bd -> briDocSeqSpine bd-  BDAnnotationRest _annKey bd   -> briDocSeqSpine bd-  BDMoveToKWDP _annKey _kw bd   -> briDocSeqSpine bd-  BDLines lines                 -> foldl' (\(!()) -> briDocSeqSpine) () lines-  BDEnsureIndent _ind bd        -> briDocSeqSpine bd-  BDForceMultiline   bd         -> briDocSeqSpine bd-  BDForceSingleline  bd         -> briDocSeqSpine bd-  BDNonBottomSpacing bd         -> briDocSeqSpine bd-  BDSetParSpacing    bd         -> briDocSeqSpine bd-  BDForceParSpacing  bd         -> briDocSeqSpine bd-  BDDebug _s bd                 -> briDocSeqSpine bd+  BDAlt             alts         -> foldl' (\(!()) -> briDocSeqSpine) () alts+  BDForwardLineMode bd           -> briDocSeqSpine bd+  BDExternal{}                   -> ()+  BDPlain{}                      -> ()+  BDAnnotationPrior _annKey bd   -> briDocSeqSpine bd+  BDAnnotationKW _annKey _kw bd  -> briDocSeqSpine bd+  BDAnnotationRest _annKey bd    -> briDocSeqSpine bd+  BDMoveToKWDP _annKey _kw _b bd -> briDocSeqSpine bd+  BDLines lines                  -> foldl' (\(!()) -> briDocSeqSpine) () lines+  BDEnsureIndent _ind bd         -> briDocSeqSpine bd+  BDForceMultiline   bd          -> briDocSeqSpine bd+  BDForceSingleline  bd          -> briDocSeqSpine bd+  BDNonBottomSpacing bd          -> briDocSeqSpine bd+  BDSetParSpacing    bd          -> briDocSeqSpine bd+  BDForceParSpacing  bd          -> briDocSeqSpine bd+  BDDebug _s bd                  -> briDocSeqSpine bd  briDocForceSpine :: BriDoc -> BriDoc briDocForceSpine bd = briDocSeqSpine bd `seq` bd@@ -411,7 +417,7 @@  data VerticalSpacingPar   = VerticalSpacingParNone -- no indented lines-  | VerticalSpacingParSome   Int -- indented lines, requiring this much +  | VerticalSpacingParSome   Int -- indented lines, requiring this much                                  -- vertical space at most   | VerticalSpacingParAlways Int -- indented lines, requiring this much                                  -- vertical space at most, but should

@@ -24,6 +24,7 @@   , FirstLastView(..)   , splitFirstLast   , lines'+  , showOutputable   ) where @@ -69,8 +70,8 @@ showSDoc_ :: GHC.SDoc -> String showSDoc_ = GHC.showSDoc GHC.unsafeGlobalDynFlags -showGhc :: (GHC.Outputable a) => a -> String-showGhc = GHC.showPpr GHC.unsafeGlobalDynFlags+showOutputable :: (GHC.Outputable a) => a -> String+showOutputable = GHC.showPpr GHC.unsafeGlobalDynFlags  fromMaybeIdentity :: Identity a -> Maybe a -> Identity a fromMaybeIdentity x y = Data.Coerce.coerce $ fromMaybe (Data.Coerce.coerce x) y@@ -124,7 +125,7 @@   srcSpan :: GHC.SrcSpan -> NodeLayouter   srcSpan ss = simpleLayouter              -- - $ "{"++ showSDoc_ (GHC.ppr ss)++"}"-                              $ "{" ++ showGhc ss ++ "}"+                              $ "{" ++ showOutputable ss ++ "}"   located :: (Data b, Data loc) => GHC.GenLocated loc b -> NodeLayouter   located (GHC.L ss a) = runDataToLayouter layoutF $ A annStr a    where