brittany 0.10.0.0 → 0.11.0.0

raw patch · 33 files changed

+3085/−2421 lines, 33 filesdep +randomdep ~aesondep ~basedep ~butcherPVP ok

version bump matches the API change (PVP)

Dependencies added: random

Dependency ranges changed: aeson, base, butcher, czipwith, ghc, ghc-boot-th, hspec, multistate

API changes (from Hackage documentation)

Files

• ChangeLog.md +47/−0
• README.md +3/−3
• brittany.cabal +14/−16
• src-brittany/Main.hs +56/−19
• src-literatetests/15-regressions.blt +24/−0
• src-literatetests/30-tests-context-free.blt +1399/−0
• src-literatetests/40-indent-policy-multiple.blt +42/−0
• src-literatetests/Main.hs +9/−9
• src-literatetests/tests-context-free.blt +0/−1399
• src-unittests/TestUtils.hs +8/−8
• src/Language/Haskell/Brittany/Internal.hs +244/−79
• src/Language/Haskell/Brittany/Internal/Backend.hs +104/−16
• src/Language/Haskell/Brittany/Internal/Config.hs +12/−5
• src/Language/Haskell/Brittany/Internal/Config/Types.hs +25/−2
• src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs +2/−0
• src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +36/−6
• src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +63/−44
• src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +296/−275
• src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +370/−359
• src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot +5/−2
• src/Language/Haskell/Brittany/Internal/Layouters/IE.hs +25/−32
• src/Language/Haskell/Brittany/Internal/Layouters/Import.hs +14/−19
• src/Language/Haskell/Brittany/Internal/Layouters/Module.hs +25/−21
• src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs +14/−15
• src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +59/−57
• src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot +1/−2
• src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +4/−5
• src/Language/Haskell/Brittany/Internal/Obfuscation.hs +100/−0
• src/Language/Haskell/Brittany/Internal/Prelude.hs +30/−4
• src/Language/Haskell/Brittany/Internal/PreludeUtils.hs +6/−7
• src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs +24/−10
• src/Language/Haskell/Brittany/Internal/Types.hs +19/−5
• src/Language/Haskell/Brittany/Internal/Utils.hs +5/−2

@@ -1,5 +1,52 @@ # Revision history for brittany +## 0.11.0.0 -- May 2018++* Support for ghc-8.4+* Implement inline-config+    e.g. "-- brittany --indent=4"++    respects the following comment forms as input:++    ~~~~+    source comment                       affected target+    ======================================================+    "-- brittany CONFIG"                 whole module+    "-- brittany-next-binding CONFIG"    next binding+    "-- brittany-disable-next-binding"   next binding+    "-- brittany @ myExampleFunc CONFIG" `myExampleFunc`+    ~~~~++    multiline-comments are supported too, although+    the specification must still be a single line. E.g.+    +    > "{- brittany --columns 50 -}"+    +    CONFIG is either:+    +    1) one or more flags in the form of what brittany accepts+       on the commandline, e.g. "-- columns 50", or+    2) one or more specifications in the form of what brittany+       accepts in its config files for the layouting config+       (a one-line yaml document), e.g. "{ lconfig_cols: 50 }"+* Implement `IndentPolicyMultiple` (thanks to Bryan Richter @chreekat)+    Restrict indentation amounts to `n * indentAmount`+* Implement `--obfuscate` that replaces non-keyword identifiers with random+  names+* Do not write files unless there are changes (don't update modtime)+  (`--write-mode=inplace`) (#93)+* Bugfixes:+    - Fix empty function constraints (`() => IO ()`) (#133)+    - Fix overflowing columns caused by aligning with surrounding lines+      for certain complex cases+    - Implement hacky workaround for `type instance`s (`-XTypeFamilies`) (#89)+* Layouting changes:+    - On default settings, allow single-line module header+      `module MyModule where` when no exports+    - Fix one case of non-optimal layouting for if-then-else+    - Allow same-line let binding inside do-notation with+      `IndentPolicyLeft/Multiple` and `indentAmount>=4`+ ## 0.10.0.0 -- March 2018  * Implement module/exports/imports layouting (thanks to sniperrifle2004)

@@ -48,7 +48,7 @@  # Other usage notes -- Supports GHC versions `8.0.*` and `8.2.*`.+- Supports GHC versions `8.0`, `8.2` and `8.4`. - 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.@@ -72,7 +72,7 @@      ~~~~.sh     cabal unpack brittany-    cd brittany-0.8.0.2+    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.@@ -159,7 +159,7 @@  # License -Copyright (C) 2016-2017 Lennart Spitzner+Copyright (C) 2016-2018 Lennart Spitzner  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.10.0.0+version:              0.11.0.0 synopsis:             Haskell source code formatter description: {   See <https://github.com/lspitzner/brittany/blob/master/README.md the README>.@@ -12,10 +12,10 @@ license-file:         LICENSE author:               Lennart Spitzner maintainer:           Lennart Spitzner <hexagoxel@hexagoxel.de>-copyright:            Copyright (C) 2016-2017 Lennart Spitzner+copyright:            Copyright (C) 2016-2018 Lennart Spitzner category:             Language build-type:           Simple-cabal-version:        >=1.18+cabal-version:        1.18 homepage:             https://github.com/lspitzner/brittany/ bug-reports:          https://github.com/lspitzner/brittany/issues extra-doc-files: {@@ -55,6 +55,7 @@     Language.Haskell.Brittany.Internal.Config     Language.Haskell.Brittany.Internal.Config.Types     Language.Haskell.Brittany.Internal.Config.Types.Instances+    Language.Haskell.Brittany.Internal.Obfuscation     Paths_brittany   }   other-modules: {@@ -82,22 +83,22 @@     -fno-warn-redundant-constraints   }   build-depends:-    { base >=4.9 && <4.11-    , ghc >=8.0.1 && <8.3+    { base >=4.9 && <4.12+    , ghc >=8.0.1 && <8.5     , ghc-paths >=0.1.0.9 && <0.2     , ghc-exactprint >=0.5.6.0 && <0.5.7     , transformers >=0.5.2.0 && <0.6     , containers >=0.5.7.1 && <0.6     , mtl >=2.2.1 && <2.3     , text >=1.2 && <1.3-    , multistate >=0.7.1.1 && <0.8+    , multistate >=0.7.1.1 && <0.9     , syb >=0.6 && <0.8     , neat-interpolation >=0.3.2 && <0.4     , data-tree-print     , pretty >=1.1.3.3 && <1.2     , bytestring >=0.10.8.1 && <0.11     , directory >=1.2.6.2 && <1.4-    , butcher >=1.3 && <1.4+    , butcher >=1.3.1 && <1.4     , yaml >=0.8.18 && <0.9     , aeson >=1.0.1.0 && <1.3     , extra >=1.4.10 && <1.7@@ -109,9 +110,10 @@     , deepseq >=1.4.2.0 && <1.5     , semigroups >=0.18.2 && <0.19     , cmdargs >=0.10.14 && <0.11-    , czipwith >=1.0.0.0 && <1.1-    , ghc-boot-th >=8.0.1 && <8.3+    , czipwith >=1.0.1.0 && <1.1+    , ghc-boot-th >=8.0.1 && <8.5     , filepath >=1.4.1.0 && <1.5+    , random >= 1.1 && <1.2     }   default-extensions: {     CPP@@ -174,7 +176,6 @@     , cmdargs     , czipwith     , ghc-boot-th-    , hspec >=2.4.1 && <2.5     , filepath >=1.4.1.0 && <1.5     }   hs-source-dirs:      src-brittany@@ -242,9 +243,8 @@     , cmdargs     , czipwith     , ghc-boot-th-    , hspec >=2.4.1 && <2.5+    , hspec >=2.4.1 && <2.6     }-  ghc-options:      -Wall   main-is:          TestMain.hs   other-modules:    TestUtils                     AsymptoticPerfTests@@ -310,11 +310,10 @@     , cmdargs     , czipwith     , ghc-boot-th-    , hspec >=2.4.1 && <2.5+    , hspec >=2.4.1 && <2.6     , filepath     , parsec >=3.1.11 && <3.2     }-  ghc-options:      -Wall   main-is:          Main.hs   other-modules:   hs-source-dirs:   src-literatetests@@ -353,9 +352,8 @@     , base     , text     , transformers-    , hspec >=2.4.1 && <2.5+    , hspec >=2.4.1 && <2.6     }-  ghc-options:      -Wall   main-is:          Main.hs   other-modules:   hs-source-dirs:   src-libinterfacetests

@@ -11,6 +11,7 @@ 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.Monoid  import           Text.Read (Read(..)) import qualified Text.ParserCombinators.ReadP as ReadP@@ -27,6 +28,7 @@ import           Language.Haskell.Brittany.Internal.Config import           Language.Haskell.Brittany.Internal.Config.Types import           Language.Haskell.Brittany.Internal.Utils+import           Language.Haskell.Brittany.Internal.Obfuscation  import qualified Text.PrettyPrint as PP @@ -132,7 +134,7 @@   printVersion   <- addSimpleBoolFlag "" ["version"] mempty   printLicense   <- addSimpleBoolFlag "" ["license"] mempty   configPaths    <- addFlagStringParams "" ["config-file"] "PATH" (flagHelpStr "path to config file") -- TODO: allow default on addFlagStringParam ?-  cmdlineConfig  <- configParser+  cmdlineConfig  <- cmdlineConfigParser   suppressOutput <- addSimpleBoolFlag     ""     ["suppress-output"]@@ -148,7 +150,7 @@           , PP.text "inplace: override respective input file (without backup!)"           ]         )-    <> flagDefault Display+    Data.Monoid.<> flagDefault Display     )   inputParams <- addParamNoFlagStrings "PATH" (paramHelpStr "paths to input/inout haskell source files")   reorderStop@@ -178,13 +180,14 @@     config <- runMaybeT (readConfigsWithUserConfig cmdlineConfig configsToLoad) >>= \case       Nothing -> System.Exit.exitWith (System.Exit.ExitFailure 53)       Just x  -> return x-    when (confUnpack $ _dconf_dump_config $ _conf_debug $ config) $+    when (config & _conf_debug & _dconf_dump_config & confUnpack) $       trace (showConfigYaml config) $ return ()      results <- zipWithM (coreIO putStrErrLn config suppressOutput) inputPaths outputPaths-    case sequence_ results of-      Left  _ -> System.Exit.exitWith (System.Exit.ExitFailure 1)-      Right _ -> pure ()+    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)   -- | The main IO parts for the default mode of operation, and after commandline@@ -209,11 +212,14 @@   -- 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-  -- ("-- BRITTANY_INCLUDE_HACK ") right before any lines starting with+  -- ("-- 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_debug & _dconf_roundtrip_exactprint_only & 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         then case cppMode of           CPPModeAbort -> do@@ -230,7 +236,7 @@   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 "-- BRITTANY_INCLUDE_HACK " ++ s else s+      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@@ -242,27 +248,41 @@       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, outLText) <- do+      (errsWarns, outSText) <- do         if exactprintOnly           then do-            pure ([], TextL.pack $ ExactPrint.exactPrint parsedSource anns)+            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 anns parsedSource-              else liftIO $ pPrintModuleAndCheck config anns parsedSource-            let hackF s = fromMaybe s $ TextL.stripPrefix (TextL.pack "-- BRITTANY_INCLUDE_HACK ") s-            pure $ if hackAroundIncludes-              then (ews, TextL.intercalate (TextL.pack "\n") $ fmap hackF $ TextL.splitOn (TextL.pack "\n") outRaw)-              else (ews, outRaw)+              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+                  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@@ -293,6 +313,11 @@             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?@@ -303,8 +328,20 @@           shouldOutput = not suppressOutput && (not hasErrors || outputOnErrs)        when shouldOutput $ addTraceSep (_conf_debug config) $ case outputPathM of-        Nothing -> liftIO $ TextL.IO.putStr $ outLText-        Just p  -> liftIO $ TextL.IO.writeFile p $ outLText+        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        when hasErrors $ ExceptT.throwE 70  where

@@ -587,3 +587,27 @@   <|> alterantiveTwo   -- d   <|> alternativeThree -- e   ) -- f++#test issue 133+{-# LANGUAGE ScopedTypeVariables #-}+func+  :: forall a+   . ()+  => aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+  -> aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+func+  :: ()+  => aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+  -> aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa++#test alignment-potential-overflow+go l [] = Right l+go l ((IRType, _a) : eqr) = go l eqr+go l ((_, IRType) : eqr) = go l eqr+go _ ((IRTypeError ps t1 t2, _) : _) = Left $ makeError ps t1 t2+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)

