brittany 0.9.0.0 → 0.9.0.1

raw patch · 18 files changed

+306/−105 lines, 18 filesdep ~butcherdep ~ghc-exactprintPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: butcher, ghc-exactprint

API changes (from Hackage documentation)

Files

• ChangeLog.md +17/−0
• README.md +47/−11
• brittany.cabal +3/−3
• src-brittany/Main.hs +13/−12
• src-literatetests/10-tests.blt +20/−3
• src-literatetests/15-regressions.blt +15/−3
• src-literatetests/Main.hs +1/−0
• src-literatetests/tests-context-free.blt +10/−5
• src-unittests/TestUtils.hs +1/−0
• src/Language/Haskell/Brittany/Internal.hs +5/−0
• src/Language/Haskell/Brittany/Internal/Backend.hs +5/−1
• src/Language/Haskell/Brittany/Internal/Config.hs +5/−3
• src/Language/Haskell/Brittany/Internal/Config/Types.hs +11/−0
• src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +21/−6
• src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +64/−22
• src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +32/−33
• src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs +33/−3
• src/Language/Haskell/Brittany/Internal/PreludeUtils.hs +3/−0

@@ -1,10 +1,27 @@ # Revision history for brittany +## 0.9.0.1  -- February 2018++* Support `TupleSections` (thanks to Matthew Piziak)+* Bugfixes:+    - Fix Shebang handling with stdin input (#92)+    - Fix bug that effectively deleted strict/lazy matches (BangPatterns) (#116)+    - Fix infix operator whitespace bug (#101, #114)+    - Fix help command output and its layouting (#103)+    - Fix crash when config dir does not exist yet (#115)+* Layouting changes:+    - no space after opening non-tuple parenthesis even for multi-line case+    - use spaces around infix operators (applies to sections and in pattern+      matches)+    - Let-in is layouted more flexibly in fewer lines, if possible+      (thanks to Evan Borden)+ ## 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+* Support per-project config * ! Slight rework of the commandline interface:     - Support multiple inputs and outputs     - Support inplace-transformation for multiple files via

@@ -43,14 +43,21 @@   accidentally quadratic sub-algorithm); noticable for inputs with >1k loc.~~   (fixed in `0.8.0.3`) +## Try without Installing++You can [paste haskell code over here](https://hexagoxel.de/brittany/)+to test how it gets formatted by brittany. (Rg. privacy: the server does+log the size of the input, but _not_ the full requests.)+ # Other usage notes  - Supports GHC versions `8.0.*` and `8.2.*`.-- as of November'17, `brittany` is available on stackage nightly.+- included in stackage with lts>=10.0 (or nightlies dating to >=2017-11-15) - config (file) documentation is lacking. - some config values can not be configured via commandline yet.-- uses/creates user config file in `~/.brittany/config.yaml`;-  also reads `brittany.yaml` in current dir if present.+- uses/creates user config file in `~/.config/brittany/config.yaml`;+  also reads (the first) `brittany.yaml` found in current or parent+  directories.  # Installation @@ -75,23 +82,52 @@     cp `./find dist-newstyle/build/ -type f -name brittany` $HOME/.cabal/bin/     ~~~~ -- via `stack`+- via `stack` using a sufficiently recent stackage snapshot (dated to >= 2017-11-15)      ~~~~.sh-    git clone https://github.com/lspitzner/brittany.git-    cd brittany-    stack install+    stack install brittany # --resolver lts-10.0     ~~~~ +    (earlier ltss did not include `brittany` yet, but the repo should contain a+    `stack.yaml` that works with ghc-8.0.) +- on ArchLinux via [the britanny AUR package](https://aur.archlinux.org/packages/brittany/)+  using `aura`:+    ~~~~.sh+    aura -A brittany+    ~~~~++# Editor Integration++#### Sublime text+  [In this gist](https://gist.github.com/lspitzner/097c33177248a65e7657f0c6d0d12075)+  I have described a haskell setup that includes a shortcut to run brittany formatting.+#### VSCode+  [This extension](https://marketplace.visualstudio.com/items?itemName=MaxGabriel.brittany)+  connects commandline `brittany` to VSCode formatting API. Thanks to @MaxGarbriel.+#### Via HIE+  [haskell-ide-engine](https://github.com/haskell/haskell-ide-engine)+  includes a `brittany` plugin that directly uses the brittany library.+  Relevant for any editors that properly support the language-server-protocol.+#### Neovim / Vim 8+  The [Neoformat](https://github.com/sbdchd/neoformat) plugin comes with support for+  brittany built in.+ # Usage -- Currently one mode of operation: Transform a single module. By default read-  from `stdin` and written to `stdout`, but commandline arguments allow to-  read/write from/to files.+- Default mode of operation: Transform a single module, from `stdin` to `stdout`.+  Can pass one or multiple files as input, and there is a flag to override them+  in place instead of using `stdout` (since 0.9.0.0). So:+  +    ~~~~ .sh+    brittany                           # stdin -> stdout+    brittany mysource.hs               # ./mysource.hs -> stdout+    brittany --write-mode=inplace *.hs # apply formatting to all ./*.hs inplace+    ~~~~+     - For stdin/stdout usage it makes sense to enable certain syntactic extensions   by default, i.e. to add something like this to your-  `~/.brittany/config.yaml` (execute `brittany` once to create default):+  `~/.config/brittany/config.yaml` (execute `brittany` once to create default):      ~~~~     conf_forward:

