packages feed

brittany 0.8.0.3 → 0.9.0.0

raw patch · 22 files changed

+3817/−2222 lines, 22 filesdep −eitherdep ~butcherdep ~filepathPVP ok

version bump matches the API change (PVP)

Dependencies removed: either

Dependency ranges changed: butcher, filepath

API changes (from Hackage documentation)

- Language.Haskell.Brittany.Internal.Config: readMergePersConfig :: FilePath -> Bool -> CConfig Option -> MaybeT IO (CConfig Option)
+ Language.Haskell.Brittany.Internal.Config: readConfig :: MonadIO m => FilePath -> MaybeT m (Maybe (CConfig Option))
+ Language.Haskell.Brittany.Internal.Config: writeDefaultConfig :: MonadIO m => FilePath -> m ()
+ Language.Haskell.Brittany.Internal.Config.Types: instance GHC.Classes.Eq Language.Haskell.Brittany.Internal.Config.Types.IndentPolicy

Files

ChangeLog.md view
@@ -1,5 +1,31 @@ # Revision history for brittany +## 0.9.0.0  -- December 2017++* Change default global config path (use XDG spec)+    Existing config should still be respected, so this should not break+    compatibility+* ! Slight rework of the commandline interface:+    - Support multiple inputs and outputs+    - Support inplace-transformation for multiple files via+      `--write-mode=inplace`+* Implement `IndentPolicyLeft` - the indentation mode that never adds more+  than the base indentation for nested parts (no hanging indentation)++    (thanks to Evan Borden)+* Fix bug that manifested in bad output for (top-level) template haskell splices+* Extension support:+    - RecordWildCards+    - RecursiveDo (was only partially supported previously)+* Layouting Bugfixes:+    - Properly reproduce parentheses around kind signatures+    - Fix issue around promoted lists+      (example good: `'[ 'True]` bad: `'['True]`)+    - Trim text from exactprint used as workaround for unknown nodes+      (unsupported extension workaround)+* Layouting changes+    - Insert spaces around operator in sections+ ## 0.8.0.3  -- September 2017  * Support for ghc-8.2.1
README.md view
@@ -46,6 +46,7 @@ # Other usage notes  - Supports GHC versions `8.0.*` and `8.2.*`.+- as of November'17, `brittany` is available on stackage nightly. - config (file) documentation is lacking. - some config values can not be configured via commandline yet. - uses/creates user config file in `~/.brittany/config.yaml`;@@ -109,9 +110,21 @@       - -XBangPatterns     ~~~~ -# Implementation/High-level Documentation+# Feature Requests, Contribution, Documentation -[See the documentation index](doc/implementation/index.md)+This currently is a one-person project in the sense that 90% of the code is+written by one person. And (unfortunately) it is not my job to keep improving+this project. Please forgive that as a consequence my time to invest on new+features is rather limited.++Nonetheless I consider it "in active development" :)++One way of speeding things up is to make your own contributions. There is+a good amount of high-level documentation at++[the documentation index](doc/implementation/index.md)++Note that most development happens on the `dev` branch of this repository!  # License 
brittany.cabal view
@@ -1,5 +1,5 @@ name:                 brittany-version:              0.8.0.3+version:              0.9.0.0 synopsis:             Haskell source code formatter description: {   See <https://github.com/lspitzner/brittany/blob/master/README.md the README>.@@ -24,7 +24,7 @@   doc/implementation/*.md } extra-source-files: {-  src-literatetests/tests.blt+  src-literatetests/*.blt }  source-repository head {@@ -32,11 +32,6 @@   location: https://github.com/lspitzner/brittany.git } -flag brittany-dev-  description: dev options-  default: False-  manual: True- flag brittany-dev-lib   description: set buildable false for anything but lib   default: False@@ -80,13 +75,9 @@   }   ghc-options: {     -Wall-    -j     -fno-warn-unused-imports     -fno-warn-redundant-constraints   }-  if flag(brittany-dev) {-    ghc-options: -O0 -Werror -fobject-code-  }   build-depends:     { base >=4.9 && <4.11     , ghc >=8.0.1 && <8.3@@ -103,7 +94,7 @@     , pretty >=1.1.3.3 && <1.2     , bytestring >=0.10.8.1 && <0.11     , directory >=1.2.6.2 && <1.4-    , butcher >=1.1.0.0 && <1.2+    , butcher >=1.2 && <1.3     , yaml >=0.8.18 && <0.9     , aeson >=1.0.1.0 && <1.3     , extra >=1.4.10 && <1.7@@ -113,7 +104,6 @@     , unsafe >=0.0 && <0.1     , safe >=0.3.9 && <0.4     , deepseq >=1.4.2.0 && <1.5-    , either >=4.4.1.1 && <4.5     , semigroups >=0.18.2 && <0.19     , cmdargs >=0.10.14 && <0.11     , czipwith >=1.0.0.0 && <1.1@@ -148,7 +138,7 @@   other-modules: {     Paths_brittany   }-  -- other-extensions:    +  -- other-extensions:   build-depends:     { brittany     , base@@ -176,7 +166,6 @@     , unsafe     , safe     , deepseq-    , either     , semigroups     , cmdargs     , czipwith@@ -203,21 +192,12 @@   }   ghc-options: {     -Wall-    -j     -fno-spec-constr     -fno-warn-unused-imports     -fno-warn-redundant-constraints     -rtsopts     -with-rtsopts "-M2G"   }-  if flag(brittany-dev) {-    ghc-options:-      -O0-      -Werror-      -fobject-code-      -fprof-auto-      -fprof-cafs-  }  test-suite unittests   if flag(brittany-dev-lib) {@@ -254,7 +234,6 @@     , unsafe     , safe     , deepseq-    , either     , semigroups     , cmdargs     , czipwith@@ -283,14 +262,10 @@   }   ghc-options: {     -Wall-    -j     -fno-warn-unused-imports     -rtsopts     -with-rtsopts "-M2G"   }-  if flag(brittany-dev) {-    ghc-options: -O0 -Werror -fobject-code-  }  test-suite littests   if flag(brittany-dev-lib) {@@ -327,17 +302,17 @@     , unsafe     , safe     , deepseq-    , either     , semigroups     , cmdargs     , czipwith     , ghc-boot-th     , hspec >=2.4.1 && <2.5+    , filepath     , parsec >=3.1.11 && <3.2     }   ghc-options:      -Wall   main-is:          Main.hs-  other-modules:    +  other-modules:   hs-source-dirs:   src-literatetests   default-extensions: {     CPP@@ -356,14 +331,10 @@   }   ghc-options: {     -Wall-    -j     -fno-warn-unused-imports     -rtsopts     -with-rtsopts "-M2G"   }-  if flag(brittany-dev) {-    ghc-options: -O0 -Werror -fobject-code-  }  test-suite libinterfacetests   if flag(brittany-dev-lib) {@@ -382,7 +353,7 @@     }   ghc-options:      -Wall   main-is:          Main.hs-  other-modules:    +  other-modules:   hs-source-dirs:   src-libinterfacetests   default-extensions: {     FlexibleContexts@@ -395,7 +366,6 @@   }   ghc-options: {     -Wall-    -j     -fno-warn-unused-imports     -rtsopts     -with-rtsopts "-M2G"
src-brittany/Main.hs view
@@ -12,8 +12,12 @@ import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers import qualified Data.Map as Map +import           Text.Read (Read(..))+import qualified Text.ParserCombinators.ReadP as ReadP+import qualified Text.ParserCombinators.ReadPrec as ReadPrec import qualified Data.Text.Lazy.Builder as Text.Builder +import           Control.Monad (zipWithM) import           Data.CZipWith  import qualified Debug.Trace as Trace@@ -39,7 +43,18 @@ import Paths_brittany  +data WriteMode = Display | Inplace +instance Read WriteMode where+  readPrec = val "display" Display <|> val "inplace" Inplace+   where+    val iden v = ReadPrec.lift $ ReadP.string iden >> return v++instance Show WriteMode where+  show Display = "display"+  show Inplace = "inplace"++ main :: IO () main = mainFromCmdParserWithHelpDesc mainCmdParser @@ -47,13 +62,24 @@ helpDoc = PP.vcat $ List.intersperse   (PP.text "")   [ parDocW-    [ "Transforms one haskell module by reformatting"-    , "(parts of) the source code (while preserving the"-    , "parts not transformed)."+    [ "Reformats one or more haskell modules."+    , "Currently affects only type signatures and function bindings;"+    , "everything else is left unmodified."     , "Based on ghc-exactprint, thus (theoretically) supporting all"     , "that ghc does."-    , "Currently, only type-signatures and function-bindings are transformed."     ]+  , parDoc $ "Example invocations:"+  , PP.hang (PP.text "") 2 $ PP.vcat+      [ PP.text "brittany"+      , PP.hang (PP.text "  ") 2 $ PP.text "read from stdin, output to stdout"+      ]+  , PP.hang (PP.text "") 2 $ PP.vcat+      [ PP.text "brittany --indent=4 --write-mode=inplace *.hs"+      , PP.nest 2 $ PP.vcat+        [ PP.text "run on all modules in current directory (no backup!)"+        , PP.text "4 spaces indentation"+        ]+      ]   , parDocW     [ "This program is written carefully and contains safeguards to ensure"     , "the transformation does not change semantics (or the syntax tree at all)"@@ -103,8 +129,6 @@   printHelp      <- addSimpleBoolFlag "h" ["help"] mempty   printVersion   <- addSimpleBoolFlag "" ["version"] mempty   printLicense   <- addSimpleBoolFlag "" ["license"] mempty-  inputPaths     <- addFlagStringParams "i" ["input"] "PATH" (flagHelpStr "path to input haskell source file")-  outputPaths    <- addFlagStringParams "o" ["output"] "PATH" (flagHelpStr "output file path")   configPaths    <- addFlagStringParams "" ["config-file"] "PATH" (flagHelpStr "path to config file") -- TODO: allow default on addFlagStringParam ?   cmdlineConfig  <- configParser   suppressOutput <- addSimpleBoolFlag@@ -112,9 +136,20 @@     ["suppress-output"]     (flagHelp $ parDoc "suppress the regular output, i.e. the transformed haskell source")   _verbosity <- addSimpleCountFlag "v" ["verbose"] (flagHelp $ parDoc "[currently without effect; TODO]")+  writeMode  <- addFlagReadParam+    ""+    ["write-mode"]+    "(display|inplace)"+    Flag+      { _flag_help    = Just $ PP.vcat+          [ PP.text "display: output for any input(s) goes to stdout"+          , PP.text "inplace: override respective input file (without backup!)"+          ]+      , _flag_default = Just Display+      }+  inputParams <- addParamNoFlagStrings "PATH" (paramHelpStr "paths to input haskell source files")   reorderStop-  inputParam <- addStringParamOpt "PATH" (paramHelpStr "path to input haskell source file")-  desc       <- peekCmdDesc+  desc        <- peekCmdDesc   addCmdImpl $ void $ do     when printLicense $ do       print licenseDoc@@ -128,31 +163,24 @@     when printHelp $ do       liftIO $ print $ ppHelpShallow desc       System.Exit.exitSuccess-    inputPathM <- case maybeToList inputParam ++ inputPaths of-      [] -> do-        return Nothing-      [x] -> return $ Just x-      _   -> do-        putStrErrLn $ "more than one input, aborting"-        System.Exit.exitWith (System.Exit.ExitFailure 51)-    outputPathM <- case outputPaths of-      [] -> do-        return Nothing-      [x] -> return $ Just x-      _   -> do-        putStrErrLn $ "more than one output, aborting"-        System.Exit.exitWith (System.Exit.ExitFailure 52)++    let inputPaths  = if null inputParams then [Nothing] else map Just inputParams+    let outputPaths = case writeMode of+                      Display -> repeat Nothing+                      Inplace -> inputPaths+     config <- runMaybeT (readConfigs cmdlineConfig configPaths) >>= \case       Nothing -> System.Exit.exitWith (System.Exit.ExitFailure 53)       Just x  -> return x     when (confUnpack $ _dconf_dump_config $ _conf_debug $ config) $ do       trace (showConfigYaml config) $ return ()-    eitherErrSucc <- coreIO putStrErrLn config suppressOutput inputPathM outputPathM-    case eitherErrSucc of-      Left errNo -> System.Exit.exitWith (System.Exit.ExitFailure errNo)-      Right ()   -> pure () +    results <- zipWithM (coreIO putStrErrLn config suppressOutput) inputPaths outputPaths+    case sequence_ results of+      Left  _ -> System.Exit.exitWith (System.Exit.ExitFailure 1)+      Right _ -> pure () + -- | The main IO parts for the default mode of operation, and after commandline -- and config stuff is processed. coreIO@@ -165,8 +193,8 @@   -> Maybe FilePath.FilePath -- ^ input filepath; stdin if Nothing.   -> Maybe FilePath.FilePath -- ^ output filepath; stdout if Nothing.   -> IO (Either Int ())      -- ^ Either an errorNo, or success.-coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = EitherT.runEitherT $ do-  let putErrorLn         = liftIO . putErrorLnIO :: String -> EitherT.EitherT e IO ()+coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runExceptT $ do+  let putErrorLn         = liftIO . putErrorLnIO :: String -> ExceptT.ExceptT e IO ()   let ghcOptions         = config & _conf_forward & _options_ghc & runIdentity   -- there is a good of code duplication between the following code and the   -- `pureModuleTransform` function. Unfortunately, there are also a good@@ -206,7 +234,7 @@     Left left -> do       putErrorLn "parse error:"       putErrorLn $ show left-      EitherT.left 60+      ExceptT.throwE 60     Right (anns, parsedSource, hasCPP) -> do       when (config & _conf_debug .> _dconf_dump_ast_full .> confUnpack) $ do         let val = printTreeWithCustom 100 (customLayouterF anns) parsedSource@@ -272,7 +300,7 @@         Nothing -> liftIO $ TextL.IO.putStr $ outLText         Just p  -> liftIO $ TextL.IO.writeFile p $ outLText -      when hasErrors $ EitherT.left 70+      when hasErrors $ ExceptT.throwE 70  where   addTraceSep conf =     if or@@ -292,15 +320,38 @@  readConfigs :: CConfig Option -> [System.IO.FilePath] -> MaybeT IO Config readConfigs cmdlineConfig configPaths = do-  let defLocalConfigPath = "brittany.yaml"-  userBritPath <- liftIO $ Directory.getAppUserDataDirectory "brittany"-  let defUserConfigPath = userBritPath FilePath.</> "config.yaml"-  merged <- case configPaths of+  userBritPathSimple <- liftIO $ Directory.getAppUserDataDirectory "brittany"+  userBritPathXdg    <- liftIO+    $ Directory.getXdgDirectory Directory.XdgConfig "brittany"+  let userConfigPathSimple = userBritPathSimple FilePath.</> "config.yaml"+  let userConfigPathXdg    = userBritPathXdg FilePath.</> "config.yaml"+  let+    findLocalConfig :: MaybeT IO (Maybe (CConfig Option))+    findLocalConfig = do+      cwd <- liftIO $ Directory.getCurrentDirectory+      let dirParts = FilePath.splitDirectories cwd+      let searchDirs =+            [ FilePath.joinPath x | x <- reverse $ List.inits dirParts ]+      -- when cwd is "a/b/c", searchDirs is ["a/b/c", "a/b", "a", "/"]+      mFilePath <- liftIO $ Directory.findFileWith Directory.doesFileExist+                                                   searchDirs+                                                   "brittany.yaml"+      case mFilePath of+        Nothing -> pure Nothing+        Just fp -> readConfig fp+  configsRead <- case configPaths of     [] -> do-      liftIO $ Directory.createDirectoryIfMissing False userBritPath-      return cmdlineConfig-        >>= readMergePersConfig defLocalConfigPath False-        >>= readMergePersConfig defUserConfigPath  True-    -- TODO: ensure that paths exist ?-    paths -> foldl (\prev p -> prev >>= readMergePersConfig p False) (return cmdlineConfig) paths+      localConfig      <- findLocalConfig+      userConfigSimple <- readConfig userConfigPathSimple+      userConfigXdg    <- readConfig userConfigPathXdg+      let userConfig = userConfigSimple <|> userConfigXdg+      when (Data.Maybe.isNothing userConfig) $ do+        liftIO $ Directory.createDirectoryIfMissing False userBritPathXdg+        writeDefaultConfig userConfigPathXdg+      -- rightmost has highest priority+      pure $ [userConfig, localConfig]+    paths -> readConfig `mapM` reverse paths+                   -- reverse to give highest priority to the first+  merged <-+    pure $ Semigroup.mconcat $ catMaybes $ configsRead ++ [Just cmdlineConfig]   return $ cZipWith fromOptionIdentity staticDefaultConfig merged
+ src-literatetests/10-tests.blt view
@@ -0,0 +1,546 @@++###############################################################################+###############################################################################+###############################################################################+#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+++###############################################################################+###############################################################################+###############################################################################+#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 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+func = (1 `abc`)++#test right inf+func = (`abc` 1)++###+#group tuples+###++#test 1+func = (abc, def)++#test 2+#pending+func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd+  , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd)++++###############################################################################+###############################################################################+###############################################################################+#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 stylisticspecialcases+###############################################################################+###############################################################################+###############################################################################++#test operatorprefixalignment-even-with-multiline-alignbreak+func =+  foo+    $  [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+       , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb+       ]+    ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]+
+ src-literatetests/14-extensions.blt view
@@ -0,0 +1,68 @@+###############################################################################+###############################################################################+###############################################################################+#group extensions+###############################################################################+###############################################################################+###############################################################################++###############################################################################+## MultiWayIf+#test multiwayif 1+{-# LANGUAGE MultiWayIf #-}+func = if+  | cond1 -> loooooooooooooooooooooooooooooong expr1+  | cond2 -> loooooooooooooooooooooooooooooong expr2++#test multiwayif 2+{-# LANGUAGE MultiWayIf #-}+func = do+  foo+  bar $ if+    | cond1 -> loooooooooooooooooooooooooooooong expr1+    | cond2 -> loooooooooooooooooooooooooooooong expr2+++###############################################################################+## LambdaCase+#test lambdacase 1+{-# LANGUAGE LambdaCase #-}+func = \case+  FooBar -> x+  Baz    -> y++++###############################################################################+## ImplicitParams+#test ImplicitParams 1+{-# LANGUAGE ImplicitParams #-}+func :: (?asd::Int) -> ()++#test ImplicitParams 2+{-# LANGUAGE ImplicitParams #-}+func+  :: (  ?asd+     :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+     )+  -> ()+++###############################################################################+## RecursiveDo+#test recursivedo 1+{-# LANGUAGE RecursiveDo #-}+foo = do+  rec a <- f b+      b <- g a+  return (a, b)++#test recursivedo 2+{-# LANGUAGE RecursiveDo #-}+foo = do+  rec -- comment+      a <- f b+      b <- g a+  return (a, b)+
+ src-literatetests/15-regressions.blt view
@@ -0,0 +1,515 @@+###############################################################################+###############################################################################+###############################################################################+#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 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 lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+    }++#test record construction 1+func = Foo {_lstate_indent = _lstate_indent state}++#test record construction 2+func = Foo+  { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd+  , _lstate_fooo   = _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++#test issue 52 a++{-# LANGUAGE RecordWildCards #-}+v = A {a = 1, ..} where b = 2++#test issue 52 b++{-# LANGUAGE RecordWildCards #-}+v = A {..} where b = 2++#test issue 52 c++{-# LANGUAGE RecordWildCards #-}+v = A {a = 1, b = 2, c = 3}++#test issue 63 a+#pending fix does not work on 8.0.2+test :: Proxy 'Int++#test issue 63 b+#pending fix does not work on 8.0.2+test :: Proxy '[ 'True]++#test issue 63 c+#pending fix does not work on 8.0.2+test :: Proxy '[Bool]++#test issue 64+{-# LANGUAGE RankNTypes, KindSignatures #-}+func+  :: forall m str+   . (Str str, Monad m)+  => Int+  -> Proxy (str :: [*])+  -> m (Tagged str String)++#test issue 67+fmapuv :: U.Unbox a => (a -> b) -> U.Vector a -> V.Vector b+fmapuv f xs = G.generate (G.length xs) (f . (xs G.!))+++#test parallellistcomp-workaround+cs0 = 0 : [ c / Interval n | c <- cs | n <- [1..] ]++#test issue 70+{-# LANGUAGE TemplateHaskell #-}+deriveFromJSON (unPrefix "assignPost") ''AssignmentPost
+ src-literatetests/16-pending.blt view
@@ -0,0 +1,35 @@+###############################################################################+###############################################################################+###############################################################################+#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"+
src-literatetests/Main.hs view
@@ -24,6 +24,7 @@ import Data.Coerce ( coerce )  import qualified Data.Text.IO as Text.IO+import           System.FilePath ( (</>) )   @@ -38,13 +39,28 @@  main :: IO () main = do-  input <- Text.IO.readFile "src-literatetests/tests.blt"-  let groups = createChunks input-  hspec $ groups `forM_` \(groupname, tests) -> do-    describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do-      (if pend then before_ pending else id)-        $ it (Text.unpack name)-        $ roundTripEqual inp+  files <- System.Directory.listDirectory "src-literatetests/"+  let blts =+        List.sort+          $ filter (\x -> not ("tests-context-free.blt" `isSuffixOf` x))+          $ 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"+  let groupsCtxFree = createChunks inputCtxFree+  hspec $ do+    groups `forM_` \(groupname, tests) -> do+      describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do+        (if pend then before_ pending else id)+          $ it (Text.unpack name)+          $ roundTripEqual defaultTestConfig inp+    groupsCtxFree `forM_` \(groupname, tests) -> do+      describe ("context free: " ++ Text.unpack groupname)+        $       tests+        `forM_` \(name, pend, inp) -> do+                  (if pend then before_ pending else id)+                    $ it (Text.unpack name)+                    $ roundTripEqual contextFreeTestConfig inp  where   -- this function might be implemented in a weirdly complex fashion; the   -- reason being that it was copied from a somewhat more complex variant.@@ -129,10 +145,10 @@ -------------------- -- past this line:  copy-pasta from other test (meh..) ---------------------roundTripEqual :: Text -> Expectation-roundTripEqual t =+roundTripEqual :: Config -> Text -> Expectation+roundTripEqual c t =   fmap (fmap PPTextWrapper)-       (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t)+       (parsePrintModuleTests c "TestFakeFileName.hs" t)     `shouldReturn` Right (PPTextWrapper t)  newtype PPTextWrapper = PPTextWrapper Text@@ -167,3 +183,12 @@     }   } +contextFreeTestConfig :: Config+contextFreeTestConfig =+  defaultTestConfig+  { _conf_layout = (_conf_layout defaultTestConfig)+    {_lconfig_indentPolicy = coerce IndentPolicyLeft+    ,_lconfig_alignmentLimit = coerce (1 :: Int)+    ,_lconfig_columnAlignMode = coerce ColumnAlignModeDisabled+    }+  }
+ src-literatetests/tests-context-free.blt view
@@ -0,0 +1,1131 @@++###############################################################################+###############################################################################+###############################################################################+#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)++++###############################################################################+###############################################################################+###############################################################################+#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 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"+
− src-literatetests/tests.blt
@@ -1,1080 +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)----###############################################################################-###############################################################################-###############################################################################-#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 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 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_indent = _lstate_indent state-           }--#test record update indentation 3-func = do-  s <- mGet-  mSet $ s-    { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd-    , _lstate_indent = _lstate_indent 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"-
src/Language/Haskell/Brittany/Internal.hs view
@@ -20,7 +20,7 @@ import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers  import           Data.Data-import           Control.Monad.Trans.Either+import           Control.Monad.Trans.Except import           Data.HList.HList import           Data.CZipWith @@ -62,7 +62,7 @@ -- Note that this function ignores/resets all config values regarding -- debugging, i.e. it will never use `trace`/write to stderr. parsePrintModule :: Config -> Text -> IO (Either [BrittanyError] Text)-parsePrintModule configRaw inputText = runEitherT $ do+parsePrintModule configRaw inputText = runExceptT $ do   let config = configRaw { _conf_debug = _conf_debug staticDefaultConfig }   let ghcOptions         = config & _conf_forward & _options_ghc & runIdentity   let config_pp          = config & _conf_preprocessor@@ -87,7 +87,7 @@       cppCheckFunc       (hackTransform $ Text.unpack inputText)     case parseResult of-      Left  err -> left $ [ErrorInput err]+      Left  err -> throwE $ [ErrorInput err]       Right x   -> pure $ x   (errsWarns, outputTextL) <- do     let omitCheck =@@ -117,7 +117,7 @@         case config & _conf_errorHandling & _econf_Werror & confUnpack of           False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)           True  -> not $ null errsWarns-  if hasErrors then left $ errsWarns else pure $ TextL.toStrict outputTextL+  if hasErrors then throwE $ errsWarns else pure $ TextL.toStrict outputTextL   @@ -320,8 +320,8 @@  ppDecl :: LHsDecl RdrName -> PPMLocal () ppDecl d@(L loc decl) = case decl of-  SigD sig  -> -- trace (_sigHead sig) $-               withTransformedAnns d $ do+  SigD sig -> -- trace (_sigHead sig) $+              withTransformedAnns d $ do     -- runLayouter $ Old.layoutSig (L loc sig)     briDoc <- briDocMToPPM $ layoutSig (L loc sig)     layoutBriDoc briDoc@@ -332,9 +332,9 @@       eitherNode <- layoutBind (L loc bind)       case eitherNode of         Left  ns -> docLines $ return <$> ns-        Right n -> return n+        Right n  -> return n     layoutBriDoc briDoc-  _         -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc+  _ -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc  _sigHead :: Sig RdrName -> String _sigHead = \case
src/Language/Haskell/Brittany/Internal/Config.hs view
@@ -8,7 +8,8 @@   , configParser   , staticDefaultConfig   , forwardOptionsSyntaxExtsEnabled-  , readMergePersConfig+  , readConfig+  , writeDefaultConfig   , showConfigYaml   ) where@@ -198,29 +199,37 @@ --   , infoIntersperse = True --   } -readMergePersConfig-  :: System.IO.FilePath -> Bool -> CConfig Option -> MaybeT IO (CConfig Option)-readMergePersConfig path shouldCreate conf = do++-- | Reads a config from a file. If the file does not exist, returns+-- Nothing. If the file exists and parsing fails, prints to stderr and+-- aborts the MaybeT. Otherwise succeed via Just.+-- If the second parameter is True and the file does not exist, writes the+-- staticDefaultConfig to the file.+readConfig+  :: MonadIO m => System.IO.FilePath -> MaybeT m (Maybe (CConfig Option))+readConfig path = 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+  if exists+    then 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 $ Just fileConf+    else return $ Nothing++writeDefaultConfig :: MonadIO m => System.IO.FilePath -> m ()+writeDefaultConfig path =+  liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap+    (Option . Just . runIdentity)+    staticDefaultConfig  showConfigYaml :: Config -> String showConfigYaml = Data.ByteString.Char8.unpack
src/Language/Haskell/Brittany/Internal/Config/Types.hs view
@@ -191,7 +191,7 @@                   | IndentPolicyFree -- can create new indentations whereever                   | IndentPolicyMultiple -- can create indentations only                                          -- at any n * amount.-  deriving (Show, Generic, Data)+  deriving (Eq, Show, Generic, Data)  data AltChooser = AltChooserSimpleQuick -- always choose last alternative.                                         -- leads to tons of sparsely filled
src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs view
@@ -58,26 +58,24 @@   -> (GHC.DynFlags -> IO (Either String a))   -> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a)) parseModuleWithCpp cpp opts args fp dynCheck =-  ExactPrint.ghcWrapper $ EitherT.runEitherT $ do+  ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do     dflags0                       <- lift $ GHC.getSessionDynFlags-    (dflags1, leftover, warnings) <- lift $ GHC.parseDynamicFlagsCmdLine-      dflags0-      (GHC.noLoc <$> args)+    (dflags1, leftover, warnings) <- lift+      $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args)     void $ lift $ GHC.setSessionDynFlags dflags1-    dflags2                       <- lift $ ExactPrint.initDynFlags fp+    dflags2 <- lift $ ExactPrint.initDynFlags fp     when (not $ null leftover)-      $  EitherT.left+      $  ExceptT.throwE       $  "when parsing ghc flags: leftover flags: "       ++ show (leftover <&> \(L _ s) -> s)     when (not $ null warnings)-      $  EitherT.left+      $  ExceptT.throwE       $  "when parsing ghc flags: encountered warnings: "       ++ show (warnings <&> \(L _ s) -> s)-    x <- EitherT.EitherT $ liftIO $ dynCheck dflags2+    x   <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2     res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp-    EitherT.hoistEither-      $ either (\(span, err) -> Left $ show span ++ ": " ++ err)-               (\(a, m) -> Right (a, m, x))+    either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err)+           (\(a, m) -> pure (a, m, x))       $ ExactPrint.postParseTransform res opts  parseModuleFromString@@ -87,22 +85,21 @@   -> String   -> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a)) parseModuleFromString args fp dynCheck str =-  ExactPrint.ghcWrapper $ EitherT.runEitherT $ do+  ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do     dflags0                       <- lift $ ExactPrint.initDynFlagsPure fp str-    (dflags1, leftover, warnings) <--      lift $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args)+    (dflags1, leftover, warnings) <- lift+      $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args)     when (not $ null leftover)-      $  EitherT.left+      $  ExceptT.throwE       $  "when parsing ghc flags: leftover flags: "       ++ show (leftover <&> \(L _ s) -> s)     when (not $ null warnings)-      $  EitherT.left+      $  ExceptT.throwE       $  "when parsing ghc flags: encountered warnings: "       ++ show (warnings <&> \(L _ s) -> s)-    x <- EitherT.EitherT $ liftIO $ dynCheck dflags1-    EitherT.hoistEither-      $ either (\(span, err) -> Left $ show span ++ ": " ++ err)-               (\(a, m) -> Right (a, m, x))+    x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1+    either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err)+           (\(a, m) -> pure (a, m, x))       $ ExactPrint.parseWith dflags1 fp GHC.parseModule str  -----------@@ -220,11 +217,18 @@ extractToplevelAnns lmod anns = output  where   (L _ (HsModule _ _ _ ldecls _ _)) = lmod-  declMap :: Map ExactPrint.AnnKey ExactPrint.AnnKey-  declMap = Map.unions $ ldecls <&> \ldecl ->+  declMap1 :: Map ExactPrint.AnnKey ExactPrint.AnnKey+  declMap1 = Map.unions $ ldecls <&> \ldecl ->     Map.fromSet (const (ExactPrint.mkAnnKey ldecl)) (foldedAnnKeys ldecl)-  modKey = ExactPrint.mkAnnKey lmod-  output = groupMap (\k _ -> Map.findWithDefault modKey k declMap) anns+  declMap2 :: Map ExactPrint.AnnKey ExactPrint.AnnKey+  declMap2 =+    Map.fromList+      $ [ (captured, declMap1 Map.! k)+        | (k, ExactPrint.Ann _ _ _ _ _ (Just captured)) <- Map.toList anns+        ]+  declMap = declMap1 `Map.union` declMap2+  modKey  = ExactPrint.mkAnnKey lmod+  output  = groupMap (\k _ -> Map.findWithDefault modKey k declMap) anns  groupMap :: (Ord k, Ord l) => (k -> a -> l) -> Map k a -> Map l (Map k a) groupMap f = Map.foldlWithKey' (\m k a -> Map.alter (insert k a) (f k a) m)
src/Language/Haskell/Brittany/Internal/LayouterBasics.hs view
@@ -42,11 +42,13 @@   , appSep   , docCommaSep   , docParenLSep+  , docTick   , spacifyDocs   , briDocMToPPM   , allocateNode   , docSharedWrapper   , hasAnyCommentsBelow+  , hasAnnKeyword   ) where @@ -80,6 +82,8 @@ import           Data.Data import           Data.Generics.Schemes +import qualified Data.Char as Char+ import           DataTreePrint  import           Data.HList.HList@@ -152,20 +156,21 @@   let exactPrinted = Text.pack $ ExactPrint.exactPrint ast anns   fallbackMode <-     mAsk <&> _conf_errorHandling .> _econf_ExactPrintFallback .> confUnpack-  let exactPrintNode = allocateNode $ BDFExternal+  let exactPrintNode t = allocateNode $ BDFExternal         (ExactPrint.Types.mkAnnKey ast)         (foldedAnnKeys ast)         False-        exactPrinted-  let-    errorAction = do-      mTell $ [ErrorUnknownNode infoStr ast]-      docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"+        t+  let errorAction = do+        mTell $ [ErrorUnknownNode infoStr ast]+        docLit+          $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"   case (fallbackMode, Text.lines exactPrinted) of     (ExactPrintFallbackModeNever, _  ) -> errorAction-    (_                          , [_]) -> exactPrintNode-    (ExactPrintFallbackModeRisky, _  ) -> exactPrintNode-    _                                  -> errorAction+    (_                          , [t]) -> exactPrintNode+      (Text.dropWhile Char.isSpace . Text.dropWhileEnd Char.isSpace $ t)+    (ExactPrintFallbackModeRisky, _) -> exactPrintNode exactPrinted+    _ -> errorAction  rdrNameToText :: RdrName -> Text -- rdrNameToText = Text.pack . show . flip runSDoc unsafeGlobalDynFlags . ppr@@ -238,6 +243,19 @@     $ Map.elems     $ anns +hasAnnKeyword+  :: (Data a, MonadMultiReader (Map AnnKey Annotation) m)+  => Located a+  -> AnnKeywordId+  -> m Bool+hasAnnKeyword ast annKeyword = do+  anns <- mAsk+  let hasK (ExactPrint.Types.G x, _) = x == annKeyword+      hasK _                         = False+  pure $ case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of+    Nothing -> False+    Just (ExactPrint.Types.Ann _ _ _ aks _ _) -> any hasK aks+ -- new BriDoc stuff  allocateNode@@ -446,6 +464,9 @@  docParenLSep :: ToBriDocM BriDocNumbered docParenLSep = appSep $ docLit $ Text.pack "("++docTick :: ToBriDocM BriDocNumbered+docTick = docLit $ Text.pack "'"  docNodeAnnKW   :: Data.Data.Data ast
src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs view
@@ -265,9 +265,15 @@         gs  -> docSeq             $  [appSep $ docLit $ Text.pack "|"]             ++ List.intersperse docCommaSep (return <$> gs)-  docAlt++  indentPolicy <- mAsk+    <&> _conf_layout+    .>  _lconfig_indentPolicy+    .>  confUnpack+  docAltFilter     $  -- one-line solution-       [ docCols+       [ ( True+         , docCols          (ColBindingLine alignmentToken)          [ docSeq (patPartInline ++ [guardPart])          , docSeq@@ -276,6 +282,7 @@            , wherePart            ]          ]+         )        | not hasComments        , [(guards, body, _bodyRaw)] <- [clauseDocs]        , let guardPart = singleLineGuardsDoc guards@@ -289,7 +296,8 @@          _        -> []        ]     ++ -- one-line solution + where in next line(s)-       [ docLines+       [ ( True+         , docLines          $  [ docCols               (ColBindingLine alignmentToken)               [ docSeq (patPartInline ++ [guardPart])@@ -298,23 +306,27 @@               ]             ]          ++ wherePartMultiLine+         )        | [(guards, body, _bodyRaw)] <- [clauseDocs]        , let guardPart = singleLineGuardsDoc guards        , Data.Maybe.isJust mWhereDocs        ]     ++ -- two-line solution + where in next line(s)-       [ docLines+       [ ( 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-       [                            docLines+       [ ( True+         , docLines          $  [ docCols               (ColBindingLine alignmentToken)               [ docSeq (patPartInline ++ [guardPart])@@ -329,24 +341,28 @@           --   , 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.-       [ docLines+       [ ( 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-       [ docLines+       [ ( indentPolicy /= IndentPolicyLeft+         , docLines          $  [ docSeq               [ appSep $ docForceSingleline $ return patDoc               , docSetBaseY@@ -370,10 +386,12 @@               ]             ]          ++ wherePartMultiLine+         )        | Just patDoc <- [mPatDoc]        ]     ++ -- multiple clauses, each in a separate, single line-       [ docLines+       [ ( True+         , docLines          $  [ docAddBaseY BrIndentRegular               $   patPartParWrap               $   docLines@@ -396,10 +414,12 @@                       ]             ]          ++ wherePartMultiLine+         )        ]     ++ -- multiple clauses, each with the guard(s) in a single line, body        -- as a paragraph-       [ docLines+       [ ( True+         , docLines          $  [ docAddBaseY BrIndentRegular               $   patPartParWrap               $   docLines@@ -431,10 +451,12 @@                          ]             ]          ++ wherePartMultiLine+         )        ]     ++ -- multiple clauses, each with the guard(s) in a single line, body        -- in a new line as a paragraph-       [ docLines+       [ ( True+         , docLines          $  [ docAddBaseY BrIndentRegular               $   patPartParWrap               $   docLines@@ -464,9 +486,11 @@                        ]             ]          ++ wherePartMultiLine+         )        ]     ++ -- conservative approach: everything starts on the left.-       [ docLines+       [ ( True+         , docLines          $  [ docAddBaseY BrIndentRegular               $   patPartParWrap               $   docLines@@ -494,4 +518,5 @@                          ]             ]          ++ wherePartMultiLine+         )        ]
src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs view
@@ -13,916 +13,1051 @@  import           Language.Haskell.Brittany.Internal.Types import           Language.Haskell.Brittany.Internal.LayouterBasics--import           RdrName ( RdrName(..) )-import           GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) )-import           HsSyn-import           Name-import qualified FastString-import           BasicTypes--import           Language.Haskell.Brittany.Internal.Utils-import           Language.Haskell.Brittany.Internal.Layouters.Pattern-import           Language.Haskell.Brittany.Internal.Layouters.Decl-import           Language.Haskell.Brittany.Internal.Layouters.Stmt-import           Language.Haskell.Brittany.Internal.Layouters.Type----layoutExpr :: ToBriDoc HsExpr-layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of-  HsVar vname -> do-    docLit =<< lrdrNameToTextAnn vname-  HsUnboundVar var -> case var of-    OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname-    TrueExprHole oname -> docLit $ Text.pack $ occNameString oname-  HsRecFld{} -> do-    -- TODO-    briDocByExactInlineOnly "HsRecFld" lexpr-  HsOverLabel{} -> do-    -- TODO-    briDocByExactInlineOnly "HsOverLabel{}" lexpr-  HsIPVar{} -> do-    -- TODO-    briDocByExactInlineOnly "HsOverLabel{}" lexpr-  HsOverLit (OverLit olit _ _ _) -> do-    allocateNode $ overLitValBriDoc olit-  HsLit lit -> do-    allocateNode $ litBriDoc lit-  HsLam (MG (L _ [lmatch@(L _ (Match _ pats _ (GRHSs [lgrhs@(L _ (GRHS [] body))] (L _ EmptyLocalBinds))))]) _ _ _) -> 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]))-    docAlt-      [ -- single line-        docSeq-        [ docLit $ Text.pack "\\"-        , docWrapNode lmatch $ docForceSingleline funcPatternPartLine-        , appSep $ docLit $ Text.pack "->"-        , docWrapNode lgrhs $ docForceSingleline bodyDoc-        ]-        -- double line-      , docSetParSpacing-      $ docAddBaseY BrIndentRegular-      $ docPar-        (docSeq-          [ docLit $ Text.pack "\\"-          , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine-          , docLit $ Text.pack "->"-          ])-        (docWrapNode lgrhs $ docForceSingleline bodyDoc)-        -- wrapped par spacing-      , docSetParSpacing-      $ docSeq-        [ docLit $ Text.pack "\\"-        , docWrapNode lmatch $ docForceSingleline funcPatternPartLine-        , appSep $ docLit $ Text.pack "->"-        , docWrapNode lgrhs $ docForceParSpacing bodyDoc-        ]-        -- conservative-      , docSetParSpacing-      $ docAddBaseY BrIndentRegular-      $ docPar-        (docSeq-          [ docLit $ Text.pack "\\"-          , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine-          , docLit $ Text.pack "->"-          ])-        (docWrapNode lgrhs $ docNonBottomSpacing bodyDoc)-      ]-  HsLam{} ->-    unknownNodeError "HsLam too complex" lexpr-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */-  HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do-#else /* ghc-8.0 */-  HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do-#endif-    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])-        gather list = \case-          (L _ (HsApp l r)) -> gather (r:list) l-          x -> (x, list)-    let (headE, paramEs) = gather [exp2] exp1-    headDoc <- docSharedWrapper layoutExpr headE-    paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs-    docAlt-      [ -- foo x y-        docCols ColApp-      $ appSep (docForceSingleline headDoc)-      : spacifyDocs (docForceSingleline <$> paramDocs)-      , -- foo x-        --     y-        docSeq-        [ appSep (docForceSingleline headDoc)-        , docSetBaseY-        $ docAddBaseY BrIndentRegular-        $ docLines-        $ (docForceSingleline <$> paramDocs)-        ]-      , -- foo-        --   x-        --   y-        docSetParSpacing-      $ docAddBaseY BrIndentRegular-      $ docPar-        (docForceSingleline headDoc)-        ( docNonBottomSpacing-        $ docLines paramDocs-        )-      , -- ( multi-        --   line-        --   function-        -- )-        --   x-        --   y-        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-    expDoc2 <- docSharedWrapper layoutExpr exp2-    docAlt-      [ docSeq [appSep $ docForceSingleline expDoc1, docForceSingleline expDoc2]-      , docSetParSpacing-      $ docAddBaseY BrIndentRegular-      $ docSeq-        [ appSep $ docForceSingleline expDoc1-        , docForceParSpacing expDoc2-        ]-      , docSetParSpacing-      $ docAddBaseY BrIndentRegular-      $ docPar-        (docForceSingleline expDoc1)-        expDoc2-      , docAddBaseY BrIndentRegular-      $ docPar-        expDoc1-        expDoc2-      ]-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */-  HsAppType exp1 (HsWC _ ty1) -> do-#else /* ghc-8.0 */-  HsAppType exp1 (HsWC _ _ ty1) -> do-#endif-    t <- docSharedWrapper layoutType ty1-    e <- docSharedWrapper layoutExpr exp1-    docAlt-      [ docSeq-          [ docForceSingleline e-          , docSeparator-          , docLit $ Text.pack "@"-          , docForceSingleline t-          ]-      , docPar-          e-          (docSeq [docLit $ Text.pack "@", t ])-      ]-  HsAppTypeOut{} -> do-    -- 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)])-        gather opExprList = \case-          (L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1-          final -> (final, opExprList)-        (leftOperand, appList) = gather [] expLeft-    leftOperandDoc <- docSharedWrapper layoutExpr leftOperand-    appListDocs <- appList `forM` \(x,y) -> [ (xD, yD)-                                            | xD <- docSharedWrapper layoutExpr x-                                            , yD <- docSharedWrapper layoutExpr y-                                            ]-    opLastDoc <- docSharedWrapper layoutExpr expOp-    expLastDoc <- docSharedWrapper layoutExpr expRight-    let allowPar = case (expOp, expRight) of-          (L _ (HsVar (L _ (Unqual occname))), _)-            | occNameString occname == "$" -> True-          (_, L _ (HsApp _ (L _ HsVar{}))) -> False-          _ -> True-    docAlt-      [ 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-        ]-      -- this case rather leads to some unfortunate layouting than to anything-      -- useful; disabling for now. (it interfers with cols stuff.)-      -- , docSetBaseY-      -- - $ docPar-      --     leftOperandDoc-      --     ( docLines-      -- -    $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])-      --       ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]-      --     )-      , 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-    expDocRight <- docSharedWrapper layoutExpr expRight-    let allowPar = case (expOp, expRight) of-          (L _ (HsVar (L _ (Unqual occname))), _)-            | 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])-          ]-  NegApp op _ -> do-    opDoc <- docSharedWrapper layoutExpr op-    docSeq $ [ docLit $ Text.pack "-"-             , opDoc-             ]-  HsPar innerExp -> do-    innerExpDoc <- docSharedWrapper layoutExpr innerExp-    docAlt-      [ docSeq-        [ docLit $ Text.pack "("-        , docForceSingleline innerExpDoc-        , docLit $ Text.pack ")"-        ]-      , docSetBaseY $ docLines-        [ docCols ColOpPrefix-          [ docParenLSep-          , docAddBaseY (BrIndentSpecial 2) innerExpDoc-          ]-        , docLit $ Text.pack ")"-        ]-      ]-  SectionL left op -> do -- TODO: add to testsuite-    leftDoc <- docSharedWrapper layoutExpr left-    opDoc   <- docSharedWrapper layoutExpr op-    docSeq [leftDoc, opDoc]-  SectionR op right -> do -- TODO: add to testsuite-    opDoc    <- docSharedWrapper layoutExpr op-    rightDoc <- docSharedWrapper layoutExpr right-    docSeq [opDoc, rightDoc]-  ExplicitTuple args boxity-    | Just argExprs <- args `forM` (\case (L _ (Present e)) -> Just e; _ -> Nothing) -> do-    argDocs <- docSharedWrapper layoutExpr `mapM` argExprs-    hasComments <- hasAnyCommentsBelow lexpr-    let (openLit, closeLit) = case boxity of-          Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")")-          Unboxed -> (docLit $ Text.pack "(#", docLit $ Text.pack "#)")-    case splitFirstLast argDocs of-      FirstLastEmpty -> docSeq-        [ openLit-        , docNodeAnnKW lexpr (Just AnnOpenP) $ closeLit-        ]-      FirstLastSingleton e -> docAlt-        [ docCols ColTuple-          [ openLit-          , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e-          , closeLit-          ]-        , docSetBaseY $ docLines-          [ docSeq-            [ openLit-            , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e-            ]-          , 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]-          ]-  ExplicitTuple{} ->-    unknownNodeError "ExplicitTuple|.." lexpr -  HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do-    cExpDoc <- docSharedWrapper layoutExpr cExp-    binderDoc <- docLit $ Text.pack "->"-    funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches-    docAlt-      [ docSetParSpacing-      $ docAddBaseY BrIndentRegular-      $ docPar-        ( docSeq-          [ appSep $ docLit $ Text.pack "case"-          , appSep $ docForceSingleline cExpDoc-          , docLit $ Text.pack "of"-          ])-        (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)-      , docPar-          ( docAddBaseY BrIndentRegular-          $ docPar (docLit $ Text.pack "case") cExpDoc-          )-          ( docAddBaseY BrIndentRegular-          $ docPar (docLit $ Text.pack "of")-            (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)-          )-      ]-  HsIf _ ifExpr thenExpr elseExpr -> do-    ifExprDoc   <- docSharedWrapper layoutExpr ifExpr-    thenExprDoc <- docSharedWrapper layoutExpr thenExpr-    elseExprDoc <- docSharedWrapper layoutExpr elseExpr-    hasComments <- hasAnyCommentsBelow lexpr-    docAltFilter-      [ -- if _ then _ else _-        (,) (not hasComments)-      $ docSeq-        [ appSep $ docLit $ Text.pack "if"-        , appSep $ docForceSingleline ifExprDoc-        , appSep $ docLit $ Text.pack "then"-        , appSep $ docForceSingleline thenExprDoc-        , 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-          ( docAddBaseY (BrIndentSpecial 3)-          $ 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]-              , 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-              ]-            ])-      , -- 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 (BrIndentSpecial 3)-          $ 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 (BrIndentSpecial 3)-        $ 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-        ]-      ]-  HsMultiIf _ cases -> do-    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-    mBindDocs <- layoutLocalBinds binds-    -- this `docSetIndentLevel` might seem out of place, but is here due to-    -- ghc-exactprint's DP handling of "let" in particular.-    -- Just pushing another indentation level is a straightforward approach-    -- to making brittany idempotent, even though the result is non-optimal-    -- if "let" is moved horizontally as part of the transformation, as the-    -- comments before the first let item are moved horizontally with it.-    docSetIndentLevel $ case mBindDocs of-      Just [bindDoc] -> docAlt-        [ docSeq-          [ appSep $ docLit $ Text.pack "let"-          , appSep $ docForceSingleline $ return bindDoc-          , appSep $ docLit $ Text.pack "in"-          , docForceSingleline $ expDoc1-          ]-        , docLines-          [ docSeq-            [ appSep $ docLit $ Text.pack "let"-            , docSetBaseAndIndent $ return bindDoc-            ]-          , docSeq-            [ appSep $ docLit $ Text.pack "in "-            , docSetBaseY $ expDoc1-            ]-          ]-        , docLines-          [ docAddBaseY BrIndentRegular-          $ docPar-            (appSep $ docLit $ Text.pack "let")-            (docSetBaseAndIndent $ return bindDoc)-          , docAddBaseY BrIndentRegular-          $ docPar-            (appSep $ docLit $ Text.pack "in")-            (docSetBaseY $ expDoc1)-          ]-        ]-      Just bindDocs@(_:_) -> docAlt-        [ docLines-          [ docSeq-            [ appSep $ docLit $ Text.pack "let"-            , docSetBaseAndIndent $ docLines $ return <$> bindDocs-            ]-          , docSeq-            [ appSep $ docLit $ Text.pack "in "-            , docSetBaseY $ expDoc1-            ]-          ]-        , docLines-          [ docAddBaseY BrIndentRegular-          $ docPar-            (docLit $ Text.pack "let")-            (docSetBaseAndIndent $ docLines $ return <$> 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-    stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts-    docSetParSpacing-      $ docAddBaseY BrIndentRegular-      $ docPar-          (docLit $ Text.pack "do")-          (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)-  HsDo MDoExpr (L _ stmts) _ -> do-    stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts-    docSetParSpacing-      $ docAddBaseY BrIndentRegular-      $ docPar-          (docLit $ Text.pack "mdo")-          (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)-  HsDo x  (L _ stmts) _ | case x of { ListComp -> True-                                    ; MonadComp -> True-                                    ; _ -> False } -> do-    stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts-    hasComments <- hasAnyCommentsBelow lexpr-    docAltFilter-      [ (,) (not hasComments)-      $ docSeq-        [ docNodeAnnKW lexpr Nothing-        $ appSep-        $ docLit-        $ Text.pack "["-        , docNodeAnnKW lexpr (Just AnnOpenS)-        $ appSep-        $ docForceSingleline-        $ List.last stmtDocs-        , appSep $ docLit $ Text.pack "|"-        , docSeq $ List.intersperse docCommaSep-                $ fmap docForceSingleline $ List.init stmtDocs-        , docLit $ Text.pack " ]"-        ]-      , (,) True-      $ let-          start = docCols ColListComp-                    [ docNodeAnnKW lexpr Nothing-                    $ appSep $ docLit $ Text.pack "["-                    , docSetBaseY-                    $ docNodeAnnKW lexpr (Just AnnOpenS)-                    $ List.last stmtDocs-                    ]-          (s1:sM) = List.init stmtDocs-          line1 = docCols ColListComp-                    [appSep $ docLit $ Text.pack "|", s1]-          lineM = sM <&> \d ->-                  docCols ColListComp [docCommaSep, d]-          end   = docLit $ Text.pack "]"-        in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]-      ]-  HsDo{} -> do-    -- TODO-    unknownNodeError "HsDo{} no comp" lexpr-  ExplicitList _ _ elems@(_:_) -> do-    elemDocs <- elems `forM` docSharedWrapper layoutExpr-    hasComments <- hasAnyCommentsBelow lexpr-    case splitFirstLast elemDocs of-      FirstLastEmpty -> docSeq-        [ docLit $ Text.pack "["-        , docNodeAnnKW lexpr (Just AnnOpenS) $ docLit $ Text.pack "]"-        ]-      FirstLastSingleton e -> docAlt-        [ docSeq-          [ docLit $ Text.pack "["-          , docNodeAnnKW lexpr (Just AnnOpenS) $ docForceSingleline e-          , docLit $ Text.pack "]"-          ]-        , docSetBaseY $ docLines-          [ docSeq-            [ docLit $ Text.pack "["-            , docSeparator-            , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) $ e-            ]-          , docLit $ Text.pack "]"-          ]-        ]-      FirstLast e1 ems eN ->-        docAltFilter-          [  (,) (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]-          ]-  ExplicitList _ _ [] ->-    docLit $ Text.pack "[]"-  ExplicitPArr{} -> do-    -- TODO-    briDocByExactInlineOnly "ExplicitPArr{}" lexpr-  RecordCon lname _ _ (HsRecFields [] Nothing) -> do-    let t = lrdrNameToText lname-    docWrapNode lname $ docSeq-      [ docNodeAnnKW lexpr (Just AnnOpenC) $ docLit $ t <> Text.pack "{"-      , docLit $ Text.pack "}"-      ]-  RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do-    let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname-    ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do-      fExpDoc <- if pun-        then return Nothing-        else Just <$> docSharedWrapper layoutExpr fExpr-      return $ (fieldl, lrdrNameToText lnameF, fExpDoc)-    docAlt-      [ docSetParSpacing-      $ docAddBaseY BrIndentRegular-      $ docPar-          (docNodeAnnKW lexpr Nothing $ nameDoc)-          (docNonBottomSpacing $ docLines $ let-            line1 = docCols ColRecUpdate-              [ appSep $ docLit $ Text.pack "{"-              , docWrapNodePrior fd1l $ appSep $ docLit $ fd1n-              , case fd1e of-                  Just x -> docSeq-                    [ appSep $ docLit $ Text.pack "="-                    , docWrapNodeRest fd1l $ docAddBaseY BrIndentRegular $ x-                    ]-                  Nothing -> docEmpty-              ]-            lineR = fdr <&> \(lfield, fText, fDoc) -> docCols ColRecUpdate-              [ appSep $ docLit $ Text.pack ","-              , appSep $ docLit $ fText-              , case fDoc of-                  Just x -> docWrapNode lfield $ docSeq-                    [ appSep $ docLit $ Text.pack "="-                    , docAddBaseY BrIndentRegular x-                    ]-                  Nothing -> docEmpty-              ]-            lineN = docSeq-              [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty-              , docLit $ Text.pack "}"-              ]-            in [line1] ++ lineR ++ [lineN])-      -- TODO oneliner (?)-      ]-  RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do-    let t = lrdrNameToText lname-    docWrapNode lname $ docLit $ t <> Text.pack " {..}"-  RecordCon{} ->-    unknownNodeError "RecordCon with puns" lexpr-  RecordUpd rExpr [] _ _ _ _ -> do-    rExprDoc <- docSharedWrapper layoutExpr rExpr-    docSeq [rExprDoc, docLit $ Text.pack "{}"]-  RecordUpd rExpr fields@(_:_) _ _ _ _ -> do-    rExprDoc <- docSharedWrapper layoutExpr rExpr-    rFs@((rF1f, rF1n, rF1e):rFr) <- fields-      `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do-        rFExpDoc <- if pun-          then return Nothing-          else Just <$> docSharedWrapper layoutExpr rFExpr-        return $ case ambName of-          Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)-          Ambiguous   n _ -> (lfield, lrdrNameToText n, rFExpDoc)-    docAlt-      -- singleline-      [ 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 "}"-        ]-      -- wild-indentation block-      , 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-              [ appSep $ docLit $ Text.pack ","-              , 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]-        ]-      -- strict indentation block-      , docSetParSpacing-      $ docAddBaseY BrIndentRegular-      $ docPar-          (docNodeAnnKW lexpr Nothing $ rExprDoc)-          (docNonBottomSpacing $ docLines $ let-            line1 = docCols ColRecUpdate-              [ appSep $ docLit $ Text.pack "{"-              , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n-              , docWrapNodeRest rF1f $ case rF1e of-                  Just x -> docSeq [ appSep $ docLit $ Text.pack "="-                                   , docAddBaseY BrIndentRegular $ x-                                   ]-                  Nothing -> docEmpty-              ]-            lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate-              [ appSep $ docLit $ Text.pack ","-              , appSep $ docLit $ fText-              , case fDoc of-                  Just x ->  docSeq [ appSep $ docLit $ Text.pack "="-                                    , docAddBaseY BrIndentRegular x-                                    ]-                  Nothing -> docEmpty-              ]-            lineN = docSeq-              [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty-              , docLit $ Text.pack "}"-              ]-            in [line1] ++ lineR ++ [lineN])-      ]-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */-  ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do-#else /* ghc-8.0 */-  ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do-#endif-    expDoc <- docSharedWrapper layoutExpr exp1-    typDoc <- docSharedWrapper layoutType typ1-    docSeq-      [ appSep expDoc-      , appSep $ docLit $ Text.pack "::"-      , typDoc-      ]-  ExprWithTySigOut{} -> do-    -- TODO-    briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr-  ArithSeq _ Nothing info ->-    case info of-      From e1 -> do-        e1Doc <- docSharedWrapper layoutExpr e1-        docSeq-          [ docLit $ Text.pack "["-          , appSep $ docForceSingleline e1Doc-          , docLit $ Text.pack "..]"-          ]-      FromThen e1 e2 -> do-        e1Doc <- docSharedWrapper layoutExpr e1-        e2Doc <- docSharedWrapper layoutExpr e2-        docSeq-          [ docLit $ Text.pack "["-          , docForceSingleline e1Doc-          , appSep $ docLit $ Text.pack ","-          , appSep $ docForceSingleline e2Doc-          , docLit $ Text.pack "..]"-          ]-      FromTo e1 eN -> do-        e1Doc <- docSharedWrapper layoutExpr e1-        eNDoc <- docSharedWrapper layoutExpr eN-        docSeq-          [ docLit $ Text.pack "["-          , appSep $ docForceSingleline e1Doc-          , appSep $ docLit $ Text.pack ".."-          , docForceSingleline eNDoc-          , docLit $ Text.pack "]"-          ]-      FromThenTo e1 e2 eN -> do-        e1Doc <- docSharedWrapper layoutExpr e1-        e2Doc <- docSharedWrapper layoutExpr e2-        eNDoc <- docSharedWrapper layoutExpr eN-        docSeq-          [ docLit $ Text.pack "["-          , docForceSingleline e1Doc-          , appSep $ docLit $ Text.pack ","-          , appSep $ docForceSingleline e2Doc-          , appSep $ docLit $ Text.pack ".."-          , docForceSingleline eNDoc-          , docLit $ Text.pack "]"-          ]-  ArithSeq{} ->-    briDocByExactInlineOnly "ArithSeq" lexpr-  PArrSeq{} -> do-    -- TODO-    briDocByExactInlineOnly "PArrSeq{}" lexpr-  HsSCC{} -> do-    -- TODO-    briDocByExactInlineOnly "HsSCC{}" lexpr-  HsCoreAnn{} -> do-    -- TODO-    briDocByExactInlineOnly "HsCoreAnn{}" lexpr-  HsBracket{} -> do-    -- TODO-    briDocByExactInlineOnly "HsBracket{}" lexpr-  HsRnBracketOut{} -> do-    -- TODO-    briDocByExactInlineOnly "HsRnBracketOut{}" lexpr-  HsTcBracketOut{} -> do-    -- TODO-    briDocByExactInlineOnly "HsTcBracketOut{}" lexpr-  HsSpliceE{} -> do-    -- TODO-    briDocByExactInlineOnly "HsSpliceE{}" lexpr-  HsProc{} -> do-    -- TODO-    briDocByExactInlineOnly "HsProc{}" lexpr-  HsStatic{} -> do-    -- TODO-    briDocByExactInlineOnly "HsStatic{}" lexpr-  HsArrApp{} -> do-    -- TODO-    briDocByExactInlineOnly "HsArrApp{}" lexpr-  HsArrForm{} -> do-    -- TODO-    briDocByExactInlineOnly "HsArrForm{}" lexpr-  HsTick{} -> do-    -- TODO-    briDocByExactInlineOnly "HsTick{}" lexpr-  HsBinTick{} -> do-    -- TODO-    briDocByExactInlineOnly "HsBinTick{}" lexpr-  HsTickPragma{} -> do-    -- TODO-    briDocByExactInlineOnly "HsTickPragma{}" lexpr-  EWildPat{} -> do-    docLit $ Text.pack "_"-  EAsPat asName asExpr -> do-    docSeq-      [ docLit $ (lrdrNameToText asName) <> Text.pack "@"-      , layoutExpr asExpr-      ]-  EViewPat{} -> do-    -- TODO-    briDocByExactInlineOnly "EViewPat{}" lexpr-  ELazyPat{} -> do-    -- TODO-    briDocByExactInlineOnly "ELazyPat{}" lexpr-  HsWrap{} -> do-    -- TODO-    briDocByExactInlineOnly "HsWrap{}" lexpr-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */-  HsConLikeOut{} -> do-    -- TODO-    briDocByExactInlineOnly "HsWrap{}" lexpr-  ExplicitSum{} -> do-    -- TODO-    briDocByExactInlineOnly "ExplicitSum{}" lexpr+import           Language.Haskell.Brittany.Internal.Config.Types++import           RdrName ( RdrName(..) )+import           GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) )+import           HsSyn+import           Name+import qualified FastString+import           BasicTypes++import           Language.Haskell.Brittany.Internal.Utils+import           Language.Haskell.Brittany.Internal.Layouters.Pattern+import           Language.Haskell.Brittany.Internal.Layouters.Decl+import           Language.Haskell.Brittany.Internal.Layouters.Stmt+import           Language.Haskell.Brittany.Internal.Layouters.Type++++layoutExpr :: ToBriDoc HsExpr+layoutExpr lexpr@(L _ expr) = do+  indentPolicy <- mAsk+    <&> _conf_layout+    .>  _lconfig_indentPolicy+    .>  confUnpack+  let allowFreeIndent = indentPolicy == IndentPolicyFree+  docWrapNode lexpr $ case expr of+    HsVar vname -> do+      docLit =<< lrdrNameToTextAnn vname+    HsUnboundVar var -> case var of+      OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname+      TrueExprHole oname -> docLit $ Text.pack $ occNameString oname+    HsRecFld{} -> do+      -- TODO+      briDocByExactInlineOnly "HsRecFld" lexpr+    HsOverLabel{} -> do+      -- TODO+      briDocByExactInlineOnly "HsOverLabel{}" lexpr+    HsIPVar{} -> do+      -- TODO+      briDocByExactInlineOnly "HsOverLabel{}" lexpr+    HsOverLit (OverLit olit _ _ _) -> do+      allocateNode $ overLitValBriDoc olit+    HsLit lit -> do+      allocateNode $ litBriDoc lit+    HsLam (MG (L _ [lmatch@(L _ (Match _ pats _ (GRHSs [lgrhs@(L _ (GRHS [] body))] (L _ EmptyLocalBinds))))]) _ _ _) -> 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]))+      docAlt+        [ -- single line+          docSeq+          [ docLit $ Text.pack "\\"+          , docWrapNode lmatch $ docForceSingleline funcPatternPartLine+          , appSep $ docLit $ Text.pack "->"+          , docWrapNode lgrhs $ docForceSingleline bodyDoc+          ]+          -- double line+        , docSetParSpacing+        $ docAddBaseY BrIndentRegular+        $ docPar+          (docSeq+            [ docLit $ Text.pack "\\"+            , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine+            , docLit $ Text.pack "->"+            ])+          (docWrapNode lgrhs $ docForceSingleline bodyDoc)+          -- wrapped par spacing+        , docSetParSpacing+        $ docSeq+          [ docLit $ Text.pack "\\"+          , docWrapNode lmatch $ docForceSingleline funcPatternPartLine+          , appSep $ docLit $ Text.pack "->"+          , docWrapNode lgrhs $ docForceParSpacing bodyDoc+          ]+          -- conservative+        , docSetParSpacing+        $ docAddBaseY BrIndentRegular+        $ docPar+          (docSeq+            [ docLit $ Text.pack "\\"+            , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine+            , docLit $ Text.pack "->"+            ])+          (docWrapNode lgrhs $ docNonBottomSpacing bodyDoc)+        ]+    HsLam{} ->+      unknownNodeError "HsLam too complex" lexpr+#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+    HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do+#else /* ghc-8.0 */+    HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do+#endif+      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])+          gather list = \case+            (L _ (HsApp l r)) -> gather (r:list) l+            x -> (x, list)+      let (headE, paramEs) = gather [exp2] exp1+      headDoc <- docSharedWrapper layoutExpr headE+      paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs+      docAltFilter+        [ -- foo x y+          ( True+          , docCols ColApp+          $ 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+          $ docAddBaseY BrIndentRegular+          $ docPar+            (docForceSingleline headDoc)+            ( docNonBottomSpacing+            $ docLines paramDocs+            )+          )+        , -- ( multi+          --   line+          --   function+          -- )+          --   x+          --   y+          ( True+          , 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+      expDoc2 <- docSharedWrapper layoutExpr exp2+      docAlt+        [ -- func arg+          docSeq [appSep $ docForceSingleline expDoc1, docForceSingleline expDoc2]+        , -- func argline1+          --   arglines+          -- e.g.+          -- func if x+          --   then 1+          --   else 2+          docSetParSpacing+        $ docAddBaseY BrIndentRegular+        $ docSeq+          [ appSep $ docForceSingleline expDoc1+          , docForceParSpacing expDoc2+          ]+        , -- func+          --   arg+          docSetParSpacing+        $ docAddBaseY BrIndentRegular+        $ docPar+          (docForceSingleline expDoc1)+          (docNonBottomSpacing expDoc2)+        , -- fu+          --   nc+          --   ar+          --     gument+          docAddBaseY BrIndentRegular+        $ docPar+          expDoc1+          expDoc2+        ]+#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+    HsAppType exp1 (HsWC _ ty1) -> do+#else /* ghc-8.0 */+    HsAppType exp1 (HsWC _ _ ty1) -> do+#endif+      t <- docSharedWrapper layoutType ty1+      e <- docSharedWrapper layoutExpr exp1+      docAlt+        [ docSeq+            [ docForceSingleline e+            , docSeparator+            , docLit $ Text.pack "@"+            , docForceSingleline t+            ]+        , docPar+            e+            (docSeq [docLit $ Text.pack "@", t ])+        ]+    HsAppTypeOut{} -> do+      -- 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)])+          gather opExprList = \case+            (L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1+            final -> (final, opExprList)+          (leftOperand, appList) = gather [] expLeft+      leftOperandDoc <- docSharedWrapper layoutExpr leftOperand+      appListDocs <- appList `forM` \(x,y) -> [ (xD, yD)+                                              | xD <- docSharedWrapper layoutExpr x+                                              , yD <- docSharedWrapper layoutExpr y+                                              ]+      opLastDoc <- docSharedWrapper layoutExpr expOp+      expLastDoc <- docSharedWrapper layoutExpr expRight+      let allowPar = case (expOp, expRight) of+            (L _ (HsVar (L _ (Unqual occname))), _)+              | occNameString occname == "$" -> True+            (_, L _ (HsApp _ (L _ HsVar{}))) -> False+            _ -> True+      docAlt+        [ 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+          ]+        -- this case rather leads to some unfortunate layouting than to anything+        -- useful; disabling for now. (it interfers with cols stuff.)+        -- , docSetBaseY+        -- - $ docPar+        --     leftOperandDoc+        --     ( docLines+        -- -    $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])+        --       ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]+        --     )+        , 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+      expDocRight <- docSharedWrapper layoutExpr expRight+      let allowPar = case (expOp, expRight) of+            (L _ (HsVar (L _ (Unqual occname))), _)+              | 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])+            ]+    NegApp op _ -> do+      opDoc <- docSharedWrapper layoutExpr op+      docSeq $ [ docLit $ Text.pack "-"+               , opDoc+               ]+    HsPar innerExp -> do+      innerExpDoc <- docSharedWrapper layoutExpr innerExp+      docAlt+        [ docSeq+          [ docLit $ Text.pack "("+          , docForceSingleline innerExpDoc+          , docLit $ Text.pack ")"+          ]+        , docSetBaseY $ docLines+          [ docCols ColOpPrefix+            [ docParenLSep+            , docAddBaseY (BrIndentSpecial 2) innerExpDoc+            ]+          , docLit $ Text.pack ")"+          ]+        ]+    SectionL left op -> do -- TODO: add to testsuite+      leftDoc <- docSharedWrapper layoutExpr left+      opDoc   <- docSharedWrapper layoutExpr op+      docSeq [leftDoc, docSeparator, opDoc]+    SectionR op right -> do -- TODO: add to testsuite+      opDoc    <- docSharedWrapper layoutExpr op+      rightDoc <- docSharedWrapper layoutExpr right+      docSeq [opDoc, docSeparator, rightDoc]+    ExplicitTuple args boxity+      | Just argExprs <- args `forM` (\case (L _ (Present e)) -> Just e; _ -> Nothing) -> do+      argDocs <- docSharedWrapper layoutExpr `mapM` argExprs+      hasComments <- hasAnyCommentsBelow lexpr+      let (openLit, closeLit) = case boxity of+            Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")")+            Unboxed -> (docLit $ Text.pack "(#", docLit $ Text.pack "#)")+      case splitFirstLast argDocs of+        FirstLastEmpty -> docSeq+          [ openLit+          , docNodeAnnKW lexpr (Just AnnOpenP) $ closeLit+          ]+        FirstLastSingleton e -> docAlt+          [ docCols ColTuple+            [ openLit+            , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e+            , closeLit+            ]+          , docSetBaseY $ docLines+            [ docSeq+              [ openLit+              , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e+              ]+            , 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]+            ]+    ExplicitTuple{} ->+      unknownNodeError "ExplicitTuple|.." lexpr +    HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do+      cExpDoc <- docSharedWrapper layoutExpr cExp+      binderDoc <- docLit $ Text.pack "->"+      funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches+      docAlt+        [ docSetParSpacing+        $ docAddBaseY BrIndentRegular+        $ docPar+          ( docSeq+            [ appSep $ docLit $ Text.pack "case"+            , appSep $ docForceSingleline cExpDoc+            , docLit $ Text.pack "of"+            ])+          (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)+        , docPar+            ( docAddBaseY BrIndentRegular+            $ docPar (docLit $ Text.pack "case") cExpDoc+            )+            ( docAddBaseY BrIndentRegular+            $ docPar (docLit $ Text.pack "of")+              (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)+            )+        ]+    HsIf _ ifExpr thenExpr elseExpr -> do+      ifExprDoc   <- docSharedWrapper layoutExpr ifExpr+      thenExprDoc <- docSharedWrapper layoutExpr thenExpr+      elseExprDoc <- docSharedWrapper layoutExpr elseExpr+      hasComments <- hasAnyCommentsBelow lexpr+      let maySpecialIndent =+            case indentPolicy of+              IndentPolicyLeft -> BrIndentRegular+              _ -> BrIndentSpecial 3+      -- TODO: some of the alternatives (especially last and last-but-one)+      -- overlap.+      docAltFilter+        [ -- if _ then _ else _+          (,) (not hasComments)+        $ docSeq+          [ appSep $ docLit $ Text.pack "if"+          , appSep $ docForceSingleline ifExprDoc+          , appSep $ docLit $ Text.pack "then"+          , appSep $ docForceSingleline thenExprDoc+          , 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]+                , 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+                ]+              ])+        , -- 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+            $ 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+          ]+        ]+    HsMultiIf _ cases -> do+      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+      mBindDocs <- layoutLocalBinds binds+      -- this `docSetIndentLevel` might seem out of place, but is here due to+      -- ghc-exactprint's DP handling of "let" in particular.+      -- Just pushing another indentation level is a straightforward approach+      -- to making brittany idempotent, even though the result is non-optimal+      -- if "let" is moved horizontally as part of the transformation, as the+      -- comments before the first let item are moved horizontally with it.+      docSetIndentLevel $ case mBindDocs of+        Just [bindDoc] -> docAltFilter+          [ ( True+            , docSeq+              [ appSep $ docLit $ Text.pack "let"+              , appSep $ docForceSingleline $ return bindDoc+              , appSep $ docLit $ Text.pack "in"+              , docForceSingleline $ expDoc1+              ]+            )+          , ( indentPolicy /= IndentPolicyLeft+            , docLines+              [ docSeq+                [ appSep $ docLit $ Text.pack "let"+                , docSetBaseAndIndent $ return bindDoc+                ]+              , docSeq+                [ appSep $ docLit $ Text.pack "in "+                , docSetBaseY $ expDoc1+                ]+              ]+            )+          , ( True+            , docLines+              [ docAddBaseY BrIndentRegular+              $ docPar+                (appSep $ docLit $ Text.pack "let")+                (docSetBaseAndIndent $ return bindDoc)+              , docAddBaseY BrIndentRegular+              $ docPar+                (appSep $ docLit $ Text.pack "in")+                (docSetBaseY $ expDoc1)+              ]+            )+          ]+        Just bindDocs@(_:_) -> docAltFilter+          --either+          --  let+          --    a = b+          --    c = d+          --  in foo+          --    bar+          --    baz+          --or+          --  let+          --    a = b+          --    c = d+          --  in+          --    fooooooooooooooooooo+          [ ( indentPolicy == IndentPolicyLeft+            , docLines+              [ docAddBaseY BrIndentRegular+              $ docPar+                (docLit $ Text.pack "let")+                (docSetBaseAndIndent $ docLines $ return <$> bindDocs)+              , docSeq+                [ docLit $ Text.pack "in "+                , docAddBaseY BrIndentRegular $ expDoc1+                ]+              ]+            )+          , ( indentPolicy /= IndentPolicyLeft+            , docLines+              [ docSeq+                [ appSep $ docLit $ Text.pack "let"+                , docSetBaseAndIndent $ docLines $ return <$> bindDocs+                ]+              , docSeq+                [ appSep $ docLit $ Text.pack "in "+                , docSetBaseY $ expDoc1+                ]+              ]+            )+          , ( True+            , docLines+              [ docAddBaseY BrIndentRegular+              $ docPar+                (docLit $ Text.pack "let")+                (docSetBaseAndIndent $ docLines $ return <$> 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+      stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts+      docSetParSpacing+        $ docAddBaseY BrIndentRegular+        $ docPar+            (docLit $ Text.pack "do")+            (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)+    HsDo MDoExpr (L _ stmts) _ -> do+      stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts+      docSetParSpacing+        $ docAddBaseY BrIndentRegular+        $ docPar+            (docLit $ Text.pack "mdo")+            (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)+    HsDo x  (L _ stmts) _ | case x of { ListComp -> True+                                      ; MonadComp -> True+                                      ; _ -> False } -> do+      stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts+      hasComments <- hasAnyCommentsBelow lexpr+      docAltFilter+        [ (,) (not hasComments)+        $ docSeq+          [ docNodeAnnKW lexpr Nothing+          $ appSep+          $ docLit+          $ Text.pack "["+          , docNodeAnnKW lexpr (Just AnnOpenS)+          $ appSep+          $ docForceSingleline+          $ List.last stmtDocs+          , appSep $ docLit $ Text.pack "|"+          , docSeq $ List.intersperse docCommaSep+                  $ fmap docForceSingleline $ List.init stmtDocs+          , docLit $ Text.pack " ]"+          ]+        , (,) True+        $ let+            start = docCols ColListComp+                      [ docNodeAnnKW lexpr Nothing+                      $ appSep $ docLit $ Text.pack "["+                      , docSetBaseY+                      $ docNodeAnnKW lexpr (Just AnnOpenS)+                      $ List.last stmtDocs+                      ]+            (s1:sM) = List.init stmtDocs+            line1 = docCols ColListComp+                      [appSep $ docLit $ Text.pack "|", s1]+            lineM = sM <&> \d ->+                    docCols ColListComp [docCommaSep, d]+            end   = docLit $ Text.pack "]"+          in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]+        ]+    HsDo{} -> do+      -- TODO+      unknownNodeError "HsDo{} no comp" lexpr+    ExplicitList _ _ elems@(_:_) -> do+      elemDocs <- elems `forM` docSharedWrapper layoutExpr+      hasComments <- hasAnyCommentsBelow lexpr+      case splitFirstLast elemDocs of+        FirstLastEmpty -> docSeq+          [ docLit $ Text.pack "["+          , docNodeAnnKW lexpr (Just AnnOpenS) $ docLit $ Text.pack "]"+          ]+        FirstLastSingleton e -> docAlt+          [ docSeq+            [ docLit $ Text.pack "["+            , docNodeAnnKW lexpr (Just AnnOpenS) $ docForceSingleline e+            , docLit $ Text.pack "]"+            ]+          , docSetBaseY $ docLines+            [ docSeq+              [ docLit $ Text.pack "["+              , docSeparator+              , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) $ e+              ]+            , docLit $ Text.pack "]"+            ]+          ]+        FirstLast e1 ems eN ->+          docAltFilter+            [  (,) (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]+            ]+    ExplicitList _ _ [] ->+      docLit $ Text.pack "[]"+    ExplicitPArr{} -> do+      -- TODO+      briDocByExactInlineOnly "ExplicitPArr{}" lexpr+    RecordCon lname _ _ (HsRecFields [] Nothing) -> do+      let t = lrdrNameToText lname+      docWrapNode lname $ docSeq+        [ docNodeAnnKW lexpr (Just AnnOpenC) $ docLit $ t <> Text.pack "{"+        , docLit $ Text.pack "}"+        ]+    RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do+      let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname+      ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do+        fExpDoc <- if pun+          then return Nothing+          else Just <$> docSharedWrapper layoutExpr fExpr+        return $ (fieldl, lrdrNameToText lnameF, fExpDoc)+      let line1 appender wrapper =+            [ appender $ docLit $ Text.pack "{"+            , docWrapNodePrior fd1l $ appSep $ docLit $ fd1n+            , case fd1e of+                Just x -> docSeq+                  [ appSep $ docLit $ Text.pack "="+                  , docWrapNodeRest fd1l $ wrapper $ x+                  ]+                Nothing -> docEmpty+            ]+      let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->+            [ docCommaSep+            , appSep $ docLit $ fText+            , case fDoc of+                Just x -> docWrapNode lfield $ docSeq+                  [ appSep $ docLit $ Text.pack "="+                  , wrapper x+                  ]+                Nothing -> docEmpty+            ]+      let lineN =+            [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty+            , docLit $ Text.pack "}"+            ]+      docAlt+        [  docSeq+        $  [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator]+        ++ line1 id docForceSingleline+        ++ join (lineR docForceSingleline)+        ++ lineN+        , docSetParSpacing+        $ docAddBaseY BrIndentRegular+        $ docPar+            (docNodeAnnKW lexpr Nothing $ nameDoc)+            ( docNonBottomSpacing+            $ docLines+            $  [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]+            ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular))+            ++ [docSeq lineN]+            )+        ]+    RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do+      let t = lrdrNameToText lname+      docWrapNode lname $ docLit $ t <> Text.pack " {..}"+    RecordCon lname _ _ (HsRecFields fs@(_:_) (Just dotdoti)) | dotdoti == length fs -> do+      let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname+      ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do+        fExpDoc <- if pun+          then return Nothing+          else Just <$> docSharedWrapper layoutExpr fExpr+        return $ (fieldl, lrdrNameToText lnameF, fExpDoc)+      let line1 appender wrapper =+            [ appender $ docLit $ Text.pack "{"+            , docWrapNodePrior fd1l $ appSep $ docLit $ fd1n+            , case fd1e of+                Just x -> docSeq+                  [ appSep $ docLit $ Text.pack "="+                  , docWrapNodeRest fd1l $ wrapper $ x+                  ]+                Nothing -> docEmpty+            ]+      let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->+            [ docCommaSep+            , appSep $ docLit $ fText+            , case fDoc of+                Just x -> docWrapNode lfield $ docSeq+                  [ appSep $ docLit $ Text.pack "="+                  , wrapper x+                  ]+                Nothing -> docEmpty+            ]+      let lineDot =+            [ docCommaSep+            , docLit $ Text.pack ".."+            ]+      let lineN =+            [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty+            , docLit $ Text.pack "}"+            ]+      docAlt+        [  docSeq+        $  [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator]+        ++ line1 id docForceSingleline+        ++ join (lineR docForceSingleline)+        ++ lineDot+        ++ lineN+        , docSetParSpacing+        $ docAddBaseY BrIndentRegular+        $ docPar+            (docNodeAnnKW lexpr Nothing $ nameDoc)+            ( docNonBottomSpacing+            $ docLines+            $  [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]+            ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular))+            ++ [docSeq lineDot, docSeq lineN]+            )+        ]+    RecordCon{} ->+      unknownNodeError "RecordCon with puns" lexpr+    RecordUpd rExpr [] _ _ _ _ -> do+      rExprDoc <- docSharedWrapper layoutExpr rExpr+      docSeq [rExprDoc, docLit $ Text.pack "{}"]+    RecordUpd rExpr fields@(_:_) _ _ _ _ -> do+      rExprDoc <- docSharedWrapper layoutExpr rExpr+      rFs@((rF1f, rF1n, rF1e):rFr) <- fields+        `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do+          rFExpDoc <- if pun+            then return Nothing+            else Just <$> docSharedWrapper layoutExpr rFExpr+          return $ case ambName of+            Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)+            Ambiguous   n _ -> (lfield, lrdrNameToText n, rFExpDoc)+      docAltFilter+        -- singleline+        [ ( 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 "}"+            ]+          )+        -- wild-indentation block+        , ( 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 "="+                                      , 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]+            ]+          )+        -- strict indentation block+        , ( True+          , docSetParSpacing+          $ docAddBaseY BrIndentRegular+          $ docPar+              (docNodeAnnKW lexpr Nothing $ rExprDoc)+              (docNonBottomSpacing $ docLines $ let+                line1 = docCols ColRecUpdate+                  [ appSep $ docLit $ Text.pack "{"+                  , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n+                  , docWrapNodeRest rF1f $ case rF1e of+                      Just x -> docSeq [ appSep $ docLit $ Text.pack "="+                                      , docAddBaseY BrIndentRegular $ 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 "="+                                        , docAddBaseY BrIndentRegular x+                                        ]+                      Nothing -> docEmpty+                  ]+                lineN = docSeq+                  [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty+                  , docLit $ Text.pack "}"+                  ]+                in [line1] ++ lineR ++ [lineN])+          )+        ]+#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+    ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do+#else /* ghc-8.0 */+    ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do+#endif+      expDoc <- docSharedWrapper layoutExpr exp1+      typDoc <- docSharedWrapper layoutType typ1+      docSeq+        [ appSep expDoc+        , appSep $ docLit $ Text.pack "::"+        , typDoc+        ]+    ExprWithTySigOut{} -> do+      -- TODO+      briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr+    ArithSeq _ Nothing info ->+      case info of+        From e1 -> do+          e1Doc <- docSharedWrapper layoutExpr e1+          docSeq+            [ docLit $ Text.pack "["+            , appSep $ docForceSingleline e1Doc+            , docLit $ Text.pack "..]"+            ]+        FromThen e1 e2 -> do+          e1Doc <- docSharedWrapper layoutExpr e1+          e2Doc <- docSharedWrapper layoutExpr e2+          docSeq+            [ docLit $ Text.pack "["+            , docForceSingleline e1Doc+            , appSep $ docLit $ Text.pack ","+            , appSep $ docForceSingleline e2Doc+            , docLit $ Text.pack "..]"+            ]+        FromTo e1 eN -> do+          e1Doc <- docSharedWrapper layoutExpr e1+          eNDoc <- docSharedWrapper layoutExpr eN+          docSeq+            [ docLit $ Text.pack "["+            , appSep $ docForceSingleline e1Doc+            , appSep $ docLit $ Text.pack ".."+            , docForceSingleline eNDoc+            , docLit $ Text.pack "]"+            ]+        FromThenTo e1 e2 eN -> do+          e1Doc <- docSharedWrapper layoutExpr e1+          e2Doc <- docSharedWrapper layoutExpr e2+          eNDoc <- docSharedWrapper layoutExpr eN+          docSeq+            [ docLit $ Text.pack "["+            , docForceSingleline e1Doc+            , appSep $ docLit $ Text.pack ","+            , appSep $ docForceSingleline e2Doc+            , appSep $ docLit $ Text.pack ".."+            , docForceSingleline eNDoc+            , docLit $ Text.pack "]"+            ]+    ArithSeq{} ->+      briDocByExactInlineOnly "ArithSeq" lexpr+    PArrSeq{} -> do+      -- TODO+      briDocByExactInlineOnly "PArrSeq{}" lexpr+    HsSCC{} -> do+      -- TODO+      briDocByExactInlineOnly "HsSCC{}" lexpr+    HsCoreAnn{} -> do+      -- TODO+      briDocByExactInlineOnly "HsCoreAnn{}" lexpr+    HsBracket{} -> do+      -- TODO+      briDocByExactInlineOnly "HsBracket{}" lexpr+    HsRnBracketOut{} -> do+      -- TODO+      briDocByExactInlineOnly "HsRnBracketOut{}" lexpr+    HsTcBracketOut{} -> do+      -- TODO+      briDocByExactInlineOnly "HsTcBracketOut{}" lexpr+    HsSpliceE{} -> do+      -- TODO+      briDocByExactInlineOnly "HsSpliceE{}" lexpr+    HsProc{} -> do+      -- TODO+      briDocByExactInlineOnly "HsProc{}" lexpr+    HsStatic{} -> do+      -- TODO+      briDocByExactInlineOnly "HsStatic{}" lexpr+    HsArrApp{} -> do+      -- TODO+      briDocByExactInlineOnly "HsArrApp{}" lexpr+    HsArrForm{} -> do+      -- TODO+      briDocByExactInlineOnly "HsArrForm{}" lexpr+    HsTick{} -> do+      -- TODO+      briDocByExactInlineOnly "HsTick{}" lexpr+    HsBinTick{} -> do+      -- TODO+      briDocByExactInlineOnly "HsBinTick{}" lexpr+    HsTickPragma{} -> do+      -- TODO+      briDocByExactInlineOnly "HsTickPragma{}" lexpr+    EWildPat{} -> do+      docLit $ Text.pack "_"+    EAsPat asName asExpr -> do+      docSeq+        [ docLit $ (lrdrNameToText asName) <> Text.pack "@"+        , layoutExpr asExpr+        ]+    EViewPat{} -> do+      -- TODO+      briDocByExactInlineOnly "EViewPat{}" lexpr+    ELazyPat{} -> do+      -- TODO+      briDocByExactInlineOnly "ELazyPat{}" lexpr+    HsWrap{} -> do+      -- TODO+      briDocByExactInlineOnly "HsWrap{}" lexpr+#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+    HsConLikeOut{} -> do+      -- TODO+      briDocByExactInlineOnly "HsWrap{}" lexpr+    ExplicitSum{} -> do+      -- TODO+      briDocByExactInlineOnly "ExplicitSum{}" lexpr #endif  
src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs view
@@ -96,6 +96,26 @@       [ appSep $ docLit t       , docLit $ Text.pack "{..}"       ]+  ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do+    let t = lrdrNameToText lname+    fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do+      fExpDoc <- if pun+        then return Nothing+        else Just <$> docSharedWrapper layoutPat fPat+      return $ (lrdrNameToText lnameF, fExpDoc)+    fmap Seq.singleton $ docSeq+      [ appSep $ docLit t+      , appSep $ docLit $ Text.pack "{"+      , docSeq $ fds >>= \case+          (fieldName, Just fieldDoc) ->+            [ appSep $ docLit $ fieldName+            , appSep $ docLit $ Text.pack "="+            , fieldDoc >>= colsWrapPat+            , docCommaSep+            ]+          (fieldName, Nothing) -> [docLit fieldName, docCommaSep]+      , docLit $ Text.pack "..}"+      ]   TuplePat args boxity _ -> do     case boxity of       Boxed   -> wrapPatListy args "(" ")"
src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs view
@@ -11,6 +11,7 @@  import           Language.Haskell.Brittany.Internal.Types import           Language.Haskell.Brittany.Internal.LayouterBasics+import           Language.Haskell.Brittany.Internal.Config.Types  import           RdrName ( RdrName(..) ) import           GHC ( runGhc, GenLocated(L), moduleNameString )@@ -26,51 +27,91 @@   layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName))-layoutStmt lstmt@(L _ stmt) = docWrapNode lstmt $ case stmt of-  LastStmt body False _    -> do-    layoutExpr body-  BindStmt lPat expr _ _ _ -> do-    patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat-    expDoc <- docSharedWrapper layoutExpr expr-    docAlt-      [ docCols-        ColBindStmt-        [ appSep patDoc-        , docSeq [appSep $ docLit $ Text.pack "<-", docForceParSpacing expDoc]-        ]-      , docCols-        ColBindStmt-        [ appSep patDoc-        , docAddBaseY BrIndentRegular-          $ docPar (docLit $ Text.pack "<-") (expDoc)+layoutStmt lstmt@(L _ stmt) = do+  indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack+  docWrapNode lstmt $ case stmt of+    LastStmt body False _ -> do+      layoutExpr body+    BindStmt lPat expr _ _ _ -> do+      patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat+      expDoc <- docSharedWrapper layoutExpr expr+      docAlt+        [ docCols+          ColBindStmt+          [ appSep patDoc+          , docSeq [appSep $ docLit $ Text.pack "<-", docForceParSpacing expDoc]+          ]+        , docCols+          ColBindStmt+          [ appSep patDoc+          , docAddBaseY BrIndentRegular+            $ 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-      [ docCols-        ColDoLet-        [ appSep $ docLit $ Text.pack "let"-        , docSetBaseAndIndent $ return bindDoc+    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+          ]+        , -- let+          --   bind = expr+          docAddBaseY BrIndentRegular $ docPar+          (docLit $ Text.pack "let")+          (docSetBaseAndIndent $ return bindDoc)         ]-      , docAddBaseY BrIndentRegular-        $ docPar (docLit $ Text.pack "let")-                 (docSetBaseAndIndent $ return bindDoc)-      ]-    Just bindDocs  -> docAlt-      [ docSeq-        [ appSep $ docLit $ Text.pack "let"-        , docSetBaseAndIndent $ docLines $ return <$> bindDocs+      Just bindDocs -> docAltFilter+        [ -- let aaa = expra+          --     bbb = exprb+          --     ccc = exprc+          ( indentPolicy /= IndentPolicyLeft+          , docSeq+            [ appSep $ docLit $ Text.pack "let"+            , docSetBaseAndIndent $ docLines $ return <$> bindDocs+            ]+          )+        , -- let+          --   aaa = expra+          --   bbb = exprb+          --   ccc = exprc+          ( True+          , docAddBaseY BrIndentRegular $ docPar+            (docLit $ Text.pack "let")+            (docSetBaseAndIndent $ docLines $ return <$> bindDocs)+          )         ]-      , docAddBaseY BrIndentRegular $ docPar-        (docLit $ Text.pack "let")-        (docSetBaseAndIndent $ docLines $ return <$> bindDocs)+    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)+        )       ]-  BodyStmt expr _ _ _      -> do-    expDoc <- docSharedWrapper layoutExpr expr-    docAddBaseY BrIndentRegular $ expDoc-  _                        -> briDocByExactInlineOnly "some unknown statement" lstmt+    BodyStmt expr _ _ _ -> do+      expDoc <- docSharedWrapper layoutExpr expr+      docAddBaseY BrIndentRegular $ expDoc+    _ -> briDocByExactInlineOnly "some unknown statement" lstmt
src/Language/Haskell/Brittany/Internal/Layouters/Type.hs view
@@ -14,7 +14,11 @@ import           Language.Haskell.Brittany.Internal.LayouterBasics  import           RdrName ( RdrName(..) )-import           GHC ( runGhc, GenLocated(L), moduleNameString )+import           GHC ( runGhc+                     , GenLocated(L)+                     , moduleNameString+                     , AnnKeywordId (..)+                     ) import           Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey ) import           HsSyn import           Name@@ -29,12 +33,20 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of   -- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible" #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */-  HsTyVar _ name -> do+  HsTyVar promoted name -> do+    t <- lrdrNameToTextAnn name+    case promoted of+      Promoted -> docSeq+        [ docSeparator+        , docTick+        , docWrapNode name $ docLit t+        ]+      NotPromoted -> docWrapNode name $ docLit t #else /* ghc-8.0 */   HsTyVar name -> do-#endif     t <- lrdrNameToTextAnn name     docWrapNode name $ docLit t+#endif   HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts@(_:_)) typ2)) -> do     typeDoc <- docSharedWrapper layoutType typ2     tyVarDocs <- bndrs `forM` \case@@ -162,17 +174,17 @@         , docForceSingleline $ return $ typeDoc         ]       -- :: forall x-      -- .  x+      --  . x       , docPar           (docSeq $ docLit (Text.pack "forall") : tyVarDocLineList)           ( docCols ColTyOpPrefix-            [ docWrapNodeRest ltype $ docLit $ Text.pack ". "+            [ docWrapNodeRest ltype $ docLit $ Text.pack " . "             , maybeForceML $ return typeDoc             ]           )       -- :: forall       --      (x :: *)-      -- .  x+      --  . x       , docPar           (docLit (Text.pack "forall"))           (docLines@@ -192,7 +204,7 @@                   ]             )           ++[ docCols ColTyOpPrefix-              [ docWrapNodeRest ltype $ docLit $ Text.pack ". "+              [ docWrapNodeRest ltype $ docLit $ Text.pack " . "               , maybeForceML $ return typeDoc               ]             ]@@ -294,7 +306,7 @@     docAlt       [ docSeq         [ docForceSingleline typeDoc1-        , docLit $ Text.pack " "+        , docSeparator         , docForceSingleline typeDoc2         ]       , docPar@@ -324,7 +336,7 @@     docAlt       [ docSeq       $ docForceSingleline docHead : (docRest >>= \d ->-        [ docLit $ Text.pack " ", docForceSingleline d ])+        [ docSeparator, docForceSingleline d ])       , docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest)       ]   HsAppsTy (typHead:typRest) -> do@@ -333,7 +345,7 @@     docAlt       [ docSeq       $ docForceSingleline docHead : (docRest >>= \d ->-        [ docLit $ Text.pack " ", docForceSingleline d ])+        [ docSeparator, docForceSingleline d ])       , docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest)       ]     where@@ -487,7 +499,7 @@           )           (docCols ColTyOpPrefix             [ docWrapNodeRest ltype-            $ docLit $ Text.pack "::"+            $ docLit $ Text.pack ":: "             , docAddBaseY (BrIndentSpecial 2) typeDoc1             ])       ]@@ -513,19 +525,47 @@   HsKindSig typ1 kind1 -> do     typeDoc1 <- docSharedWrapper layoutType typ1     kindDoc1 <- docSharedWrapper layoutType kind1+    hasParens <- hasAnnKeyword ltype AnnOpenP     docAlt-      [ docSeq-        [ docForceSingleline typeDoc1-        , docLit $ Text.pack " :: "-        , docForceSingleline kindDoc1-        ]-      , docPar+      [ if hasParens+        then docSeq+          [ docLit $ Text.pack "("+          , docForceSingleline typeDoc1+          , docSeparator+          , docLit $ Text.pack "::"+          , docSeparator+          , docForceSingleline kindDoc1+          , docLit $ Text.pack ")"+          ]+        else docSeq+          [ docForceSingleline typeDoc1+          , docSeparator+          , docLit $ Text.pack "::"+          , docSeparator+          , docForceSingleline kindDoc1+          ]+      , if hasParens+        then docLines+          [ docCols+            ColTyOpPrefix+            [ docWrapNodeRest ltype $ docParenLSep+            , docAddBaseY (BrIndentSpecial 3) $ typeDoc1+            ]+          , docCols+            ColTyOpPrefix+            [ docWrapNodeRest ltype $ docLit $ Text.pack ":: "+            , docAddBaseY (BrIndentSpecial 3) kindDoc1+            ]+          , (docLit $ Text.pack ")")+          ]+        else docPar           typeDoc1-          ( docCols ColTyOpPrefix-              [ docWrapNodeRest ltype-              $ docLit $ Text.pack ":: "-              , docAddBaseY (BrIndentSpecial 3) kindDoc1-              ])+          ( docCols+            ColTyOpPrefix+            [ docWrapNodeRest ltype $ docLit $ Text.pack ":: "+            , docAddBaseY (BrIndentSpecial 3) kindDoc1+            ]+          )       ]   HsBangTy{} -> -- TODO     briDocByExactInlineOnly "HsBangTy{}" ltype
srcinc/prelude.inc view
@@ -136,7 +136,7 @@ import qualified Control.Monad.Trans.State as State import qualified Control.Monad.Trans.State.Lazy as StateL import qualified Control.Monad.Trans.State.Strict as StateS-import qualified Control.Monad.Trans.Either as EitherT+import qualified Control.Monad.Trans.Except as ExceptT  import qualified Data.Strict.Maybe as Strict