@@ -0,0 +1,1399 @@++###############################################################################+###############################################################################+###############################################################################+#group type signatures+###############################################################################+###############################################################################+###############################################################################++#test simple001+func :: a -> a++#test long typeVar+func+  :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd++#test keep linebreak mode+func+  :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  -> lakjsdlkjasldkj+  -> lakjsdlkjasldkj++#test simple parens 1+func :: ((a))++#test simple parens 2+func :: (a -> a) -> a++#test simple parens 3+func :: a -> (a -> a)++#test did anyone say parentheses?+func :: (((((((((())))))))))++-- current output is.. funny. wonder if that can/needs to be improved..+#test give me more!+#pending+func :: ((((((((((((((((((((((((((((((((((((((((((()))))))))))))))))))))))))))))))))))))))))))++#test unit+func :: ()+++###############################################################################++#test paren'd func 1+func+  :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     -> lakjsdlkjasldkj+     -> lakjsdlkjasldkj+     )++#test paren'd func 2+func+  :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  -> (lakjsdlkjasldkj -> lakjsdlkjasldkj)++#test paren'd func 3+func+  :: (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> lakjsdlkjasldkj)+  -> lakjsdlkjasldkj++#test paren'd func 4+func+  :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     )+  -> lakjsdlkjasldkj++#test paren'd func 5+func+  :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       )+     )++###############################################################################++#test type application 1+func :: asd -> Either a b++#test type application 2+func+  :: asd+  -> Either+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd++#test type application 3+func+  :: asd+  -> Trither+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd++#test type application 4+func+  :: Trither+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  -> asd++#test type application 5+func+  :: Trither+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> asd)++#test type application 6+func+  :: Trither+       asd+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       )++#test type application paren 1+func+  :: asd+  -> ( Trither+         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     )++#test type application paren 2+func+  :: asd+  -> ( Trither+         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     )+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd++#test type application paren 3+func+  :: ( Trither+         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     )+       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  -> asd++###############################################################################++#test list simple+func :: [a -> b]++#test list func+func+  :: [ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     ]++#test list paren+func+  :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       )+     ]++################################################################## -- #############++#test tuple type 1+func :: (a, b, c)++#test tuple type 2+func :: ((a, b, c), (a, b, c), (a, b, c))++#test tuple type long+func+  :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     )++#test tuple type nested+func+  :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       , (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd)+       , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       )+     )++#test tuple type function+func+  :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+       )+     ]+###############################################################################+#test type operator stuff+#pending+test050 :: a :+: b+test051+  :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+test052+  :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd++###############################################################################++#test forall oneliner+{-# LANGUAGE ScopedTypeVariables #-}+func :: forall (a :: *) b . a -> b++#test forall context multiline+{-# LANGUAGE ScopedTypeVariables #-}+func+  :: forall m+   . Foo+  => ColMap2+  -> ColInfo+  -> ColInfo+  -> ColInfo+  -> ColInfo+  -> m ()++#test forall no-context multiline+{-# LANGUAGE ScopedTypeVariables #-}+func+  :: forall m+   . ColMap2+  -> ColInfo+  -> ColInfo+  -> ColInfo+  -> ColInfo+  -> ColInfo+  -> m ()++#test language pragma issue+{-# LANGUAGE ScopedTypeVariables #-}+func :: forall (a :: *) b . a -> b++#test comments 1+func :: a -> b -- comment++#test comments 2+funcA :: a -> b -- comment A+funcB :: a -> b -- comment B++#test comments all+#pending+-- a+func -- b+  :: -- c+  a -- d+  -> -- e+  ( -- f+  c -- g+  , -- h+  d -- i+  ) -- j+-- k++###############################################################################++#test ImplicitParams 1+{-# LANGUAGE ImplicitParams #-}+func :: (?asd::Int) -> ()++#test ImplicitParams 2+{-# LANGUAGE ImplicitParams #-}+func+  :: ( ?asd+     :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     )+  -> ()+++###############################################################################+###############################################################################+###############################################################################+#group type signatures pragmas+###############################################################################+###############################################################################+###############################################################################++#test inline pragma 1+func = f+ where+  {-# INLINE f #-}+  f = id++#test inline pragma 2+func = ($)+ where+  {-# INLINE ($) #-}+  ($) = id++#test inline pragma 3+func = f+ where+  {-# INLINE CONLIKE [1] f #-}+  f = id++#test inline pragma 4+#pending this does not work with the compiler version we currently use yet (i think). should work with ghc-8.0.2.+func = f+ where+  {-# INLINE [~] f #-}+  f = id+++###############################################################################+###############################################################################+###############################################################################+#group equation.basic+###############################################################################+###############################################################################+###############################################################################+## some basic testing of different kinds of equations.+## some focus on column layouting for multiple-equation definitions.+## (that part probably is not implemented in any way yet.)++#test basic 1+func x = x++#test infix 1+x *** y = x++#test symbol prefix+(***) x y = x+++###############################################################################+###############################################################################+###############################################################################+#group equation.patterns+###############################################################################+###############################################################################+###############################################################################++#test wildcard+func _ = x++#test simple long pattern+#pending+func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable+  = x++#test simple multiline pattern+#pending+func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable+  reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable+  = x++#test another multiline pattern+#pending+func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable+  a+  b+  = x++#test simple constructor+func (A a) = a++#test list constructor+func (x : xr) = x++#test some other constructor symbol+#pending+func (x :+: xr) = x+++###############################################################################+###############################################################################+###############################################################################+#group equation.guards+###############################################################################+###############################################################################+###############################################################################+#test simple guard+func | True = x++#test multiple-clauses-1+func x+  | x = simple expression+  | otherwise = 0++#test multiple-clauses-2+func x+  | a somewhat longer guard x = "and a somewhat longer expession that does not"+  | otherwise = "fit without putting the guards in new lines"++#test multiple-clauses-3+func x+  | very long guard, another rather long guard that refers to x = nontrivial+    expression+    foo+    bar+    alsdkjlasdjlasj+  | otherwise = 0++#test multiple-clauses-4+func x+  | very long guard, another rather long guard that refers to x+  = nontrivialexpression foo bar alsdkjlasdjlasj+  | otherwise+  = 0++#test multiple-clauses-5+func x+  | very loooooooooooooooooooooooooooooong guard+  , another rather long guard that refers to x+  = nontrivial expression foo bar alsdkjlasdjlasj+  | otherwise+  = 0+++###############################################################################+###############################################################################+###############################################################################+#group expression.basic+###############################################################################+###############################################################################+###############################################################################++#test var+func = x++describe "infix op" $ do+#test 1+func = x + x++#test long+#pending+func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj+  + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj++#test long keep linemode 1+#pending+func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj+  + mweroiuxlskdfjlksj+  + mweroiuxlskdfjlksj++#test long keep linemode 2+#pending+func = mweroiuxlskdfjlksj+  + mweroiuxlskdfjlksj+  + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj++#test literals+func = 1+func = "abc"+func = 1.1e5+func = 'x'+func = 981409823458910394810928414192837123987123987123++#test lambdacase+{-# LANGUAGE LambdaCase #-}+func = \case+  FooBar -> x+  Baz -> y++#test lambda+func = \x -> abc++describe "app" $ do+#test 1+func = klajsdas klajsdas klajsdas++#test 2+func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+  lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+  lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd++#test 3+func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+  lakjsdlajsdljas+  lakjsdlajsdljas+  lakjsdlajsdljas++###+#group expression.basic.sections+###++#test left+func = (1 +)++#test right+func = (+ 1)++#test left inf+## TODO: this could be improved..+func = (1 `abc`)++#test right inf+func = (`abc` 1)++###+#group tuples+###++#test 1+func = (abc, def)++#test 2+#pending+func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+  , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd)++#test let in on single line+foo =+  let longIdentifierForShortValue = 1+  in longIdentifierForShortValue + longIdentifierForShortValue++++###############################################################################+###############################################################################+###############################################################################+#group expression.do statements+###############################################################################+###############################################################################+###############################################################################++#test simple+func = do+  stmt+  stmt++#test bind+func = do+  x <- stmt+  stmt x++#test let+func = do+  let x = 13+  stmt x+++###############################################################################+###############################################################################+###############################################################################+#group expression.lists+###############################################################################+###############################################################################+###############################################################################++#test monad-comprehension-case-of+func =+  foooooo+    $ [ case+          foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo+        of+          _ -> True+      ]+++###############################################################################+###############################################################################+###############################################################################+#group expression.multiwayif+###############################################################################+###############################################################################+###############################################################################++#test simple+{-# LANGUAGE MultiWayIf #-}+func = if+  | cond1 -> loooooooooooooooooooooooooooooong expr1+  | cond2 -> loooooooooooooooooooooooooooooong expr2++#test simplenested+{-# LANGUAGE MultiWayIf #-}+func = do+  foo+  bar $ if+    | cond1 -> loooooooooooooooooooooooooooooong expr1+    | cond2 -> loooooooooooooooooooooooooooooong expr2+++###############################################################################+###############################################################################+###############################################################################+#group stylisticspecialcases+###############################################################################+###############################################################################+###############################################################################++#test operatorprefixalignment-even-with-multiline-alignbreak+func =+  foo+    $ [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+      , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb+      ]+    ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]++###############################################################################+###############################################################################+###############################################################################+#group module+###############################################################################+###############################################################################+###############################################################################++#test simple+module Main where++#test no-exports+module Main () where++#test one-export+module Main (main) where++#test several-exports+module Main (main, test1, test2) where++#test many-exports+module Main+  ( main+  , test1+  , test2+  , test3+  , test4+  , test5+  , test6+  , test7+  , test8+  , test9+  )+where++#test exports-with-comments+module Main+  ( main+  -- main+  , test1+  , test2+  -- Test 3+  , test3+  , test4+  -- Test 5+  , test5+  -- Test 6+  )+where++#test simple-export-with-things+module Main (Test(..)) where++#test simple-export-with-module-contents+module Main (module Main) where++#test export-with-things+module Main (Test(Test, a, b)) where++#test export-with-empty-thing+module Main (Test()) where++#test empty-with-comment+-- Intentionally left empty++###############################################################################+###############################################################################+###############################################################################+#group import+###############################################################################+###############################################################################+###############################################################################++#test simple-import+import Data.List++#test simple-import-alias+import Data.List as L++#test simple-qualified-import+import qualified Data.List++#test simple-qualified-import-alias+import qualified Data.List as L++#test simple-safe+import safe Data.List as L++#test simple-source+import {-# SOURCE #-} Data.List ()++#test simple-safe-qualified+import safe qualified Data.List hiding (nub)++#test simple-safe-qualified-source+import {-# SOURCE #-} safe qualified Data.List++#test simple-qualified-package+import qualified "base" Data.List++#test qualifier-effect+import {-# SOURCE #-} safe qualified "base" Data.List as L+import {-# SOURCE #-} safe qualified "base" Data.List ()+import {-# SOURCE #-} safe qualified Data.List hiding ()++#test instances-only+import qualified Data.List ()++#test one-element+import Data.List (nub)++#test several-elements+import Data.List (nub, foldl', indexElem)++#test a-ridiculous-amount-of-elements+import Test+  ( Long+  , list+  , with+  , items+  , that+  , will+  , not+  , quite+  , fit+  , onA+  , single+  , line+  , anymore+  )++#test with-things+import Test (T, T2(), T3(..), T4(T4), T5(T5, t5), T6((<|>)), (+))++#test hiding+import Test hiding ()+import Test as T hiding ()++#test long-module-name-simple+import TestJustShortEnoughModuleNameLikeThisOne ()+import TestJustAbitToLongModuleNameLikeThisOneIs ()+import MoreThanSufficientlyLongModuleNameWithSome+  (items, that, will, not, fit, inA, compact, layout)++#test long-module-name-as+import TestJustShortEnoughModuleNameLikeThisOn as T+import TestJustAbitToLongModuleNameLikeThisOneI as T++#test long-module-name-hiding+import TestJustShortEnoughModuleNameLike hiding ()+import TestJustAbitToLongModuleNameLikeTh hiding ()++#test long-module-name-simple-items+import MoreThanSufficientlyLongModuleNameWithSome+  (items, that, will, not, fit, inA, compact, layout)++#test long-module-name-hiding-items+import TestJustShortEnoughModuleNameLike hiding (abc, def, ghci, jklm)++#test import-with-comments+-- Test+import Data.List (nub) -- Test+{- Test -}+import qualified Data.List as L (foldl') {- Test -}++#test import-with-comments-2++import Test+  ( abc+  , def+  -- comment+  )++#test import-with-comments-3++import Test+  ( abc+  -- comment+  )++#test import-with-comments-4+import Test+  ( abc+  -- comment+  , def+  , ghi+  {- comment -}+  , jkl+  -- comment+  )++-- Test+import Test (test)++#test import-with-comments-5+import Test+  ( -- comment+  )++#test long-bindings+import Test (longbindingNameThatoverflowsColum)+import Test (Long(List, Of, Things))++#test things-with-with-comments+import Test+  ( Thing+    ( With+    -- Comments+    , and+    -- also+    , items+    -- !+    )+  )+import Test+  ( Thing+    ( Item+    -- and Comment+    )+  )+import Test+  ( Thing+    ( With+    -- Comments+    , and+    -- also+    , items+    -- !+    )+  )++#test prefer-dense-empty-list+import VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine+  ()++#test preamble full-preamble+{-# LANGUAGE BangPatterns #-}++{-+ - Test module+ -}+module Test+  ( test1+  -- ^ test+  , test2+  -- | test+  , test3+  , test4+  , test5+  , test6+  , test7+  , test8+  , test9+  , test10+  )+where++-- Test+import Data.List (nub) -- Test+{- Test -}+import qualified Data.List as L (foldl') {- Test -}++-- Test+import Test (test)++###############################################################################+###############################################################################+###############################################################################+#group regression+###############################################################################+###############################################################################+###############################################################################++#test newlines-comment+func = do+  abc <- foo++--abc+return ()++#test parenthesis-around-unit+func = (())++#test let-defs indentation+func = do+  let+    foo True = True+    foo _ = False+  return ()++#test let-defs no indent+func = do+  let+    foo True = True+    foo _ = False+  return ()++#test let-defs no indent+func = do+  let+    foo = True+    b = False+  return ()++#test let-defs no indent+func =+  let+    foo = True+    b = False+  in return ()++#test record update indentation 1+func = do+  s <- mGet+  mSet $ s { _lstate_indent = _lstate_indent state }++#test record update indentation 2+func = do+  s <- mGet+  mSet $ s+    { _lstate_indent = _lstate_indent state+    , _lstate_foo = _lstate_foo state+    }++#test record update indentation 3+func = do+  s <- mGet+  mSet $ s+    { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+    , _lstate_foo = _lstate_foo kasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+    }++#test record construction 1+func = Foo {_lstate_indent = _lstate_indent state}++#test record construction 2+func = Foo+  { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  }++#test record construction 3+func = do+  Foo+    { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+    , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+    }++#test post-indent comment+func = do+-- abc+  -- def+  return ()++#test post-unindent comment+func = do+  do+    return ()+    -- abc+  -- def+  return ()++#test CPP empty comment case+#pending CPP parsing needs fixing for roundTripEqual+{-# LANGUAGE CPP #-}+module Test where+func = do+#if FOO+  let x = 13+#endif+  stmt x++## really, the following should be handled by forcing the Alt to multiline+## because there are comments. as long as this is not implemented though,+## we should ensure the trivial solution works.+#test comment inline placement (temporary)+func+  :: Int -- basic indentation amount+  -> Int -- currently used width in current line (after indent)+         -- used to accurately calc placing of the current-line+  -> LayoutDesc+  -> Int++#test some indentation thingy+func =+  (lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj+  $ abc+  $ def+  $ ghi+  $ jkl+  )++#test parenthesized operator+buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0)+  where reassoc (v, e, w) = (v, (e, w))++#test record pattern matching stuff+downloadRepoPackage = case repo of+  RepoLocal {..} -> return ()+  RepoLocal { abc } -> return ()+  RepoLocal{} -> return ()++#test do let comment indentation level problem+func = do+  let+    (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs'+    (bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets''+    -- default local dir target if there's no given target+    utargets'' = "foo"+  return ()++#test list comprehension comment placement+func =+  [ (thing, take 10 alts) --TODO: select best ones+  | (thing, _got, alts@(_ : _)) <- nosuchFooThing+  , gast <- award+  ]++#test if-then-else comment placement+func = if x+  then if y -- y is important+    then foo+    else bar+  else Nothing++#test qualified infix pattern+#pending "TODO"+wrapPatPrepend pat prepElem = do+  patDocs <- layoutPat pat+  case Seq.viewl patDocs of+    Seq.EmptyL -> return $ Seq.empty+    x1 Seq.:< xR -> do+      x1' <- docSeq [prepElem, return x1]+      return $ x1' Seq.<| xR++#test type signature multiline forcing issue+layoutWriteNewlineBlock+  :: ( MonadMultiWriter Text.Builder.Builder m+     , MonadMultiState LayoutState m+     , MonadMultiWriter (Seq String) m+     )+  => m ()++#test multiwayif proper indentation+{-# LANGUAGE MultiWayIf #-}+readMergePersConfig path shouldCreate conf = do+  exists <- liftIO $ System.Directory.doesFileExist path+  if+    | exists -> do+      contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.+      fileConf <- case Data.Yaml.decodeEither contents of+        Left e -> do+          liftIO+            $ putStrErrLn+            $ "error reading in brittany config from "+            ++ path+            ++ ":"+          liftIO $ putStrErrLn e+          mzero+        Right x -> return x+      return $ fileConf Semigroup.<> conf+    | shouldCreate -> do+      liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap+        (Option . Just . runIdentity)+        staticDefaultConfig+      return $ conf+    | otherwise -> do+      return conf++#test nested pattern alignment issue"+func = BuildReport+ where+  convertInstallOutcome = case result of+    Left BR.PlanningFailed -> PlanningFailed+    Left (BR.DependentFailed p) -> DependencyFailed p+    Left (BR.DownloadFailed _) -> DownloadFailed+    Left (BR.UnpackFailed _) -> UnpackFailed+    Left (BR.ConfigureFailed _) -> ConfigureFailed+    Left (BR.BuildFailed _) -> BuildFailed+    Left (BR.TestsFailed _) -> TestsFailed+    Left (BR.InstallFailed _) -> InstallFailed+    Right (BR.BuildOk _ _ _) -> InstallOk++#test nested pattern alignment issue"+func = BuildReport+ where+  convertInstallOutcome = case result of+    Left BR.PlanningFailed -> PlanningFailed+    Left (BR.DependentFailed p) -> DependencyFailed p+    Left (BR.DownloadFailed _) -> DownloadFailed+    Left (BR.UnpackFailed _) -> UnpackFailed+    Left (BR.ConfigureFailed _) -> ConfigureFailed+    Left (BR.BuildFailed _) -> BuildFailed+    Left (BR.TestsFailed _) -> TestsFailed+    Left (BR.InstallFailed _) -> InstallFailed+    Right (BR.BuildOk _ _ _) -> InstallOk++#test partially overflowing alignment issue"+showPackageDetailedInfo pkginfo =+  renderStyle (style { lineLength = 80, ribbonsPerLine = 1 })+    $ char '*'+    $+$ something+          [ entry "Synopsis" synopsis hideIfNull reflowParagraphs+          , entry+            "Versions available"+            sourceVersions+            (altText null "[ Not available from server ]")+            (dispTopVersions 9 (preferredVersions pkginfo))+          , entry+            "Versions installed"+            installedVersions+            (altText+              null+              (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")+            )+            (dispTopVersions 4 (preferredVersions pkginfo))+          , entry "Homepage" homepage orNotSpecified text+          , entry "Bug reports" bugReports orNotSpecified text+          , entry "Description" description hideIfNull reflowParagraphs+          , entry "Category" category hideIfNull text+          , entry "License" license alwaysShow disp+          , entry "Author" author hideIfNull reflowLines+          , entry "Maintainer" maintainer hideIfNull reflowLines+          , entry "Source repo" sourceRepo orNotSpecified text+          , entry "Executables" executables hideIfNull (commaSep text)+          , entry "Flags" flags hideIfNull (commaSep dispFlag)+          , entry "Dependencies" dependencies hideIfNull (commaSep dispExtDep)+          , entry "Documentation" haddockHtml showIfInstalled text+          , entry "Cached" haveTarball alwaysShow dispYesNo+          , if not (hasLib pkginfo)+            then empty+            else text "Modules:"+              $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))+          ]++#test issue 7a+isValidPosition position+  | validX && validY = Just position+  | otherwise = Nothing++#test issue-6-pattern-linebreak-validity+## this is ugly, but at least syntactically valid.+foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do+  (inputEvent :: Reflex.Event Reflex.Spider String, inputFire :: String+    -> IO Bool) <-+    ReflexHost.newExternalEvent+  liftIO . forkIO . forever $ getLine >>= inputFire+  ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent++#test issue 16+foldrDesc f z = unSwitchQueue $ \q ->+  switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q)++#test issue 18+autocheckCases =+  [ ("Never Deadlocks", representative deadlocksNever)+  , ("No Exceptions", representative exceptionsNever)+  , ("Consistent Result", alwaysSame) -- already representative+  ]++#test issue 18b+autocheckCases =+  [ ("Never Deadlocks", representative deadlocksNever)+  , ("No Exceptions", representative exceptionsNever)+  , ( "Consistent Result"+    , alwaysSame -- already representative+    )+  ]++#test issue 18c+func =+  [ (abc, (1111, 1111))+  , (def, (2, 2))+  , foo -- comment+  ]++#test issue 26+foo a b = g a b -- fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo+  where g a b = b + b * a++#test issue 26b+foo a b = g a b where g a b = b + b * a -- fooooooooooooooooooooooooooooooooooo++#test aggressive alignment 1+func = do+  abc <- expr+  abcccccccccccccccccc <- expr+  abcccccccccccccccccccccccccccccccccccccccccc <- expr+  abccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc <- expr++#test example alignment 1+func (MyLongFoo abc def) = 1+func (Bar a d) = 2+func _ = 3++#test listcomprehension-case-of+parserCompactLocation =+  [ try+      $ [ ParseRelAbs (Text.Read.read digits) _ _+        | digits <- many1 digit+        , rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe+          [ case divPart of+              Nothing -> Left $ Text.Read.read digits+              Just ddigits ->+                Right $ Text.Read.read digits % Text.Read.read ddigits+          | digits <- many1 digit+          , divPart <- optionMaybe (string "/" *> many1 digit)+          ]+        ]+  ]++#test opapp-specialcasing-1+func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo+  foooooooooooooooooooooooooooooooo+  foooooooooooooooooooooooooooooooo++#test opapp-specialcasing-2+func =+  fooooooooooooooooooooooooooooooooo+    + foooooooooooooooooooooooooooooooo+        foooooooooooooooooooooooooooooooo+        foooooooooooooooooooooooooooooooo++#test opapp-specialcasing-3+func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo+  [ foooooooooooooooooooooooooooooooo+  , foooooooooooooooooooooooooooooooo+  , foooooooooooooooooooooooooooooooo+  ]++#test opapp-indenting+parserPrim =+  [ r+  | r <-+    [ SGPPrimFloat $ bool id (0 -) minus $ readGnok+        "parserPrim"+        (d1 ++ d2 ++ d3 ++ d4)+    | d2 <- string "."+    , d3 <- many1 (oneOf "0123456789")+    , _ <- string "f"+    ]+    <|> [ SGPPrimFloat $ bool id (0 -) minus $ fromIntegral+            (readGnok "parserPrim" d1 :: Integer)+        | _ <- string "f"+        ]+    <|> [ SGPPrimInt $ bool id (0 -) minus $ fromIntegral+            (readGnok "parserPrim" d1 :: Integer)+        | _ <- string "i"+        ]+  ]++#test another-parspacing-testcase++samples = (SV.unpackaaaaadat) <&> \f ->+  aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa++#test recordupd-singleline-bug++runBrittany tabSize text = do+  let+    config' = staticDefaultConfig+    config = config'+      { _conf_layout = (_conf_layout config')+        { _lconfig_indentAmount = coerce tabSize+        }+      , _conf_forward = forwardOptionsSyntaxExtsEnabled+      }+  parsePrintModule config text++#test issue 38++{-# LANGUAGE TypeApplications #-}+foo = bar @Baz++#test comment-before-BDCols+{-# LANGUAGE TypeApplications #-}+layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do+  docAlt+    $  -- one-line solution+      [ docCols+          (ColBindingLine alignmentToken)+          [ docSeq (patPartInline ++ [guardPart])+          , docSeq+            [ appSep $ return binderDoc+            , docForceSingleline $ return body+            , wherePart+            ]+          ]+      | not hasComments+      , [(guards, body, _bodyRaw)] <- [clauseDocs]+      , let guardPart = singleLineGuardsDoc guards+      , wherePart <- case mWhereDocs of+        Nothing -> return @[] $ docEmpty+        Just [w] -> return @[] $ docSeq+          [ docSeparator+          , appSep $ docLit $ Text.pack "where"+          , docSetIndentLevel $ docForceSingleline $ return w+          ]+        _ -> []+      ]+    ++ -- one-line solution + where in next line(s)+       [ docLines+         $ [ docCols+               (ColBindingLine alignmentToken)+               [ docSeq (patPartInline ++ [guardPart])+               , docSeq+                 [appSep $ return binderDoc, docForceParSpacing $ return body]+               ]+           ]+         ++ wherePartMultiLine+       | [(guards, body, _bodyRaw)] <- [clauseDocs]+       , let guardPart = singleLineGuardsDoc guards+       , Data.Maybe.isJust mWhereDocs+       ]+    ++ -- two-line solution + where in next line(s)+       [ docLines+         $ [ docForceSingleline+             $ docSeq (patPartInline ++ [guardPart, return binderDoc])+           , docEnsureIndent BrIndentRegular $ docForceSingleline $ return+             body+           ]+         ++ wherePartMultiLine+       | [(guards, body, _bodyRaw)] <- [clauseDocs]+       , let guardPart = singleLineGuardsDoc guards+       ]++#test comment-testcase-17+{-# LANGUAGE MultiWayIf #-}+func = do+  let+    foo = if+      | Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO+                                                                    -> max+        (defLen - 0.2) -- TODO+        (defLen * 0.8)+      | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO+  return True++#test issue 49++foo n = case n of+  1 -> True+  -1 -> False++bar n = case n of+  (-2, -2) -> (-2, -2)++#test issue 48 a++foo =+  let+    a = b@1+    cccc = ()+  in foo++#test issue 48 b++{-# LANGUAGE TypeApplications #-}+foo =+  let+    a = b @1+    cccc = ()+  in foo+++###############################################################################+###############################################################################+###############################################################################+#group pending+###############################################################################+###############################################################################+###############################################################################++++## this testcase is not about idempotency, but about _how_ the output differs+## from the input; i cannot really express this yet with the current+## test-suite.+## #test ayaz+##+## myManageHook =+##   composeOne [isFullscreen -?> doFullFloat, isDialog -?> doFloat, transience]+##     <+> composeAll+##           [ className =? "Pidgin" --> doFloat+##           , className =? "XCalc" --> doFloat+##           -- plan9port's acme+##           , className =? "acme" --> doFloat+##           -- Acme with Vi bindings editor+##           , title =? "ED" --> doFloat+##           , title =? "wlc-x11" --> doFloat+##           , className =? "Skype" --> doFloat+##           , className =? "ffplay" --> doFloat+##           , className =? "mpv" --> doFloat+##           , className =? "Plugin-container" --> doFloat -- Firefox flash, etc.+##           -- Firefox works well tiled, but it has dialog windows we want to float.+##           , appName =? "Browser" --> doFloat+##           ]+##  where+##   role = stringProperty "WM_WINDOW_ROLE"

@@ -0,0 +1,42 @@+###############################################################################+###############################################################################+###############################################################################+#group indent-policy-multiple+###############################################################################+###############################################################################+###############################################################################++#test long+-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }+func =+    mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj+        + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj++#test let indAmount=4+-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }+foo = do+    let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =+            aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+    foo++#test let indAmount=8+-- brittany { lconfig_indentAmount: 8, lconfig_indentPolicy: IndentPolicyMultiple }+foo = do+        let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =+                aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+        foo+foo = do+        let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =+                aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+                        + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+                        + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+        foo++#test nested do-block+-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }+foo = asdyf8asdf+    "ajsdfas"+    [ asjdf asyhf $ do+        aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+        aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+    ]

@@ -46,7 +46,7 @@           $ filter (".blt"`isSuffixOf`) files   inputs <- blts `forM` \blt -> Text.IO.readFile ("src-literatetests" </> blt)   let groups = createChunks =<< inputs-  inputCtxFree <- Text.IO.readFile "src-literatetests/tests-context-free.blt"+  inputCtxFree <- Text.IO.readFile "src-literatetests/30-tests-context-free.blt"   let groupsCtxFree = createChunks inputCtxFree   hspec $ do     groups `forM_` \(groupname, tests) -> do@@ -160,9 +160,9 @@  defaultTestConfig :: Config defaultTestConfig = Config-  { _conf_version = _conf_version staticDefaultConfig-  , _conf_debug   = _conf_debug staticDefaultConfig-  , _conf_layout  = LayoutConfig+  { _conf_version                   = _conf_version staticDefaultConfig+  , _conf_debug                     = _conf_debug staticDefaultConfig+  , _conf_layout                    = LayoutConfig     { _lconfig_cols                      = coerce (80 :: Int)     , _lconfig_indentPolicy              = coerce IndentPolicyFree     , _lconfig_indentAmount              = coerce (2 :: Int)@@ -178,13 +178,13 @@     , _lconfig_reformatModulePreamble    = coerce True     , _lconfig_allowSingleLineExportList = coerce True     }-  , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)+  , _conf_errorHandling             = (_conf_errorHandling staticDefaultConfig)     { _econf_omit_output_valid_check = coerce True     }-  , _conf_preprocessor = _conf_preprocessor staticDefaultConfig-  , _conf_forward      = ForwardOptions-    { _options_ghc = Identity []-    }+  , _conf_preprocessor              = _conf_preprocessor staticDefaultConfig+  , _conf_forward = ForwardOptions {_options_ghc = Identity []}+  , _conf_roundtrip_exactprint_only = coerce False+  , _conf_obfuscate = coerce False   }  contextFreeTestConfig :: Config