@@ -1,5 +1,5 @@ name:                 brittany-version:              0.9.0.0+version:              0.9.0.1 synopsis:             Haskell source code formatter description: {   See <https://github.com/lspitzner/brittany/blob/master/README.md the README>.@@ -82,7 +82,7 @@     { base >=4.9 && <4.11     , ghc >=8.0.1 && <8.3     , ghc-paths >=0.1.0.9 && <0.2-    , ghc-exactprint >=0.5.3.0 && <0.6+    , ghc-exactprint >=0.5.6.0 && <0.5.7     , transformers >=0.5.2.0 && <0.6     , containers >=0.5.7.1 && <0.6     , mtl >=2.2.1 && <2.3@@ -94,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.2 && <1.3+    , butcher >=1.3 && <1.4     , yaml >=0.8.18 && <0.9     , aeson >=1.0.1.0 && <1.3     , extra >=1.4.10 && <1.7

@@ -82,9 +82,10 @@       ]   , parDocW     [ "This program is written carefully and contains safeguards to ensure"-    , "the transformation does not change semantics (or the syntax tree at all)"-    , "and that no comments are removed."-    , "Nonetheless, this is a young project, and there will always be bugs."+    , "the output is syntactically valid and that no comments are removed."+    , "Nonetheless, this is a young project, and there will always be bugs,"+    , "and ensuring that the transformation never changes semantics of the"+    , "transformed source is currently not possible."     , "Please do check the output and do not let brittany override your large"     , "codebase without having backups."     ]@@ -140,16 +141,16 @@     ""     ["write-mode"]     "(display|inplace)"-    Flag-      { _flag_help    = Just $ PP.vcat+    (  flagHelp+        ( PP.vcat           [ PP.text "display: output for any input(s) goes to stdout"           , PP.text "inplace: override respective input file (without backup!)"           ]-      , _flag_default = Just Display-      }-  inputParams <- addParamNoFlagStrings "PATH" (paramHelpStr "paths to input haskell source files")+        )+    <> flagDefault Display+    )+  inputParams <- addParamNoFlagStrings "PATH" (paramHelpStr "paths to input/inout haskell source files")   reorderStop-  desc        <- peekCmdDesc   addCmdImpl $ void $ do     when printLicense $ do       print licenseDoc@@ -161,7 +162,7 @@         putStrLn $ "There is NO WARRANTY, to the extent permitted by law."       System.Exit.exitSuccess     when printHelp $ do-      liftIO $ print $ ppHelpShallow desc+      liftIO $ putStrLn $ PP.renderStyle PP.style { PP.ribbonsPerLine = 1.0 } $ ppHelpShallow helpDesc       System.Exit.exitSuccess      let inputPaths  = if null inputParams then [Nothing] else map Just inputParams@@ -281,7 +282,7 @@             putErrorLn               $  "Error: detected unprocessed comments."               ++ " The transformation output will most likely"-              ++ " not contain certain of the comments"+              ++ " not contain some of the comments"               ++ " present in the input haskell source file."             putErrorLn $ "Affected are the following comments:"             unused `forM_` \case@@ -346,7 +347,7 @@       userConfigXdg    <- readConfig userConfigPathXdg       let userConfig = userConfigSimple <|> userConfigXdg       when (Data.Maybe.isNothing userConfig) $ do-        liftIO $ Directory.createDirectoryIfMissing False userBritPathXdg+        liftIO $ Directory.createDirectoryIfMissing True userBritPathXdg         writeDefaultConfig userConfigPathXdg       -- rightmost has highest priority       pure $ [userConfig, localConfig]

