git.iko.soy/ormolu
on master help sign in
Support transform list comprehensions
commit9e880c5299a91e2ae0351f683e99c5523dae4a42 authoryumiova <yumiova@protonmail.ch> dateMon 8 Jul 2019, 19:54 (7 years ago) parent069ae69
3 files changed+182−13
compare with master
unifiedsplit
data/examples/declaration/value/function/transform-comprehensions-out.hs+58 data/examples/declaration/value/function/transform-comprehensions.hs+55 src/Ormolu/Printer/Meat/Declaration/Value.hs+69−13
data/examples/declaration/value/function/transform-comprehensions-out.hsnew file+58
@@ -0,0 +1,58 @@
1+{-# LANGUAGE TransformListComp #-}
2+
3+foo xs ys = [(x, y) | x <- xs, y <- ys, then reverse]
4+
5+foo' xs ys =
6+ [ ( x
7+ , y
8+ )
9+ | x <- xs
10+ , y <- ys
11+ , -- First comment
12+ then reverse -- Second comment
13+ ]
14+
15+bar xs ys = [(x, y) | x <- xs, y <- ys, then sortWith by (x + y)]
16+
17+bar' xs ys =
18+ [ ( x
19+ , y
20+ )
21+ | x <- xs
22+ , y <- ys
23+ , -- First comment
24+ then sortWith
25+ by
26+ ( x +
27+ y -- Second comment
28+ )
29+ ]
30+
31+baz xs ys = [(x, y) | x <- xs, y <- ys, then group using permutations]
32+
33+baz' xs ys =
34+ [ ( x
35+ , y
36+ )
37+ | x <- xs
38+ , y <- ys
39+ , -- First comment
40+ then group using permutations -- Second comment
41+ ]
42+
43+quux xs ys = [(x, y) | x <- xs, y <- ys, then group by (x + y) using groupWith]
44+
45+quux' xs ys =
46+ [ ( x
47+ , y
48+ )
49+ | x <- xs
50+ , y <- ys
51+ , -- First comment
52+ then group by
53+ ( x +
54+ y
55+ )
56+ -- Second comment
57+ using groupWith -- Third comment
58+ ]
data/examples/declaration/value/function/transform-comprehensions.hsnew file+55
@@ -0,0 +1,55 @@
1+{-# LANGUAGE TransformListComp #-}
2+
3+foo xs ys = [(x, y) | x <- xs, y <- ys, then reverse]
4+
5+foo' xs ys = [
6+ (x,
7+ y) |
8+ x <- xs,
9+ y <- ys,
10+ then -- First comment
11+ reverse -- Second comment
12+ ]
13+
14+bar xs ys = [(x, y) | x <- xs, y <- ys, then sortWith by (x + y)]
15+
16+bar' xs ys = [
17+ (x,
18+ y) |
19+ x <- xs,
20+ y <- ys,
21+ then -- First comment
22+ sortWith
23+ by
24+ (x
25+ + y) -- Second comment
26+ ]
27+
28+baz xs ys = [(x, y) | x <- xs, y <- ys, then group using permutations]
29+
30+baz' xs ys = [
31+ (x,
32+ y) |
33+ x <- xs,
34+ y <- ys,
35+ then
36+ group
37+ using -- First comment
38+ permutations -- Second comment
39+ ]
40+
41+quux xs ys = [(x, y) | x <- xs, y <- ys, then group by (x + y) using groupWith]
42+
43+quux' xs ys = [
44+ (x,
45+ y) |
46+ x <- xs,
47+ y <- ys,
48+ then
49+ group
50+ by -- First comment
51+ (x
52+ + y)
53+ using -- Second comment
54+ groupWith -- Third comment
55+ ]
src/Ormolu/Printer/Meat/Declaration/Value.hs+69−13
@@ -308,20 +308,60 @@ p_stmt' pretty = \case
308308 LetStmt NoExt binds -> do
309309 txt "let "
310310 sitcc $ located binds p_hsLocalBinds
311− ParStmt NoExt stmts _ _ ->
312− sequence_ $ intersperse breakpoint $
313− withSep (txt "| ") p_parStmtBlock stmts
314− TransStmt {} -> notImplemented "TransStmt"
311+ ParStmt {} ->
312+ -- NOTE 'ParStmt' should always be eliminated in 'gatherStmt' already,
313+ -- such that it never occurs in 'p_stmt''. Consequently, handling it
314+ -- here would be redundant.
315+ notImplemented "ParStmt"
316+ TransStmt {..} -> do
317+ -- NOTE 'TransStmt' only needs to account for pretty printing itself,
318+ -- since pretty printing of relevant statements (e.g., in 'trS_stmts')
319+ -- is handled through 'gatherStmt'.
320+ case (trS_form, trS_by) of
321+ (ThenForm, Nothing) -> located trS_using $ \x -> do
322+ txt "then"
323+ breakpoint
324+ inci (p_hsExpr x)
325+ (ThenForm, Just e) -> do
326+ located trS_using $ \x -> do
327+ txt "then"
328+ breakpoint
329+ inci (p_hsExpr x)
330+ breakpoint
331+ located e $ \x -> do
332+ txt "by"
333+ breakpoint
334+ inci (p_hsExpr x)
335+ (GroupForm, Nothing) -> located trS_using $ \x -> do
336+ txt "then group using"
337+ breakpoint
338+ inci (p_hsExpr x)
339+ (GroupForm, Just e) -> do
340+ located e $ \x -> do
341+ txt "then group by"
342+ breakpoint
343+ inci (p_hsExpr x)
344+ breakpoint
345+ located trS_using $ \x -> do
346+ txt "using"
347+ breakpoint
348+ inci (p_hsExpr x)
315349 RecStmt {..} -> do
316350 txt "rec "
317351 sitcc $ newlineSep (located' (p_stmt' pretty)) recS_stmts
318352 XStmtLR {} -> notImplemented "XStmtLR"
319353
320−p_parStmtBlock :: ParStmtBlock GhcPs GhcPs -> R ()
321−p_parStmtBlock = \case
322− ParStmtBlock NoExt stmts _ _ ->
323− velt $ withSep comma (located' (sitcc . p_stmt)) stmts
324− XParStmtBlock {} -> notImplemented "XParStmtBlock"
354+gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
355+gatherStmt (L _ (ParStmt NoExt block _ _)) =
356+ foldr ((<>) . gatherStmtBlock) [] block
357+gatherStmt (L s stmt@TransStmt {..}) =
358+ foldr liftAppend [] ((gatherStmt <$> trS_stmts) <> pure [[L s stmt]])
359+gatherStmt stmt = [[stmt]]
360+
361+gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]]
362+gatherStmtBlock (ParStmtBlock _ stmts _ _) =
363+ foldr (liftAppend . gatherStmt) [] stmts
364+gatherStmtBlock XParStmtBlock {} = notImplemented "XParStmtBlock"
325365
326366p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
327367p_hsLocalBinds = \case
@@ -468,14 +508,21 @@ p_hsExpr = \case
468508 newline
469509 inci $ located es (newlineSep (located' (sitcc . p_stmt)))
470510 compBody = brackets $ located es $ \xs -> do
471− let stmts = init xs
511+ let p_parBody =
512+ sequence_ .
513+ intersperse breakpoint .
514+ withSep (txt "| ") p_seqBody
515+ p_seqBody =
516+ sequence_ .
517+ intersperse (vlayout (pure ()) newline) .
518+ withSep comma (located' (sitcc . p_stmt))
519+ stmts = init xs
472520 yield = last xs
521+ lists = foldr (liftAppend . gatherStmt) [] stmts
473522 located yield p_stmt
474523 breakpoint
475524 txt "| "
476− case stmts of
477− [stmt] | ParStmt {} <- unLoc stmt -> located stmt p_stmt
478− _ -> velt $ withSep comma (located' (sitcc . p_stmt)) stmts
525+ p_parBody lists
479526 case ctx of
480527 DoExpr -> doBody "do"
481528 MDoExpr -> doBody "mdo"
@@ -757,6 +804,15 @@ p_hsBracket = \case
757804----------------------------------------------------------------------------
758805-- Helpers
759806
807+-- | Append each element in both lists with semigroups. If one list is shorter
808+-- than the other, return the rest of the longer list unchanged.
809+
810+liftAppend :: Semigroup a => [a] -> [a] -> [a]
811+liftAppend [] [] = []
812+liftAppend [] (y : ys) = y : ys
813+liftAppend (x : xs) [] = x : xs
814+liftAppend (x : xs) (y : ys) = x <> y : liftAppend xs ys
815+
760816getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan
761817getGRHSSpan (GRHS NoExt _ body) = getLoc body
762818getGRHSSpan (XGRHS NoExt) = notImplemented "XGRHS"