Do not hang record constructors

Previously we hanged record constructors but not record updates. It looks
like unlike other hanging constructions (lambdas, case expressions, and
do-blocks), record constructors and updates should rather be placed
normally. Indeed, when we stop hanging them, many constructions start to
look more reasonable and predictable (see the updated test cases).

Yet the change is not enough to fix the problem in general case: it is
enough to replace the record with a e.g. do-block to get the same failure.
To correct that we adjust what should fit in one line for hanging placement
to fire: now we consider the span between beginning of function and the
start of potentially-hanging construction.

CHANGELOG.md

@@ -11,6 +11,10 @@
 * Added support for record dot pre-processor when used via the plugin.
   [Issue 486](https://github.com/tweag/ormolu/issues/486).
 
+* Stopped hanging record constructors and improved placing
+  potentially-hanging consturctions in the presence of comments. [Issue
+  447](https://github.com/tweag/ormolu/issues/447).
+
 ## Ormolu 0.0.2.0
 
 * Switched to `ghc-lib-parser` instead of depending on the `ghc` package

data/examples/declaration/value/function/overindentation-out.hs

@@ -1,9 +1,11 @@
-reallyincrediblyLongName = f
-  a
-  A
-    { reallyincrediblyLongName = f
-        a
-        A
-          { reallyincrediblyLongName
-          }
-    }
+reallyincrediblyLongName =
+  f
+    a
+    A
+      { reallyincrediblyLongName =
+          f
+            a
+            A
+              { reallyincrediblyLongName
+              }
+      }

data/examples/declaration/value/function/record-constructors-out.hs

@@ -1,9 +1,10 @@
 foo = Foo {a = 3}
 
-bar = Bar
-  { abc = foo,
-    def = Foo {a = 10}
-  }
+bar =
+  Bar
+    { abc = foo,
+      def = Foo {a = 10}
+    }
 
 baz = Baz {}
 
@@ -12,15 +13,18 @@ sym = Foo {(+) = 3}
 aLongVariableName =
   ALongRecordName
     { short = baz,
-      aLongRecordFieldName = YetAnotherLongRecordName
-        { yetAnotherLongRecordFieldName = "a long string"
-        },
-      aLongRecordFieldName2 = Just YetAnotherLongRecordName
-        { yetAnotherLongRecordFieldName = "a long string",
-          yetAnotherLongRecordFieldName =
-            Just
-              "a long string"
-        },
+      aLongRecordFieldName =
+        YetAnotherLongRecordName
+          { yetAnotherLongRecordFieldName = "a long string"
+          },
+      aLongRecordFieldName2 =
+        Just
+          YetAnotherLongRecordName
+            { yetAnotherLongRecordFieldName = "a long string",
+              yetAnotherLongRecordFieldName =
+                Just
+                  "a long string"
+            },
       aLongRecordFieldName3 = do
         foo
         bar

data/examples/declaration/value/function/record-inter-comments-out.hs

@@ -0,0 +1,13 @@
+x =
+  Just
+    -- comment
+    A
+      { x
+      }
+
+x =
+  Just
+    -- comment
+    a
+      { x
+      }

data/examples/declaration/value/function/record-inter-comments.hs

@@ -0,0 +1,11 @@
+x = Just
+  -- comment
+  A
+   { x
+   }
+
+x = Just
+  -- comment
+  a
+   { x
+   }

data/examples/declaration/value/function/record-wildcards-out.hs

@@ -3,11 +3,12 @@
 
 foo x y = Foo {x, y}
 
-bar x y z = Bar
-  { x,
-    y,
-    z,
-    ..
-  }
+bar x y z =
+  Bar
+    { x,
+      y,
+      z,
+      ..
+    }
 
 baz = Baz {..}

data/examples/other/comment-before-hanging-out.hs

@@ -0,0 +1,5 @@
+x = Just
+  -- comment
+  do
+    foo
+    bar

data/examples/other/comment-before-hanging.hs

@@ -0,0 +1,5 @@
+x = Just
+  -- comment
+  do
+    foo
+    bar

src/GHC/DynFlags.hs

@@ -12,14 +12,15 @@ import Platform
 
 -- | Taken from HLint.
 fakeSettings :: Settings
-fakeSettings = Settings
-  { sTargetPlatform = platform,
-    sPlatformConstants = platformConstants,
-    sProjectVersion = cProjectVersion,
-    sProgramName = "ghc",
-    sOpt_P_fingerprint = fingerprint0,
-    sPgm_F = ""
-  }
+fakeSettings =
+  Settings
+    { sTargetPlatform = platform,
+      sPlatformConstants = platformConstants,
+      sProjectVersion = cProjectVersion,
+      sProgramName = "ghc",
+      sOpt_P_fingerprint = fingerprint0,
+      sPgm_F = ""
+    }
   where
     platform =
       Platform

src/Ormolu/Config.hs

@@ -29,13 +29,14 @@ data Config
 
 -- | Default 'Config'.
 defaultConfig :: Config
-defaultConfig = Config
-  { cfgDynOptions = [],
-    cfgUnsafe = False,
-    cfgDebug = False,
-    cfgTolerateCpp = False,
-    cfgCheckIdempotency = False
-  }
+defaultConfig =
+  Config
+    { cfgDynOptions = [],
+      cfgUnsafe = False,
+      cfgDebug = False,
+      cfgTolerateCpp = False,
+      cfgCheckIdempotency = False
+    }
 
 -- | A wrapper for dynamic options.
 newtype DynOption

src/Ormolu/Parser.hs

@@ -78,14 +78,15 @@ parseModule Config {..} path input' = liftIO $ do
           Left (ss, GHC.showSDoc dynFlags m)
         GHC.POk pstate pmod ->
           let (comments, exts, shebangs) = mkCommentStream extraComments pstate
-           in Right ParseResult
-                { prParsedSource = pmod,
-                  prAnns = mkAnns pstate,
-                  prCommentStream = comments,
-                  prExtensions = exts,
-                  prShebangs = shebangs,
-                  prUseRecordDot = useRecordDot
-                }
+           in Right
+                ParseResult
+                  { prParsedSource = pmod,
+                    prAnns = mkAnns pstate,
+                    prCommentStream = comments,
+                    prExtensions = exts,
+                    prShebangs = shebangs,
+                    prUseRecordDot = useRecordDot
+                  }
   return (warnings, r)
 
 -- | Extensions that are not enabled automatically and should be activated

src/Ormolu/Printer/Internal.hs

@@ -160,24 +160,26 @@ runR ::
 runR (R m) sstream cstream anns recDot =
   TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc
   where
-    rc = RC
-      { rcIndent = 0,
-        rcLayout = MultiLine,
-        rcEnclosingSpans = [],
-        rcAnns = anns,
-        rcCanUseBraces = False,
-        rcUseRecDot = recDot
-      }
-    sc = SC
-      { scColumn = 0,
-        scBuilder = mempty,
-        scSpanStream = sstream,
-        scCommentStream = cstream,
-        scPendingComments = [],
-        scDirtyLine = False,
-        scRequestedDelimiter = VeryBeginning,
-        scLastCommentSpan = Nothing
-      }
+    rc =
+      RC
+        { rcIndent = 0,
+          rcLayout = MultiLine,
+          rcEnclosingSpans = [],
+          rcAnns = anns,
+          rcCanUseBraces = False,
+          rcUseRecDot = recDot
+        }
+    sc =
+      SC
+        { scColumn = 0,
+          scBuilder = mempty,
+          scSpanStream = sstream,
+          scCommentStream = cstream,
+          scPendingComments = [],
+          scDirtyLine = False,
+          scRequestedDelimiter = VeryBeginning,
+          scLastCommentSpan = Nothing
+        }
 
 ----------------------------------------------------------------------------
 -- Internal functions

src/Ormolu/Printer/Meat/Declaration/Value.hs

@@ -542,8 +542,10 @@ p_hsExpr' s = \case
         -- We need to handle the last argument specially if it is a
         -- hanging construct, so separate it from the rest.
         (initp, lastp) = (NE.init args, NE.last args)
-        initSpan = combineSrcSpans' $ getLoc f :| map getLoc initp
-        -- Hang the last argument only if the initial arguments spans one
+        initSpan =
+          combineSrcSpans' $
+            getLoc f :| [(srcLocSpan . srcSpanStart . getLoc) lastp]
+        -- Hang the last argument only if the initial arguments span one
         -- line.
         placement =
           if isOneLineSpan initSpan
@@ -1211,7 +1213,6 @@ exprPlacement = \case
   HsCase NoExt _ _ -> Hanging
   HsDo NoExt DoExpr _ -> Hanging
   HsDo NoExt MDoExpr _ -> Hanging
-  RecordCon NoExt _ _ -> Hanging
   -- If the rightmost expression in an operator chain is hanging, make the
   -- whole block hanging; so that we can use the common @f = foo $ do@
   -- style.