@@ -349,13 +349,16 @@ func (A a) = a  #test list constructor-func (x:xr) = x+func (x : xr) = x  #test some other constructor symbol #pending-func (x:+:xr) = x+func (x :+: xr) = x +#test normal infix constructor+func (x `Foo` xr) = x + ############################################################################### ############################################################################### ###############################################################################@@ -476,8 +479,22 @@ #group tuples ### -#test 1+#test pair func = (abc, def)++#test pair section left+func = (abc, )++#test pair section right+func = (, abc)++#test quintuple section long+myTupleSection =+  ( verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargefirstelement+  ,+  , verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargethirdelement+  ,+  )  #test 2 #pending

@@ -123,8 +123,8 @@ #test list comprehension comment placement func =   [ (thing, take 10 alts) --TODO: select best ones-  | (thing, _got, alts@(_:_)) <- nosuchFooThing-  , gast                      <- award+  | (thing, _got, alts@(_ : _)) <- nosuchFooThing+  , gast                        <- award   ]  #test if-then-else comment placement@@ -219,7 +219,7 @@           , entry             "Versions installed"             installedVersions-            ( altText+            (altText               null               (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")             )@@ -513,3 +513,15 @@ #test issue 70 {-# LANGUAGE TemplateHaskell #-} deriveFromJSON (unPrefix "assignPost") ''AssignmentPost++#test issue 116+{-# LANGUAGE BangPatterns #-}+func = do+  let !forced = some+  pure ()++#test let-in-hanging+spanKey p q = case minViewWithKey q of+  Just ((k, _), q') | p k ->+    let (kas, q'') = spanKey p q' in ((k, a) : kas, q'')+  _ -> ([], q)

