Merge branch 'master' into import

.travis.yml

@@ -115,7 +115,7 @@ matrix:
   #- env: BUILD=stack ARGS="--resolver lts-7"
   #  compiler: ": #stack 8.0.1"
   #  addons: {apt: {packages: [libgmp-dev]}}
-  - env: BUILD=stack ARGS="--resolver lts-8"
+  - env: BUILD=stack ARGS="--stack-yaml stack-8.0.2.yaml"
     compiler: ": #stack 8.0.2"
     addons: {apt: {packages: [libgmp-dev]}}
 

ChangeLog.md

@@ -1,5 +1,21 @@
 # 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)

README.md

@@ -52,11 +52,12 @@ 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 `~/.config/brittany/config.yaml`;
-  also reads `brittany.yaml` in current dir if present.
+  also reads (the first) `brittany.yaml` found in current or parent
+  directories.
 
 # Installation
 
@@ -84,11 +85,11 @@ log the size of the input, but _not_ the full requests.)
 - via `stack` using a sufficiently recent stackage snapshot (dated to >= 2017-11-15)
 
     ~~~~.sh
-    stack install brittany # --resolver=nightly-2017-11-15
+    stack install brittany # --resolver lts-10.0
     ~~~~
 
-    (alternatively, should nightlies be unreliable, or you want to use ghc-8.0 or something, then
+    (earlier ltss did not include `brittany` yet, but the repo should contain a
-    cloning the repo and doing `stack install` will use an lts resolver.)
+    `stack.yaml` that works with ghc-8.0.)
 
 - on ArchLinux via [the britanny AUR package](https://aur.archlinux.org/packages/brittany/)
   using `aura`:
@@ -96,6 +97,22 @@ log the size of the input, but _not_ the full requests.)
     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 @MaxGabriel.
+#### 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
 
 - Default mode of operation: Transform a single module, from `stdin` to `stdout`.
@@ -143,8 +160,6 @@ 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
 
 Copyright (C) 2016-2017 Lennart Spitzner

brittany.cabal

