Fix #26: Fix comment glitch in patternbind layouting

Prevent single-line layout when it would not even be
a single line due to a comment.
This patch might be a bit over-eager in at least one
case (I think you'd get a two-line layout with a
multiway-if and a comment _after_ the where binding).

src-literatetests/tests.blt

@@ -590,8 +590,7 @@ func =
 
 #test parenthesized operator
 buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0)
- where
+  where reassoc (v, e, w) = (v, (e, w))
-  reassoc (v, e, w) = (v, (e, w))
 
 #test record pattern matching stuff
 downloadRepoPackage = case repo of
@@ -768,6 +767,13 @@ func =
   , 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
+
 
 ###############################################################################
 ###############################################################################
@@ -777,6 +783,8 @@ func =
 ###############################################################################
 ###############################################################################
 
+
+
 ## 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.

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

@@ -118,11 +118,13 @@ layoutBind lbind@(L _ bind) = case bind of
     clauseDocs <- layoutGrhs `mapM` grhss
     mWhereDocs <- layoutLocalBinds whereBinds
     binderDoc  <- docLit $ Text.pack "="
+    hasComments <- hasAnyCommentsBelow lbind
     fmap Right $ docWrapNode lbind $ layoutPatternBindFinal Nothing
                                                             binderDoc
                                                             (Just patDocs)
                                                             clauseDocs
                                                             mWhereDocs
+                                                            hasComments
   _ -> Right <$> unknownNodeError "" lbind
 
 data BagBindOrSig = BagBind (LHsBindLR RdrName RdrName)
@@ -190,11 +192,13 @@ layoutPatternBind mIdStr binderDoc lmatch@(L _ match@(Match _ pats _ (GRHSs grhs
   clauseDocs <- docWrapNodeRest lmatch $ layoutGrhs `mapM` grhss
   mWhereDocs <- layoutLocalBinds whereBinds
   let alignmentToken = if null pats then Nothing else mIdStr
+  hasComments <- hasAnyCommentsBelow lmatch
   layoutPatternBindFinal alignmentToken
                          binderDoc
                          (Just patDoc)
                          clauseDocs
                          mWhereDocs
+                         hasComments
 
 layoutPatternBindFinal
   :: Maybe Text
@@ -202,8 +206,9 @@ layoutPatternBindFinal
   -> Maybe BriDocNumbered
   -> [([BriDocNumbered], BriDocNumbered, LHsExpr RdrName)]
   -> Maybe [BriDocNumbered]
+  -> Bool
   -> ToBriDocM BriDocNumbered
-layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs = do
+layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs hasComments = do
   let patPartInline  = case mPatDoc of
         Nothing     -> []
         Just patDoc -> [appSep $ docForceSingleline $ return patDoc]
@@ -219,21 +224,31 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs =
   -- TODO: apart from this, there probably are more nodes below which could
   --       be shared between alternatives.
   wherePartMultiLine :: [ToBriDocM BriDocNumbered] <- case mWhereDocs of
-    Nothing -> return $ []
+    Nothing  -> return $ []
-    Just ws ->
+    Just [w] -> fmap (pure . pure) $ docAlt
-      fmap (fmap return)
+      [ docEnsureIndent BrIndentRegular
-        $ sequence
+        $ docSeq
-        $ return @[]
-        $ docEnsureIndent whereIndent
-        $ docLines
             [ docLit $ Text.pack "where"
-            , docEnsureIndent whereIndent
+            , docSeparator
-              $   docSetIndentLevel
+            , docForceSingleline $ return w
-              $   docNonBottomSpacing
-              $   docLines
-              $   return
-              <$> ws
             ]
+      , docEnsureIndent whereIndent $ docLines
+        [ docLit $ Text.pack "where"
+        , docEnsureIndent whereIndent
+          $ docSetIndentLevel
+          $ docNonBottomSpacing
+          $ return w
+        ]
+      ]
+    Just ws  -> fmap (pure . pure) $ docEnsureIndent whereIndent $ docLines
+      [ docLit $ Text.pack "where"
+      , docEnsureIndent whereIndent
+        $   docSetIndentLevel
+        $   docNonBottomSpacing
+        $   docLines
+        $   return
+        <$> ws
+      ]
   let singleLineGuardsDoc guards = appSep $ case guards of
         []  -> docEmpty
         [g] -> docSeq [appSep $ docLit $ Text.pack "|", return g]
@@ -251,7 +266,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs =
            , wherePart
            ]
          ]
-       | [(guards, body, _bodyRaw)] <- [clauseDocs]
+       | not hasComments
+       , [(guards, body, _bodyRaw)] <- [clauseDocs]
        , let guardPart = singleLineGuardsDoc guards
        , wherePart <- case mWhereDocs of
          Nothing  -> return @[] $ docEmpty

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

@@ -460,9 +460,10 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
   HsMultiIf _ cases -> do
     clauseDocs <- cases `forM` layoutGrhs
     binderDoc <- docLit $ Text.pack " ->"
+    hasComments <- hasAnyCommentsBelow lexpr
     docAddBaseY BrIndentRegular $ docPar
       (docLit $ Text.pack "if")
-      (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing)
+      (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments)
   HsLet binds exp1 -> do
     expDoc1 <- docSharedWrapper layoutExpr exp1
     mBindDocs <- layoutLocalBinds binds