@@ -173,6 +173,7 @@     , _lconfig_columnAlignMode           = coerce (ColumnAlignModeMajority 0.7)     , _lconfig_alignmentLimit            = coerce (30 :: Int)     , _lconfig_alignmentBreakOnMultiline = coerce True+    , _lconfig_hangingTypeSignature      = coerce False     }   , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)     { _econf_omit_output_valid_check = coerce True

@@ -366,11 +366,11 @@ func (A a) = a  #test list constructor-func (x:xr) = x+func (x : xr) = x  #test some other constructor symbol #pending-func (x:+:xr) = x+func (x :+: xr) = x   ###############################################################################@@ -510,8 +510,13 @@ func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd   , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd) +#test let in on single line+foo =+  let longIdentifierForShortValue = 1+  in longIdentifierForShortValue + longIdentifierForShortValue  + ############################################################################### ############################################################################### ###############################################################################@@ -714,7 +719,7 @@  #test some indentation thingy func =-  ( lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj+  (lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj   $ abc   $ def   $ ghi@@ -743,7 +748,7 @@ #test list comprehension comment placement func =   [ (thing, take 10 alts) --TODO: select best ones-  | (thing, _got, alts@(_:_)) <- nosuchFooThing+  | (thing, _got, alts@(_ : _)) <- nosuchFooThing   , gast <- award   ] @@ -840,7 +845,7 @@           , entry             "Versions installed"             installedVersions-            ( altText+            (altText               null               (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")             )

@@ -55,6 +55,7 @@     , _lconfig_columnAlignMode           = coerce (ColumnAlignModeMajority 0.7)     , _lconfig_alignmentLimit            = coerce (30 :: Int)     , _lconfig_alignmentBreakOnMultiline = coerce True+    , _lconfig_hangingTypeSignature      = coerce False     }   , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)     { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever

@@ -61,6 +61,11 @@ -- -- Note that this function ignores/resets all config values regarding -- debugging, i.e. it will never use `trace`/write to stderr.+--+-- Note that the ghc parsing function used internally currently is wrapped in+-- `mask_`, so cannot be killed easily. If you don't control the input, you+-- may wish to put some proper upper bound on the input's size as a timeout+-- won't do. parsePrintModule :: Config -> Text -> IO (Either [BrittanyError] Text) parsePrintModule configRaw inputText = runExceptT $ do   let config = configRaw { _conf_debug = _conf_debug staticDefaultConfig }

@@ -352,7 +352,11 @@       -- maxZipper xs [] = xs       -- maxZipper (x:xr) (y:yr) = max x y : maxZipper xr yr       colAggregation :: [Int] -> Int-      colAggregation xs = maximum [ x | x <- xs, x < minimum xs + alignMax ]+      colAggregation [] = 0 -- this probably cannot happen the way we call+                            -- this function, because _cbs_map only ever+                            -- contains nonempty Seqs.+      colAggregation xs = maximum [ x | x <- xs, x <= minimum xs + alignMax' ]+        where alignMax' = max 0 alignMax        processedMap :: ColMap2       processedMap =

@@ -63,6 +63,7 @@     , _lconfig_columnAlignMode           = coerce (ColumnAlignModeMajority 0.7)     , _lconfig_alignmentLimit            = coerce (30 :: Int)     , _lconfig_alignmentBreakOnMultiline = coerce True+    , _lconfig_hangingTypeSignature      = coerce False     }   , _conf_errorHandling = ErrorHandlingConfig     { _econf_produceOutputOnErrors   = coerce False@@ -104,7 +105,7 @@   cols               <- addFlagReadParams "" ["columns"] "AMOUNT" (flagHelpStr "target max columns (80 is an old default for this)")   importCol          <- addFlagReadParams "" ["import-col"] "N" (flagHelpStr "column to align import lists at") -  dumpConfig         <- addSimpleBoolFlag "" ["dump-config"] (flagHelp $ parDoc "dump the programs full config (commandline + file + defaults)")+  dumpConfig         <- addSimpleBoolFlag "" ["dump-config"] (flagHelp $ parDoc "dump the programs full config (merged commandline + file + defaults)")   dumpAnnotations    <- addSimpleBoolFlag "" ["dump-annotations"] (flagHelp $ parDoc "dump the full annotations returned by ghc-exactprint")   dumpUnknownAST     <- addSimpleBoolFlag "" ["dump-ast-unknown"] (flagHelp $ parDoc "dump the ast for any nodes not transformed, but copied as-is by brittany")   dumpCompleteAST    <- addSimpleBoolFlag "" ["dump-ast-full"] (flagHelp $ parDoc "dump the full ast")@@ -118,9 +119,9 @@   dumpBriDocIndent  <- addSimpleBoolFlag "" ["dump-bridoc-indent"] (flagHelp $ parDoc "dump the partially transformed bridoc: after transformation: indent")   dumpBriDocFinal   <- addSimpleBoolFlag "" ["dump-bridoc-final"] (flagHelp $ parDoc "dump the post-transformation bridoc") -  outputOnErrors <- addSimpleBoolFlag "" ["output-on-errors"] (flagHelp $ parDoc "even when there are errors, produce output (or try to to the degree possible")+  outputOnErrors <- addSimpleBoolFlag "" ["output-on-errors"] (flagHelp $ parDoc "even when there are errors, produce output (or try to to the degree possible)")   wError            <- addSimpleBoolFlag "" ["werror"] (flagHelp $ parDoc "treat warnings as errors")-  omitValidCheck    <- addSimpleBoolFlag "" ["omit-output-check"] (flagHelp $ parDoc "omit checking if the output is syntactically valid; for dev on brittany")+  omitValidCheck    <- addSimpleBoolFlag "" ["omit-output-check"] (flagHelp $ parDoc "omit checking if the output is syntactically valid (debugging)")    roundtripOnly    <- addSimpleBoolFlag "" ["exactprint-only"] (flagHelp $ parDoc "do not reformat, but exclusively use exactprint to roundtrip (debugging)") @@ -156,6 +157,7 @@       , _lconfig_columnAlignMode           = mempty       , _lconfig_alignmentLimit            = mempty       , _lconfig_alignmentBreakOnMultiline = mempty+      , _lconfig_hangingTypeSignature      = mempty       }     , _conf_errorHandling = ErrorHandlingConfig       { _econf_produceOutputOnErrors   = wrapLast $ falseToNothing outputOnErrors

@@ -73,6 +73,17 @@     --     short <- some more stuff     --       that requires two lines     --     loooooooong <- stuff+  , _lconfig_hangingTypeSignature :: f (Last Bool)+    -- Do not put "::" in a new line, and use hanging indentation for the+    -- signature, i.e.:+    -- func :: SomeLongStuff+    --      -> SomeLongStuff+    -- instead of the usual+    -- func+    --   :: SomeLongStuff+    --   -> SomeLongStuff+    -- As usual for hanging indentation, the result will be+    -- context-sensitive (in the function name).   }   deriving (Generic) 

@@ -24,11 +24,17 @@ import qualified GHC           as GHC hiding (parseModule) import qualified Parser        as GHC import qualified SrcLoc        as GHC+import qualified FastString    as GHC+import qualified GHC           as GHC hiding (parseModule)+import qualified Lexer         as GHC+import qualified StringBuffer  as GHC+import qualified Outputable    as GHC import           RdrName ( RdrName(..) ) import           HsSyn import           SrcLoc ( SrcSpan, Located ) import           RdrName ( RdrName(..) ) + import qualified Language.Haskell.GHC.ExactPrint            as ExactPrint import qualified Language.Haskell.GHC.ExactPrint.Annotate   as ExactPrint import qualified Language.Haskell.GHC.ExactPrint.Types      as ExactPrint@@ -37,6 +43,8 @@ import qualified Language.Haskell.GHC.ExactPrint.Delta      as ExactPrint  import qualified Data.Generics as SYB++import           Control.Exception -- import           Data.Generics.Schemes  @@ -85,7 +93,14 @@   -> String   -> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a)) parseModuleFromString args fp dynCheck str =-  ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do+  -- We mask here because otherwise using `throwTo` (i.e. for a timeout) will+  -- produce nasty looking errors ("ghc panic"). The `mask_` makes it so we+  -- cannot kill the parsing thread - not very nice. But i'll+  -- optimistically assume that most of the time brittany uses noticable or+  -- longer time, the majority of the time is not spend in parsing, but in+  -- bridoc transformation stuff.+  -- (reminder to update note on `parsePrintModule` if this changes.)+  mask_ $ ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do     dflags0                       <- lift $ ExactPrint.initDynFlagsPure fp str     (dflags1, leftover, warnings) <- lift       $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args)@@ -97,12 +112,12 @@       $  ExceptT.throwE       $  "when parsing ghc flags: encountered warnings: "       ++ show (warnings <&> \(L _ s) -> s)-    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+    dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1+    let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str+    case res of+      Left  (span, err) -> ExceptT.throwE $ show span ++ ": " ++ err+      Right (a   , m  ) -> pure (a, m, dynCheckRes) ------------  commentAnnFixTransformGlob :: SYB.Data ast => ast -> ExactPrint.Transform () commentAnnFixTransformGlob ast = do