@@ -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>.
@@ -85,7 +85,7 @@ library {
     { 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
@@ -97,7 +97,7 @@ library {
     , 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

src-brittany/Main.hs

@@ -82,9 +82,10 @@ helpDoc = PP.vcat $ List.intersperse
       ]
   , parDocW
     [ "This program is written carefully and contains safeguards to ensure"
-    , "the transformation does not change semantics (or the syntax tree at all)"
+    , "the output is syntactically valid and that no comments are removed."
-    , "and that no comments are removed."
+    , "Nonetheless, this is a young project, and there will always be bugs,"
-    , "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 @@ mainCmdParser helpDesc = do
     ""
     ["write-mode"]
     "(display|inplace)"
-    Flag
+    (  flagHelp
-      { _flag_help    = Just $ PP.vcat
+        ( 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
+        )
-      }
+    <> flagDefault Display
-  inputParams <- addParamNoFlagStrings "PATH" (paramHelpStr "paths to input haskell source files")
+    )
+  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 @@ mainCmdParser helpDesc = do
         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 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runEx
             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 @@ readConfigs cmdlineConfig configPaths = do
       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]

src-literatetests/10-tests.blt

@@ -287,6 +287,10 @@ func = f
   {-# INLINE CONLIKE [1] f #-}
   f = id
 
+#test noinline pragma 1
+{-# NOINLINE func #-}
+func :: Int
+
 #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
@@ -355,6 +359,9 @@ func (x:xr) = x
 #pending
 func (x :+: xr) = x
 
+#test normal infix constructor
+func (x `Foo` xr) = x
+
 
 ###############################################################################
 ###############################################################################

src-literatetests/15-regressions.blt

@@ -367,9 +367,8 @@ runBrittany tabSize text = do
   let
     config' = staticDefaultConfig
     config  = config'
-      { _conf_layout  = (_conf_layout config') { _lconfig_indentAmount = coerce
+      { _conf_layout  =
-                                                 tabSize
+        (_conf_layout config') { _lconfig_indentAmount = coerce tabSize }
-                                               }
       , _conf_forward = forwardOptionsSyntaxExtsEnabled
       }
   parsePrintModule config text
@@ -513,3 +512,15 @@ cs0 = 0 : [ c / Interval n | c <- cs | n <- [1..] ]
 #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)

src-literatetests/Main.hs

@@ -173,6 +173,7 @@ defaultTestConfig = Config
     , _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

src-literatetests/tests-context-free.blt

@@ -510,6 +510,11 @@ func = (abc, def)
 func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
   , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd)
 
+#test let in on single line
+foo =
+  let longIdentifierForShortValue = 1
+  in longIdentifierForShortValue + longIdentifierForShortValue
+
 
 
 ###############################################################################

src-unittests/TestUtils.hs

@@ -55,6 +55,7 @@ defaultTestConfig = Config
     , _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

src/Language/Haskell/Brittany/Internal/Backend.hs

@@ -352,7 +352,11 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
       -- 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 =

src/Language/Haskell/Brittany/Internal/Config.hs

@@ -63,6 +63,7 @@ staticDefaultConfig = Config
     , _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 @@ configParser = do
   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 @@ configParser = do
   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 @@ configParser = do
       , _lconfig_columnAlignMode           = mempty
       , _lconfig_alignmentLimit            = mempty
       , _lconfig_alignmentBreakOnMultiline = mempty
+      , _lconfig_hangingTypeSignature      = mempty
       }
     , _conf_errorHandling = ErrorHandlingConfig
       { _econf_produceOutputOnErrors   = wrapLast $ falseToNothing outputOnErrors

src/Language/Haskell/Brittany/Internal/Config/Types.hs

@@ -73,6 +73,17 @@ data CLayoutConfig f = LayoutConfig
     --     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)
 

src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs

@@ -24,11 +24,17 @@ import qualified DynFlags      as GHC
 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
@@ -106,12 +112,12 @@ parseModuleFromString args fp dynCheck str =
       $  ExceptT.throwE
       $  "when parsing ghc flags: encountered warnings: "
       ++ show (warnings <&> \(L _ s) -> s)
-    x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1
+    dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1
-    either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err)
+    let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str
-           (\(a, m) -> pure (a, m, x))
+    case res of
-      $ ExactPrint.parseWith dflags1 fp GHC.parseModule str
+      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

src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs

@@ -52,6 +52,22 @@ layoutSig lsig@(L _loc sig) = case sig of
     let nameStr = Text.intercalate (Text.pack ", ") $ nameStrs
     typeDoc     <- docSharedWrapper layoutType typ
     hasComments <- hasAnyCommentsBelow lsig
+    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
@@ -78,7 +94,8 @@ layoutSig lsig@(L _loc sig) = case sig of
             NoInline        -> "NOINLINE "
             EmptyInlineSpec -> "" -- i have no idea if this is correct.
       let phaseStr = case phaseAct of
-            NeverActive      -> "[] "
+            NeverActive      -> "" -- not [] - for NOINLINE NeverActive is
+                                   -- in fact the default
             AlwaysActive     -> ""
             ActiveBefore _ i -> "[~" ++ show i ++ "] "
             ActiveAfter  _ i -> "[" ++ show i ++ "] "
@@ -176,10 +193,11 @@ layoutPatternBind
   -> 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
+  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]
@@ -204,6 +222,28 @@ layoutPatternBind mIdStr binderDoc lmatch@(L _ match@(Match _ pats _ (GRHSs grhs
                          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 +301,13 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
       ]
   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

src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs

@@ -327,7 +327,7 @@ layoutExpr lexpr@(L _ expr) = do
           ]
         , docSetBaseY $ docLines
           [ docCols ColOpPrefix
-            [ docParenLSep
+            [ docLit $ Text.pack "("
             , docAddBaseY (BrIndentSpecial 2) innerExpDoc
             ]
           , docLit $ Text.pack ")"
@@ -531,46 +531,49 @@ layoutExpr lexpr@(L _ expr) = do
     HsLet binds exp1 -> do
       expDoc1 <- docSharedWrapper layoutExpr exp1
       mBindDocs <- layoutLocalBinds binds
-      -- this `docSetIndentLevel` might seem out of place, but is here due to
+      let
-      -- ghc-exactprint's DP handling of "let" in particular.
+        ifIndentLeftElse :: a -> a -> a
+        ifIndentLeftElse x y =
+          if indentPolicy == IndentPolicyLeft then x else y
+      -- this `docSetBaseAndIndent` might seem out of place (especially the
+      -- Indent part; setBase is necessary due to the use of docLines below),
+      -- but is here due to ghc-exactprint's DP handling of "let" in
+      -- 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
+      docSetBaseAndIndent $ case mBindDocs of
-        Just [bindDoc] -> docAltFilter
+        Just [bindDoc] -> docAlt
-          [ ( True
+          [ docSeq
-            , docSeq
               [ appSep $ docLit $ Text.pack "let"
               , appSep $ docForceSingleline $ return bindDoc
               , appSep $ docLit $ Text.pack "in"
               , docForceSingleline $ expDoc1
               ]
-            )
-          , ( indentPolicy /= IndentPolicyLeft
           , docLines
+              [ docAlt
                   [ docSeq
                       [ appSep $ docLit $ Text.pack "let"
-                , docSetBaseAndIndent $ return bindDoc
+                      , ifIndentLeftElse docForceSingleline 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")
+                    (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
@@ -732,6 +735,8 @@ layoutExpr lexpr@(L _ expr) = do
         , docLit $ Text.pack "}"
         ]
     RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do
+      -- TODO: the layouter for RecordUpd is slightly more clever. Should
+      -- probably copy the approach from there.
       let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
       ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do
         fExpDoc <- if pun
@@ -851,7 +856,7 @@ layoutExpr lexpr@(L _ expr) = do
             Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
             Ambiguous   n _ -> (lfield, lrdrNameToText n, rFExpDoc)
       docAltFilter
-        -- singleline
+        -- container { fieldA = blub, fieldB = blub }
         [ ( True
           , docSeq
             [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc
@@ -869,7 +874,10 @@ layoutExpr lexpr@(L _ expr) = do
             , docLit $ Text.pack "}"
             ]
           )
-        -- wild-indentation block
+        -- hanging single-line fields
+        -- container { fieldA = blub
+        --           , fieldB = blub
+        --           }
         , ( indentPolicy /= IndentPolicyLeft
           , docSeq
             [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
@@ -880,7 +888,7 @@ layoutExpr lexpr@(L _ expr) = do
                   , case rF1e of
                       Just x -> docWrapNodeRest rF1f $ docSeq
                                       [ appSep $ docLit $ Text.pack "="
-                                      , docForceSingleline $ x
+                                      , docForceSingleline x
                                       ]
                       Nothing -> docEmpty
                   ]
@@ -900,28 +908,45 @@ layoutExpr lexpr@(L _ expr) = do
                 in [line1] ++ lineR ++ [lineN]
             ]
           )
-        -- strict indentation block
+          -- non-hanging with expressions placed to the right of the names
+          -- container
+          -- { fieldA = blub
+          -- , fieldB = potentially
+          --     multiline
+          -- }
         , ( True
           , docSetParSpacing
           $ docAddBaseY BrIndentRegular
           $ docPar
               (docNodeAnnKW lexpr Nothing $ rExprDoc)
               (docNonBottomSpacing $ docLines $ let
+                expressionWrapper = if indentPolicy == IndentPolicyLeft
+                  then docForceParSpacing
+                  else docSetBaseY
                 line1 = docCols ColRecUpdate
                   [ appSep $ docLit $ Text.pack "{"
                   , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n
                   , docWrapNodeRest rF1f $ case rF1e of
-                      Just x -> docSeq [ appSep $ docLit $ Text.pack "="
+                      Just x -> docAlt
-                                      , docAddBaseY BrIndentRegular $ x
+                        [ docSeq [ appSep $ docLit $ Text.pack "="
+                                 , expressionWrapper x
+                                 ]
+                        , docAddBaseY BrIndentRegular
+                        $ docPar (docLit $ Text.pack "=") x
                         ]
                       Nothing -> docEmpty
                   ]
-                lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate
+                lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield
+                  $ docCols ColRecUpdate
                   [ docCommaSep
                   , appSep $ docLit $ fText
                   , case fDoc of
-                      Just x ->  docSeq [ appSep $ docLit $ Text.pack "="
+                      Just x -> docAlt
-                                        , docAddBaseY BrIndentRegular x
+                        [ docSeq [ appSep $ docLit $ Text.pack "="
+                                 , expressionWrapper x
+                                 ]
+                        , docAddBaseY BrIndentRegular
+                        $ docPar (docLit $ Text.pack "=") x
                         ]
                       Nothing -> docEmpty
                   ]
@@ -929,7 +954,8 @@ layoutExpr lexpr@(L _ expr) = do
                   [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
                   , docLit $ Text.pack "}"
                   ]
-                in [line1] ++ lineR ++ [lineN])
+                in [line1] ++ lineR ++ [lineN]
+              )
           )
         ]
 #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */

src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs

@@ -77,10 +77,10 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
         return $ x1 Seq.<| xR
   ConPatIn lname (InfixCon left right) -> do
     -- a :< b -> expr
-    let nameDoc = lrdrNameToText lname
+    nameDoc <- lrdrNameToTextAnn lname
-    leftDoc  <- colsWrapPat =<< layoutPat left
+    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

src/Language/Haskell/Brittany/Internal/PreludeUtils.hs

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

stack-8.0.2.yaml

@@ -0,0 +1,12 @@
+resolver: lts-9.0
+
+extra-deps:
+  - monad-memo-0.4.1
+  - czipwith-1.0.0.0
+  - butcher-1.3.0.0
+  - data-tree-print-0.1.0.0
+  - deque-0.2
+  - ghc-exactprint-0.5.6.0
+
+packages:
+  - .

stack.yaml

@@ -1,11 +1,4 @@
-resolver: lts-9.0
+resolver: lts-10.0
-
-extra-deps:
-  - monad-memo-0.4.1
-  - czipwith-1.0.0.0
-  - butcher-1.2.0.0
-  - data-tree-print-0.1.0.0
-  - deque-0.2
 
 packages:
   - .