@@ -1,1399 +0,0 @@--###############################################################################-###############################################################################-###############################################################################-#group type signatures-###############################################################################-###############################################################################-###############################################################################--#test simple001-func :: a -> a--#test long typeVar-func-  :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-  -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd--#test keep linebreak mode-func-  :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-  -> lakjsdlkjasldkj-  -> lakjsdlkjasldkj--#test simple parens 1-func :: ((a))--#test simple parens 2-func :: (a -> a) -> a--#test simple parens 3-func :: a -> (a -> a)--#test did anyone say parentheses?-func :: (((((((((())))))))))---- current output is.. funny. wonder if that can/needs to be improved..-#test give me more!-#pending-func :: ((((((((((((((((((((((((((((((((((((((((((()))))))))))))))))))))))))))))))))))))))))))--#test unit-func :: ()---###############################################################################--#test paren'd func 1-func-  :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     -> lakjsdlkjasldkj-     -> lakjsdlkjasldkj-     )--#test paren'd func 2-func-  :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-  -> (lakjsdlkjasldkj -> lakjsdlkjasldkj)--#test paren'd func 3-func-  :: (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> lakjsdlkjasldkj)-  -> lakjsdlkjasldkj--#test paren'd func 4-func-  :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     )-  -> lakjsdlkjasldkj--#test paren'd func 5-func-  :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       )-     )--###############################################################################--#test type application 1-func :: asd -> Either a b--#test type application 2-func-  :: asd-  -> Either-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd--#test type application 3-func-  :: asd-  -> Trither-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd--#test type application 4-func-  :: Trither-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-  -> asd--#test type application 5-func-  :: Trither-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> asd)--#test type application 6-func-  :: Trither-       asd-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       )--#test type application paren 1-func-  :: asd-  -> ( Trither-         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     )--#test type application paren 2-func-  :: asd-  -> ( Trither-         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     )-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd--#test type application paren 3-func-  :: ( Trither-         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-         lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     )-       lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-  -> asd--###############################################################################--#test list simple-func :: [a -> b]--#test list func-func-  :: [ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     ]--#test list paren-func-  :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       )-     ]--################################################################## -- #############--#test tuple type 1-func :: (a, b, c)--#test tuple type 2-func :: ((a, b, c), (a, b, c), (a, b, c))--#test tuple type long-func-  :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     )--#test tuple type nested-func-  :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       , (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd)-       , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       )-     )--#test tuple type function-func-  :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-       )-     ]-###############################################################################-#test type operator stuff-#pending-test050 :: a :+: b-test051-  :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-  :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-test052-  :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-  -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-  :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-  -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd--###############################################################################--#test forall oneliner-{-# LANGUAGE ScopedTypeVariables #-}-func :: forall (a :: *) b . a -> b--#test forall context multiline-{-# LANGUAGE ScopedTypeVariables #-}-func-  :: forall m-   . Foo-  => ColMap2-  -> ColInfo-  -> ColInfo-  -> ColInfo-  -> ColInfo-  -> m ()--#test forall no-context multiline-{-# LANGUAGE ScopedTypeVariables #-}-func-  :: forall m-   . ColMap2-  -> ColInfo-  -> ColInfo-  -> ColInfo-  -> ColInfo-  -> ColInfo-  -> m ()--#test language pragma issue-{-# LANGUAGE ScopedTypeVariables #-}-func :: forall (a :: *) b . a -> b--#test comments 1-func :: a -> b -- comment--#test comments 2-funcA :: a -> b -- comment A-funcB :: a -> b -- comment B--#test comments all-#pending--- a-func -- b-  :: -- c-  a -- d-  -> -- e-  ( -- f-  c -- g-  , -- h-  d -- i-  ) -- j--- k--###############################################################################--#test ImplicitParams 1-{-# LANGUAGE ImplicitParams #-}-func :: (?asd::Int) -> ()--#test ImplicitParams 2-{-# LANGUAGE ImplicitParams #-}-func-  :: ( ?asd-     :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-     )-  -> ()---###############################################################################-###############################################################################-###############################################################################-#group type signatures pragmas-###############################################################################-###############################################################################-###############################################################################--#test inline pragma 1-func = f- where-  {-# INLINE f #-}-  f = id--#test inline pragma 2-func = ($)- where-  {-# INLINE ($) #-}-  ($) = id--#test inline pragma 3-func = f- where-  {-# INLINE CONLIKE [1] f #-}-  f = id--#test inline pragma 4-#pending this does not work with the compiler version we currently use yet (i think). should work with ghc-8.0.2.-func = f- where-  {-# INLINE [~] f #-}-  f = id---###############################################################################-###############################################################################-###############################################################################-#group equation.basic-###############################################################################-###############################################################################-###############################################################################-## some basic testing of different kinds of equations.-## some focus on column layouting for multiple-equation definitions.-## (that part probably is not implemented in any way yet.)--#test basic 1-func x = x--#test infix 1-x *** y = x--#test symbol prefix-(***) x y = x---###############################################################################-###############################################################################-###############################################################################-#group equation.patterns-###############################################################################-###############################################################################-###############################################################################--#test wildcard-func _ = x--#test simple long pattern-#pending-func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable-  = x--#test simple multiline pattern-#pending-func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable-  reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable-  = x--#test another multiline pattern-#pending-func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable-  a-  b-  = x--#test simple constructor-func (A a) = a--#test list constructor-func (x : xr) = x--#test some other constructor symbol-#pending-func (x :+: xr) = x---###############################################################################-###############################################################################-###############################################################################-#group equation.guards-###############################################################################-###############################################################################-###############################################################################-#test simple guard-func | True = x--#test multiple-clauses-1-func x-  | x = simple expression-  | otherwise = 0--#test multiple-clauses-2-func x-  | a somewhat longer guard x = "and a somewhat longer expession that does not"-  | otherwise = "fit without putting the guards in new lines"--#test multiple-clauses-3-func x-  | very long guard, another rather long guard that refers to x = nontrivial-    expression-    foo-    bar-    alsdkjlasdjlasj-  | otherwise = 0--#test multiple-clauses-4-func x-  | very long guard, another rather long guard that refers to x-  = nontrivialexpression foo bar alsdkjlasdjlasj-  | otherwise-  = 0--#test multiple-clauses-5-func x-  | very loooooooooooooooooooooooooooooong guard-  , another rather long guard that refers to x-  = nontrivial expression foo bar alsdkjlasdjlasj-  | otherwise-  = 0---###############################################################################-###############################################################################-###############################################################################-#group expression.basic-###############################################################################-###############################################################################-###############################################################################--#test var-func = x--describe "infix op" $ do-#test 1-func = x + x--#test long-#pending-func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj-  + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj--#test long keep linemode 1-#pending-func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj-  + mweroiuxlskdfjlksj-  + mweroiuxlskdfjlksj--#test long keep linemode 2-#pending-func = mweroiuxlskdfjlksj-  + mweroiuxlskdfjlksj-  + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj--#test literals-func = 1-func = "abc"-func = 1.1e5-func = 'x'-func = 981409823458910394810928414192837123987123987123--#test lambdacase-{-# LANGUAGE LambdaCase #-}-func = \case-  FooBar -> x-  Baz -> y--#test lambda-func = \x -> abc--describe "app" $ do-#test 1-func = klajsdas klajsdas klajsdas--#test 2-func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd-  lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd-  lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd--#test 3-func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd-  lakjsdlajsdljas-  lakjsdlajsdljas-  lakjsdlajsdljas--###-#group expression.basic.sections-###--#test left-func = (1 +)--#test right-func = (+ 1)--#test left inf-## TODO: this could be improved..-func = (1 `abc`)--#test right inf-func = (`abc` 1)--###-#group tuples-###--#test 1-func = (abc, def)--#test 2-#pending-func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd-  , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd)--#test let in on single line-foo =-  let longIdentifierForShortValue = 1-  in longIdentifierForShortValue + longIdentifierForShortValue----###############################################################################-###############################################################################-###############################################################################-#group expression.do statements-###############################################################################-###############################################################################-###############################################################################--#test simple-func = do-  stmt-  stmt--#test bind-func = do-  x <- stmt-  stmt x--#test let-func = do-  let x = 13-  stmt x---###############################################################################-###############################################################################-###############################################################################-#group expression.lists-###############################################################################-###############################################################################-###############################################################################--#test monad-comprehension-case-of-func =-  foooooo-    $ [ case-          foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo-        of-          _ -> True-      ]---###############################################################################-###############################################################################-###############################################################################-#group expression.multiwayif-###############################################################################-###############################################################################-###############################################################################--#test simple-{-# LANGUAGE MultiWayIf #-}-func = if-  | cond1 -> loooooooooooooooooooooooooooooong expr1-  | cond2 -> loooooooooooooooooooooooooooooong expr2--#test simplenested-{-# LANGUAGE MultiWayIf #-}-func = do-  foo-  bar $ if-    | cond1 -> loooooooooooooooooooooooooooooong expr1-    | cond2 -> loooooooooooooooooooooooooooooong expr2---###############################################################################-###############################################################################-###############################################################################-#group stylisticspecialcases-###############################################################################-###############################################################################-###############################################################################--#test operatorprefixalignment-even-with-multiline-alignbreak-func =-  foo-    $ [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-      , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-      ]-    ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]--###############################################################################-###############################################################################-###############################################################################-#group module-###############################################################################-###############################################################################-###############################################################################--#test simple-module Main where--#test no-exports-module Main () where--#test one-export-module Main (main) where--#test several-exports-module Main (main, test1, test2) where--#test many-exports-module Main-  ( main-  , test1-  , test2-  , test3-  , test4-  , test5-  , test6-  , test7-  , test8-  , test9-  )-where--#test exports-with-comments-module Main-  ( main-  -- main-  , test1-  , test2-  -- Test 3-  , test3-  , test4-  -- Test 5-  , test5-  -- Test 6-  )-where--#test simple-export-with-things-module Main (Test(..)) where--#test simple-export-with-module-contents-module Main (module Main) where--#test export-with-things-module Main (Test(Test, a, b)) where--#test export-with-empty-thing-module Main (Test()) where--#test empty-with-comment--- Intentionally left empty--###############################################################################-###############################################################################-###############################################################################-#group import-###############################################################################-###############################################################################-###############################################################################--#test simple-import-import Data.List--#test simple-import-alias-import Data.List as L--#test simple-qualified-import-import qualified Data.List--#test simple-qualified-import-alias-import qualified Data.List as L--#test simple-safe-import safe Data.List as L--#test simple-source-import {-# SOURCE #-} Data.List ()--#test simple-safe-qualified-import safe qualified Data.List hiding (nub)--#test simple-safe-qualified-source-import {-# SOURCE #-} safe qualified Data.List--#test simple-qualified-package-import qualified "base" Data.List--#test qualifier-effect-import {-# SOURCE #-} safe qualified "base" Data.List as L-import {-# SOURCE #-} safe qualified "base" Data.List ()-import {-# SOURCE #-} safe qualified Data.List hiding ()--#test instances-only-import qualified Data.List ()--#test one-element-import Data.List (nub)--#test several-elements-import Data.List (nub, foldl', indexElem)--#test a-ridiculous-amount-of-elements-import Test-  ( Long-  , list-  , with-  , items-  , that-  , will-  , not-  , quite-  , fit-  , onA-  , single-  , line-  , anymore-  )--#test with-things-import Test (T, T2(), T3(..), T4(T4), T5(T5, t5), T6((<|>)), (+))--#test hiding-import Test hiding ()-import Test as T hiding ()--#test long-module-name-simple-import TestJustShortEnoughModuleNameLikeThisOne ()-import TestJustAbitToLongModuleNameLikeThisOneIs ()-import MoreThanSufficientlyLongModuleNameWithSome-  (items, that, will, not, fit, inA, compact, layout)--#test long-module-name-as-import TestJustShortEnoughModuleNameLikeThisOn as T-import TestJustAbitToLongModuleNameLikeThisOneI as T--#test long-module-name-hiding-import TestJustShortEnoughModuleNameLike hiding ()-import TestJustAbitToLongModuleNameLikeTh hiding ()--#test long-module-name-simple-items-import MoreThanSufficientlyLongModuleNameWithSome-  (items, that, will, not, fit, inA, compact, layout)--#test long-module-name-hiding-items-import TestJustShortEnoughModuleNameLike hiding (abc, def, ghci, jklm)--#test import-with-comments--- Test-import Data.List (nub) -- Test-{- Test -}-import qualified Data.List as L (foldl') {- Test -}--#test import-with-comments-2--import Test-  ( abc-  , def-  -- comment-  )--#test import-with-comments-3--import Test-  ( abc-  -- comment-  )--#test import-with-comments-4-import Test-  ( abc-  -- comment-  , def-  , ghi-  {- comment -}-  , jkl-  -- comment-  )---- Test-import Test (test)--#test import-with-comments-5-import Test-  ( -- comment-  )--#test long-bindings-import Test (longbindingNameThatoverflowsColum)-import Test (Long(List, Of, Things))--#test things-with-with-comments-import Test-  ( Thing-    ( With-    -- Comments-    , and-    -- also-    , items-    -- !-    )-  )-import Test-  ( Thing-    ( Item-    -- and Comment-    )-  )-import Test-  ( Thing-    ( With-    -- Comments-    , and-    -- also-    , items-    -- !-    )-  )--#test prefer-dense-empty-list-import VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine-  ()--#test preamble full-preamble-{-# LANGUAGE BangPatterns #-}--{-- - Test module- -}-module Test-  ( test1-  -- ^ test-  , test2-  -- | test-  , test3-  , test4-  , test5-  , test6-  , test7-  , test8-  , test9-  , test10-  )-where---- Test-import Data.List (nub) -- Test-{- Test -}-import qualified Data.List as L (foldl') {- Test -}---- Test-import Test (test)--###############################################################################-###############################################################################-###############################################################################-#group regression-###############################################################################-###############################################################################-###############################################################################--#test newlines-comment-func = do-  abc <- foo----abc-return ()--#test parenthesis-around-unit-func = (())--#test let-defs indentation-func = do-  let-    foo True = True-    foo _ = False-  return ()--#test let-defs no indent-func = do-  let-    foo True = True-    foo _ = False-  return ()--#test let-defs no indent-func = do-  let-    foo = True-    b = False-  return ()--#test let-defs no indent-func =-  let-    foo = True-    b = False-  in return ()--#test record update indentation 1-func = do-  s <- mGet-  mSet $ s { _lstate_indent = _lstate_indent state }--#test record update indentation 2-func = do-  s <- mGet-  mSet $ s-    { _lstate_indent = _lstate_indent state-    , _lstate_foo = _lstate_foo state-    }--#test record update indentation 3-func = do-  s <- mGet-  mSet $ s-    { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-    , _lstate_foo = _lstate_foo kasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-    }--#test record construction 1-func = Foo {_lstate_indent = _lstate_indent state}--#test record construction 2-func = Foo-  { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-  , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-  }--#test record construction 3-func = do-  Foo-    { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-    , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-    }--#test post-indent comment-func = do--- abc-  -- def-  return ()--#test post-unindent comment-func = do-  do-    return ()-    -- abc-  -- def-  return ()--#test CPP empty comment case-#pending CPP parsing needs fixing for roundTripEqual-{-# LANGUAGE CPP #-}-module Test where-func = do-#if FOO-  let x = 13-#endif-  stmt x--## really, the following should be handled by forcing the Alt to multiline-## because there are comments. as long as this is not implemented though,-## we should ensure the trivial solution works.-#test comment inline placement (temporary)-func-  :: Int -- basic indentation amount-  -> Int -- currently used width in current line (after indent)-         -- used to accurately calc placing of the current-line-  -> LayoutDesc-  -> Int--#test some indentation thingy-func =-  (lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj-  $ abc-  $ def-  $ ghi-  $ jkl-  )--#test parenthesized operator-buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0)-  where reassoc (v, e, w) = (v, (e, w))--#test record pattern matching stuff-downloadRepoPackage = case repo of-  RepoLocal {..} -> return ()-  RepoLocal { abc } -> return ()-  RepoLocal{} -> return ()--#test do let comment indentation level problem-func = do-  let-    (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs'-    (bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets''-    -- default local dir target if there's no given target-    utargets'' = "foo"-  return ()--#test list comprehension comment placement-func =-  [ (thing, take 10 alts) --TODO: select best ones-  | (thing, _got, alts@(_ : _)) <- nosuchFooThing-  , gast <- award-  ]--#test if-then-else comment placement-func = if x-  then if y -- y is important-    then foo-    else bar-  else Nothing--#test qualified infix pattern-#pending "TODO"-wrapPatPrepend pat prepElem = do-  patDocs <- layoutPat pat-  case Seq.viewl patDocs of-    Seq.EmptyL -> return $ Seq.empty-    x1 Seq.:< xR -> do-      x1' <- docSeq [prepElem, return x1]-      return $ x1' Seq.<| xR--#test type signature multiline forcing issue-layoutWriteNewlineBlock-  :: ( MonadMultiWriter Text.Builder.Builder m-     , MonadMultiState LayoutState m-     , MonadMultiWriter (Seq String) m-     )-  => m ()--#test multiwayif proper indentation-{-# LANGUAGE MultiWayIf #-}-readMergePersConfig path shouldCreate conf = do-  exists <- liftIO $ System.Directory.doesFileExist path-  if-    | exists -> do-      contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.-      fileConf <- case Data.Yaml.decodeEither contents of-        Left e -> do-          liftIO-            $ putStrErrLn-            $ "error reading in brittany config from "-            ++ path-            ++ ":"-          liftIO $ putStrErrLn e-          mzero-        Right x -> return x-      return $ fileConf Semigroup.<> conf-    | shouldCreate -> do-      liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap-        (Option . Just . runIdentity)-        staticDefaultConfig-      return $ conf-    | otherwise -> do-      return conf--#test nested pattern alignment issue"-func = BuildReport- where-  convertInstallOutcome = case result of-    Left BR.PlanningFailed -> PlanningFailed-    Left (BR.DependentFailed p) -> DependencyFailed p-    Left (BR.DownloadFailed _) -> DownloadFailed-    Left (BR.UnpackFailed _) -> UnpackFailed-    Left (BR.ConfigureFailed _) -> ConfigureFailed-    Left (BR.BuildFailed _) -> BuildFailed-    Left (BR.TestsFailed _) -> TestsFailed-    Left (BR.InstallFailed _) -> InstallFailed-    Right (BR.BuildOk _ _ _) -> InstallOk--#test nested pattern alignment issue"-func = BuildReport- where-  convertInstallOutcome = case result of-    Left BR.PlanningFailed -> PlanningFailed-    Left (BR.DependentFailed p) -> DependencyFailed p-    Left (BR.DownloadFailed _) -> DownloadFailed-    Left (BR.UnpackFailed _) -> UnpackFailed-    Left (BR.ConfigureFailed _) -> ConfigureFailed-    Left (BR.BuildFailed _) -> BuildFailed-    Left (BR.TestsFailed _) -> TestsFailed-    Left (BR.InstallFailed _) -> InstallFailed-    Right (BR.BuildOk _ _ _) -> InstallOk--#test partially overflowing alignment issue"-showPackageDetailedInfo pkginfo =-  renderStyle (style { lineLength = 80, ribbonsPerLine = 1 })-    $ char '*'-    $+$ something-          [ entry "Synopsis" synopsis hideIfNull reflowParagraphs-          , entry-            "Versions available"-            sourceVersions-            (altText null "[ Not available from server ]")-            (dispTopVersions 9 (preferredVersions pkginfo))-          , entry-            "Versions installed"-            installedVersions-            (altText-              null-              (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")-            )-            (dispTopVersions 4 (preferredVersions pkginfo))-          , entry "Homepage" homepage orNotSpecified text-          , entry "Bug reports" bugReports orNotSpecified text-          , entry "Description" description hideIfNull reflowParagraphs-          , entry "Category" category hideIfNull text-          , entry "License" license alwaysShow disp-          , entry "Author" author hideIfNull reflowLines-          , entry "Maintainer" maintainer hideIfNull reflowLines-          , entry "Source repo" sourceRepo orNotSpecified text-          , entry "Executables" executables hideIfNull (commaSep text)-          , entry "Flags" flags hideIfNull (commaSep dispFlag)-          , entry "Dependencies" dependencies hideIfNull (commaSep dispExtDep)-          , entry "Documentation" haddockHtml showIfInstalled text-          , entry "Cached" haveTarball alwaysShow dispYesNo-          , if not (hasLib pkginfo)-            then empty-            else text "Modules:"-              $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))-          ]--#test issue 7a-isValidPosition position-  | validX && validY = Just position-  | otherwise = Nothing--#test issue-6-pattern-linebreak-validity-## this is ugly, but at least syntactically valid.-foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do-  (inputEvent :: Reflex.Event Reflex.Spider String, inputFire :: String-    -> IO Bool) <--    ReflexHost.newExternalEvent-  liftIO . forkIO . forever $ getLine >>= inputFire-  ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent--#test issue 16-foldrDesc f z = unSwitchQueue $ \q ->-  switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q)--#test issue 18-autocheckCases =-  [ ("Never Deadlocks", representative deadlocksNever)-  , ("No Exceptions", representative exceptionsNever)-  , ("Consistent Result", alwaysSame) -- already representative-  ]--#test issue 18b-autocheckCases =-  [ ("Never Deadlocks", representative deadlocksNever)-  , ("No Exceptions", representative exceptionsNever)-  , ( "Consistent Result"-    , alwaysSame -- already representative-    )-  ]--#test issue 18c-func =-  [ (abc, (1111, 1111))-  , (def, (2, 2))-  , foo -- comment-  ]--#test issue 26-foo a b = g a b -- fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo-  where g a b = b + b * a--#test issue 26b-foo a b = g a b where g a b = b + b * a -- fooooooooooooooooooooooooooooooooooo--#test aggressive alignment 1-func = do-  abc <- expr-  abcccccccccccccccccc <- expr-  abcccccccccccccccccccccccccccccccccccccccccc <- expr-  abccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc <- expr--#test example alignment 1-func (MyLongFoo abc def) = 1-func (Bar a d) = 2-func _ = 3--#test listcomprehension-case-of-parserCompactLocation =-  [ try-      $ [ ParseRelAbs (Text.Read.read digits) _ _-        | digits <- many1 digit-        , rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe-          [ case divPart of-              Nothing -> Left $ Text.Read.read digits-              Just ddigits ->-                Right $ Text.Read.read digits % Text.Read.read ddigits-          | digits <- many1 digit-          , divPart <- optionMaybe (string "/" *> many1 digit)-          ]-        ]-  ]--#test opapp-specialcasing-1-func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo-  foooooooooooooooooooooooooooooooo-  foooooooooooooooooooooooooooooooo--#test opapp-specialcasing-2-func =-  fooooooooooooooooooooooooooooooooo-    + foooooooooooooooooooooooooooooooo-        foooooooooooooooooooooooooooooooo-        foooooooooooooooooooooooooooooooo--#test opapp-specialcasing-3-func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo-  [ foooooooooooooooooooooooooooooooo-  , foooooooooooooooooooooooooooooooo-  , foooooooooooooooooooooooooooooooo-  ]--#test opapp-indenting-parserPrim =-  [ r-  | r <--    [ SGPPrimFloat $ bool id (0 -) minus $ readGnok-        "parserPrim"-        (d1 ++ d2 ++ d3 ++ d4)-    | d2 <- string "."-    , d3 <- many1 (oneOf "0123456789")-    , _ <- string "f"-    ]-    <|> [ SGPPrimFloat $ bool id (0 -) minus $ fromIntegral-            (readGnok "parserPrim" d1 :: Integer)-        | _ <- string "f"-        ]-    <|> [ SGPPrimInt $ bool id (0 -) minus $ fromIntegral-            (readGnok "parserPrim" d1 :: Integer)-        | _ <- string "i"-        ]-  ]--#test another-parspacing-testcase--samples = (SV.unpackaaaaadat) <&> \f ->-  aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa--#test recordupd-singleline-bug--runBrittany tabSize text = do-  let-    config' = staticDefaultConfig-    config = config'-      { _conf_layout = (_conf_layout config')-        { _lconfig_indentAmount = coerce tabSize-        }-      , _conf_forward = forwardOptionsSyntaxExtsEnabled-      }-  parsePrintModule config text--#test issue 38--{-# LANGUAGE TypeApplications #-}-foo = bar @Baz--#test comment-before-BDCols-{-# LANGUAGE TypeApplications #-}-layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do-  docAlt-    $  -- one-line solution-      [ docCols-          (ColBindingLine alignmentToken)-          [ docSeq (patPartInline ++ [guardPart])-          , docSeq-            [ appSep $ return binderDoc-            , docForceSingleline $ return body-            , wherePart-            ]-          ]-      | not hasComments-      , [(guards, body, _bodyRaw)] <- [clauseDocs]-      , let guardPart = singleLineGuardsDoc guards-      , wherePart <- case mWhereDocs of-        Nothing -> return @[] $ docEmpty-        Just [w] -> return @[] $ docSeq-          [ docSeparator-          , appSep $ docLit $ Text.pack "where"-          , docSetIndentLevel $ docForceSingleline $ return w-          ]-        _ -> []-      ]-    ++ -- one-line solution + where in next line(s)-       [ docLines-         $ [ docCols-               (ColBindingLine alignmentToken)-               [ docSeq (patPartInline ++ [guardPart])-               , docSeq-                 [appSep $ return binderDoc, docForceParSpacing $ return body]-               ]-           ]-         ++ wherePartMultiLine-       | [(guards, body, _bodyRaw)] <- [clauseDocs]-       , let guardPart = singleLineGuardsDoc guards-       , Data.Maybe.isJust mWhereDocs-       ]-    ++ -- two-line solution + where in next line(s)-       [ docLines-         $ [ docForceSingleline-             $ docSeq (patPartInline ++ [guardPart, return binderDoc])-           , docEnsureIndent BrIndentRegular $ docForceSingleline $ return-             body-           ]-         ++ wherePartMultiLine-       | [(guards, body, _bodyRaw)] <- [clauseDocs]-       , let guardPart = singleLineGuardsDoc guards-       ]--#test comment-testcase-17-{-# LANGUAGE MultiWayIf #-}-func = do-  let-    foo = if-      | Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO-                                                                    -> max-        (defLen - 0.2) -- TODO-        (defLen * 0.8)-      | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO-  return True--#test issue 49--foo n = case n of-  1 -> True-  -1 -> False--bar n = case n of-  (-2, -2) -> (-2, -2)--#test issue 48 a--foo =-  let-    a = b@1-    cccc = ()-  in foo--#test issue 48 b--{-# LANGUAGE TypeApplications #-}-foo =-  let-    a = b @1-    cccc = ()-  in foo---###############################################################################-###############################################################################-###############################################################################-#group pending-###############################################################################-###############################################################################-###############################################################################----## this testcase is not about idempotency, but about _how_ the output differs-## from the input; i cannot really express this yet with the current-## test-suite.-## #test ayaz-##-## myManageHook =-##   composeOne [isFullscreen -?> doFullFloat, isDialog -?> doFloat, transience]-##     <+> composeAll-##           [ className =? "Pidgin" --> doFloat-##           , className =? "XCalc" --> doFloat-##           -- plan9port's acme-##           , className =? "acme" --> doFloat-##           -- Acme with Vi bindings editor-##           , title =? "ED" --> doFloat-##           , title =? "wlc-x11" --> doFloat-##           , className =? "Skype" --> doFloat-##           , className =? "ffplay" --> doFloat-##           , className =? "mpv" --> doFloat-##           , className =? "Plugin-container" --> doFloat -- Firefox flash, etc.-##           -- Firefox works well tiled, but it has dialog windows we want to float.-##           , appName =? "Browser" --> doFloat-##           ]-##  where-##   role = stringProperty "WM_WINDOW_ROLE"

@@ -42,9 +42,9 @@  defaultTestConfig :: Config defaultTestConfig = Config-  { _conf_version = _conf_version staticDefaultConfig-  , _conf_debug   = _conf_debug staticDefaultConfig-  , _conf_layout  = LayoutConfig+  { _conf_version                   = _conf_version staticDefaultConfig+  , _conf_debug                     = _conf_debug staticDefaultConfig+  , _conf_layout                    = LayoutConfig     { _lconfig_cols                      = coerce (80 :: Int)     , _lconfig_indentPolicy              = coerce IndentPolicyFree     , _lconfig_indentAmount              = coerce (2 :: Int)@@ -60,11 +60,11 @@     , _lconfig_reformatModulePreamble    = coerce True     , _lconfig_allowSingleLineExportList = coerce True     }-  , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)+  , _conf_errorHandling             = (_conf_errorHandling staticDefaultConfig)     { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever     }-  , _conf_preprocessor = (_conf_preprocessor staticDefaultConfig)-  , _conf_forward      = ForwardOptions-    { _options_ghc = Identity []-    }+  , _conf_preprocessor              = (_conf_preprocessor staticDefaultConfig)+  , _conf_forward = ForwardOptions {_options_ghc = Identity []}+  , _conf_roundtrip_exactprint_only = coerce False+  , _conf_obfuscate = coerce False   }

