From c701e5d00bbd5fa8bc01063216026aaeeb239477 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Tue, 2 May 2017 17:10:04 +0200 Subject: [PATCH] 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 | 12 ++++- .../Haskell/Brittany/Layouters/Decl.hs | 46 +++++++++++++------ .../Haskell/Brittany/Layouters/Expr.hs | 3 +- 3 files changed, 43 insertions(+), 18 deletions(-) diff --git a/src-literatetests/tests.blt b/src-literatetests/tests.blt index 69bc348..7bf1945 100644 --- a/src-literatetests/tests.blt +++ b/src-literatetests/tests.blt @@ -590,8 +590,7 @@ func = #test parenthesized operator buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0) - where - reassoc (v, e, w) = (v, (e, w)) + where 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. diff --git a/src/Language/Haskell/Brittany/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Layouters/Decl.hs index a6bbb46..b01d283 100644 --- a/src/Language/Haskell/Brittany/Layouters/Decl.hs +++ b/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 $ [] - Just ws -> - fmap (fmap return) - $ sequence - $ return @[] - $ docEnsureIndent whereIndent - $ docLines + Nothing -> return $ [] + Just [w] -> fmap (pure . pure) $ docAlt + [ docEnsureIndent BrIndentRegular + $ docSeq [ docLit $ Text.pack "where" - , docEnsureIndent whereIndent - $ docSetIndentLevel - $ docNonBottomSpacing - $ docLines - $ return - <$> ws + , docSeparator + , docForceSingleline $ return w ] + , 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 diff --git a/src/Language/Haskell/Brittany/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Layouters/Expr.hs index 02809c8..98b9d03 100644 --- a/src/Language/Haskell/Brittany/Layouters/Expr.hs +++ b/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