@@ -52,23 +52,39 @@     let nameStr = Text.intercalate (Text.pack ", ") $ nameStrs     typeDoc     <- docSharedWrapper layoutType typ     hasComments <- hasAnyCommentsBelow lsig-    docAlt-      $  [ docSeq-           [ appSep $ docWrapNodeRest lsig $ docLit nameStr-           , appSep $ docLit $ Text.pack "::"-           , docForceSingleline typeDoc-           ]-         | not hasComments-         ]-      ++ [ docAddBaseY BrIndentRegular $ docPar-           (docWrapNodeRest lsig $ docLit nameStr)-           ( docCols-             ColTyOpPrefix-             [ docLit $ Text.pack ":: "-             , docAddBaseY (BrIndentSpecial 3) $ typeDoc+    shouldBeHanging <- mAsk+      <&> _conf_layout+      .>  _lconfig_hangingTypeSignature+      .>  confUnpack+    if shouldBeHanging+      then docSeq+        [ appSep $ docWrapNodeRest lsig $ docLit nameStr+        , docSetBaseY $ docLines+          [ docCols+            ColTyOpPrefix+            [ docLit $ Text.pack ":: "+            , docAddBaseY (BrIndentSpecial 3) $ typeDoc+            ]+          ]+        ]+      else+        docAlt+          $  [ docSeq+               [ appSep $ docWrapNodeRest lsig $ docLit nameStr+               , appSep $ docLit $ Text.pack "::"+               , docForceSingleline typeDoc+               ]+             | not hasComments              ]-           )-         ]+          ++ [ docAddBaseY BrIndentRegular $ docPar+               (docWrapNodeRest lsig $ docLit nameStr)+               ( docCols+                 ColTyOpPrefix+                 [ docLit $ Text.pack ":: "+                 , docAddBaseY (BrIndentSpecial 3) $ typeDoc+                 ]+               )+             ]   InlineSig name (InlinePragma _ spec _arity phaseAct conlike) ->     docWrapNode lsig $ do       nameStr <- lrdrNameToTextAnn name@@ -176,16 +192,17 @@   -> BriDocNumbered   -> LMatch RdrName (LHsExpr RdrName)   -> ToBriDocM BriDocNumbered-layoutPatternBind mIdStr binderDoc lmatch@(L _ match@(Match _ pats _ (GRHSs grhss whereBinds))) = do+layoutPatternBind mIdStr binderDoc lmatch@(L _ match@(Match fixityOrCtx pats _ (GRHSs grhss whereBinds))) = do   patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p   let isInfix = isInfixMatch match-  patDoc     <- docWrapNodePrior lmatch $ case (mIdStr, patDocs) of-    (Just idStr, p1:pr) | isInfix -> docCols+  let mIdStr' = fixPatternBindIdentifier fixityOrCtx <$> mIdStr+  patDoc <- docWrapNodePrior lmatch $ case (mIdStr', patDocs) of+    (Just idStr, p1 : pr) | isInfix -> docCols       ColPatternsFuncInfix       (  [appSep $ docForceSingleline p1, appSep $ docLit idStr]       ++ (spacifyDocs $ docForceSingleline <$> pr)       )-    (Just idStr, []   )           -> docLit idStr+    (Just idStr, []) -> docLit idStr     (Just idStr, ps) ->       docCols ColPatternsFuncPrefix         $ appSep (docLit $ idStr)@@ -204,6 +221,28 @@                          mWhereDocs                          hasComments +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */+fixPatternBindIdentifier+  :: HsMatchContext (NameOrRdrName RdrName) -> Text -> Text+fixPatternBindIdentifier ctx idStr = case ctx of+  (FunRhs _ _ SrcLazy    ) -> Text.cons '~' idStr+  (FunRhs _ _ SrcStrict  ) -> Text.cons '!' idStr+  (FunRhs _ _ NoSrcStrict) -> idStr+  (StmtCtxt ctx1         ) -> fixPatternBindIdentifier' ctx1+  _                        -> idStr+ where+  -- I have really no idea if this path ever occurs, but better safe than+  -- risking another "drop bangpatterns" bugs.+  fixPatternBindIdentifier' = \case+    (PatGuard      ctx1) -> fixPatternBindIdentifier ctx1 idStr+    (ParStmtCtxt   ctx1) -> fixPatternBindIdentifier' ctx1+    (TransStmtCtxt ctx1) -> fixPatternBindIdentifier' ctx1+    _                    -> idStr+#else                      /* ghc-8.0 */+fixPatternBindIdentifier :: MatchFixity RdrName -> Text -> Text+fixPatternBindIdentifier _ x = x+#endif+ layoutPatternBindFinal   :: Maybe Text   -> BriDocNumbered@@ -261,10 +300,13 @@       ]   let singleLineGuardsDoc guards = appSep $ case guards of         []  -> docEmpty-        [g] -> docSeq [appSep $ docLit $ Text.pack "|", return g]+        [g] -> docSeq+               [appSep $ docLit $ Text.pack "|", docForceSingleline $ return g]         gs  -> docSeq             $  [appSep $ docLit $ Text.pack "|"]-            ++ List.intersperse docCommaSep (return <$> gs)+            ++ (List.intersperse docCommaSep+                                 (docForceSingleline . return <$> gs)+               )    indentPolicy <- mAsk     <&> _conf_layout

