c13a515 · ormolu · git.iko.soy

git.iko.soy/ormolu

Implement pretty printing of normal & parallel list comprehensions

There are no real problems to speak of, as the formatting is obvious and consistent with what the Haskell community already does.See the tests for an example. The reason transform list comprehensions are not implemented yet is because the GHC AST for representing list comprehensions is ahorrible mess, where slightly different list comprehensions end upcausing massively different syntax trees. The simplest way of solving this would likely be a preprocessing step that reads the syntaxtrees and produces a simple, linear list of bindings. I decided not to implement this yet to avoid delaying this commit further.

commitc13a515b2840102b41d494606e78a7f44be26f1c authoryumiova <yumiova@protonmail.ch> dateSun 23 Jun 2019, 18:05 (7 years ago) parent3cc9021

5 files changed+141−10

compare with master

unifiedsplit

data/examples/declaration/value/function/list-comprehensions-out.hs+25 data/examples/declaration/value/function/list-comprehensions.hs+22 data/examples/declaration/value/function/parallel-comprehensions-out.hs+37 data/examples/declaration/value/function/parallel-comprehensions.hs+28 src/Ormolu/Printer/Meat/Declaration/Value.hs+29−10

data/examples/declaration/value/function/list-comprehensions-out.hsnew file+25

@@ -0,0 +1,25 @@

1+foo x = [a | a <- x]

3+bar x y = [(a, b) | a <- x, even a, b <- y, a != b]

5+barbaz x y z w =

6+ [ (a, b, c, d) -- Foo

7+ | a <-

8+ x -- Bar

9+ , b <- y -- Baz

10+ , any even [a, b]

11+ , c <-

12+ z *

13+ z ^

14+ 2 -- Bar baz

15+ , d <-

16+ w +

17+ w -- Baz bar

18+ , all

19+ even

20+ [ a

21+ , b

22+ , c

23+ , d

24+ ]

25+ ]

data/examples/declaration/value/function/list-comprehensions.hsnew file+22

@@ -0,0 +1,22 @@

1+foo x = [a|a<-x]

3+bar x y = [ (a, b) | a<-x, even a , b<-y, a != b ]

5+barbaz x y z w = [

6+ (a, b, c, d) | -- Foo

7+ a <-

8+ x, -- Bar

9+ b<-y, -- Baz

10+ any even [a, b],

11+ c <- z *

12+ z ^ 2, -- Bar baz

13+ d <-

14+ w

15+ +

16+ w, -- Baz bar

17+ all

18+ even [

19+ a, b,

20+ c, d

21+ ]

22+ ]

data/examples/declaration/value/function/parallel-comprehensions-out.hsnew file+37

@@ -0,0 +1,37 @@

1+foo x y = [(a, b) | a <- x | b <- y]

3+bar x y z w = [(a, b, c, d) | a <- x, b <- y, a `mod` b == 0 | c <- z | d <- w]

5+baz x y z w =

6+ [ ( a

7+ , b

8+ , c

9+ , d

10+ , e

11+ , f

12+ , g

13+ , h

14+ , i

15+ , j

16+ )

17+ | a <- -- Foo 1

18+ x -- Foo 2

19+ , b <- -- Bar 1

20+ y -- Bar 2

21+ , a `mod`

22+ b == -- Value

23+ 0

24+ | c <- -- Baz 1

25+ z * -- Baz 2

26+ z -- Baz 3

27+ | d <- w -- Other

28+ | e <- x * x -- Foo bar

29+ | f <- -- Foo baz 1

30+ y + y -- Foo baz 2

31+ | h <- z + z * w ^ 2 -- Bar foo

32+ | i <- -- Bar bar 1

33+ a + -- Bar bar 2

34+ b -- Bar bar 3

35+ , j <- -- Bar baz 1

36+ a + b -- Bar baz 2

37+ ]

data/examples/declaration/value/function/parallel-comprehensions.hsnew file+28

@@ -0,0 +1,28 @@

1+foo x y = [(a,b) | a<-x | b<-y]

3+bar x y z w = [(a,b,c,d) | a<-x, b<-y, a`mod`b == 0|c<-z|d<-w ]