@@ -8,6 +8,8 @@    -- re-export from utils:   , parseModule   , parseModuleFromString+  , extractCommentConfigs+  , getTopLevelDeclNameMap   ) where @@ -22,7 +24,10 @@ import           Data.Data import           Control.Monad.Trans.Except import           Data.HList.HList+import qualified Data.Yaml+import qualified Data.ByteString.Char8 import           Data.CZipWith+import qualified UI.Butcher.Monadic as Butcher  import qualified Data.Text.Lazy.Builder as Text.Builder @@ -47,15 +52,170 @@  import qualified GHC as GHC hiding (parseModule) import           ApiAnnotation ( AnnKeywordId(..) )-import           RdrName ( RdrName(..) ) import           GHC ( runGhc, GenLocated(L), moduleNameString ) import           SrcLoc ( SrcSpan ) import           HsSyn import qualified DynFlags as GHC import qualified GHC.LanguageExtensions.Type as GHC +import           Data.Char (isSpace)  ++data InlineConfigTarget+    = InlineConfigTargetModule+    | InlineConfigTargetNextDecl    -- really only next in module+    | InlineConfigTargetNextBinding -- by name+    | InlineConfigTargetBinding String++extractCommentConfigs+  :: ExactPrint.Anns+  -> TopLevelDeclNameMap+  -> Either (String, String) InlineConfig+extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do+  let+    commentLiness =+      [ ( k+        , [ x+          | (ExactPrint.Comment x _ _, _) <-+            (  ExactPrint.annPriorComments ann+            ++ ExactPrint.annFollowingComments ann+            )+          ]+          ++ [ x+             | (ExactPrint.AnnComment (ExactPrint.Comment x _ _), _) <-+               ExactPrint.annsDP ann+             ]+        )+      | (k, ann) <- Map.toList anns+      ]+  let configLiness = commentLiness <&> second+        (Data.Maybe.mapMaybe $ \line -> do+          l1 <-+            List.stripPrefix "-- BRITTANY" line+            <|> List.stripPrefix "--BRITTANY" line+            <|> List.stripPrefix "-- brittany" line+            <|> List.stripPrefix "--brittany" line+            <|> (List.stripPrefix "{- BRITTANY" line >>= stripSuffix "-}")+          let l2 = dropWhile isSpace l1+          guard+            (  ("@" `isPrefixOf` l2)+            || ("-disable" `isPrefixOf` l2)+            || ("-next" `isPrefixOf` l2)+            || ("{" `isPrefixOf` l2)+            || ("--" `isPrefixOf` l2)+            )+          pure l2+        )+  let+    configParser = Butcher.addAlternatives+      [ ( "commandline-config"+        , \s -> "-" `isPrefixOf` dropWhile (== ' ') s+        , cmdlineConfigParser+        )+      , ( "yaml-config-document"+        , \s -> "{" `isPrefixOf` dropWhile (== ' ') s+        , Butcher.addCmdPart (Butcher.varPartDesc "yaml-config-document")+        $ fmap (\lconf -> (mempty { _conf_layout = lconf }, ""))+        . Data.Yaml.decode+        . Data.ByteString.Char8.pack+          -- TODO: use some proper utf8 encoder instead?+        )+      ]+    parser = do -- we will (mis?)use butcher here to parse the inline config+                -- line.+      let nextDecl = do+            conf <- configParser+            Butcher.addCmdImpl (InlineConfigTargetNextDecl, conf)+      Butcher.addCmd "-next-declaration" nextDecl+      Butcher.addCmd "-Next-Declaration" nextDecl+      Butcher.addCmd "-NEXT-DECLARATION" nextDecl+      let nextBinding = do+            conf <- configParser+            Butcher.addCmdImpl (InlineConfigTargetNextBinding, conf)+      Butcher.addCmd "-next-binding" nextBinding+      Butcher.addCmd "-Next-Binding" nextBinding+      Butcher.addCmd "-NEXT-BINDING" nextBinding+      let disableNextBinding = do+            Butcher.addCmdImpl+              ( InlineConfigTargetNextBinding+              , mempty { _conf_roundtrip_exactprint_only = pure $ pure True }+              )+      Butcher.addCmd "-disable-next-binding" disableNextBinding+      Butcher.addCmd "-Disable-Next-Binding" disableNextBinding+      Butcher.addCmd "-DISABLE-NEXT-BINDING" disableNextBinding+      let disableNextDecl = do+            Butcher.addCmdImpl+              ( InlineConfigTargetNextDecl+              , mempty { _conf_roundtrip_exactprint_only = pure $ pure True }+              )+      Butcher.addCmd "-disable-next-declaration" disableNextDecl+      Butcher.addCmd "-Disable-Next-Declaration" disableNextDecl+      Butcher.addCmd "-DISABLE-NEXT-DECLARATION" disableNextDecl+      Butcher.addCmd "@" $ do+        -- Butcher.addCmd "module" $ do+        --   conf <- configParser+        --   Butcher.addCmdImpl (InlineConfigTargetModule, conf)+        Butcher.addNullCmd $ do+          bindingName <- Butcher.addParamString "BINDING" mempty+          conf        <- configParser+          Butcher.addCmdImpl (InlineConfigTargetBinding bindingName, conf)+      conf <- configParser+      Butcher.addCmdImpl (InlineConfigTargetModule, conf)+  lineConfigss <- configLiness `forM` \(k, ss) -> do+    r <- ss `forM` \s -> case Butcher.runCmdParserSimple s parser of+      Left  err -> Left $ (err, s)+      Right c   -> Right $ c+    pure (k, r)++  let perModule = foldl'+        (<>)+        mempty+        [ conf+        | (_                       , lineConfigs) <- lineConfigss+        , (InlineConfigTargetModule, conf       ) <- lineConfigs+        ]+  let+    perBinding = Map.fromListWith+      (<>)+      [ (n, conf)+      | (k     , lineConfigs) <- lineConfigss+      , (target, conf       ) <- lineConfigs+      , n                     <- case target of+        InlineConfigTargetBinding s -> [s]+        InlineConfigTargetNextBinding | Just name <- Map.lookup k declNameMap ->+          [name]+        _ -> []+      ]+  let+    perKey = Map.fromListWith+      (<>)+      [ (k, conf)+      | (k     , lineConfigs) <- lineConfigss+      , (target, conf       ) <- lineConfigs+      , case target of+        InlineConfigTargetNextDecl -> True+        InlineConfigTargetNextBinding | Nothing <- Map.lookup k declNameMap ->+          True+        _ -> False+      ]++  pure $ InlineConfig+    { _icd_perModule  = perModule+    , _icd_perBinding = perBinding+    , _icd_perKey     = perKey+    }+++getTopLevelDeclNameMap :: GHC.ParsedSource -> TopLevelDeclNameMap+getTopLevelDeclNameMap (L _ (HsModule _name _exports _ decls _ _)) =+  TopLevelDeclNameMap $ Map.fromList+    [ (ExactPrint.mkAnnKey decl, name)+    | decl       <- decls+    , (name : _) <- [getDeclBindingNames decl]+    ]++ -- | Exposes the transformation in an pseudo-pure fashion. The signature -- contains `IO` due to the GHC API not exposing a pure parsing function, but -- there should be no observable effects.@@ -68,15 +228,16 @@ -- may wish to put some proper upper bound on the input's size as a timeout -- won't do. parsePrintModule :: Config -> Text -> IO (Either [BrittanyError] Text)-parsePrintModule configRaw inputText = runExceptT $ do-  let config = configRaw { _conf_debug = _conf_debug staticDefaultConfig }+parsePrintModule configWithDebugs inputText = runExceptT $ do+  let config =+        configWithDebugs { _conf_debug = _conf_debug staticDefaultConfig }   let ghcOptions         = config & _conf_forward & _options_ghc & runIdentity   let config_pp          = config & _conf_preprocessor   let cppMode            = config_pp & _ppconf_CPPMode & confUnpack   let hackAroundIncludes = config_pp & _ppconf_hackAroundIncludes & confUnpack   (anns, parsedSource, hasCPP) <- do     let hackF s = if "#include" `isPrefixOf` s-          then "-- BRITTANY_INCLUDE_HACK " ++ s+          then "-- BRITANY_INCLUDE_HACK " ++ s           else s     let hackTransform = if hackAroundIncludes           then List.intercalate "\n" . fmap hackF . lines'@@ -93,8 +254,10 @@       cppCheckFunc       (hackTransform $ Text.unpack inputText)     case parseResult of-      Left  err -> throwE $ [ErrorInput err]-      Right x   -> pure $ x+      Left  err -> throwE [ErrorInput err]+      Right x   -> pure x+  inlineConf <- either (throwE . (: []) . uncurry ErrorMacroConfig) pure+    $ extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource)   (errsWarns, outputTextL) <- do     let omitCheck =           config@@ -102,10 +265,10 @@             & _econf_omit_output_valid_check             & confUnpack     (ews, outRaw) <- if hasCPP || omitCheck-      then return $ pPrintModule config anns parsedSource-      else lift $ pPrintModuleAndCheck config anns parsedSource+      then return $ pPrintModule config inlineConf anns parsedSource+      else lift $ pPrintModuleAndCheck config inlineConf anns parsedSource     let hackF s = fromMaybe s-          $ TextL.stripPrefix (TextL.pack "-- BRITTANY_INCLUDE_HACK ") s+          $ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s     pure $ if hackAroundIncludes       then         ( ews@@ -119,6 +282,7 @@       customErrOrder ErrorOutputCheck{}   = 1       customErrOrder ErrorUnusedComment{} = 2       customErrOrder ErrorUnknownNode{}   = 3+      customErrOrder ErrorMacroConfig{}   = 5   let hasErrors =         case config & _conf_errorHandling & _econf_Werror & confUnpack of           False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)@@ -133,10 +297,11 @@ -- can occur. pPrintModule   :: Config+  -> InlineConfig   -> ExactPrint.Anns   -> GHC.ParsedSource   -> ([BrittanyError], TextL.Text)-pPrintModule conf anns parsedModule =+pPrintModule conf inlineConf anns parsedModule =   let     ((out, errs), debugStrings) =       runIdentity@@ -146,6 +311,7 @@         $ MultiRWSS.withMultiWriterW         $ MultiRWSS.withMultiReader anns         $ MultiRWSS.withMultiReader conf+        $ MultiRWSS.withMultiReader inlineConf         $ MultiRWSS.withMultiReader (extractToplevelAnns parsedModule anns)         $ do             traceIfDumpConf "bridoc annotations raw" _dconf_dump_annotations@@ -169,12 +335,13 @@ -- if it does not. pPrintModuleAndCheck   :: Config+  -> InlineConfig   -> ExactPrint.Anns   -> GHC.ParsedSource   -> IO ([BrittanyError], TextL.Text)-pPrintModuleAndCheck conf anns parsedModule = do+pPrintModuleAndCheck conf inlineConf anns parsedModule = do   let ghcOptions     = conf & _conf_forward & _options_ghc & runIdentity-  let (errs, output) = pPrintModule conf anns parsedModule+  let (errs, output) = pPrintModule conf inlineConf anns parsedModule   parseResult <- parseModuleFromString ghcOptions                                        "output"                                        (\_ -> return $ Right ())@@ -193,28 +360,34 @@   parseResult <- ExactPrint.Parsers.parseModuleFromString filename inputStr   case parseResult of     Left  (_   , s           ) -> return $ Left $ "parsing error: " ++ s-    Right (anns, parsedModule) -> do+    Right (anns, parsedModule) -> runExceptT $ do+      inlineConf <-+        case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of+          Left  err -> throwE $ "error in inline config: " ++ show err+          Right x   -> pure x       let omitCheck =             conf               &  _conf_errorHandling               .> _econf_omit_output_valid_check               .> confUnpack       (errs, ltext) <- if omitCheck-        then return $ pPrintModule conf anns parsedModule-        else pPrintModuleAndCheck conf anns parsedModule-      return $ if null errs-        then Right $ TextL.toStrict $ ltext+        then return $ pPrintModule conf inlineConf anns parsedModule+        else lift $ pPrintModuleAndCheck conf inlineConf anns parsedModule+      if null errs+        then pure $ TextL.toStrict $ ltext         else-          let errStrs = errs <&> \case-                ErrorInput         str -> str-                ErrorUnusedComment str -> str-                LayoutWarning      str -> str-                ErrorUnknownNode str _ -> str-                ErrorOutputCheck       -> "Output is not syntactically valid."-          in  Left $ "pretty printing error(s):\n" ++ List.unlines errStrs+          let+            errStrs = errs <&> \case+              ErrorInput         str -> str+              ErrorUnusedComment str -> str+              LayoutWarning      str -> str+              ErrorUnknownNode str _ -> str+              ErrorMacroConfig str _ -> "when parsing inline config: " ++ str+              ErrorOutputCheck       -> "Output is not syntactically valid."+          in  throwE $ "pretty printing error(s):\n" ++ List.unlines errStrs  --- this approach would for with there was a pure GHC.parseDynamicFilePragma.+-- this approach would for if there was a pure GHC.parseDynamicFilePragma. -- Unfortunately that does not exist yet, so we cannot provide a nominally -- pure interface. @@ -248,12 +421,25 @@ --           Left $ "pretty printing error(s):\n" ++ List.unlines errStrs --         else return $ TextL.toStrict $ Text.Builder.toLazyText out -ppModule :: GenLocated SrcSpan (HsModule RdrName) -> PPM ()+toLocal :: Config -> ExactPrint.Anns -> PPMLocal a -> PPM a+toLocal conf anns m = do+  (x, write) <- lift $ MultiRWSS.runMultiRWSTAW (conf :+: anns :+: HNil) HNil $ m+  MultiRWSS.mGetRawW >>= \w -> MultiRWSS.mPutRawW (w `mappend` write)+  pure x++ppModule :: GenLocated SrcSpan (HsModule GhcPs) -> PPM () ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do   post <- ppPreamble lmod   decls `forM_` \decl -> do-    filteredAnns <- mAsk <&> \annMap ->-      Map.findWithDefault Map.empty (ExactPrint.mkAnnKey decl) annMap+    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 mBindingConfs =+          declBindingNames <&> \n -> Map.lookup n $ _icd_perBinding inlineConf+    filteredAnns <- mAsk+      <&> \annMap -> Map.findWithDefault Map.empty declAnnKey annMap      traceIfDumpConf "bridoc annotations filtered/transformed"                     _dconf_dump_annotations@@ -261,13 +447,20 @@      config <- mAsk -    MultiRWSS.withoutMultiReader $ do-      MultiRWSS.mPutRawR $ config :+: filteredAnns :+: HNil-      ppDecl decl+    let config' = cZipWith fromOptionIdentity config $ mconcat+          (inlineModConf : (catMaybes (mBindingConfs ++ [mDeclConf])))++    let exactprintOnly = config' & _conf_roundtrip_exactprint_only & confUnpack+    toLocal config' filteredAnns $ do+      bd <- briDocMToPPM $ if exactprintOnly+        then briDocByExactNoComment decl+        else layoutDecl decl+      layoutBriDoc bd+   let finalComments = filter-        ( fst .> \case+        (fst .> \case           ExactPrint.AnnComment{} -> True-          _                             -> False+          _                       -> False         )         post   post `forM_` \case@@ -275,54 +468,28 @@       ppmMoveToExactLoc l       mTell $ Text.Builder.fromString cmStr     (ExactPrint.G AnnEofPos, (ExactPrint.DP (eofZ, eofX))) ->-      let-        folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of-          ExactPrint.AnnComment cm-            | GHC.RealSrcSpan span <- ExactPrint.commentIdentifier cm-            -> ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span-               , x + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span-               )-          _ -> (acc + y, x)-        (cmY, cmX) = foldl' folder (0, 0) finalComments-      in-        ppmMoveToExactLoc $ ExactPrint.DP (eofZ - cmY, eofX - cmX)+      let folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of+            ExactPrint.AnnComment cm+              | GHC.RealSrcSpan span <- ExactPrint.commentIdentifier cm+              -> ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span+                 , x + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span+                 )+            _ -> (acc + y, x)+          (cmY, cmX) = foldl' folder (0, 0) finalComments+      in  ppmMoveToExactLoc $ ExactPrint.DP (eofZ - cmY, eofX - cmX)     _ -> return () -withTransformedAnns :: Data ast => ast -> PPMLocal () -> PPMLocal ()-withTransformedAnns ast m = do-  -- TODO: implement `local` for MultiReader/MultiRWS-  readers@(conf :+: anns :+: HNil) <- MultiRWSS.mGetRawR-  MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)-  m-  MultiRWSS.mPutRawR readers- where-  f anns =-    let ((), (annsBalanced, _), _) =-          ExactPrint.runTransform anns (commentAnnFixTransformGlob ast)-    in  annsBalanced +getDeclBindingNames :: LHsDecl GhcPs -> [String]+getDeclBindingNames (L _ decl) = case decl of+  SigD (TypeSig ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)+  ValD (FunBind (L _ n) _ _ _ _) -> [Text.unpack $ rdrNameToText n]+  _ -> [] -ppDecl :: LHsDecl RdrName -> PPMLocal ()-ppDecl d@(L loc decl) = case decl of-  SigD sig -> -- trace (_sigHead sig) $-              withTransformedAnns d $ do-    -- runLayouter $ Old.layoutSig (L loc sig)-    briDoc <- briDocMToPPM $ layoutSig (L loc sig)-    layoutBriDoc briDoc-  ValD bind -> -- trace (_bindHead bind) $-               withTransformedAnns d $ do-    -- Old.layoutBind (L loc bind)-    briDoc <- briDocMToPPM $ do-      eitherNode <- layoutBind (L loc bind)-      case eitherNode of-        Left  ns -> docLines $ return <$> ns-        Right n  -> return n-    layoutBriDoc briDoc-  _ -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc  -- Prints the information associated with the module annotation -- This includes the imports-ppPreamble :: GenLocated SrcSpan (HsModule RdrName)+ppPreamble :: GenLocated SrcSpan (HsModule GhcPs)            -> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)] ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do   filteredAnns <- mAsk <&> \annMap ->@@ -380,9 +547,7 @@     $ annsDoc filteredAnns'    if shouldReformatPreamble-    then MultiRWSS.withoutMultiReader $ do-      MultiRWSS.mPutRawR $ config :+: filteredAnns' :+: HNil-      withTransformedAnns lmod $ do+    then toLocal config filteredAnns' $ withTransformedAnns lmod $ do         briDoc <- briDocMToPPM $ layoutModule lmod         layoutBriDoc briDoc     else@@ -390,13 +555,13 @@       in  MultiRWSS.withMultiReader filteredAnns' $ processDefault emptyModule   return post -_sigHead :: Sig RdrName -> String+_sigHead :: Sig GhcPs -> String _sigHead = \case   TypeSig names _ ->     "TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names)   _ -> "unknown sig" -_bindHead :: HsBind RdrName -> String+_bindHead :: HsBind GhcPs -> String _bindHead = \case   FunBind fId _ _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)   PatBind _pat _ _ _ ([], []) -> "PatBind smth"

@@ -56,7 +56,7 @@  instance Show ColInfo where   show ColInfoStart = "ColInfoStart"-  show ColInfoNo{} = "ColInfoNo{}"+  show (ColInfoNo bd) = "ColInfoNo " ++ show (take 30 (show (briDocToDoc bd)) ++ "..")   show (ColInfo ind sig list) = "ColInfo " ++ show ind ++ " " ++ show sig ++ " " ++ show list  data ColBuildState = ColBuildState@@ -345,6 +345,81 @@     BDNonBottomSpacing bd   -> rec bd     BDDebug _ bd            -> rec bd +-- In theory+-- =========++-- .. this algorithm works roughly in these steps:+--+-- 1. For each line, get the (nested) column info, descending as far as+--    BDCols nodes go. The column info is a (rose) tree where the leafs+--    are arbitrary (non-BDCols) BriDocs.+-- 2. Walk through the lines and compare its column info with that of its+--    predecessor. If both are non-leafs and the column "signatures" align+--    (they don't align e.g. when they are totally different syntactical+--    structures or the number of children differs), mark these parts of+--    the two tree structures as connected and recurse to its children+--    (i.e. again comparing the children in this line with the children in+--    the previous line).+-- 3. What we now have is one tree per line, and connections between "same"+--    nodes between lines. These connection can span multiple lines.+--    We next look at spacing information. This is available at the leafs,+--    but in this step we aggregate _over connections_. At the top level, this+--    gives us one piece of data: How long would each line be, if we fully+--    aligned everything (kept all connections "active"). In contrast to+--    just taking the sum of all leafs for each tree, this line length includes+--    the spaces used for alignment.+-- 4. Treat those lines where alignment would result in overflowing of the+--    column limit. This "treatment" is currently configurable, and can e.g.+--    mean:+--    a) we stop alignment alltogether,+--    b) we remove alignment just from the overflowing lines,+--    c) we reduce the number of spaces inserted in overflowing lines using+--       some technique to make them not overflow, but without reducing the+--       space insertion to zero,+--    d) don't do anything+-- 5. Actually print the lines, walking over each tree and inserting spaces+--    according to the info and decisions gathered in the previous steps.+--+-- Possible improvements+-- =====================+--+-- - If alignment is disabled for specific lines, the aggregated per-connection+--   info of those lines is still retained and not recalculated. This can+--   result in spaces being inserted to create alignment with a line that+--   would overflow and thus gets disabled entirely.+--   An better approach would be to repeat step 3 after marking overflowing+--   lines as such, and not include the overflowing spacings as references+--   for non-overflowing ones. In the simplest case one additional iteration+--   would suffice, e.g. 1-2-3-4-3-5, but it would also be possible to refine+--   this and first remove alignment in the deepest parts of the tree for+--   overflowing lines, repeating and moving upwards until no lines are+--   anymore overflowing.+--   Further, it may make sense to break up connections when overflowing would+--   occur.+-- - It may also make sense to not filter all overflowing lines, but remove+--   them one-by-one and in each step recalculate the aggregated connection+--   spacing info. Because removing one overflowing line from the calculation+--   may very well cause another previously overflowing line to not overflow+--   any longer.+--   There is also a nasty optimization problem hiding in there (find the+--   minimal amount of alignment disabling that results in no overflows)+--   but that is overkill.+--+--   (with both these improvements there would be quite some repetition between+--   steps 3 and 4, but it should be possible to ensure termination. Still,+--   performance might become an issue as such an approach is not necessarily+--   linear in bridoc size any more.)+--+-- In practice+-- ===========+--+-- .. the current implementation is somewhat sloppy. Steps 1 and 2+-- are executed in one step, step 3 already applies one strategy that disables+-- certain connections (see `_lconfig_alignmentLimit`) and step 4 does some+-- of the calculations one might expect to occur in step 3. Steps 4 and 5+-- are executed in the same recursion, too.+-- Also, _lconfig_alignmentLimit really is itself a hack that hides the issue+-- mentioned in the first "possible improvement". alignColsLines :: LayoutConstraints m => [BriDoc] -> m () alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do   -- tellDebugMess ("alignColsLines: at " ++ take 100 (show $ briDocToDoc $ head bridocs))@@ -358,11 +433,12 @@   alignBreak <-     mAsk <&> _conf_layout .> _lconfig_alignmentBreakOnMultiline .> confUnpack   case () of-    _ ->+    _ -> do+      -- tellDebugMess ("processedMap: " ++ show processedMap)       sequence_         $   List.intersperse layoutWriteEnsureNewlineBlock         $   colInfos-        <&> processInfo processedMap+        <&> processInfo colMax processedMap      where       (colInfos, finalState) =         StateS.runState (mergeBriDocs bridocs) (ColBuildState IntMapS.empty 0)@@ -393,10 +469,9 @@                 Nothing           -> 0                 Just (_, maxs, _) -> sum maxs             maxCols = {-Foldable.foldl1 maxZipper-}-              fmap colAggregation $ transpose $ Foldable.toList-              --  $ trace ("colss=" ++ show colss ++ " for" ++ take 100 (show $ briDocToDoc $ head bridocs))-              colss-            (_, posXs) = mapAccumL (\acc x -> (acc + x, acc)) curX maxCols+              fmap colAggregation $ transpose $ Foldable.toList colss+            (_, posXs) = -- trace ("colss=" ++ show colss ++ ", maxCols=" ++ show maxCols ++ " for " ++ take 100 (show $ briDocToDoc $ head bridocs)) $+                         mapAccumL (\acc x -> (acc + x, acc)) curX maxCols             counter count l = if List.last posXs + List.last l <= colMax               then count + 1               else count@@ -528,12 +603,13 @@     $ c { _cbs_map = IntMapS.insert ind (lastFlag, space) $ _cbs_map c }   return info -processInfo :: LayoutConstraints m => ColMap2 -> ColInfo -> m ()-processInfo m = \case+processInfo :: LayoutConstraints m => Int -> ColMap2 -> ColInfo -> m ()+processInfo maxSpace m = \case   ColInfoStart       -> error "should not happen (TM)"   ColInfoNo doc      -> layoutBriDocM doc-  ColInfo ind _ list -> do-    colMax    <- mAsk <&> _conf_layout .> _lconfig_cols .> confUnpack+  ColInfo ind _ list -> -- trace ("processInfo ind=" ++ show ind ++ ", list=" ++ show list ++ ", colmap=" ++ show m) $+                        do+    colMaxConf <- mAsk <&> _conf_layout .> _lconfig_cols .> confUnpack     alignMode <- mAsk <&> _conf_layout .> _lconfig_columnAlignMode .> confUnpack     curX      <- do       state <- mGet@@ -546,8 +622,14 @@           Nothing -> spaceAdd + i           Just c -> c         Right{} -> spaceAdd+    let colMax = min colMaxConf (curX + maxSpace)     -- tellDebugMess $ show curX-    let Just (ratio, maxCols, _colss) = IntMapS.lookup ind m+    let Just (ratio, maxCols1, _colss) = IntMapS.lookup ind m+    let maxCols2 = list <&> \e -> case e of+          (_, ColInfo i _ _) ->+            let Just (_, ms, _) = IntMapS.lookup i m in sum ms+          (l, _) -> l+    let maxCols = zipWith max maxCols1 maxCols2     let (maxX, posXs) = mapAccumL (\acc x -> (acc + x, acc)) curX maxCols     -- handle the cases that the vertical alignment leads to more than max     -- cols:@@ -568,15 +650,21 @@             offsets = (subtract curX) <$> posXs             fixed   = offsets <&> fromIntegral .> (*factor) .> truncate           _ -> posXs+    let spacings = zipWith (-)+                           (List.tail fixedPosXs ++ [min maxX colMax])+                           fixedPosXs+    -- tellDebugMess $ "ind = " ++ show ind     -- tellDebugMess $ "maxCols = " ++ show maxCols     -- tellDebugMess $ "fixedPosXs = " ++ show fixedPosXs-    let alignAct = zip fixedPosXs list `forM_` \(destX, x) -> do+    -- tellDebugMess $ "list = " ++ show list+    -- tellDebugMess $ "maxSpace = " ++ show maxSpace+    let alignAct = zip3 fixedPosXs spacings list `forM_` \(destX, s, x) -> do           layoutWriteEnsureAbsoluteN destX-          processInfo m (snd x)+          processInfo s m (snd x)         noAlignAct = list `forM_` (snd .> processInfoIgnore)-        animousAct =-          -- per-item check if there is overflowing.+        animousAct = -- trace ("animousAct fixedPosXs=" ++ show fixedPosXs ++ ", list=" ++ show list ++ ", maxSpace=" ++ show maxSpace ++ ", colMax="++show colMax) $                      if List.last fixedPosXs + fst (List.last list) > colMax+                     -- per-item check if there is overflowing.           then noAlignAct           else alignAct     case alignMode of

@@ -5,7 +5,7 @@   , DebugConfig   , LayoutConfig   , Config-  , configParser+  , cmdlineConfigParser   , staticDefaultConfig   , forwardOptionsSyntaxExtsEnabled   , readConfig@@ -38,6 +38,7 @@ import           Language.Haskell.Brittany.Internal.Utils  import           Data.Coerce ( Coercible, coerce )+import qualified Data.List.NonEmpty as NonEmpty  import qualified System.Directory as Directory import qualified System.FilePath.Posix as FilePath@@ -88,6 +89,8 @@   , _conf_forward = ForwardOptions     { _options_ghc = Identity []     }+  , _conf_roundtrip_exactprint_only  = coerce False+  , _conf_obfuscate                  = coerce False   }  forwardOptionsSyntaxExtsEnabled :: ForwardOptions@@ -108,8 +111,9 @@     ]   } -configParser :: CmdParser Identity out (CConfig Option)-configParser = do+-- brittany-next-binding --columns=200+cmdlineConfigParser :: CmdParser Identity out (CConfig Option)+cmdlineConfigParser = do   -- TODO: why does the default not trigger; ind never should be []!!   ind                <- addFlagReadParams "" ["indent"] "AMOUNT" (flagHelpStr "spaces per indentation level")   cols               <- addFlagReadParams "" ["columns"] "AMOUNT" (flagHelpStr "target max columns (80 is an old default for this)")@@ -140,6 +144,7 @@                                            ["ghc-options"]                                            "STRING"                                            (flagHelp $ parDoc "allows to define default language extensions. The parameter is forwarded to ghc.")+  obfuscate <- addSimpleBoolFlag "" ["obfuscate"] (flagHelp $ parDoc "apply obfuscator to the output.")    return $ Config     { _conf_version = mempty@@ -155,7 +160,7 @@       , _dconf_dump_bridoc_simpl_columns  = wrapLast $ falseToNothing dumpBriDocColumns       , _dconf_dump_bridoc_simpl_indent   = wrapLast $ falseToNothing dumpBriDocIndent       , _dconf_dump_bridoc_final          = wrapLast $ falseToNothing dumpBriDocFinal-      , _dconf_roundtrip_exactprint_only  = wrapLast $ falseToNothing roundtripOnly+      , _dconf_roundtrip_exactprint_only  = mempty       }     , _conf_layout = LayoutConfig       { _lconfig_cols                      = optionConcat cols@@ -186,6 +191,8 @@     , _conf_forward = ForwardOptions       { _options_ghc = [ optionsGhc & List.unwords & CmdArgs.splitArgs | not $ null optionsGhc ]       }+    , _conf_roundtrip_exactprint_only  = wrapLast $ falseToNothing roundtripOnly+    , _conf_obfuscate                  = wrapLast $ falseToNothing obfuscate     }  where   falseToNothing = Option . Bool.bool Nothing (Just True)@@ -272,7 +279,7 @@   -> MaybeT IO Config readConfigs cmdlineConfig configPaths = do   configs <- readConfig `mapM` configPaths-  let merged = Semigroup.mconcat $ reverse (cmdlineConfig:catMaybes configs)+  let merged = Semigroup.sconcat $ NonEmpty.reverse (cmdlineConfig :| catMaybes configs)   return $ cZipWith fromOptionIdentity staticDefaultConfig merged  -- | Reads provided configs