@@ -327,7 +327,7 @@           ]         , docSetBaseY $ docLines           [ docCols ColOpPrefix-            [ docParenLSep+            [ docLit $ Text.pack "("             , docAddBaseY (BrIndentSpecial 2) innerExpDoc             ]           , docLit $ Text.pack ")"@@ -341,9 +341,9 @@       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+    ExplicitTuple args boxity -> do+      let argExprs = fmap (\case (L _ (Present e)) -> Just e; (L _ (Missing PlaceHolder)) -> Nothing) args+      argDocs <- docSharedWrapper (maybe docEmpty layoutExpr) `mapM` argExprs       hasComments <- hasAnyCommentsBelow lexpr       let (openLit, closeLit) = case boxity of             Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")")@@ -385,8 +385,6 @@                 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 "->"@@ -533,6 +531,10 @@     HsLet binds exp1 -> do       expDoc1 <- docSharedWrapper layoutExpr exp1       mBindDocs <- layoutLocalBinds binds+      let+        ifIndentLeftElse :: a -> a -> a+        ifIndentLeftElse x y =+          if indentPolicy == IndentPolicyLeft then x else y       -- 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@@ -540,39 +542,36 @@       -- 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+        Just [bindDoc] -> docAlt+          [ 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)+          , docLines+              [ docAlt+                  [ docSeq+                      [ appSep $ docLit $ Text.pack "let"+                      , ifIndentLeftElse docForceSingleline docSetBaseAndIndent+                      $ return bindDoc+                      ]+                  , docAddBaseY BrIndentRegular+                  $ docPar+                    (docLit $ Text.pack "let")+                    (docSetBaseAndIndent $ return bindDoc)+                  ]+              , docAlt+                  [ docSeq+                      [ appSep $ docLit $ Text.pack $ ifIndentLeftElse "in" "in "+                      , ifIndentLeftElse docForceSingleline docSetBaseAndIndent expDoc1+                      ]+                  , docAddBaseY BrIndentRegular+                  $ docPar+                    (docLit $ Text.pack "in")+                    (docSetBaseY $ expDoc1)+                  ]               ]-            )           ]         Just bindDocs@(_:_) -> docAltFilter           --either