5+baz x y z w = [

6+ (a,b,c,d,e,

7+ f,g,h,i,j) |

8+ a<- -- Foo 1

9+ x, -- Foo 2

10+ b<- -- Bar 1

11+ y, -- Bar 2

12+ a

13+ `mod` b -- Value

14+ == 0|

15+ c<- -- Baz 1

16+ z * -- Baz 2

17+ z| -- Baz 3

18+ d<- w | -- Other

19+ e <- x * x | -- Foo bar

20+ f -- Foo baz 1

21+ <- y + y | -- Foo baz 2

22+ h <- z + z * w ^ 2 | -- Bar foo

23+ i <- -- Bar bar 1

24+ a + -- Bar bar 2

25+ b, -- Bar bar 3

26+ j <- -- Bar baz 1

27+ a + b -- Bar baz 2

28+ ]

src/Ormolu/Printer/Meat/Declaration/Value.hs+29−10

@@ -14,7 +14,7 @@ import Bag (bagToList)

1414import BasicTypes

1515import Control.Monad

1616import Data.Data

17−import Data.List (sortOn)

17+import Data.List (intersperse, sortOn)

1818import Data.Text (Text)

1919import GHC

2020import Ormolu.Printer.Combinators

@@ -186,8 +186,7 @@ p_grhs _ (XGRHS NoExt) = notImplemented "XGRHS"

186186

187187p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()

188188p_stmt = \case

189− LastStmt NoExt _ _ _ ->

190− notImplemented "LastStmt" -- only available after renamer

189+ LastStmt NoExt body _ _ -> located body p_hsExpr

191190 BindStmt NoExt l f _ _ -> do

192191 located l p_pat

193192 space

@@ -199,11 +198,19 @@ p_stmt = \case

199198 LetStmt NoExt binds -> do

200199 txt "let "

201200 sitcc $ located binds p_hsLocalBinds

202− ParStmt {} -> notImplemented "ParStmt"

201+ ParStmt NoExt stmts _ _ ->

202+ sequence_ $ intersperse breakpoint $

203+ withSep (txt "| ") p_parStmtBlock stmts

203204 TransStmt {} -> notImplemented "TransStmt"

204205 RecStmt {} -> notImplemented "RecStmt"

205206 XStmtLR {} -> notImplemented "XStmtLR"

206207

208+p_parStmtBlock :: ParStmtBlock GhcPs GhcPs -> R ()

209+p_parStmtBlock = \case

210+ ParStmtBlock NoExt stmts _ _ ->

211+ velt $ withSep comma (located' (sitcc . p_stmt)) stmts

212+ XParStmtBlock {} -> notImplemented "XParStmtBlock"

213+

207214p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()

208215p_hsLocalBinds = \case

209216 HsValBinds NoExt (ValBinds NoExt bag lsigs) -> do

@@ -344,18 +351,29 @@ p_hsExpr = \case

344351 txt "in "

345352 sitcc (located e p_hsExpr)

346353 HsDo NoExt ctx es -> do

354+ let doBody header = do

355+ txt header

356+ newline

357+ inci $ located es (newlineSep (located' (sitcc . p_stmt)))

358+ compBody = brackets $ located es $ \xs -> do

359+ let stmts = init xs

360+ yield = last xs

361+ located yield p_stmt

362+ breakpoint

363+ txt "| "

364+ case stmts of

365+ [stmt] | ParStmt {} <- unLoc stmt -> located stmt p_stmt

366+ _ -> velt $ withSep comma (located' (sitcc . p_stmt)) stmts

347367 case ctx of

348− DoExpr -> txt "do"

349− MDoExpr -> txt "mdo"

350− ListComp -> notImplemented "ListComp"

368+ DoExpr -> doBody "do"

369+ MDoExpr -> doBody "mdo"

370+ ListComp -> compBody

351371 MonadComp -> notImplemented "MonadComp"

352372 ArrowExpr -> notImplemented "ArrowExpr"

353373 GhciStmtCtxt -> notImplemented "GhciStmtCtxt"

354374 PatGuard _ -> notImplemented "PatGuard"

355375 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"

356376 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

357− newline

358− inci $ located es (newlineSep (located' (sitcc . p_stmt)))

359377 ExplicitList _ _ xs ->

360378 brackets $ velt (withSep comma (located' p_hsExpr) xs)

361379 RecordCon {..} -> do

@@ -644,7 +662,8 @@ exprPlacement = \case

644662 HsLam NoExt _ -> Hanging

645663 HsLamCase NoExt _ -> Hanging

646664 HsCase NoExt _ _ -> Hanging

647− HsDo NoExt _ _ -> Hanging

665+ HsDo NoExt DoExpr _ -> Hanging

666+ HsDo NoExt MDoExpr _ -> Hanging

648667 RecordCon NoExt _ _ -> Hanging

649668 _ -> Normal

650669