@@ -5,6 +5,9 @@ {-# LANGUAGE DeriveDataTypeable #-}  module Language.Haskell.Brittany.Internal.Config.Types+  ( module Language.Haskell.Brittany.Internal.Config.Types+  , cMap+  ) where  @@ -142,6 +145,12 @@   , _conf_errorHandling :: CErrorHandlingConfig f   , _conf_forward       :: CForwardOptions f   , _conf_preprocessor  :: CPreProcessorConfig f+  , _conf_roundtrip_exactprint_only :: f (Semigroup.Last Bool)+  , _conf_obfuscate     :: f (Semigroup.Last Bool)+    -- ^ this field is somewhat of a duplicate of the one in DebugConfig.+    -- It is used for per-declaration disabling by the inline config+    -- implementation. Could have re-used the existing field, but felt risky+    -- to use a "debug" labeled field for non-debug functionality.   }   deriving (Generic) @@ -173,6 +182,16 @@ deriving instance Data (CPreProcessorConfig Identity) deriving instance Data (CConfig Identity) +#if MIN_VERSION_ghc(8,2,0)+-- these instances break on earlier ghcs+deriving instance Data (CDebugConfig Option)+deriving instance Data (CLayoutConfig Option)+deriving instance Data (CErrorHandlingConfig Option)+deriving instance Data (CForwardOptions Option)+deriving instance Data (CPreProcessorConfig Option)+deriving instance Data (CConfig Option)+#endif+ instance Semigroup.Semigroup (CDebugConfig Option) where   (<>) = gmappend instance Semigroup.Semigroup (CLayoutConfig Option) where@@ -277,8 +296,12 @@                                  -- A PROGRAM BY TRANSFORMING IT.   deriving (Show, Generic, Data) -cMap :: CZipWith k => (forall a . f a -> g a) -> k f -> k g-cMap f c = cZipWith (\_ -> f) c c+instance CFunctor CDebugConfig+instance CFunctor CLayoutConfig+instance CFunctor CErrorHandlingConfig+instance CFunctor CForwardOptions+instance CFunctor CPreProcessorConfig+instance CFunctor CConfig  deriveCZipWith ''CDebugConfig deriveCZipWith ''CLayoutConfig

@@ -119,6 +119,8 @@     <*> v .:?= Text.pack "conf_errorHandling"     <*> v .:?= Text.pack "conf_forward"     <*> v .:?= Text.pack "conf_preprocessor"+    <*> v .:?  Text.pack "conf_roundtrip_exactprint_only"+    <*> v .:?  Text.pack "conf_obfuscate"   parseJSON invalid    = Aeson.typeMismatch "Config" invalid  -- Pretends that the value is {} when the key is not present.

@@ -7,6 +7,7 @@   , commentAnnFixTransformGlob   , extractToplevelAnns   , foldedAnnKeys+  , withTransformedAnns   ) where @@ -17,6 +18,8 @@ import           Language.Haskell.Brittany.Internal.Types import           Language.Haskell.Brittany.Internal.Config.Types import           Language.Haskell.Brittany.Internal.Utils+import           Data.Data+import           Data.HList.HList  import           DynFlags ( getDynFlags ) import           GHC ( runGhc, GenLocated(L), moduleNameString )@@ -29,10 +32,9 @@ import qualified Lexer         as GHC import qualified StringBuffer  as GHC import qualified Outputable    as GHC-import           RdrName ( RdrName(..) )+import qualified CmdLineParser as GHC import           HsSyn import           SrcLoc ( SrcSpan, Located )-import           RdrName ( RdrName(..) )   import qualified Language.Haskell.GHC.ExactPrint            as ExactPrint@@ -79,7 +81,7 @@     when (not $ null warnings)       $  ExceptT.throwE       $  "when parsing ghc flags: encountered warnings: "-      ++ show (warnings <&> \(L _ s) -> s)+      ++ show (warnings <&> warnExtractorCompat)     x   <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2     res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp     either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err)@@ -111,7 +113,7 @@     when (not $ null warnings)       $  ExceptT.throwE       $  "when parsing ghc flags: encountered warnings: "-      ++ show (warnings <&> \(L _ s) -> s)+      ++ show (warnings <&> warnExtractorCompat)     dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1     let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str     case res of@@ -187,7 +189,7 @@  where   genF :: Data.Data.Data a => a -> ExactPrint.Transform ()   genF = (\_ -> return ()) `SYB.extQ` exprF-  exprF :: Located (HsExpr RdrName) -> ExactPrint.Transform ()+  exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform ()   exprF lexpr@(L _ expr) = case expr of     RecordCon _lname _ _ (HsRecFields fs@(_:_) Nothing) ->       moveTrailingComments lexpr (List.last fs)@@ -226,7 +228,7 @@ -- elements to the relevant annotations. Avoids quadratic behaviour a trivial -- implementation would have. extractToplevelAnns-  :: Located (HsModule RdrName)+  :: Located (HsModule GhcPs)   -> ExactPrint.Anns   -> Map ExactPrint.AnnKey ExactPrint.Anns extractToplevelAnns lmod anns = output@@ -265,3 +267,31 @@   )   ast   where locTyCon = SYB.typeRepTyCon (SYB.typeOf (L () ()))+++withTransformedAnns+  :: Data ast+  => 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+ where+  f anns =+    let ((), (annsBalanced, _), _) =+          ExactPrint.runTransform anns (commentAnnFixTransformGlob ast)+    in  annsBalanced+++#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */+warnExtractorCompat :: GHC.Warn -> String+warnExtractorCompat (GHC.Warn _ (L _ s)) = s+#else /* ghc-8.0 && ghc-8.2 */+warnExtractorCompat :: GenLocated l String -> String+warnExtractorCompat (L _ s) = s+#endif