@@ -24,12 +24,26 @@   +-- | layouts patterns (inside function bindings, case alternatives, let+-- bindings or do notation). E.g. for input+--        > case computation of+--        >   (warnings, Success a b) -> ..+-- This part  ^^^^^^^^^^^^^^^^^^^^^^^ of the syntax tree is layouted by+-- 'layoutPat'. Similarly for+-- > func abc True 0 = []+--        ^^^^^^^^^^ this part+-- We will use `case .. of` as the imagined prefix to the examples used in+-- the different cases below. layoutPat :: ToBriDocC (Pat RdrName) (Seq BriDocNumbered) layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of   WildPat _  -> fmap Seq.singleton $ docLit $ Text.pack "_"+    -- _ -> expr   VarPat n   -> fmap Seq.singleton $ docLit $ lrdrNameToText n+    -- abc -> expr   LitPat lit -> fmap Seq.singleton $ allocateNode $ litBriDoc lit+    -- 0 -> expr   ParPat inner -> do+    -- (nestedpat) -> expr     left  <- docLit $ Text.pack "("     right <- docLit $ Text.pack ")"     innerDocs <- colsWrapPat =<< layoutPat inner@@ -49,6 +63,7 @@     --       xN' <- docSeq [return xN, docLit $ Text.pack ")"]     --       return $ (x1' Seq.<| middle) Seq.|> xN'   ConPatIn lname (PrefixCon args) -> do+    -- Abc a b c -> expr     let nameDoc = lrdrNameToText lname     argDocs <- layoutPat `mapM` args     if null argDocs@@ -61,15 +76,19 @@           $ fmap colsWrapPat argDocs         return $ x1 Seq.<| xR   ConPatIn lname (InfixCon left right) -> do-    let nameDoc = lrdrNameToText lname-    leftDoc  <- colsWrapPat =<< layoutPat left+    -- a :< b -> expr+    nameDoc <- lrdrNameToTextAnn lname+    leftDoc <- appSep . colsWrapPat =<< layoutPat left     rightDoc <- colsWrapPat =<< layoutPat right-    middle <- docLit nameDoc+    middle <- appSep $ docLit nameDoc     return $ Seq.empty Seq.|> leftDoc Seq.|> middle Seq.|> rightDoc   ConPatIn lname (RecCon (HsRecFields [] Nothing)) -> do+    -- Abc{} -> expr     let t = lrdrNameToText lname     fmap Seq.singleton $ docLit $ t <> Text.pack "{}"   ConPatIn lname (RecCon (HsRecFields fs@(_:_) Nothing)) -> do+    -- Abc { a = locA, b = locB, c = locC } -> expr1+    -- Abc { a, b, c } -> expr2     let t = lrdrNameToText lname     fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do       fExpDoc <- if pun@@ -91,12 +110,14 @@       , docLit $ Text.pack "}"       ]   ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do+    -- Abc { .. } -> expr     let t = lrdrNameToText lname     fmap Seq.singleton $ docSeq       [ appSep $ docLit t       , docLit $ Text.pack "{..}"       ]   ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do+    -- Abc { a = locA, .. }     let t = lrdrNameToText lname     fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do       fExpDoc <- if pun@@ -117,16 +138,20 @@       , docLit $ Text.pack "..}"       ]   TuplePat args boxity _ -> do+    -- (nestedpat1, nestedpat2, nestedpat3) -> expr+    -- (#nestedpat1, nestedpat2, nestedpat3#) -> expr     case boxity of       Boxed   -> wrapPatListy args "(" ")"       Unboxed -> wrapPatListy args "(#" "#)"   AsPat asName asPat -> do+    -- bind@nestedpat -> expr     wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@") #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */   SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do #else /* ghc-8.0 */   SigPatIn pat1 (HsIB _ (HsWC _ _ ty1)) -> do #endif+    -- i :: Int -> expr     patDocs <- layoutPat pat1     tyDoc <- docSharedWrapper layoutType ty1     case Seq.viewr patDocs of@@ -146,12 +171,17 @@           ]         return $ xR Seq.|> xN'   ListPat elems _ _ ->+    -- [] -> expr1+    -- [nestedpat1, nestedpat2, nestedpat3] -> expr2     wrapPatListy elems "[" "]"   BangPat pat1 -> do+    -- !nestedpat -> expr     wrapPatPrepend pat1 (docLit $ Text.pack "!")   LazyPat pat1 -> do+    -- ~nestedpat -> expr     wrapPatPrepend pat1 (docLit $ Text.pack "~")   NPat llit@(L _ (OverLit olit _ _ _)) mNegative _ _ -> do+    -- -13 -> expr     litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc olit     negDoc <- docLit $ Text.pack "-"     pure $ case mNegative of

@@ -46,6 +46,9 @@ putStrErrLn :: String -> IO () putStrErrLn s = hPutStrLn stderr s +putStrErr :: String -> IO ()+putStrErr s = hPutStr stderr s+ printErr :: Show a => a -> IO () printErr = putStrErrLn . show