From cece70380ca347ec7f57b2cfb9742b3a57b7271f Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Wed, 28 Jun 2017 23:35:02 +0200 Subject: [PATCH] Fix/Implement proper layouting of MultiWayIf --- src-literatetests/tests.blt | 72 ++++++++++++++----- .../Brittany/Internal/Layouters/Decl.hs | 62 ++++++++++++---- .../Brittany/Internal/Layouters/Expr.hs | 4 +- 3 files changed, 105 insertions(+), 33 deletions(-) diff --git a/src-literatetests/tests.blt b/src-literatetests/tests.blt index 76fe86f..c57dc7f 100644 --- a/src-literatetests/tests.blt +++ b/src-literatetests/tests.blt @@ -391,13 +391,22 @@ func x | otherwise = "fit without putting the guards in new lines" #test multiple-clauses-3 +func x + | very long guard, another rather long guard that refers to x = nontrivial + expression + foo + bar + alsdkjlasdjlasj + | otherwise = 0 + +#test multiple-clauses-4 func x | very long guard, another rather long guard that refers to x - = nontrivial expression foo bar alsdkjlasdjlasj + = nontrivialexpression foo bar alsdkjlasdjlasj | otherwise = 0 -#test multiple-clauses-4 +#test multiple-clauses-5 func x | very loooooooooooooooooooooooooooooong guard , another rather long guard that refers to x @@ -541,6 +550,29 @@ func = ] +############################################################################### +############################################################################### +############################################################################### +#group expression.multiwayif +############################################################################### +############################################################################### +############################################################################### + +#test simple +{-# LANGUAGE MultiWayIf #-} +func = if + | cond1 -> loooooooooooooooooooooooooooooong expr1 + | cond2 -> loooooooooooooooooooooooooooooong expr2 + +#test simplenested +{-# LANGUAGE MultiWayIf #-} +func = do + foo + bar $ if + | cond1 -> loooooooooooooooooooooooooooooong expr1 + | cond2 -> loooooooooooooooooooooooooooooong expr2 + + ############################################################################### ############################################################################### ############################################################################### @@ -680,28 +712,30 @@ layoutWriteNewlineBlock => m () #test multiwayif proper indentation -#pending "TODO" +{-# LANGUAGE MultiWayIf #-} readMergePersConfig path shouldCreate conf = do exists <- liftIO $ System.Directory.doesFileExist path if | exists -> do - contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm. - fileConf <- case Data.Yaml.decodeEither contents of - Left e -> do - liftIO - $ putStrErrLn - $ "error reading in brittany config from " ++ path ++ ":" - liftIO $ putStrErrLn e - mzero - Right x -> return x - return $ fileConf Semigroup.<> conf + contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm. + fileConf <- case Data.Yaml.decodeEither contents of + Left e -> do + liftIO + $ putStrErrLn + $ "error reading in brittany config from " + ++ path + ++ ":" + liftIO $ putStrErrLn e + mzero + Right x -> return x + return $ fileConf Semigroup.<> conf | shouldCreate -> do - liftIO $ ByteString.writeFile path - $ Data.Yaml.encode - $ cMap (Option . Just . runIdentity) staticDefaultConfig - return $ conf + liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap + (Option . Just . runIdentity) + staticDefaultConfig + return $ conf | otherwise -> do - return conf + return conf #test nested pattern alignment issue" func = BuildReport @@ -854,7 +888,7 @@ func = + foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo -#test opapp-specialcasing-2 +#test opapp-specialcasing-3 func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo [ foooooooooooooooooooooooooooooooo , foooooooooooooooooooooooooooooooo diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index a2da0a1..a4a9836 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -324,7 +324,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ++ -- pattern and exactly one clause in single line, body in new line. [ docLines - $ [ docSeq (patPartInline ++ [appSep $ guardPart, return binderDoc]) + $ [ docSeq (patPartInline ++ [guardPart, return binderDoc]) , docEnsureIndent BrIndentRegular $ docNonBottomSpacing $ (docAddBaseY BrIndentRegular $ return body) @@ -364,9 +364,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ++ -- multiple clauses, each in a separate, single line [ docLines - $ [ patPartParWrap - $ docEnsureIndent BrIndentRegular + $ [ docAddBaseY BrIndentRegular + $ patPartParWrap $ docLines + $ map docSetBaseY $ clauseDocs <&> \(guardDocs, bodyDoc, _) -> do let guardPart = singleLineGuardsDoc guardDocs @@ -389,12 +390,14 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ++ -- multiple clauses, each with the guard(s) in a single line, body -- as a paragraph [ docLines - $ [ patPartParWrap - $ docEnsureIndent BrIndentRegular + $ [ docAddBaseY BrIndentRegular + $ patPartParWrap $ docLines + $ map docSetBaseY $ clauseDocs - >>= \(guardDocs, bodyDoc, _) -> - ( case guardDocs of + <&> \(guardDocs, bodyDoc, _) -> + docSeq + $ ( case guardDocs of [] -> [] [g] -> [ docForceSingleline @@ -407,22 +410,57 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ++ List.intersperse docCommaSep (return <$> gs) ] ) - ++ [ docCols + ++ [ docSeparator + , docCols ColOpPrefix [ appSep $ return binderDoc - , docForceParSpacing - $ docAddBaseY BrIndentRegular + , docAddBaseY BrIndentRegular + $ docForceParSpacing $ return bodyDoc ] ] ] ++ wherePartMultiLine ] + ++ -- multiple clauses, each with the guard(s) in a single line, body + -- in a new line as a paragraph + [ docLines + $ [ docAddBaseY BrIndentRegular + $ patPartParWrap + $ docLines + $ map docSetBaseY + $ clauseDocs + >>= \(guardDocs, bodyDoc, _) -> + ( case guardDocs of + [] -> [] + [g] -> + [ docForceSingleline + $ docSeq [appSep $ docLit $ Text.pack "|", return g] + ] + gs -> + [ docForceSingleline + $ docSeq + $ [appSep $ docLit $ Text.pack "|"] + ++ List.intersperse docCommaSep (return <$> gs) + ] + ) + ++ [ docCols + ColOpPrefix + [ appSep $ return binderDoc + , docAddBaseY BrIndentRegular + $ docForceParSpacing + $ return bodyDoc + ] + ] + ] + ++ wherePartMultiLine + ] ++ -- conservative approach: everything starts on the left. [ docLines - $ [ patPartParWrap - $ docEnsureIndent BrIndentRegular + $ [ docAddBaseY BrIndentRegular + $ patPartParWrap $ docLines + $ map docSetBaseY $ clauseDocs >>= \(guardDocs, bodyDoc, _) -> ( case guardDocs of diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 4580c5b..9694968 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -473,9 +473,9 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of ] HsMultiIf _ cases -> do clauseDocs <- cases `forM` layoutGrhs - binderDoc <- docLit $ Text.pack " ->" + binderDoc <- docLit $ Text.pack "->" hasComments <- hasAnyCommentsBelow lexpr - docAddBaseY BrIndentRegular $ docPar + docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar (docLit $ Text.pack "if") (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments) HsLet binds exp1 -> do