@@ -1,3 +1,5 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module Language.Haskell.Brittany.Internal.LayouterBasics   ( processDefault   , rdrNameToText@@ -11,7 +13,10 @@   , docEmpty   , docLit   , docAlt-  , docAltFilter+  , CollectAltM+  , addAlternativeCond+  , addAlternative+  , runFilteredAlternative   , docLines   , docCols   , docSeq@@ -60,6 +65,8 @@  #include "prelude.inc" +import qualified Control.Monad.Writer.Strict as Writer+ 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@@ -111,7 +118,7 @@   --       the module (header). This would remove the need for this hack!   case str of     "\n" -> return ()-    _    -> mTell $ Text.Builder.fromString $ str+    _    -> mTell $ Text.Builder.fromString str  -- | Use ExactPrint's output for this node; add a newly generated inline comment -- at insertion position (meant to point out to the user that this node is@@ -166,7 +173,7 @@         False         t   let errorAction = do-        mTell $ [ErrorUnknownNode infoStr ast]+        mTell [ErrorUnknownNode infoStr ast]         docLit           $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"   case (fallbackMode, Text.lines exactPrinted) of@@ -256,8 +263,8 @@        )  filterAnns :: Data.Data.Data ast => ast -> ExactPrint.Anns -> ExactPrint.Anns-filterAnns ast anns =-  Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast) anns+filterAnns ast =+  Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast)  hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool hasAnyCommentsBelow ast@(L l _) = do@@ -297,10 +304,10 @@  -- docEmpty :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -- docEmpty = allocateNode BDFEmpty--- +-- -- docLit :: MonadMultiState NodeAllocIndex m => Text -> m BriDocNumbered -- docLit t = allocateNode $ BDFLit t--- +-- -- docExt :: (ExactPrint.Annotate.Annotate ast, MonadMultiState NodeAllocIndex m) --        => Located ast -> ExactPrint.Types.Anns -> Bool -> m BriDocNumbered -- docExt x anns shouldAddComment = allocateNode $ BDFExternal@@ -308,51 +315,51 @@ --                   (foldedAnnKeys x) --                   shouldAddComment --                   (Text.pack $ ExactPrint.exactPrint x anns)--- +-- -- docAlt :: MonadMultiState NodeAllocIndex m => [m BriDocNumbered] -> m BriDocNumbered -- docAlt l = allocateNode . BDFAlt =<< sequence l--- --- +--+-- -- docSeq :: MonadMultiState NodeAllocIndex m => [m BriDocNumbered] -> m BriDocNumbered -- docSeq l = allocateNode . BDFSeq =<< sequence l--- +-- -- docLines :: MonadMultiState NodeAllocIndex m => [m BriDocNumbered] -> m BriDocNumbered -- docLines l = allocateNode . BDFLines =<< sequence l--- +-- -- docCols :: MonadMultiState NodeAllocIndex m => ColSig -> [m BriDocNumbered] -> m BriDocNumbered -- docCols sig l = allocateNode . BDFCols sig =<< sequence l--- +-- -- docAddBaseY :: MonadMultiState NodeAllocIndex m => BrIndent -> m BriDocNumbered -> m BriDocNumbered -- docAddBaseY ind bdm = allocateNode . BDFAddBaseY ind =<< bdm--- +-- -- docSetBaseY :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered -- docSetBaseY bdm = allocateNode . BDFSetBaseY =<< bdm--- +-- -- docSetIndentLevel :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered -- docSetIndentLevel bdm = allocateNode . BDFSetIndentLevel =<< bdm--- +-- -- docSeparator :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -- docSeparator = allocateNode BDFSeparator--- +-- -- docAnnotationPrior :: MonadMultiState NodeAllocIndex m => AnnKey -> m BriDocNumbered -> m BriDocNumbered -- docAnnotationPrior annKey bdm = allocateNode . BDFAnnotationPrior annKey =<< bdm--- +-- -- docAnnotationPost :: MonadMultiState NodeAllocIndex m => AnnKey -> m BriDocNumbered -> m BriDocNumbered -- docAnnotationPost  annKey bdm = allocateNode . BDFAnnotationPost annKey =<< bdm--- +-- -- docNonBottomSpacing :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered -- docNonBottomSpacing bdm = allocateNode . BDFNonBottomSpacing =<< bdm--- +-- -- appSep :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered -- appSep x = docSeq [x, docSeparator]--- +-- -- docCommaSep :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -- docCommaSep = appSep $ docLit $ Text.pack ","--- +-- -- docParenLSep :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -- docParenLSep = appSep $ docLit $ Text.pack "("--- --- +--+-- -- docPostComment :: (Data.Data.Data ast, MonadMultiState NodeAllocIndex m) --                => Located ast --                -> m BriDocNumbered@@ -360,7 +367,7 @@ -- docPostComment ast bdm = do --   bd <- bdm --   allocateNode $ BDFAnnotationPost (ExactPrint.Types.mkAnnKey ast) bd--- +-- -- docWrapNode :: ( Data.Data.Data ast, MonadMultiState NodeAllocIndex m) --             => Located ast --             -> m BriDocNumbered@@ -375,7 +382,7 @@ --     $ (,) i2 --     $ BDFAnnotationPost (ExactPrint.Types.mkAnnKey ast) --     $ bd--- +-- -- docPar :: MonadMultiState NodeAllocIndex m --        => m BriDocNumbered --        -> m BriDocNumbered@@ -384,13 +391,13 @@ --   line <- lineM --   indented <- indentedM --   allocateNode $ BDFPar BrIndentNone line indented--- +-- -- docForceSingleline :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered -- docForceSingleline bdm = allocateNode . BDFForceSingleline =<< bdm--- +-- -- docForceMultiline :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered -- docForceMultiline bdm = allocateNode . BDFForceMultiline =<< bdm--- +-- -- docEnsureIndent :: MonadMultiState NodeAllocIndex m => BrIndent -> m BriDocNumbered -> m BriDocNumbered -- docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd @@ -415,10 +422,22 @@ docAlt :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered docAlt l = allocateNode . BDFAlt =<< sequence l -docAltFilter :: [(Bool, ToBriDocM BriDocNumbered)] -> ToBriDocM BriDocNumbered-docAltFilter = docAlt . map snd . filter fst+newtype CollectAltM a = CollectAltM (Writer.Writer [ToBriDocM BriDocNumbered] a)+  deriving (Functor, Applicative, Monad) +addAlternativeCond :: Bool -> ToBriDocM BriDocNumbered -> CollectAltM ()+addAlternativeCond cond doc =+  when cond (addAlternative doc) +addAlternative :: ToBriDocM BriDocNumbered -> CollectAltM ()+addAlternative =+  CollectAltM . Writer.tell . (: [])++runFilteredAlternative :: CollectAltM () -> ToBriDocM BriDocNumbered+runFilteredAlternative (CollectAltM action) =+  docAlt $ Writer.execWriter action++ docSeq :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered docSeq [] = docEmpty docSeq l = allocateNode . BDFSeq =<< sequence l@@ -565,7 +584,7 @@   docWrapNode ast bdsm = do     bds <- bdsm     case bds of-      [] -> return $ [] -- TODO: this might be bad. maybe. then again, not really. well.+      [] -> return [] -- TODO: this might be bad. maybe. then again, not really. well.       [bd] -> do         bd' <- docWrapNode ast (return bd)         return [bd']@@ -577,23 +596,23 @@   docWrapNodePrior ast bdsm = do     bds <- bdsm     case bds of-      [] -> return $ []+      [] -> return []       (bd1:bdR) -> do         bd1' <- docWrapNodePrior ast (return bd1)-        return $ (bd1':bdR)+        return (bd1':bdR)   docWrapNodeRest ast bdsm = do     bds <- bdsm     case reverse bds of-      [] -> return $ []+      [] -> return []       (bdN:bdR) -> do         bdN' <- docWrapNodeRest ast (return bdN)-        return $ reverse $ (bdN':bdR)+        return $ reverse (bdN':bdR)  instance DocWrapable a => DocWrapable (Seq a) where   docWrapNode ast bdsm = do     bds <- bdsm     case Seq.viewl bds of-      Seq.EmptyL -> return $ Seq.empty -- TODO: this might be bad. maybe. then again, not really. well.+      Seq.EmptyL -> return Seq.empty -- TODO: this might be bad. maybe. then again, not really. well.       bd1 Seq.:< rest -> case Seq.viewr rest of         Seq.EmptyR -> do           bd1' <- docWrapNode ast (return bd1)@@ -605,14 +624,14 @@   docWrapNodePrior ast bdsm = do     bds <- bdsm     case Seq.viewl bds of-      Seq.EmptyL -> return $ Seq.empty+      Seq.EmptyL -> return Seq.empty       bd1 Seq.:< bdR -> do         bd1' <- docWrapNodePrior ast (return bd1)         return $ bd1' Seq.<| bdR   docWrapNodeRest ast bdsm = do     bds <- bdsm     case Seq.viewr bds of-      Seq.EmptyR -> return $ Seq.empty+      Seq.EmptyR -> return Seq.empty       bdR Seq.:> bdN -> do         bdN' <- docWrapNodeRest ast (return bdN)         return $ bdR Seq.|> bdN'@@ -623,19 +642,19 @@     if null bds       then do         bd' <- docWrapNode ast (return bd)-        return $ (bds, bd', x)+        return (bds, bd', x)       else do         bds' <- docWrapNodePrior ast (return bds)         bd' <- docWrapNodeRest ast (return bd)-        return $ (bds', bd', x)+        return (bds', bd', x)   docWrapNodePrior ast stuffM = do     (bds, bd, x) <- stuffM     bds' <- docWrapNodePrior ast (return bds)-    return $ (bds', bd, x)+    return (bds', bd, x)   docWrapNodeRest ast stuffM = do     (bds, bd, x) <- stuffM     bd' <- docWrapNodeRest ast (return bd)-    return $ (bds, bd', x)+    return (bds, bd', x)   @@ -661,7 +680,7 @@ unknownNodeError   :: Data.Data.Data ast => String -> ast -> ToBriDocM BriDocNumbered unknownNodeError infoStr ast = do-  mTell $ [ErrorUnknownNode infoStr ast]+  mTell [ErrorUnknownNode infoStr ast]   docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"  spacifyDocs :: [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]

@@ -2,7 +2,8 @@ {-# LANGUAGE TypeApplications #-}  module Language.Haskell.Brittany.Internal.Layouters.Decl-  ( layoutSig+  ( layoutDecl+  , layoutSig   , layoutBind   , layoutLocalBinds   , layoutGuardLStmt@@ -20,7 +21,11 @@ import           Language.Haskell.Brittany.Internal.LayouterBasics import           Language.Haskell.Brittany.Internal.Config.Types -import           RdrName ( RdrName(..) )+import qualified Language.Haskell.GHC.ExactPrint as ExactPrint+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint+import           Language.Haskell.Brittany.Internal.ExactPrintUtils+import           Language.Haskell.Brittany.Internal.Utils+ import           GHC ( runGhc, GenLocated(L), moduleNameString ) import           SrcLoc ( SrcSpan ) import           HsSyn@@ -41,6 +46,28 @@   +layoutDecl :: ToBriDoc HsDecl+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++ layoutSig :: ToBriDoc Sig layoutSig lsig@(L _loc sig) = case sig of #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */@@ -88,11 +115,7 @@   InlineSig name (InlinePragma _ spec _arity phaseAct conlike) ->     docWrapNode lsig $ do       nameStr <- lrdrNameToTextAnn name-      let specStr = case spec of-            Inline          -> "INLINE "-            Inlinable       -> "INLINABLE "-            NoInline        -> "NOINLINE "-            EmptyInlineSpec -> "" -- i have no idea if this is correct.+      specStr <- specStringCompat lsig spec       let phaseStr = case phaseAct of             NeverActive      -> "" -- not [] - for NOINLINE NeverActive is                                    -- in fact the default@@ -108,7 +131,23 @@         <> Text.pack " #-}"   _ -> briDocByExactNoComment lsig -- TODO -layoutGuardLStmt :: ToBriDoc' (Stmt RdrName (LHsExpr RdrName))+specStringCompat+  :: MonadMultiWriter [BrittanyError] m => LSig GhcPs -> InlineSpec -> m String+#if MIN_VERSION_ghc(8,4,0)+specStringCompat ast = \case+  NoUserInline    -> mTell [ErrorUnknownNode "NoUserInline" ast] $> ""+  Inline          -> pure "INLINE "+  Inlinable       -> pure "INLINABLE "+  NoInline        -> pure "NOINLINE "+#else+specStringCompat _ = \case+  Inline          -> pure "INLINE "+  Inlinable       -> pure "INLINABLE "+  NoInline        -> pure "NOINLINE "+  EmptyInlineSpec -> pure ""+#endif++layoutGuardLStmt :: ToBriDoc' (Stmt GhcPs (LHsExpr GhcPs)) layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of   BodyStmt body _ _ _      -> layoutExpr body   BindStmt lPat expr _ _ _ -> do@@ -122,7 +161,7 @@  layoutBind   :: ToBriDocC-       (HsBindLR RdrName RdrName)+       (HsBindLR GhcPs GhcPs)        (Either [BriDocNumbered] BriDocNumbered) layoutBind lbind@(L _ bind) = case bind of   FunBind fId (MG lmatches@(L _ matches) _ _ _) _ _ [] -> do@@ -148,15 +187,15 @@                                                             hasComments   _ -> Right <$> unknownNodeError "" lbind -data BagBindOrSig = BagBind (LHsBindLR RdrName RdrName)-                  | BagSig (LSig RdrName)+data BagBindOrSig = BagBind (LHsBindLR GhcPs GhcPs)+                  | BagSig (LSig GhcPs)  bindOrSigtoSrcSpan :: BagBindOrSig -> SrcSpan bindOrSigtoSrcSpan (BagBind (L l _)) = l bindOrSigtoSrcSpan (BagSig  (L l _)) = l  layoutLocalBinds-  :: ToBriDocC (HsLocalBindsLR RdrName RdrName) (Maybe [BriDocNumbered])+  :: ToBriDocC (HsLocalBindsLR GhcPs GhcPs) (Maybe [BriDocNumbered]) layoutLocalBinds lbinds@(L _ binds) = case binds of   -- HsValBinds (ValBindsIn lhsBindsLR []) ->   --   Just . (>>= either id return) . Data.Foldable.toList <$> mapBagM layoutBind lhsBindsLR -- TODO: fix ordering@@ -178,11 +217,11 @@   x@(HsIPBinds _ipBinds) -> Just . (:[]) <$> unknownNodeError "HsIPBinds" x   EmptyLocalBinds        -> return $ Nothing --- TODO: we don't need the `LHsExpr RdrName` anymore, now that there is+-- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is -- parSpacing stuff.B layoutGrhs-  :: LGRHS RdrName (LHsExpr RdrName)-  -> ToBriDocM ([BriDocNumbered], BriDocNumbered, LHsExpr RdrName)+  :: LGRHS GhcPs (LHsExpr GhcPs)+  -> ToBriDocM ([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs) layoutGrhs lgrhs@(L _ (GRHS guards body)) = do   guardDocs <- docWrapNode lgrhs $ layoutStmt `mapM` guards   bodyDoc   <- layoutExpr body@@ -191,12 +230,14 @@ layoutPatternBind   :: Maybe Text   -> BriDocNumbered-  -> LMatch RdrName (LHsExpr RdrName)+  -> LMatch GhcPs (LHsExpr GhcPs)   -> ToBriDocM BriDocNumbered-layoutPatternBind mIdStr binderDoc lmatch@(L _ match@(Match fixityOrCtx pats _ (GRHSs grhss whereBinds))) = do+layoutPatternBind mIdStr binderDoc lmatch@(L _ match) = do+  let pats                     = m_pats match+  let (GRHSs grhss whereBinds) = m_grhss match   patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p   let isInfix = isInfixMatch match-  let mIdStr' = fixPatternBindIdentifier fixityOrCtx <$> mIdStr+  let mIdStr' = fixPatternBindIdentifier match <$> mIdStr   patDoc <- docWrapNodePrior lmatch $ case (mIdStr', patDocs) of     (Just idStr, p1 : pr) | isInfix -> docCols       ColPatternsFuncInfix@@ -222,25 +263,26 @@                          mWhereDocs                          hasComments -#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 && ghc-8.4 */ fixPatternBindIdentifier-  :: HsMatchContext (NameOrRdrName RdrName) -> Text -> Text-fixPatternBindIdentifier ctx idStr = case ctx of-  (FunRhs _ _ SrcLazy    ) -> Text.cons '~' idStr-  (FunRhs _ _ SrcStrict  ) -> Text.cons '!' idStr-  (FunRhs _ _ NoSrcStrict) -> idStr-  (StmtCtxt ctx1         ) -> fixPatternBindIdentifier' ctx1-  _                        -> idStr+  :: Match GhcPs (LHsExpr GhcPs) -> Text -> Text+fixPatternBindIdentifier match idStr = go $ m_ctxt match  where+  go = \case+    (FunRhs _ _ SrcLazy    ) -> Text.cons '~' idStr+    (FunRhs _ _ SrcStrict  ) -> Text.cons '!' idStr+    (FunRhs _ _ NoSrcStrict) -> idStr+    (StmtCtxt ctx1         ) -> goInner ctx1+    _                        -> idStr   -- I have really no idea if this path ever occurs, but better safe than   -- risking another "drop bangpatterns" bugs.-  fixPatternBindIdentifier' = \case-    (PatGuard      ctx1) -> fixPatternBindIdentifier ctx1 idStr-    (ParStmtCtxt   ctx1) -> fixPatternBindIdentifier' ctx1-    (TransStmtCtxt ctx1) -> fixPatternBindIdentifier' ctx1+  goInner = \case+    (PatGuard      ctx1) -> go ctx1+    (ParStmtCtxt   ctx1) -> goInner ctx1+    (TransStmtCtxt ctx1) -> goInner ctx1     _                    -> idStr-#else                      /* ghc-8.0 */-fixPatternBindIdentifier :: MatchFixity RdrName -> Text -> Text+#else                       /* ghc-8.0 */+fixPatternBindIdentifier :: Match GhcPs (LHsExpr GhcPs) -> Text -> Text fixPatternBindIdentifier _ x = x #endif @@ -248,7 +290,7 @@   :: Maybe Text   -> BriDocNumbered   -> Maybe BriDocNumbered-  -> [([BriDocNumbered], BriDocNumbered, LHsExpr RdrName)]+  -> [([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs)]   -> Maybe [BriDocNumbered]   -> Bool   -> ToBriDocM BriDocNumbered@@ -308,258 +350,237 @@             ++ (List.intersperse docCommaSep                                  (docForceSingleline . return <$> gs)                )+      wherePart = case mWhereDocs of+        Nothing  -> Just docEmpty+        Just [w] -> Just $ docSeq+          [ docSeparator+          , appSep $ docLit $ Text.pack "where"+          , docSetIndentLevel $ docForceSingleline $ return w+          ]+        _        -> Nothing    indentPolicy <- mAsk     <&> _conf_layout     .>  _lconfig_indentPolicy     .>  confUnpack-  docAltFilter-    $  -- one-line solution-       [ ( True-         , docCols-         (ColBindingLine alignmentToken)-         [ docSeq (patPartInline ++ [guardPart])-         , docSeq-           [ appSep $ return binderDoc-           , docForceSingleline $ return body-           , wherePart-           ]-         ]-         )-       | not hasComments-       , [(guards, body, _bodyRaw)] <- [clauseDocs]-       , let guardPart = singleLineGuardsDoc guards-       , wherePart <- case mWhereDocs of-         Nothing  -> return @[] $ docEmpty-         Just [w] -> return @[] $ docSeq-           [ docSeparator-           , appSep $ docLit $ Text.pack "where"-           , docSetIndentLevel $ docForceSingleline $ return w-           ]-         _        -> []-       ]-    ++ -- one-line solution + where in next line(s)-       [ ( True-         , docLines-         $  [ docCols-              (ColBindingLine alignmentToken)-              [ docSeq (patPartInline ++ [guardPart])-              , docSeq-                [appSep $ return binderDoc, docForceParSpacing $ return body]-              ]-            ]-         ++ wherePartMultiLine-         )-       | [(guards, body, _bodyRaw)] <- [clauseDocs]-       , let guardPart = singleLineGuardsDoc guards-       , Data.Maybe.isJust mWhereDocs-       ]-    ++ -- two-line solution + where in next line(s)-       [ ( True -         , docLines-         $  [ docForceSingleline-            $ docSeq (patPartInline ++ [guardPart, return binderDoc])-            , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body-            ]-         ++ wherePartMultiLine-         )-       | [(guards, body, _bodyRaw)] <- [clauseDocs]-       , let guardPart = singleLineGuardsDoc guards-       ]-    ++ -- pattern and exactly one clause in single line, body as par;-       -- where in following lines-       [ ( True-         , docLines-         $  [ docCols-              (ColBindingLine alignmentToken)-              [ docSeq (patPartInline ++ [guardPart])-              , docSeq-                [ appSep $ return binderDoc-                , docForceParSpacing $ docAddBaseY BrIndentRegular $ return body-                ]++  runFilteredAlternative $ do++    case clauseDocs of+      [(guards, body, _bodyRaw)] -> do+        let guardPart = singleLineGuardsDoc guards+        forM_ wherePart $ \wherePart' ->+          -- one-line solution+          addAlternativeCond (not hasComments) $ docCols+            (ColBindingLine alignmentToken)+            [ docSeq (patPartInline ++ [guardPart])+            , docSeq+              [ appSep $ return binderDoc+              , docForceSingleline $ return body+              , wherePart'               ]             ]-          -- , lineMod $ docAlt-          --   [ docSetBaseY $ return body-          --   , docAddBaseY BrIndentRegular $ return body-          --   ]-         ++ wherePartMultiLine-         )-       | [(guards, body, _bodyRaw)] <- [clauseDocs]-       , let guardPart = singleLineGuardsDoc guards-       ]-    ++ -- pattern and exactly one clause in single line, body in new line.-       [ ( True-         , docLines-         $  [ docSeq (patPartInline ++ [guardPart, return binderDoc])-            , docEnsureIndent BrIndentRegular-            $ docNonBottomSpacing-            $ (docAddBaseY BrIndentRegular $ return body)-            ]-         ++ wherePartMultiLine-         )-       | [(guards, body, _)] <- [clauseDocs]-       , let guardPart = singleLineGuardsDoc guards-       ]-    ++ -- multiple clauses added in-paragraph, each in a single line-       -- example: foo | bar = baz-       --              | lll = asd-       [ ( indentPolicy /= IndentPolicyLeft-         , docLines-         $  [ docSeq-              [ appSep $ docForceSingleline $ return patDoc-              , docSetBaseY-              $   docLines-              $   clauseDocs-              <&> \(guardDocs, bodyDoc, _) -> do-                    let guardPart = singleLineGuardsDoc guardDocs-                    -- the docForceSingleline might seems superflous, but it-                    -- helps the alternative resolving impl.-                    docForceSingleline $ docCols-                      ColGuardedBody-                      [ guardPart-                      , docSeq+        -- one-line solution + where in next line(s)+        addAlternativeCond (Data.Maybe.isJust mWhereDocs)+          $ docLines+          $  [ docCols+               (ColBindingLine alignmentToken)+               [ docSeq (patPartInline ++ [guardPart])+               , docSeq+                 [appSep $ return binderDoc, docForceParSpacing $ return body]+               ]+             ]+          ++ wherePartMultiLine+        -- two-line solution + where in next line(s)+        addAlternative+          $ docLines+          $  [ docForceSingleline+             $ docSeq (patPartInline ++ [guardPart, return binderDoc])+             , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body+             ]+          ++ wherePartMultiLine+        -- pattern and exactly one clause in single line, body as par;+        -- where in following lines+        addAlternative+          $ docLines+          $  [ docCols+               (ColBindingLine alignmentToken)+               [ docSeq (patPartInline ++ [guardPart])+               , docSeq+                 [ appSep $ return binderDoc+                 , docForceParSpacing $ docAddBaseY BrIndentRegular $ return body+                 ]+               ]+             ]+           -- , lineMod $ docAlt+           --   [ docSetBaseY $ return body+           --   , docAddBaseY BrIndentRegular $ return body+           --   ]+          ++ wherePartMultiLine+        -- pattern and exactly one clause in single line, body in new line.+        addAlternative+          $ docLines+          $  [ docSeq (patPartInline ++ [guardPart, return binderDoc])+             , docEnsureIndent BrIndentRegular+             $ docNonBottomSpacing+             $ docAddBaseY BrIndentRegular+             $ return body+             ]+          ++ wherePartMultiLine++      _ -> return () -- no alternatives exclusively when `length clauseDocs /= 1`++    case mPatDoc of+      Nothing     -> return ()+      Just patDoc ->+        -- multiple clauses added in-paragraph, each in a single line+        -- example: foo | bar = baz+        --              | lll = asd+        addAlternativeCond (indentPolicy == IndentPolicyFree)+          $ docLines+          $  [ docSeq+               [ appSep $ docForceSingleline $ return patDoc+               , docSetBaseY+               $   docLines+               $   clauseDocs+               <&> \(guardDocs, bodyDoc, _) -> do+                     let guardPart = singleLineGuardsDoc guardDocs+                     -- the docForceSingleline might seems superflous, but it+                     -- helps the alternative resolving impl.+                     docForceSingleline $ docCols+                       ColGuardedBody+                       [ guardPart+                       , docSeq+                         [ appSep $ return binderDoc+                         , docForceSingleline $ return bodyDoc+                         -- i am not sure if there is a benefit to using+                         -- docForceParSpacing additionally here:+                         -- , docAddBaseY BrIndentRegular $ return bodyDoc+                         ]+                       ]+               ]+             ]+          ++ wherePartMultiLine+    -- multiple clauses, each in a separate, single line+    addAlternative+      $ docLines+      $  [ docAddBaseY BrIndentRegular+           $   patPartParWrap+           $   docLines+           $   map docSetBaseY+           $   clauseDocs+           <&> \(guardDocs, bodyDoc, _) -> do+                 let guardPart = singleLineGuardsDoc guardDocs+                 -- the docForceSingleline might seems superflous, but it+                 -- helps the alternative resolving impl.+                 docForceSingleline $ docCols+                   ColGuardedBody+                   [ guardPart+                   , docSeq+                     [ appSep $ return binderDoc+                     , docForceSingleline $ return bodyDoc+                     -- i am not sure if there is a benefit to using+                     -- docForceParSpacing additionally here:+                     -- , docAddBaseY BrIndentRegular $ return bodyDoc+                     ]+                   ]+         ]+      ++ wherePartMultiLine+    -- multiple clauses, each with the guard(s) in a single line, body+    -- as a paragraph+    addAlternative+      $ docLines+      $  [ docAddBaseY BrIndentRegular+           $   patPartParWrap+           $   docLines+           $   map docSetBaseY+           $   clauseDocs+           <&> \(guardDocs, bodyDoc, _) ->+                 docSeq+                 $ ( case guardDocs of+                     [] -> []+                     [g] ->+                       [ docForceSingleline+                       $ docSeq [appSep $ docLit $ Text.pack "|", return g]+                       ]+                     gs ->+                       [  docForceSingleline+                       $  docSeq+                       $  [appSep $ docLit $ Text.pack "|"]+                       ++ List.intersperse docCommaSep (return <$> gs)+                       ]+                   )+                   ++ [ docSeparator+                      , docCols+                        ColOpPrefix                         [ appSep $ return binderDoc-                        , docForceSingleline $ return bodyDoc-                        -- i am not sure if there is a benefit to using-                        -- docForceParSpacing additionally here:-                        -- , docAddBaseY BrIndentRegular $ return bodyDoc+                        , docAddBaseY BrIndentRegular+                        $ docForceParSpacing+                        $ return bodyDoc                         ]                       ]-              ]-            ]-         ++ wherePartMultiLine-         )-       | Just patDoc <- [mPatDoc]-       ]-    ++ -- multiple clauses, each in a separate, single line-       [ ( True-         , docLines-         $  [ docAddBaseY BrIndentRegular-              $   patPartParWrap-              $   docLines-              $   map docSetBaseY-              $   clauseDocs-              <&> \(guardDocs, bodyDoc, _) -> do-                    let guardPart = singleLineGuardsDoc guardDocs-                    -- the docForceSingleline might seems superflous, but it-                    -- helps the alternative resolving impl.-                    docForceSingleline $ docCols-                      ColGuardedBody-                      [ guardPart-                      , docSeq+         ]+      ++ wherePartMultiLine+    -- multiple clauses, each with the guard(s) in a single line, body+    -- in a new line as a paragraph+    addAlternative+      $ docLines+      $  [ docAddBaseY BrIndentRegular+           $   patPartParWrap+           $   docLines+           $   map docSetBaseY+           $   clauseDocs+           >>= \(guardDocs, bodyDoc, _) ->+                 ( case guardDocs of+                   [] -> []+                   [g] ->+                     [ docForceSingleline+                     $ docSeq [appSep $ docLit $ Text.pack "|", return g]+                     ]+                   gs ->+                     [  docForceSingleline+                     $  docSeq+                     $  [appSep $ docLit $ Text.pack "|"]+                     ++ List.intersperse docCommaSep (return <$> gs)+                     ]+                 )+                 ++ [ docCols+                      ColOpPrefix+                      [ appSep $ return binderDoc+                      , docAddBaseY BrIndentRegular+                      $ docForceParSpacing+                      $ return bodyDoc+                      ]+                    ]+         ]+      ++ wherePartMultiLine+    -- conservative approach: everything starts on the left.+    addAlternative+      $ docLines+      $  [ docAddBaseY BrIndentRegular+           $   patPartParWrap+           $   docLines+           $   map docSetBaseY+           $   clauseDocs+           >>= \(guardDocs, bodyDoc, _) ->+                 ( case guardDocs of+                     [] -> []+                     [g] ->+                       [docSeq [appSep $ docLit $ Text.pack "|", return g]]+                     (g1:gr) ->+                       ( docSeq [appSep $ docLit $ Text.pack "|", return g1]+                       : (   gr+                         <&> \g ->+                               docSeq+                                 [appSep $ docLit $ Text.pack ",", return g]+                         )+                       )+                   )+                   ++ [ docCols+                        ColOpPrefix                         [ appSep $ return binderDoc-                        , docForceSingleline $ return bodyDoc-                        -- i am not sure if there is a benefit to using-                        -- docForceParSpacing additionally here:-                        -- , docAddBaseY BrIndentRegular $ return bodyDoc+                        , docAddBaseY BrIndentRegular $ return bodyDoc                         ]                       ]-            ]-         ++ wherePartMultiLine-         )-       ]-    ++ -- multiple clauses, each with the guard(s) in a single line, body-       -- as a paragraph-       [ ( True-         , docLines-         $  [ docAddBaseY BrIndentRegular-              $   patPartParWrap-              $   docLines-              $   map docSetBaseY-              $   clauseDocs-              <&> \(guardDocs, bodyDoc, _) ->-                    docSeq-                    $ ( case guardDocs of-                        [] -> []-                        [g] ->-                          [ docForceSingleline-                          $ docSeq [appSep $ docLit $ Text.pack "|", return g]-                          ]-                        gs ->-                          [  docForceSingleline-                          $  docSeq-                          $  [appSep $ docLit $ Text.pack "|"]-                          ++ List.intersperse docCommaSep (return <$> gs)-                          ]-                      )-                      ++ [ docSeparator-                         , docCols-                           ColOpPrefix-                           [ appSep $ return binderDoc-                           , docAddBaseY BrIndentRegular-                           $ docForceParSpacing-                           $ return bodyDoc-                           ]-                         ]-            ]-         ++ wherePartMultiLine-         )-       ]-    ++ -- multiple clauses, each with the guard(s) in a single line, body-       -- in a new line as a paragraph-       [ ( True-         , docLines-         $  [ docAddBaseY BrIndentRegular-              $   patPartParWrap-              $   docLines-              $   map docSetBaseY-              $   clauseDocs-              >>= \(guardDocs, bodyDoc, _) ->-                    ( case guardDocs of-                      [] -> []-                      [g] ->-                        [ docForceSingleline-                        $ docSeq [appSep $ docLit $ Text.pack "|", return g]-                        ]-                      gs ->-                        [  docForceSingleline-                        $  docSeq-                        $  [appSep $ docLit $ Text.pack "|"]-                        ++ List.intersperse docCommaSep (return <$> gs)-                        ]-                    )-                    ++ [ docCols-                         ColOpPrefix-                         [ appSep $ return binderDoc-                         , docAddBaseY BrIndentRegular-                         $ docForceParSpacing-                         $ return bodyDoc-                         ]-                       ]-            ]-         ++ wherePartMultiLine-         )-       ]-    ++ -- conservative approach: everything starts on the left.-       [ ( True-         , docLines-         $  [ docAddBaseY BrIndentRegular-              $   patPartParWrap-              $   docLines-              $   map docSetBaseY-              $   clauseDocs-              >>= \(guardDocs, bodyDoc, _) ->-                    ( case guardDocs of-                        [] -> []-                        [g] ->-                          [docSeq [appSep $ docLit $ Text.pack "|", return g]]-                        (g1:gr) ->-                          ( docSeq [appSep $ docLit $ Text.pack "|", return g1]-                          : (   gr-                            <&> \g ->-                                  docSeq-                                    [appSep $ docLit $ Text.pack ",", return g]-                            )-                          )-                      )-                      ++ [ docCols-                           ColOpPrefix-                           [ appSep $ return binderDoc-                           , docAddBaseY BrIndentRegular $ return bodyDoc-                           ]-                         ]-            ]-         ++ wherePartMultiLine-         )-       ]+         ]+      ++ wherePartMultiLine

@@ -15,8 +15,7 @@ import           Language.Haskell.Brittany.Internal.LayouterBasics import           Language.Haskell.Brittany.Internal.Config.Types -import           RdrName ( RdrName(..) )-import           GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) )+import           GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..), RdrName(..) ) import           HsSyn import           Name import qualified FastString@@ -56,12 +55,17 @@       allocateNode $ overLitValBriDoc olit     HsLit lit -> do       allocateNode $ litBriDoc lit-    HsLam (MG (L _ [lmatch@(L _ (Match _ pats _ (GRHSs [lgrhs@(L _ (GRHS [] body))] (L _ EmptyLocalBinds))))]) _ _ _) -> do+    HsLam (MG (L _ [lmatch@(L _ match)]) _ _ _)+      |  pats                  <- m_pats match+      ,  GRHSs [lgrhs] llocals <- m_grhss match+      ,  L _ EmptyLocalBinds   <- llocals+      ,  L _ (GRHS [] body)    <- lgrhs+      -> do       patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p       bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body       let funcPatternPartLine =             docCols ColCasePattern-              $ (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator]))+              (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator]))       docAlt         [ -- single line           docSeq@@ -106,16 +110,16 @@ #else /* ghc-8.0 */     HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do #endif-      binderDoc <- docLit $ Text.pack "->"+      binderDoc   <- docLit $ Text.pack "->"       funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches       docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar         (docLit $ Text.pack "\\case")         (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)     HsApp exp1@(L _ HsApp{}) exp2 -> do-      let gather :: [LHsExpr RdrName] -> LHsExpr RdrName -> (LHsExpr RdrName, [LHsExpr RdrName])+      let gather :: [LHsExpr GhcPs] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs])           gather list = \case-            (L _ (HsApp l r)) -> gather (r:list) l-            x -> (x, list)+            L _ (HsApp l r) -> gather (r:list) l+            x               -> (x, list)       let (headE, paramEs) = gather [exp2] exp1       let colsOrSequence = case headE of             L _ (HsVar (L _ (Unqual occname))) ->@@ -123,51 +127,46 @@             _ -> docSeq       headDoc <- docSharedWrapper layoutExpr headE       paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs-      docAltFilter-        [ -- foo x y-          ( True-          , colsOrSequence+      runFilteredAlternative $ do+        -- foo x y+        addAlternative+          $ colsOrSequence           $ appSep (docForceSingleline headDoc)           : spacifyDocs (docForceSingleline <$> paramDocs)-          )-        , -- foo x-          --     y-          ( allowFreeIndent-          , docSeq-            [ appSep (docForceSingleline headDoc)-            , docSetBaseY-            $ docAddBaseY BrIndentRegular-            $ docLines-            $ (docForceSingleline <$> paramDocs)-            ]-          )-        , -- foo-          --   x-          --   y-          ( True-          , docSetParSpacing+        -- foo x+        --     y+        addAlternativeCond allowFreeIndent+          $ docSeq+          [ appSep (docForceSingleline headDoc)+          , docSetBaseY           $ docAddBaseY BrIndentRegular+          $ docLines+          $ docForceSingleline <$> paramDocs+          ]+        -- foo+        --   x+        --   y+        addAlternative+          $ docSetParSpacing+          $ docAddBaseY BrIndentRegular           $ docPar             (docForceSingleline headDoc)             ( docNonBottomSpacing             $ docLines paramDocs             )-          )-        , -- ( multi-          --   line-          --   function-          -- )-          --   x-          --   y-          ( True-          , docAddBaseY BrIndentRegular+        -- ( multi+        --   line+        --   function+        -- )+        --   x+        --   y+        addAlternative+          $ docAddBaseY BrIndentRegular           $ docPar             headDoc             ( docNonBottomSpacing             $ docLines paramDocs             )-          )-        ]     HsApp exp1 exp2 -> do       -- TODO: if expDoc1 is some literal, we may want to create a docCols here.       expDoc1 <- docSharedWrapper layoutExpr exp1@@ -225,7 +224,7 @@       -- TODO       briDocByExactInlineOnly "HsAppTypeOut{}" lexpr     OpApp expLeft@(L _ OpApp{}) expOp _ expRight -> do-      let gather :: [(LHsExpr RdrName, LHsExpr RdrName)] -> LHsExpr RdrName -> (LHsExpr RdrName, [(LHsExpr RdrName, LHsExpr RdrName)])+      let gather :: [(LHsExpr GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [(LHsExpr GhcPs, LHsExpr GhcPs)])           gather opExprList = \case             (L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1             final -> (final, opExprList)@@ -235,47 +234,44 @@                                               | xD <- docSharedWrapper layoutExpr x                                               , yD <- docSharedWrapper layoutExpr y                                               ]-      opLastDoc <- docSharedWrapper layoutExpr expOp-      expLastDoc <- docSharedWrapper layoutExpr expRight+      opLastDoc   <- docSharedWrapper layoutExpr expOp+      expLastDoc  <- docSharedWrapper layoutExpr expRight       hasComments <- hasAnyCommentsBelow lexpr       let allowPar = case (expOp, expRight) of             (L _ (HsVar (L _ (Unqual occname))), _)               | occNameString occname == "$" -> True             (_, L _ (HsApp _ (L _ HsVar{}))) -> False             _ -> True-      docAltFilter-        [ ( not hasComments+      runFilteredAlternative $ do+        addAlternativeCond (not hasComments)+          $ docSeq+          [ appSep $ docForceSingleline leftOperandDoc           , docSeq-            [ appSep $ docForceSingleline leftOperandDoc-            , docSeq-            $ (appListDocs <&> \(od, ed) -> docSeq-                [ appSep $ docForceSingleline od-                , appSep $ docForceSingleline ed-                ]-              )-            , appSep $ docForceSingleline opLastDoc-            , (if allowPar then docForceParSpacing else docForceSingleline)-                expLastDoc-            ]-          )+          $ appListDocs <&> \(od, ed) -> docSeq+              [ appSep $ docForceSingleline od+              , appSep $ docForceSingleline ed+              ]+          , appSep $ docForceSingleline opLastDoc+          , (if allowPar then docForceParSpacing else docForceSingleline)+              expLastDoc+          ]         -- this case rather leads to some unfortunate layouting than to anything         -- useful; disabling for now. (it interfers with cols stuff.)-        -- , docSetBaseY-        -- - $ docPar+        -- addAlternative+        --   $ docSetBaseY+        --   $ docPar         --     leftOperandDoc         --     ( docLines-        -- -    $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])+        --      $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])         --       ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]         --     )-        , (otherwise-          , docPar+        addAlternative $+          docPar             leftOperandDoc             ( docLines             $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])               ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]             )-          )-        ]     OpApp expLeft expOp _ expRight -> do       expDocLeft  <- docSharedWrapper layoutExpr expLeft       expDocOp    <- docSharedWrapper layoutExpr expOp@@ -285,47 +281,47 @@               | occNameString occname == "$" -> True             (_, L _ (HsApp _ (L _ HsVar{}))) -> False             _ -> True-      docAltFilter-        $   [ -- one-line-              (,) True-            $ docSeq-              [ appSep $ docForceSingleline expDocLeft-              , appSep $ docForceSingleline expDocOp-              , docForceSingleline expDocRight-              ]-            -- , -- line + freely indented block for right expression-            --   docSeq-            --   [ appSep $ docForceSingleline expDocLeft-            --   , appSep $ docForceSingleline expDocOp-            --   , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight-            --   ]-            , -- two-line-              (,) True-            $ docAddBaseY BrIndentRegular-            $ docPar-                expDocLeft-                ( docForceSingleline-                $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]-                )-            , -- one-line + par-              (,) allowPar-            $ docSeq-              [ appSep $ docForceSingleline expDocLeft-              , appSep $ docForceSingleline expDocOp-              , docForceParSpacing expDocRight-              ]-            , -- more lines-              (,) True-            $ docAddBaseY BrIndentRegular-            $ docPar-                expDocLeft-                (docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight])-            ]+      runFilteredAlternative $ do+        -- one-line+        addAlternative+          $ docSeq+          [ appSep $ docForceSingleline expDocLeft+          , appSep $ docForceSingleline expDocOp+          , docForceSingleline expDocRight+          ]+        -- -- line + freely indented block for right expression+        -- addAlternative+        --   $ docSeq+        --   [ appSep $ docForceSingleline expDocLeft+        --   , appSep $ docForceSingleline expDocOp+        --   , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight+        --   ]+        -- two-line+        addAlternative+          $ docAddBaseY BrIndentRegular+          $ docPar+              expDocLeft+              ( docForceSingleline+              $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]+              )+        -- one-line + par+        addAlternativeCond allowPar+          $ docSeq+          [ appSep $ docForceSingleline expDocLeft+          , appSep $ docForceSingleline expDocOp+          , docForceParSpacing expDocRight+          ]+        -- more lines+        addAlternative+          $ docAddBaseY BrIndentRegular+          $ docPar+              expDocLeft+              (docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight])     NegApp op _ -> do       opDoc <- docSharedWrapper layoutExpr op-      docSeq $ [ docLit $ Text.pack "-"-               , opDoc-               ]+      docSeq [ docLit $ Text.pack "-"+             , opDoc+             ]     HsPar innerExp -> do       innerExpDoc <- docSharedWrapper (docWrapNode lexpr . layoutExpr) innerExp       docAlt@@ -364,7 +360,7 @@       case splitFirstLast argDocs of         FirstLastEmpty -> docSeq           [ openLit-          , docNodeAnnKW lexpr (Just AnnOpenP) $ closeLit+          , docNodeAnnKW lexpr (Just AnnOpenP) closeLit           ]         FirstLastSingleton e -> docAlt           [ docCols ColTuple@@ -380,24 +376,21 @@             , closeLit             ]           ]-        FirstLast e1 ems eN ->-          docAltFilter-            [ (,) (not hasComments)-            $ docCols ColTuple-              (  [docSeq [openLit, docForceSingleline e1]]-              ++ (ems <&> \e -> docSeq [docCommaSep, docForceSingleline e])-              ++ [docSeq [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) (docForceSingleline eN), closeLit]]-              )-            , (,) True-            $ let-                start = docCols ColTuples-                          [appSep $ openLit, e1]-                linesM = ems <&> \d ->-                        docCols ColTuples [docCommaSep, d]-                lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]-                end   = closeLit-              in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]-            ]+        FirstLast e1 ems eN -> runFilteredAlternative $ do+          addAlternativeCond (not hasComments)+            $  docCols ColTuple+            $  [docSeq [openLit, docForceSingleline e1]]+            ++ (ems <&> \e -> docSeq [docCommaSep, docForceSingleline e])+            ++ [docSeq [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) (docForceSingleline eN), closeLit]]+          addAlternative $+            let+              start = docCols ColTuples+                        [appSep openLit, e1]+              linesM = ems <&> \d ->+                      docCols ColTuples [docCommaSep, d]+              lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]+              end   = closeLit+            in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end]     HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do       cExpDoc <- docSharedWrapper layoutExpr cExp       binderDoc <- docLit $ Text.pack "->"@@ -429,13 +422,14 @@       let maySpecialIndent =             case indentPolicy of               IndentPolicyLeft -> BrIndentRegular-              _ -> BrIndentSpecial 3+              IndentPolicyMultiple -> BrIndentRegular+              IndentPolicyFree -> BrIndentSpecial 3       -- TODO: some of the alternatives (especially last and last-but-one)       -- overlap.-      docAltFilter-        [ -- if _ then _ else _-          (,) (not hasComments)-        $ docSeq+      runFilteredAlternative $ do+        -- if _ then _ else _+        addAlternativeCond (not hasComments)+          $ docSeq           [ appSep $ docLit $ Text.pack "if"           , appSep $ docForceSingleline ifExprDoc           , appSep $ docLit $ Text.pack "then"@@ -443,113 +437,115 @@           , appSep $ docLit $ Text.pack "else"           , docForceSingleline elseExprDoc           ]-        , -- either-          --   if expr-          --   then foo-          --     bar-          --   else foo-          --     bar-          -- or-          --   if expr-          --   then-          --     stuff-          --   else-          --     stuff-          -- note that this has par-spacing-          (,) True-        $ docSetParSpacing-        $ docAddBaseY BrIndentRegular-        $ docPar-            ( docSeq-              [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"-              , docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc-              ])-            (docLines-              [ docAddBaseY BrIndentRegular-              $ docNodeAnnKW lexpr (Just AnnThen)-              $ docAlt-                [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc]+        -- either+        --   if expr+        --   then foo+        --     bar+        --   else foo+        --     bar+        -- or+        --   if expr+        --   then+        --     stuff+        --   else+        --     stuff+        -- note that this has par-spacing+        addAlternative+          $ docSetParSpacing+          $ docAddBaseY BrIndentRegular+          $ docPar+              ( docSeq+                [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"+                , docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc+                ])+              (docLines+                [ docAddBaseY BrIndentRegular+                $ docNodeAnnKW lexpr (Just AnnThen)+                $ docNonBottomSpacing $ docAlt+                  [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc]+                  , docAddBaseY BrIndentRegular+                  $ docPar (docLit $ Text.pack "then") thenExprDoc+                  ]                 , docAddBaseY BrIndentRegular-                $ docPar (docLit $ Text.pack "then") thenExprDoc-                ]-              , docAddBaseY BrIndentRegular-              $ docAlt-                [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc]+                $ docNonBottomSpacing $ docAlt+                  [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc]+                  , docAddBaseY BrIndentRegular+                  $ docPar (docLit $ Text.pack "else") elseExprDoc+                  ]+                ])+        -- either+        --   if multi+        --      line+        --      condition+        --   then foo+        --     bar+        --   else foo+        --     bar+        -- or+        --   if multi+        --      line+        --      condition+        --   then+        --     stuff+        --   else+        --     stuff+        -- note that this does _not_ have par-spacing+        addAlternative+          $ docAddBaseY BrIndentRegular+          $ docPar+              ( docAddBaseY maySpecialIndent+              $ docSeq+                [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"+                , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc+                ])+              (docLines+                [ docAddBaseY BrIndentRegular+                $ docNodeAnnKW lexpr (Just AnnThen)+                $ docAlt+                  [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc]+                  , docAddBaseY BrIndentRegular+                  $ docPar (docLit $ Text.pack "then") thenExprDoc+                  ]                 , docAddBaseY BrIndentRegular-                $ docPar (docLit $ Text.pack "else") elseExprDoc-                ]-              ])-        , -- either-          --   if multi-          --      line-          --      condition-          --   then foo-          --     bar-          --   else foo-          --     bar-          -- or-          --   if multi-          --      line-          --      condition-          --   then-          --     stuff-          --   else-          --     stuff-          -- note that this does _not_ have par-spacing-          (,) True-        $ docAddBaseY BrIndentRegular-        $ docPar-            ( docAddBaseY maySpecialIndent+                $ docAlt+                  [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc]+                  , docAddBaseY BrIndentRegular+                  $ docPar (docLit $ Text.pack "else") elseExprDoc+                  ]+                ])+        addAlternative+          $ docSetBaseY+          $ docLines+            [ docAddBaseY maySpecialIndent             $ docSeq               [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"               , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc-              ])-            (docLines-              [ docAddBaseY BrIndentRegular-              $ docNodeAnnKW lexpr (Just AnnThen)-              $ docAlt-                [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc]-                , docAddBaseY BrIndentRegular-                $ docPar (docLit $ Text.pack "then") thenExprDoc-                ]-              , docAddBaseY BrIndentRegular-              $ docAlt-                [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc]-                , docAddBaseY BrIndentRegular-                $ docPar (docLit $ Text.pack "else") elseExprDoc-                ]-              ])-        , (,) True-        $ docSetBaseY-        $ docLines-          [ docAddBaseY maySpecialIndent-          $ docSeq-            [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"-            , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc+              ]+            , docNodeAnnKW lexpr (Just AnnThen)+            $ docAddBaseY BrIndentRegular+            $ docPar (docLit $ Text.pack "then") thenExprDoc+            , docAddBaseY BrIndentRegular+            $ docPar (docLit $ Text.pack "else") elseExprDoc             ]-          , docNodeAnnKW lexpr (Just AnnThen)-          $ docAddBaseY BrIndentRegular-          $ docPar (docLit $ Text.pack "then") thenExprDoc-          , docAddBaseY BrIndentRegular-          $ docPar (docLit $ Text.pack "else") elseExprDoc-          ]-        ]     HsMultiIf _ cases -> do-      clauseDocs <- cases `forM` layoutGrhs-      binderDoc <- docLit $ Text.pack "->"+      clauseDocs  <- cases `forM` layoutGrhs+      binderDoc   <- docLit $ Text.pack "->"       hasComments <- hasAnyCommentsBelow lexpr       docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar         (docLit $ Text.pack "if")         (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments)     HsLet binds exp1 -> do-      expDoc1 <- docSharedWrapper layoutExpr exp1+      expDoc1   <- docSharedWrapper layoutExpr exp1       -- We jump through some ugly hoops here to ensure proper sharing.       mBindDocs <- mapM (fmap (fmap return) . docWrapNodeRest lexpr . return)                =<< layoutLocalBinds binds       let-        ifIndentLeftElse :: a -> a -> a-        ifIndentLeftElse x y =-          if indentPolicy == IndentPolicyLeft then x else y+        ifIndentFreeElse :: a -> a -> a+        ifIndentFreeElse x y =+          case indentPolicy of+            IndentPolicyLeft -> y+            IndentPolicyMultiple -> y+            IndentPolicyFree -> x       -- this `docSetBaseAndIndent` might seem out of place (especially the       -- Indent part; setBase is necessary due to the use of docLines below),       -- but is here due to ghc-exactprint's DP handling of "let" in@@ -562,35 +558,35 @@         Just [bindDoc] -> docAlt           [ docSeq               [ appSep $ docLit $ Text.pack "let"-              , appSep $ docForceSingleline $ bindDoc+              , appSep $ docForceSingleline bindDoc               , appSep $ docLit $ Text.pack "in"-              , docForceSingleline $ expDoc1+              , docForceSingleline expDoc1               ]           , docLines               [ docAlt                   [ docSeq                       [ appSep $ docLit $ Text.pack "let"-                      , ifIndentLeftElse docForceSingleline docSetBaseAndIndent+                      , ifIndentFreeElse docSetBaseAndIndent docForceSingleline                       $ bindDoc                       ]                   , docAddBaseY BrIndentRegular                   $ docPar                     (docLit $ Text.pack "let")-                    (docSetBaseAndIndent $ bindDoc)+                    (docSetBaseAndIndent bindDoc)                   ]               , docAlt                   [ docSeq-                      [ appSep $ docLit $ Text.pack $ ifIndentLeftElse "in" "in "-                      , ifIndentLeftElse docForceSingleline docSetBaseAndIndent expDoc1+                      [ appSep $ docLit $ Text.pack $ ifIndentFreeElse "in " "in"+                      , ifIndentFreeElse docSetBaseAndIndent docForceSingleline expDoc1                       ]                   , docAddBaseY BrIndentRegular                   $ docPar                     (docLit $ Text.pack "in")-                    (docSetBaseY $ expDoc1)+                    (docSetBaseY expDoc1)                   ]               ]           ]-        Just bindDocs@(_:_) -> docAltFilter+        Just bindDocs@(_:_) -> runFilteredAlternative $ do           --either           --  let           --    a = b@@ -604,43 +600,40 @@           --    c = d           --  in           --    fooooooooooooooooooo-          [ ( indentPolicy == IndentPolicyLeft-            , docLines-              [ docAddBaseY BrIndentRegular-              $ docPar-                (docLit $ Text.pack "let")-                (docSetBaseAndIndent $ docLines $ bindDocs)-              , docSeq-                [ docLit $ Text.pack "in "-                , docAddBaseY BrIndentRegular $ expDoc1+          let noHangingBinds =+                [ docAddBaseY BrIndentRegular+                $ docPar+                  (docLit $ Text.pack "let")+                  (docSetBaseAndIndent $ docLines bindDocs)+                , docSeq+                  [ docLit $ Text.pack "in "+                  , docAddBaseY BrIndentRegular expDoc1+                  ]                 ]-              ]-            )-          , ( indentPolicy /= IndentPolicyLeft-            , docLines+          addAlternative $ case indentPolicy of+            IndentPolicyLeft     -> docLines noHangingBinds+            IndentPolicyMultiple -> docLines noHangingBinds+            IndentPolicyFree     -> docLines               [ docSeq                 [ appSep $ docLit $ Text.pack "let"-                , docSetBaseAndIndent $ docLines $ bindDocs+                , docSetBaseAndIndent $ docLines bindDocs                 ]               , docSeq                 [ appSep $ docLit $ Text.pack "in "-                , docSetBaseY $ expDoc1+                , docSetBaseY expDoc1                 ]               ]-            )-          , ( True-            , docLines-              [ docAddBaseY BrIndentRegular-              $ docPar-                (docLit $ Text.pack "let")-                (docSetBaseAndIndent $ docLines $ bindDocs)-              , docAddBaseY BrIndentRegular-              $ docPar-                (docLit $ Text.pack "in")-                (docSetBaseY $ expDoc1)-              ]-            )-          ]+          addAlternative+            $ docLines+            [ docAddBaseY BrIndentRegular+            $ docPar+              (docLit $ Text.pack "let")+              (docSetBaseAndIndent $ docLines $ bindDocs)+            , docAddBaseY BrIndentRegular+            $ docPar+              (docLit $ Text.pack "in")+              (docSetBaseY $ expDoc1)+            ]         _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]       -- docSeq [appSep $ docLit "let in", expDoc1]     HsDo DoExpr (L _ stmts) _ -> do@@ -660,11 +653,11 @@     HsDo x  (L _ stmts) _ | case x of { ListComp -> True                                       ; MonadComp -> True                                       ; _ -> False } -> do-      stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts+      stmtDocs    <- docSharedWrapper layoutStmt `mapM` stmts       hasComments <- hasAnyCommentsBelow lexpr-      docAltFilter-        [ (,) (not hasComments)-        $ docSeq+      runFilteredAlternative $ do+        addAlternativeCond (not hasComments)+          $ docSeq           [ docNodeAnnKW lexpr Nothing           $ appSep           $ docLit@@ -675,11 +668,11 @@           $ List.last stmtDocs           , appSep $ docLit $ Text.pack "|"           , docSeq $ List.intersperse docCommaSep-                  $ fmap docForceSingleline $ List.init stmtDocs+          $ docForceSingleline <$> List.init stmtDocs           , docLit $ Text.pack " ]"           ]-        , (,) True-        $ let+        addAlternative $+          let             start = docCols ColListComp                       [ docNodeAnnKW lexpr Nothing                       $ appSep $ docLit $ Text.pack "["@@ -694,12 +687,11 @@                     docCols ColListComp [docCommaSep, d]             end   = docLit $ Text.pack "]"           in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]-        ]     HsDo{} -> do       -- TODO       unknownNodeError "HsDo{} no comp" lexpr     ExplicitList _ _ elems@(_:_) -> do-      elemDocs <- elems `forM` docSharedWrapper layoutExpr+      elemDocs    <- elems `forM` docSharedWrapper layoutExpr       hasComments <- hasAnyCommentsBelow lexpr       case splitFirstLast elemDocs of         FirstLastEmpty -> docSeq@@ -716,28 +708,26 @@             [ docSeq               [ docLit $ Text.pack "["               , docSeparator-              , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) $ e+              , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) e               ]             , docLit $ Text.pack "]"             ]           ]-        FirstLast e1 ems eN ->-          docAltFilter-            [  (,) (not hasComments)+        FirstLast e1 ems eN -> runFilteredAlternative $ do+          addAlternativeCond (not hasComments)             $  docSeq             $  [docLit $ Text.pack "["]             ++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN]))             ++ [docLit $ Text.pack "]"]-            , (,) True-            $ let-                start = docCols ColList-                          [appSep $ docLit $ Text.pack "[", e1]-                linesM = ems <&> \d ->-                        docCols ColList [docCommaSep, d]-                lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN]-                end   = docLit $ Text.pack "]"-              in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]-            ]+          addAlternative $+            let+              start = docCols ColList+                        [appSep $ docLit $ Text.pack "[", e1]+              linesM = ems <&> \d ->+                      docCols ColList [docCommaSep, d]+              lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN]+              end   = docLit $ Text.pack "]"+            in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]     ExplicitList _ _ [] ->       docLit $ Text.pack "[]"     ExplicitPArr{} -> do@@ -757,20 +747,20 @@         fExpDoc <- if pun           then return Nothing           else Just <$> docSharedWrapper layoutExpr fExpr-        return $ (fieldl, lrdrNameToText lnameF, fExpDoc)+        return (fieldl, lrdrNameToText lnameF, fExpDoc)       let line1 appender wrapper =             [ appender $ docLit $ Text.pack "{"-            , docWrapNodePrior fd1l $ appSep $ docLit $ fd1n+            , docWrapNodePrior fd1l $ appSep $ docLit fd1n             , case fd1e of                 Just x -> docSeq                   [ appSep $ docLit $ Text.pack "="-                  , docWrapNodeRest fd1l $ wrapper $ x+                  , docWrapNodeRest fd1l $ wrapper x                   ]                 Nothing -> docEmpty             ]       let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->             [ docCommaSep-            , appSep $ docLit $ fText+            , appSep $ docLit fText             , case fDoc of                 Just x -> docWrapNode lfield $ docSeq                   [ appSep $ docLit $ Text.pack "="@@ -784,14 +774,14 @@             ]       docAlt         [  docSeq-        $  [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator]+        $  [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]         ++ line1 id docForceSingleline         ++ join (lineR docForceSingleline)         ++ lineN         , docSetParSpacing         $ docAddBaseY BrIndentRegular         $ docPar-            (docNodeAnnKW lexpr Nothing $ nameDoc)+            (docNodeAnnKW lexpr Nothing nameDoc)             ( docNonBottomSpacing             $ docLines             $  [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]@@ -808,20 +798,20 @@         fExpDoc <- if pun           then return Nothing           else Just <$> docSharedWrapper layoutExpr fExpr-        return $ (fieldl, lrdrNameToText lnameF, fExpDoc)+        return (fieldl, lrdrNameToText lnameF, fExpDoc)       let line1 appender wrapper =             [ appender $ docLit $ Text.pack "{"-            , docWrapNodePrior fd1l $ appSep $ docLit $ fd1n+            , docWrapNodePrior fd1l $ appSep $ docLit fd1n             , case fd1e of                 Just x -> docSeq                   [ appSep $ docLit $ Text.pack "="-                  , docWrapNodeRest fd1l $ wrapper $ x+                  , docWrapNodeRest fd1l $ wrapper x                   ]                 Nothing -> docEmpty             ]       let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->             [ docCommaSep-            , appSep $ docLit $ fText+            , appSep $ docLit fText             , case fDoc of                 Just x -> docWrapNode lfield $ docSeq                   [ appSep $ docLit $ Text.pack "="@@ -839,7 +829,7 @@             ]       docAlt         [  docSeq-        $  [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator]+        $  [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]         ++ line1 id docForceSingleline         ++ join (lineR docForceSingleline)         ++ lineDot@@ -847,7 +837,7 @@         , docSetParSpacing         $ docAddBaseY BrIndentRegular         $ docPar-            (docNodeAnnKW lexpr Nothing $ nameDoc)+            (docNodeAnnKW lexpr Nothing nameDoc)             ( docNonBottomSpacing             $ docLines             $  [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]@@ -870,77 +860,76 @@           return $ case ambName of             Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)             Ambiguous   n _ -> (lfield, lrdrNameToText n, rFExpDoc)-      docAltFilter+      runFilteredAlternative $ do         -- container { fieldA = blub, fieldB = blub }-        [ ( True-          , 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 "}"-            ]-          )+        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         --           }-        , ( indentPolicy /= IndentPolicyLeft-          , docSeq-            [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc-            , docSetBaseY $ docLines $ let-                line1 = docCols ColRecUpdate-                  [ appSep $ docLit $ Text.pack "{"-                  , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n-                  , case rF1e of-                      Just x -> docWrapNodeRest rF1f $ docSeq-                                      [ appSep $ docLit $ Text.pack "="+        addAlternativeCond (indentPolicy == IndentPolicyFree)+          $ docSeq+          [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc+          , docSetBaseY $ docLines $ let+              line1 = docCols ColRecUpdate+                [ 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 ColRecUpdate+                [ docCommaSep+                , appSep $ docLit fText+                , case fDoc of+                    Just x ->  docSeq [ appSep $ docLit $ Text.pack "="                                       , docForceSingleline x                                       ]-                      Nothing -> docEmpty-                  ]-                lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate-                  [ 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-          -- }-        , ( True-          , docSetParSpacing+                    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 $ rExprDoc)+              (docNodeAnnKW lexpr Nothing rExprDoc)               (docNonBottomSpacing $ docLines $ let-                expressionWrapper = if indentPolicy == IndentPolicyLeft-                  then docForceParSpacing-                  else docSetBaseY+                expressionWrapper = case indentPolicy of+                  IndentPolicyLeft -> docForceParSpacing+                  IndentPolicyMultiple -> docForceParSpacing+                  IndentPolicyFree -> docSetBaseY                 line1 = docCols ColRecUpdate                   [ appSep $ docLit $ Text.pack "{"-                  , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n+                  , docWrapNodePrior rF1f $ appSep $ docLit rF1n                   , docWrapNodeRest rF1f $ case rF1e of                       Just x -> docAlt                         [ docSeq [ appSep $ docLit $ Text.pack "="@@ -954,7 +943,7 @@                 lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield                   $ docCols ColRecUpdate                   [ docCommaSep-                  , appSep $ docLit $ fText+                  , appSep $ docLit fText                   , case fDoc of                       Just x -> docAlt                         [ docSeq [ appSep $ docLit $ Text.pack "="@@ -971,8 +960,6 @@                   ]                 in [line1] ++ lineR ++ [lineN]               )-          )-        ] #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */     ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do #else /* ghc-8.0 */@@ -1078,7 +1065,7 @@       docLit $ Text.pack "_"     EAsPat asName asExpr -> do       docSeq-        [ docLit $ (lrdrNameToText asName) <> Text.pack "@"+        [ docLit $ lrdrNameToText asName <> Text.pack "@"         , layoutExpr asExpr         ]     EViewPat{} -> do@@ -1100,7 +1087,31 @@ #endif  -#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */+litBriDoc :: HsLit GhcPs -> BriDocFInt+litBriDoc = \case+  HsChar       (SourceText t) _c                         -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']+  HsCharPrim   (SourceText t) _c                         -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']+  HsString     (SourceText t) _fastString                -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ FastString.unpackFS fastString+  HsStringPrim (SourceText t) _byteString                -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ Data.ByteString.Char8.unpack byteString+  HsInt        _              (IL (SourceText t) _ _)    -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i+  HsIntPrim    (SourceText t) _i                         -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i+  HsWordPrim   (SourceText t) _i                         -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i+  HsInt64Prim  (SourceText t) _i                         -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i+  HsWord64Prim (SourceText t) _i                         -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i+  HsInteger (SourceText t) _i                      _type -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i+  HsRat     _              (FL (SourceText t) _ _) _type -> BDFLit $ Text.pack t+  HsFloatPrim  _ (FL (SourceText t) _ _)                 -> BDFLit $ Text.pack t+  HsDoublePrim _ (FL (SourceText t) _ _)                 -> BDFLit $ Text.pack t+  _ -> error "litBriDoc: literal with no SourceText"++overLitValBriDoc :: OverLitVal -> BriDocFInt+overLitValBriDoc = \case+  HsIntegral   (IL (SourceText t) _ _) -> BDFLit $ Text.pack t+  HsFractional (FL (SourceText t) _ _) -> BDFLit $ Text.pack t+  HsIsString (SourceText t) _ -> BDFLit $ Text.pack t+  _ -> error "overLitValBriDoc: literal with no SourceText"+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ litBriDoc :: HsLit -> BriDocFInt litBriDoc = \case   HsChar       (SourceText t) _c          -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']@@ -1112,10 +1123,10 @@   HsWordPrim   (SourceText t) _i          -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i   HsInt64Prim  (SourceText t) _i          -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i   HsWord64Prim (SourceText t) _i          -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i-  HsInteger (SourceText t) _i _type       -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i-  HsRat (FL t _) _type       -> BDFLit $ Text.pack t-  HsFloatPrim  (FL t _)      -> BDFLit $ Text.pack t-  HsDoublePrim (FL t _)      -> BDFLit $ Text.pack t+  HsInteger    (SourceText t) _i _type    -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i+  HsRat        (FL t _) _type             -> BDFLit $ Text.pack t+  HsFloatPrim  (FL t _)                   -> BDFLit $ Text.pack t+  HsDoublePrim (FL t _)                   -> BDFLit $ Text.pack t   _ -> error "litBriDoc: literal with no SourceText"  overLitValBriDoc :: OverLitVal -> BriDocFInt@@ -1124,7 +1135,7 @@   HsFractional (FL t _) -> BDFLit $ Text.pack t   HsIsString (SourceText t) _        -> BDFLit $ Text.pack t   _ -> error "overLitValBriDoc: literal with no SourceText"-#else+#else                        /* ghc-8.0 */ litBriDoc :: HsLit -> BriDocFInt litBriDoc = \case   HsChar       t _c          -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']

@@ -14,7 +14,6 @@ import           Language.Haskell.Brittany.Internal.Types import           Language.Haskell.Brittany.Internal.LayouterBasics -import           RdrName ( RdrName(..) ) import           GHC ( runGhc, GenLocated(L), moduleNameString ) import           HsSyn import           Name@@ -23,8 +22,12 @@  layoutExpr :: ToBriDoc HsExpr --- layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName))+-- layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs)) +#if   MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */+litBriDoc :: HsLit GhcPs -> BriDocFInt+#else /* ghc-8.0 && ghc-8.2 */ litBriDoc :: HsLit -> BriDocFInt+#endif  overLitValBriDoc :: OverLitVal -> BriDocFInt

@@ -11,7 +11,6 @@ import           Language.Haskell.Brittany.Internal.LayouterBasics import           Language.Haskell.Brittany.Internal.Config.Types -import           RdrName (RdrName(..)) import           GHC     ( unLoc                          , runGhc                          , GenLocated(L)@@ -46,18 +45,15 @@   IEThingWith _ (IEWildcard _) _ _ -> docSeq [ien, docLit $ Text.pack "(..)"]   IEThingWith _ _ ns _ -> do     hasComments <- hasAnyCommentsBelow lie-    docAltFilter-      [ ( not hasComments-        , docSeq+    runFilteredAlternative $ do+      addAlternativeCond (not hasComments)+        $  docSeq         $  [ien, docLit $ Text.pack "("]         ++ intersperse docCommaSep (map nameDoc ns)         ++ [docParenR]-        )-      , (otherwise-        , docAddBaseY BrIndentRegular+      addAlternative+        $ docAddBaseY BrIndentRegular         $ docPar ien (layoutItems (splitFirstLast ns))-        )-      ]    where     nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName     layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n]@@ -92,7 +88,7 @@ -- handling of the resulting list. Adding parens is -- left to the caller since that is context sensitive layoutAnnAndSepLLIEs-  :: Located [LIE RdrName] -> ToBriDocM [ToBriDocM BriDocNumbered]+  :: Located [LIE GhcPs] -> ToBriDocM [ToBriDocM BriDocNumbered] layoutAnnAndSepLLIEs llies@(L _ lies) = do   let makeIENode ie = docSeq [docCommaSep, ie]   let ieDocs = layoutIE <$> lies@@ -117,29 +113,26 @@ -- () -- no comments -- ( -- a comment -- )-layoutLLIEs :: Bool -> Located [LIE RdrName] -> ToBriDocM BriDocNumbered+layoutLLIEs :: Bool -> Located [LIE GhcPs] -> ToBriDocM BriDocNumbered layoutLLIEs enableSingleline llies = do   ieDs        <- layoutAnnAndSepLLIEs llies   hasComments <- hasAnyCommentsBelow llies-  case ieDs of-    [] -> docAltFilter-      [ (not hasComments, docLit $ Text.pack "()")-      , ( hasComments-        , docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])+  runFilteredAlternative $+    case ieDs of+      [] -> do+        addAlternativeCond (not hasComments) $+          docLit $ Text.pack "()"+        addAlternativeCond hasComments $+          docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])                  docParenR-        )-      ]-    (ieDsH:ieDsT) -> docAltFilter-      [ ( not hasComments && enableSingleline-        , docSeq-        $  [docLit (Text.pack "(")]-        ++ (docForceSingleline <$> ieDs)-        ++ [docParenR]-        )-      , ( otherwise-        , docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])-        $  docLines-        $  ieDsT-        ++ [docParenR]-        )-      ]+      (ieDsH:ieDsT) -> do+        addAlternativeCond (not hasComments && enableSingleline)+          $  docSeq+          $  [docLit (Text.pack "(")]+          ++ (docForceSingleline <$> ieDs)+          ++ [docParenR]+        addAlternative+          $  docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])+          $  docLines+          $  ieDsT+          ++ [docParenR]

@@ -7,7 +7,6 @@ import           Language.Haskell.Brittany.Internal.Layouters.IE import           Language.Haskell.Brittany.Internal.Config.Types -import           RdrName                                  ( RdrName(..) ) import           GHC                                      ( unLoc                                                           , GenLocated(L)                                                           , moduleNameString@@ -49,7 +48,7 @@     importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack     indentPolicy <- mAsk <&>  _conf_layout .> _lconfig_indentPolicy .> confUnpack     let-      compact  = indentPolicy == IndentPolicyLeft+      compact  = indentPolicy /= IndentPolicyFree       modNameT = Text.pack $ moduleNameString modName       pkgNameT = Text.pack . prepPkg . sl_st <$> pkg       masT     = Text.pack . moduleNameString . prepModName <$> mas@@ -98,25 +97,21 @@                 [] -> if hasComments                   then docPar                     (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty])-                    (docEnsureIndent (BrIndentSpecial hidDocColDiff) $ docParenR)+                    (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)                   else docSeq [hidDoc, docParenLSep, docSeparator, docParenR]                   -- ..[hiding].( b )-                [ieD] -> docAltFilter-                  [ ( not hasComments-                    , docSeq-                      [ hidDoc-                      , docParenLSep-                      , docForceSingleline $ ieD-                      , docSeparator-                      , docParenR-                      ]-                    )-                  , ( otherwise-                    , docPar-                      (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])-                      (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)-                    )-                  ]+                [ieD] -> runFilteredAlternative $ do+                  addAlternativeCond (not hasComments)+                    $ docSeq+                    [ hidDoc+                    , docParenLSep+                    , docForceSingleline ieD+                    , docSeparator+                    , docParenR+                    ]+                  addAlternative $ docPar+                    (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])+                    (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)                   -- ..[hiding].( b                   --            , b'                   --            )

@@ -8,7 +8,6 @@ import           Language.Haskell.Brittany.Internal.Layouters.Import import           Language.Haskell.Brittany.Internal.Config.Types -import           RdrName (RdrName(..)) import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..)) import           HsSyn import           Name@@ -33,30 +32,35 @@       <&> _conf_layout       .>  _lconfig_allowSingleLineExportList       .>  confUnpack+    -- the config should not prevent single-line layout when there is no+    -- export list+    let allowSingleLine = allowSingleLineExportList || Data.Maybe.isNothing les     docLines       $ docSeq           [ docNodeAnnKW lmod Nothing docEmpty              -- A pseudo node that serves merely to force documentation              -- before the node-          , docNodeMoveToKWDP lmod AnnModule $ docAltFilter-            [ (,) allowSingleLineExportList $ docForceSingleline $ docSeq-                   [ appSep $ docLit $ Text.pack "module"-                   , appSep $ docLit tn-                   , docWrapNode lmod $ appSep $ case les of-                     Nothing -> docEmpty-                     Just x  -> layoutLLIEs True x-                   , docLit $ Text.pack "where"-                   ]-            , (,) otherwise $ docLines-                   [ docAddBaseY BrIndentRegular $ docPar-                     (docSeq [appSep $ docLit $ Text.pack "module", docLit tn]-                     )-                     (docWrapNode lmod $ case les of-                       Nothing -> docEmpty-                       Just x  -> layoutLLIEs False x-                     )-                   , docLit $ Text.pack "where"-                   ]-            ]+          , docNodeMoveToKWDP lmod AnnModule $ runFilteredAlternative $ do+            addAlternativeCond allowSingleLine $+              docForceSingleline+                $ docSeq+                [ appSep $ docLit $ Text.pack "module"+                , appSep $ docLit tn+                , docWrapNode lmod $ appSep $ case les of+                  Nothing -> docEmpty+                  Just x  -> layoutLLIEs True x+                , docLit $ Text.pack "where"+                ]+            addAlternative+              $ docLines+              [ docAddBaseY BrIndentRegular $ docPar+                (docSeq [appSep $ docLit $ Text.pack "module", docLit tn]+                )+                (docWrapNode lmod $ case les of+                  Nothing -> docEmpty+                  Just x  -> layoutLLIEs False x+                )+              , docLit $ Text.pack "where"+              ]           ]       : map layoutImport imports

@@ -13,7 +13,6 @@ import           Language.Haskell.Brittany.Internal.Types import           Language.Haskell.Brittany.Internal.LayouterBasics -import           RdrName ( RdrName(..) ) import           GHC ( Located, runGhc, GenLocated(L), moduleNameString ) import           HsSyn import           Name@@ -34,7 +33,7 @@ --        ^^^^^^^^^^ this part -- We will use `case .. of` as the imagined prefix to the examples used in -- the different cases below.-layoutPat :: ToBriDocC (Pat RdrName) (Seq BriDocNumbered)+layoutPat :: ToBriDocC (Pat GhcPs) (Seq BriDocNumbered) layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of   WildPat _  -> fmap Seq.singleton $ docLit $ Text.pack "_"     -- _ -> expr@@ -94,14 +93,14 @@       fExpDoc <- if pun         then return Nothing         else Just <$> docSharedWrapper layoutPat fPat-      return $ (lrdrNameToText lnameF, fExpDoc)-    fmap Seq.singleton $ docSeq+      return (lrdrNameToText lnameF, fExpDoc)+    Seq.singleton <$> docSeq       [ appSep $ docLit t       , appSep $ docLit $ Text.pack "{"       , docSeq $ List.intersperse docCommaSep                $ fds <&> \case           (fieldName, Just fieldDoc) -> docSeq-            [ appSep $ docLit $ fieldName+            [ appSep $ docLit fieldName             , appSep $ docLit $ Text.pack "="             , fieldDoc >>= colsWrapPat             ]@@ -112,7 +111,7 @@   ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do     -- Abc { .. } -> expr     let t = lrdrNameToText lname-    fmap Seq.singleton $ docSeq+    Seq.singleton <$> docSeq       [ appSep $ docLit t       , docLit $ Text.pack "{..}"       ]@@ -123,13 +122,13 @@       fExpDoc <- if pun         then return Nothing         else Just <$> docSharedWrapper layoutPat fPat-      return $ (lrdrNameToText lnameF, fExpDoc)-    fmap Seq.singleton $ docSeq+      return (lrdrNameToText lnameF, fExpDoc)+    Seq.singleton <$> docSeq       [ appSep $ docLit t       , appSep $ docLit $ Text.pack "{"       , docSeq $ fds >>= \case           (fieldName, Just fieldDoc) ->-            [ appSep $ docLit $ fieldName+            [ appSep $ docLit fieldName             , appSep $ docLit $ Text.pack "="             , fieldDoc >>= colsWrapPat             , docCommaSep@@ -167,7 +166,7 @@                docAddBaseY BrIndentRegular $ docSeq           [ appSep $ return xN           , appSep $ docLit $ Text.pack "::"-          , docForceSingleline $ tyDoc+          , docForceSingleline tyDoc           ]         return $ xR Seq.|> xN'   ListPat elems _ _ ->@@ -193,30 +192,30 @@ -- else --   VarPat n -> return $ stringLayouter lpat $ rdrNameToText n -- endif-  _ -> fmap return $ briDocByExactInlineOnly "some unknown pattern" lpat+  _ -> return <$> briDocByExactInlineOnly "some unknown pattern" lpat  colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered colsWrapPat = docCols ColPatterns . fmap return . Foldable.toList  wrapPatPrepend-  :: Located (Pat RdrName)+  :: Located (Pat GhcPs)   -> ToBriDocM BriDocNumbered   -> ToBriDocM (Seq BriDocNumbered) wrapPatPrepend pat prepElem = do   patDocs <- layoutPat pat   case Seq.viewl patDocs of-    Seq.EmptyL -> return $ Seq.empty+    Seq.EmptyL -> return Seq.empty     x1 Seq.:< xR -> do       x1' <- docSeq [prepElem, return x1]       return $ x1' Seq.<| xR  wrapPatListy-  :: [Located (Pat RdrName)]+  :: [Located (Pat GhcPs)]   -> String   -> String   -> ToBriDocM (Seq BriDocNumbered) wrapPatListy elems start end = do-  elemDocs <- Seq.fromList elems `forM` \e -> layoutPat e >>= colsWrapPat+  elemDocs <- Seq.fromList elems `forM` (layoutPat >=> colsWrapPat)   sDoc <- docLit $ Text.pack start   eDoc <- docLit $ Text.pack end   case Seq.viewl elemDocs of

@@ -13,8 +13,10 @@ import           Language.Haskell.Brittany.Internal.LayouterBasics import           Language.Haskell.Brittany.Internal.Config.Types -import           RdrName ( RdrName(..) )-import           GHC ( runGhc, GenLocated(L), moduleNameString )+import           GHC                            ( runGhc+                                                , GenLocated(L)+                                                , moduleNameString+                                                ) import           HsSyn import           Name import qualified FastString@@ -26,9 +28,11 @@   -layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName))+layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs)) layoutStmt lstmt@(L _ stmt) = do   indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack+  indentAmount :: Int <-+    mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack   docWrapNode lstmt $ case stmt of     LastStmt body False _ -> do       layoutExpr body@@ -48,69 +52,67 @@             $ docPar (docLit $ Text.pack "<-") (expDoc)           ]         ]-    LetStmt binds -> layoutLocalBinds binds >>= \case-      Nothing        -> docLit $ Text.pack "let" -- i just tested-                                -- it, and it is-                                -- indeed allowed.-                                -- heh.-      Just []        -> docLit $ Text.pack "let" -- this probably never happens-      Just [bindDoc] -> docAlt-        [ -- let bind = expr-          docCols-          ColDoLet-          [ appSep $ docLit $ Text.pack "let"-          , ( if indentPolicy == IndentPolicyLeft-              then docForceSingleline-              else docSetBaseAndIndent-            )-            $ return bindDoc+    LetStmt binds -> do+      let isFree         = indentPolicy == IndentPolicyFree+      let indentFourPlus = indentAmount >= 4+      layoutLocalBinds binds >>= \case+        Nothing        -> docLit $ Text.pack "let"+          -- i just tested the above, and it is indeed allowed. heh.+        Just []        -> docLit $ Text.pack "let" -- this probably never happens+        Just [bindDoc] -> docAlt+          [ -- let bind = expr+            docCols+            ColDoLet+            [ appSep $ docLit $ Text.pack "let"+            , let+                f = case indentPolicy of+                  IndentPolicyFree -> docSetBaseAndIndent+                  IndentPolicyLeft -> docForceSingleline+                  IndentPolicyMultiple | indentFourPlus -> docSetBaseAndIndent+                                       | otherwise      -> docForceSingleline+              in  f $ return bindDoc+            ]+          , -- let+              --   bind = expr+            docAddBaseY BrIndentRegular $ docPar+            (docLit $ Text.pack "let")+            (docSetBaseAndIndent $ return bindDoc)           ]-        , -- let-          --   bind = expr-          docAddBaseY BrIndentRegular $ docPar-          (docLit $ Text.pack "let")-          (docSetBaseAndIndent $ return bindDoc)-        ]-      Just bindDocs -> docAltFilter-        [ -- let aaa = expra+        Just bindDocs -> runFilteredAlternative $ do+          -- let aaa = expra           --     bbb = exprb           --     ccc = exprc-          ( indentPolicy /= IndentPolicyLeft-          , docSeq+          addAlternativeCond (isFree || indentFourPlus) $ docSeq             [ appSep $ docLit $ Text.pack "let"-            , docSetBaseAndIndent $ docLines $ return <$> bindDocs+            , let f = if indentFourPlus+                    then docEnsureIndent BrIndentRegular+                    else docSetBaseAndIndent+              in  f $ docLines $ return <$> bindDocs             ]-          )-        , -- let+          -- let           --   aaa = expra           --   bbb = exprb           --   ccc = exprc-          ( True-          , docAddBaseY BrIndentRegular $ docPar-            (docLit $ Text.pack "let")-            (docSetBaseAndIndent $ docLines $ return <$> bindDocs)-          )+          addAlternativeCond (not indentFourPlus)+            $ docAddBaseY BrIndentRegular+            $ docPar (docLit $ Text.pack "let")+                     (docSetBaseAndIndent $ docLines $ return <$> bindDocs)+    RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do+      -- rec stmt1+      --     stmt2+      --     stmt3+      addAlternativeCond (indentPolicy == IndentPolicyFree) $ docSeq+        [ docLit (Text.pack "rec")+        , docSeparator+        , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts         ]-    RecStmt stmts _ _ _ _ _ _ _ _ _ -> docAltFilter-      [ -- rec stmt1-        --     stmt2-        --     stmt3-        ( indentPolicy /= IndentPolicyLeft-        , docSeq-          [ docLit (Text.pack "rec")-          , docSeparator-          , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts-          ]-        )-      , -- rec-        --   stmt1-        --   stmt2-        --   stmt3-        ( True-        , docAddBaseY BrIndentRegular-          $ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts)-        )-      ]+      -- rec+      --   stmt1+      --   stmt2+      --   stmt3+      addAlternative $ docAddBaseY BrIndentRegular $ docPar+        (docLit (Text.pack "rec"))+        (docLines $ layoutStmt <$> stmts)     BodyStmt expr _ _ _ -> do       expDoc <- docSharedWrapper layoutExpr expr       docAddBaseY BrIndentRegular $ expDoc

@@ -12,7 +12,6 @@ import           Language.Haskell.Brittany.Internal.Types import           Language.Haskell.Brittany.Internal.LayouterBasics -import           RdrName ( RdrName(..) ) import           GHC ( runGhc, GenLocated(L), moduleNameString ) import           HsSyn import           Name@@ -21,4 +20,4 @@   -layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName))+layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))

@@ -13,7 +13,6 @@ import           Language.Haskell.Brittany.Internal.Types import           Language.Haskell.Brittany.Internal.LayouterBasics -import           RdrName ( RdrName(..) ) import           GHC ( runGhc                      , GenLocated(L)                      , moduleNameString@@ -47,7 +46,7 @@     t <- lrdrNameToTextAnn name     docWrapNode name $ docLit t #endif-  HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts@(_:_)) typ2)) -> do+  HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts) typ2)) -> do     typeDoc <- docSharedWrapper layoutType typ2     tyVarDocs <- bndrs `forM` \case       (L _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing)@@ -90,6 +89,7 @@                     ])         ]       contextDoc = case cntxtDocs of+        [] -> docLit $ Text.pack "()"         [x] -> x         _ -> docAlt           [ let@@ -210,13 +210,12 @@             ]           )       ]-  (HsQualTy (L _ []) _) ->-    briDocByExactInlineOnly "HsQualTy [] _" ltype-  HsQualTy lcntxts@(L _ cntxts@(_:_)) typ1 -> do+  HsQualTy lcntxts@(L _ cntxts) typ1 -> do     typeDoc <- docSharedWrapper layoutType typ1     cntxtDocs <- cntxts `forM` docSharedWrapper layoutType     let       contextDoc = docWrapNode lcntxts $ case cntxtDocs of+        [] -> docLit $ Text.pack "()"         [x] -> x         _ -> docAlt           [ let

@@ -0,0 +1,100 @@+module Language.Haskell.Brittany.Internal.Obfuscation+  ( obfuscate+  )+where++++#include "prelude.inc"++import           Data.Char+import           System.Random++++obfuscate :: Text -> IO Text+obfuscate input = do+  let predi x = isAlphaNum x || x `elem` "_'"+  let groups = List.groupBy (\a b -> predi a && predi b) (Text.unpack input)+  let idents = Set.toList $ Set.fromList $ filter (all predi) groups+  let exceptionFilter x | x `elem` keywords = False+      exceptionFilter x | x `elem` extraKWs = False+      exceptionFilter x                     = not $ null $ drop 1 x+  let filtered = filter exceptionFilter idents+  mappings <- fmap Map.fromList $ filtered `forM` \x -> do+    r <- createAlias x+    pure (x, r)+  let groups' = groups <&> \w -> fromMaybe w (Map.lookup w mappings)+  pure $ Text.concat $ fmap Text.pack groups'++keywords :: [String]+keywords =+  [ "case"+  , "class"+  , "data"+  , "default"+  , "deriving"+  , "do"+  , "mdo"+  , "else"+  , "forall"+  , "if"+  , "import"+  , "in"+  , "infix"+  , "infixl"+  , "infixr"+  , "instance"+  , "let"+  , "module"+  , "newtype"+  , "of"+  , "qualified"+  , "then"+  , "type"+  , "where"+  , "_"+  , "foreign"+  , "ccall"+  , "as"+  , "safe"+  , "unsafe"+  , "hiding"+  , "proc"+  , "rec"+  , "family"+  ]++extraKWs :: [String]+extraKWs = ["return", "pure", "Int", "True", "False", "otherwise"]++createAlias :: String -> IO String+createAlias xs = go NoHint xs+ where+  go _hint ""       = pure ""+  go hint (c : cr)  = do+    c' <- case hint of+      VocalHint | isUpper c -> randomFrom $ "AAAEEEOOOIIIUUU" ++ ['A' .. 'Z']+      _ | isUpper c         -> randomFrom ['A' .. 'Z']+      VocalHint | isLower c -> randomFrom $ "aaaeeeoooiiiuuu" ++ ['a' .. 'z']+      _ | isLower c         -> randomFrom ['a' .. 'z']+      _                     -> pure c+    cr' <- go (if c' `elem` "aeuioAEUIO" then NoVocalHint else VocalHint) cr+    pure (c' : cr')++data Hint = NoHint | VocalHint | NoVocalHint++_randomRange :: Random a => a -> a -> IO a+_randomRange lo hi = do+  gen <- getStdGen+  let (x, gen') = randomR (lo, hi) gen+  setStdGen gen'+  pure x++randomFrom :: Random a => [a] -> IO a+randomFrom l = do+  let hi = length l - 1+  gen <- getStdGen+  let (x, gen') = randomR (0, hi) gen+  setStdGen gen'+  pure $ l List.!! x

@@ -1,8 +1,24 @@-module Language.Haskell.Brittany.Internal.Prelude (module E)+module Language.Haskell.Brittany.Internal.Prelude+  ( module E+  , module Language.Haskell.Brittany.Internal.Prelude+  ) where   +-- rather project-specific stuff:+---------------------------------+#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */+import HsExtension                    as E ( GhcPs )+#endif++import RdrName                        as E ( RdrName )++++-- more general:+----------------+ import Data.Functor.Identity         as E ( Identity(..) ) import Control.Concurrent.Chan       as E ( Chan ) import Control.Concurrent.MVar       as E ( MVar )@@ -255,14 +271,16 @@ import Foreign.ForeignPtr            as E ( ForeignPtr                                           ) -import Data.Monoid                   as E ( (<>)-                                          , mconcat+import Data.Monoid                   as E ( mconcat                                           , Monoid (..)                                           )  import Data.Bifunctor                as E ( bimap ) import Data.Functor                  as E ( (<$), ($>) ) import Data.Function                 as E ( (&) )+import Data.Semigroup                as E ( (<>)+                                          , Semigroup(..)+                                          ) import System.IO                     as E ( hFlush                                           , stdout                                           )@@ -306,10 +324,11 @@ import Control.Monad.Trans.MultiRWS  as E ( -- MultiRWST (..)                                           -- , MultiRWSTNull                                           -- , MultiRWS-                                          -- , +                                          -- ,                                             MonadMultiReader(..)                                           , MonadMultiWriter(..)                                           , MonadMultiState(..)+                                          , mGet                                           -- , runMultiRWST                                           -- , runMultiRWSTASW                                           -- , runMultiRWSTW@@ -376,3 +395,10 @@ import Data.Data                     as E ( toConstr                                           ) +todo :: a+todo = error "todo"+++#if !MIN_VERSION_ghc(8,4,0) /* ghc-8.0, ghc-8.2 */+type GhcPs = RdrName+#endif

@@ -32,13 +32,12 @@   x <|> Strict.Nothing = x   _ <|> x = x -traceFunctionWith-  :: String -> (a -> String) -> (b -> String) -> (a -> b) -> (a -> b)-traceFunctionWith name s1 s2 f x =-  trace traceStr y-  where-    y = f x-    traceStr = name ++ "\nBEFORE:\n" ++ s1 x ++ "\nAFTER:\n" ++ s2 y+traceFunctionWith :: String -> (a -> String) -> (b -> String) -> (a -> b) -> (a -> b)+traceFunctionWith name s1 s2 f x = trace traceStr y+ where+  y = f x+  traceStr =+    name ++ "\nBEFORE:\n" ++ s1 x ++ "\nAFTER:\n" ++ s2 y  (<&!>) :: Monad m => m a -> (a -> b) -> m b (<&!>) = flip (<$!>)

@@ -141,11 +141,7 @@         BDFSeparator  -> processSpacingSimple bdX $> bdX         BDFAddBaseY indent bd -> do           acp <- mGet-          indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack-          let indAdd = case indent of-                BrIndentNone -> 0-                BrIndentRegular -> indAmount-                BrIndentSpecial i -> i+          indAdd <- fixIndentationForMultiple acp indent           mSet $ acp { _acp_indentPrep = max (_acp_indentPrep acp) indAdd }           r <- rec bd           acp' <- mGet@@ -315,11 +311,7 @@           return $ reWrap $ BDFLines (l':lr')         BDFEnsureIndent indent bd -> do           acp <- mGet-          indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack-          let indAdd = case indent of-                BrIndentNone -> 0-                BrIndentRegular -> indAmount-                BrIndentSpecial i -> i+          indAdd <- fixIndentationForMultiple acp indent           mSet $ acp             { _acp_indentPrep = 0               -- TODO: i am not sure this is valid, in general.@@ -857,3 +849,25 @@       VerticalSpacingParSome i -> VerticalSpacingParSome $ x1 `max` i       VerticalSpacingParNone -> VerticalSpacingParSome $ x1       VerticalSpacingParAlways i -> VerticalSpacingParAlways $ x1 `max` i++fixIndentationForMultiple+  :: (MonadMultiReader (CConfig Identity) m) => AltCurPos -> BrIndent -> m Int+fixIndentationForMultiple acp indent = do+  indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack+  let indAddRaw = case indent of+        BrIndentNone      -> 0+        BrIndentRegular   -> indAmount+        BrIndentSpecial i -> i+  -- for IndentPolicyMultiple, we restrict the amount of added+  -- indentation in such a manner that we end up on a multiple of the+  -- base indentation.+  indPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack+  pure $ if indPolicy == IndentPolicyMultiple+    then+      let indAddMultiple1 =+            indAddRaw - ((_acp_indent acp + indAddRaw) `mod` indAmount)+          indAddMultiple2 = if indAddMultiple1 <= 0+            then indAddMultiple1 + indAmount+            else indAddMultiple1+      in  indAddMultiple2+    else indAddRaw

@@ -13,10 +13,10 @@ #include "prelude.inc"  import qualified Language.Haskell.GHC.ExactPrint as ExactPrint+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types  import qualified Data.Text.Lazy.Builder as Text.Builder -import           RdrName ( RdrName(..) ) import           GHC ( Located, runGhc, GenLocated(L), moduleNameString, AnnKeywordId )  import           Language.Haskell.GHC.ExactPrint ( AnnKey, Comment )@@ -28,8 +28,17 @@   +data InlineConfig = InlineConfig+  { _icd_perModule :: CConfig Option+  , _icd_perBinding :: Map String (CConfig Option)+  , _icd_perKey :: Map ExactPrint.Types.AnnKey (CConfig Option)+  }+#if MIN_VERSION_ghc(8,2,0)+  deriving Data.Data.Data+#endif+ type PPM = MultiRWSS.MultiRWS-  '[Map ExactPrint.AnnKey ExactPrint.Anns, Config, ExactPrint.Anns]+  '[Map ExactPrint.AnnKey ExactPrint.Anns, InlineConfig, Config, ExactPrint.Anns]   '[Text.Builder.Builder, [BrittanyError], Seq String]   '[] @@ -38,6 +47,8 @@   '[Text.Builder.Builder, [BrittanyError], Seq String]   '[] +newtype TopLevelDeclNameMap = TopLevelDeclNameMap (Map ExactPrint.AnnKey String)+ data LayoutState = LayoutState   { _lstate_baseYs         :: [Int]      -- ^ stack of number of current indentation columns@@ -119,6 +130,9 @@     -- ^ parsing failed   | ErrorUnusedComment String     -- ^ internal error: some comment went missing+  | ErrorMacroConfig String String+    -- ^ in-source config string parsing error; first argument is the parser+    --   output and second the corresponding, ill-formed input.   | LayoutWarning String     -- ^ some warning   | forall ast . Data.Data.Data ast => ErrorUnknownNode String ast@@ -190,9 +204,9 @@  type ToBriDocM = MultiRWSS.MultiRWS '[Config, Anns] '[[BrittanyError], Seq String] '[NodeAllocIndex] -type ToBriDoc (sym :: * -> *) = Located (sym RdrName) -> ToBriDocM BriDocNumbered-type ToBriDoc' sym            = Located sym           -> ToBriDocM BriDocNumbered-type ToBriDocC sym c          = Located sym           -> ToBriDocM c+type ToBriDoc (sym :: * -> *) = Located (sym GhcPs) -> ToBriDocM BriDocNumbered+type ToBriDoc' sym            = Located sym         -> ToBriDocM BriDocNumbered+type ToBriDocC sym c          = Located sym         -> ToBriDocM c  data DocMultiLine   = MultiLineNo

@@ -84,9 +84,12 @@ newtype Max a = Max { getMax :: a }   deriving (Eq, Ord, Show, Bounded, Num) +instance (Num a, Ord a) => Semigroup (Max a) where+  (<>) = Data.Coerce.coerce (max :: a -> a -> a)+ instance (Num a, Ord a) => Monoid (Max a) where   mempty  = Max 0-  mappend = Data.Coerce.coerce (max :: a -> a -> a)+  mappend = (<>)  newtype ShowIsId = ShowIsId String deriving Data @@ -222,7 +225,7 @@ tellDebugMess s = mTell $ Seq.singleton s  tellDebugMessShow :: forall a m . (MonadMultiWriter-  (Seq String) m, Show a) => a -> m () +  (Seq String) m, Show a) => a -> m () tellDebugMessShow = tellDebugMess . show  -- i should really put that into multistate..