45e25a1 · ormolu · git.iko.soy

git.iko.soy/ormolu

Implement rendering of most types of expressions

This pull request implements most of currently missing types of expressions, with the exception of: * Do notation * List comprehensions (list comprehensions are considered a kind of do notation in GHC) * Arrow notation * Template Haskell Most expressions are pretty printed in an uncontroversial manner, preferably similar to existing syntax.

commit45e25a11466a8dfce80fd0b96dce61c742a34799 authoryumiova <yumiova@protonmail.ch> dateSun 2 Jun 2019, 20:51 (7 years ago) parent9a0276b

27 files changed+337−19

compare with master

unifiedsplit

data/examples/declaration/value/function/arithmetic-sequences-out.hsnew file+14

@@ -0,0 +1,14 @@

1+foo = [0 ..]

3+bar x =

4+ [ 0

5+ .. x

6+ ]

8+baz x =

9+ [ 1

10+ , 3

11+ .. x

12+ ]

13+

14+barbaz x = [0, 1 ..]

data/examples/declaration/value/function/arithmetic-sequences.hsnew file+10

@@ -0,0 +1,10 @@

1+foo = [0..]

2+bar x = [

3+ 0..x

4+ ]

5+baz x = [

6+ 1,

7+ 3 ..

8+ x

9+ ]

10+barbaz x = [ 0, 1.. ]

data/examples/declaration/value/function/multi-way-if-out.hsnew file+9

@@ -0,0 +1,9 @@

1+{-# LANGUAGE MultiWayIf #-}

2+foo x = if | x == 5 -> 5

4+bar x y =

5+ if

6+ | x > y -> x

7+ | x < y ->

8+ y

9+ | otherwise -> x

data/examples/declaration/value/function/multi-way-if.hsnew file+9

@@ -0,0 +1,9 @@

1+{-# LANGUAGE MultiWayIf #-}

3+foo x = if | x == 5 -> 5

5+bar x y = if

6+ | x > y -> x

7+ | x < y

8+ -> y

9+ | otherwise -> x

data/examples/declaration/value/function/operator-sections-out.hsnew file+11

@@ -0,0 +1,11 @@

1+foo = (0 +)

3+bar = (<> "hello")

5+baz =

6+ ( 1 * 2

7+ +

8+ )

9+ ( *

10+ 3 ^ 5

11+ )

data/examples/declaration/value/function/operator-sections.hsnew file+7

@@ -0,0 +1,7 @@

1+foo = (0 +)

2+bar = ( <> "hello" )

3+baz =

4+ ( 1 * 2

5+ + )

6+ ( *

7+ 3 ^ 5)

data/examples/declaration/value/function/overloaded-labels-out.hsnew file+4

@@ -0,0 +1,4 @@

1+{-# LANGUAGE OverloadedLabels #-}

2+foo = #field

4+bar = (#this) (#that)

data/examples/declaration/value/function/overloaded-labels.hsnew file+4

@@ -0,0 +1,4 @@

1+{-# LANGUAGE OverloadedLabels #-}

3+foo = #field

4+bar = (#this ) ( #that)

data/examples/declaration/value/function/pragmas-out.hsnew file+11

@@ -0,0 +1,11 @@

1+sccfoo = {-# SCC foo #-} 1

3+sccbar =

4+ {-# SCC "barbaz" #-}

5+ "hello"

7+corefoo = {-# CORE "foo" #-} 1

9+corebar =

10+ {-# CORE "bar baz" #-}

11+ "hello"

data/examples/declaration/value/function/pragmas.hsnew file+7

@@ -0,0 +1,7 @@

1+sccfoo = {-# SCC foo#-} 1

2+sccbar = {-# SCC "barbaz"#-}

3+ "hello"

5+corefoo = {-# CORE "foo"#-} 1

6+corebar = {-# CORE "bar baz"#-}

7+ "hello"

data/examples/declaration/value/function/record-constructors-out.hsnew file+9

@@ -0,0 +1,9 @@

1+foo = Foo {a = 3}

3+bar =

4+ Bar

5+ { abc = foo

6+ , def = Foo {a = 10}

7+ }

9+baz = Baz {}

data/examples/declaration/value/function/record-constructors.hsnew file+6

@@ -0,0 +1,6 @@

1+foo = Foo { a = 3 }

2+bar = Bar {

3+ abc = foo,

4+ def = Foo {a = 10}

5+}

6+baz = Baz{ }

data/examples/declaration/value/function/record-updaters-out.hsnew file+9

@@ -0,0 +1,9 @@

1+foo x = x {a = 3}

3+bar x =

4+ x

5+ { abc = foo

6+ , def = Foo {a = 10}

7+ }

9+baz x = x {}

data/examples/declaration/value/function/record-updaters.hsnew file+6

@@ -0,0 +1,6 @@

1+foo x = x { a = 3 }

2+bar x = x {

3+ abc = foo,

4+ def = Foo {a = 10}

5+}

6+baz x = x{ }

data/examples/declaration/value/function/record-wildcards-out.hsnew file+13

@@ -0,0 +1,13 @@

1+{-# LANGUAGE NamedFieldPuns #-}

2+{-# LANGUAGE RecordWildCards #-}

3+foo x y = Foo {x, y}

5+bar x y z =

6+ Bar

7+ { x

8+ , y

9+ , z

10+ , ..

11+ }

12+

13+baz = Baz {..}

data/examples/declaration/value/function/record-wildcards.hsnew file+13

@@ -0,0 +1,13 @@

1+{-# LANGUAGE NamedFieldPuns #-}

2+{-# LANGUAGE RecordWildCards #-}

4+foo x y = Foo { x, y }

6+bar x y z = Bar {

7+ x,

8+ y,

9+ z,

10+ ..

11+}

12+

13+baz = Baz { .. }

data/examples/declaration/value/function/tuple-sections-out.hsnew file+15

@@ -0,0 +1,15 @@

1+{-# LANGUAGE TupleSections #-}

2+foo = (, 2)

4+bar = (, 5, )

6+baz =

7+ (

8+ ,

9+ , 5

10+ , 6

11+ , 7

12+ ,

13+ ,

14+ ,

15+ )

data/examples/declaration/value/function/tuple-sections.hsnew file+8

@@ -0,0 +1,8 @@

1+{-# LANGUAGE TupleSections #-}

3+foo = (,2)

4+bar = (,5,)

5+baz = (

6+ ,,5,6,

7+ 7,,,

8+ )

data/examples/declaration/value/function/tuples-out.hsnew file+7

@@ -0,0 +1,7 @@

1+foo = (1, 2, 3)

3+bar =

4+ ( 1

5+ , 2

6+ , 3

7+ )

data/examples/declaration/value/function/tuples.hsnew file+6

@@ -0,0 +1,6 @@

1+foo = ( 1,2,3 )

2+bar = (

3+ 1,

4+ 2,

5+ 3

6+ )

data/examples/declaration/value/function/typed-expressions-out.hsnew file+5

@@ -0,0 +1,5 @@

1+foo x = x :: Int

3+bar x =

4+ Just x

5+ :: Maybe String

data/examples/declaration/value/function/typed-expressions.hsnew file+3

@@ -0,0 +1,3 @@

1+foo x = x::Int

2+bar x = Just x ::

3+ Maybe String

data/examples/declaration/value/function/unboxed-sums-out.hsnew file+15

@@ -0,0 +1,15 @@

1+{-# LANGUAGE UnboxedSums #-}

2+foo = (# 1| #)

4+bar = (# | | 2| #)

6+baz =

7+ (#

8+ |

9+ |

10+ | 10

11+ |

12+ |

13+ |

14+ |

15+ | #)

data/examples/declaration/value/function/unboxed-sums.hsnew file+7

@@ -0,0 +1,7 @@

1+{-# LANGUAGE UnboxedSums #-}

3+foo = (# 1 | #)

4+bar = (# | |2| #)

5+baz = (# |

6+ | | 10 | | | |

7+ | #)

data/examples/declaration/value/function/unboxed-tuples-out.hsnew file+7

@@ -0,0 +1,7 @@

1+{-# LANGUAGE UnboxedTuples #-}

2+foo = (# 1, 2, 3 #)

4+bar =

5+ (# 1

6+ , 2

7+ , 3 #)

data/examples/declaration/value/function/unboxed-tuples.hsnew file+7

@@ -0,0 +1,7 @@

1+{-# LANGUAGE UnboxedTuples #-}

3+foo = (# 1,2,3 #)

4+bar = (#

5+ 1,

6+ 2,

7+ 3 #)

src/Ormolu/Printer/Meat/Declaration/Value.hs+115−19

@@ -8,7 +8,9 @@ module Ormolu.Printer.Meat.Declaration.Value

88where

1010import Bag (bagToList)

11+import BasicTypes

1112import Control.Monad

13+import Data.Data

1214import Data.List (sortOn)

1315import GHC

1416import Ormolu.Printer.Combinators

@@ -18,6 +20,7 @@ import Ormolu.Printer.Meat.Declaration.Pat

1820import Ormolu.Printer.Meat.Declaration.Signature

1921import Ormolu.Utils

2022import SrcLoc (isOneLineSpan)

23+import Outputable (Outputable (..))

2124import qualified Data.List.NonEmpty as NE

2225

2326p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

@@ -108,25 +111,32 @@ p_match style m_pats m_grhss = do

108111 case style of

109112 Lambda -> return ()

110113 _ -> breakpoint

111− newlineSep (located' p_grhs) grhssGRHSs

114+ newlineSep (located' (p_grhs Pattern)) grhssGRHSs

112115 unless (GHC.isEmptyLocalBindsPR (unL grhssLocalBinds)) $ do

113116 newline

114117 line (txt "where")

115118 inci (located grhssLocalBinds p_hsLocalBinds)

116119

117−p_grhs :: GRHS GhcPs (LHsExpr GhcPs) -> R ()

118−p_grhs (GRHS NoExt guards body) =

120+data GroupStyle

121+ = Pattern

122+ | MultiIf

123+

124+p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()

125+p_grhs style (GRHS NoExt guards body) =

119126 case guards of

120127 [] -> p_body

121128 xs -> do

122129 txt "| "

123130 velt $ withSep comma (located' p_stmt) xs

124− txt " ="

131+ space

132+ txt $ case style of

133+ Pattern -> "="

134+ MultiIf -> "->"

125135 breakpoint

126136 inci p_body

127137 where

128138 p_body = located body p_hsExpr

129−p_grhs (XGRHS NoExt) = notImplemented "XGRHS"

139+p_grhs _ (XGRHS NoExt) = notImplemented "XGRHS"

130140

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

132142p_stmt = \case

@@ -156,6 +166,22 @@ p_hsLocalBinds = \case

156166 EmptyLocalBinds NoExt -> return ()

157167 XHsLocalBindsLR _ -> notImplemented "XHsLocalBindsLR"

158168

169+p_hsRecField

170+ :: (Data id, Outputable id)

171+ => HsRecField' id (LHsExpr GhcPs)

172+ -> R ()

173+p_hsRecField = \HsRecField {..} -> do

174+ located hsRecFieldLbl atom

175+ unless hsRecPun $ do

176+ txt " = "

177+ located hsRecFieldArg p_hsExpr

178+

179+p_hsTupArg :: HsTupArg GhcPs -> R ()

180+p_hsTupArg = \case

181+ Present NoExt x -> located x p_hsExpr

182+ Missing NoExt -> pure ()

183+ XTupArg {} -> notImplemented "XTupArg"

184+

159185p_hsExpr :: HsExpr GhcPs -> R ()

160186p_hsExpr = \case

161187 HsVar NoExt name -> p_rdrName name

@@ -166,7 +192,9 @@ p_hsExpr = \case

166192 Unambiguous NoExt name -> p_rdrName name

167193 Ambiguous NoExt name -> p_rdrName name

168194 XAmbiguousFieldOcc NoExt -> notImplemented "XAmbiguousFieldOcc"

169− HsOverLabel NoExt _ _ -> notImplemented "HsOverLabel"

195+ HsOverLabel NoExt _ v -> do

196+ txt "#"

197+ atom v

170198 HsIPVar NoExt (HsIPName name) -> atom name

171199 HsOverLit NoExt v -> atom (ol_val v)

172200 HsLit NoExt lit -> atom lit

@@ -197,10 +225,26 @@ p_hsExpr = \case

197225 txt "-"

198226 located e p_hsExpr

199227 HsPar NoExt e -> parens (located e p_hsExpr)

200− SectionL {} -> notImplemented "SectionL"

201− SectionR {} -> notImplemented "SectionR"

202− ExplicitTuple {} -> notImplemented "ExplicitTuple"

203− ExplicitSum {} -> notImplemented "ExplicitSum"

228+ SectionL NoExt x op -> do

229+ located x p_hsExpr

230+ breakpoint

231+ inci (located op p_hsExpr)

232+ SectionR NoExt op x -> do

233+ located op p_hsExpr

234+ breakpoint

235+ inci (located x p_hsExpr)

236+ ExplicitTuple NoExt args boxity -> do

237+ let parens' =

238+ case boxity of

239+ Boxed -> parens

240+ Unboxed -> parensHash

241+ parens' $ velt (withSep comma (located' p_hsTupArg) args)

242+ ExplicitSum NoExt tag arity x -> do

243+ let before = tag - 1

244+ after = arity - before - 1

245+ args = replicate before Nothing <> [Just x] <> replicate after Nothing

246+ parensHash $

247+ velt (withSep (txt "| ") (maybe (pure ()) (located' p_hsExpr)) args)

204248 HsCase NoExt e mgroup -> do

205249 txt "case "

206250 located e p_hsExpr

@@ -220,7 +264,11 @@ p_hsExpr = \case

220264 located else' $ \x -> do

221265 breakpoint

222266 inci (p_hsExpr x)

223− HsMultiIf {} -> notImplemented "MulitiIf"

267+ HsMultiIf NoExt guards -> do

268+ txt "if"

269+ inci $ forM_ guards $ \g -> do

270+ breakpoint

271+ located g (p_grhs MultiIf)

224272 HsLet NoExt localBinds e -> do

225273 txt "let "

226274 sitcc (located localBinds p_hsLocalBinds)

@@ -230,12 +278,60 @@ p_hsExpr = \case

230278 HsDo {} -> notImplemented "HsDo"

231279 ExplicitList _ _ xs -> do

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

233− RecordCon {} -> notImplemented "RecordCon"

234− RecordUpd {} -> notImplemented "RecordUpd"

235− ExprWithTySig {} -> notImplemented "ExprWithTySig"

236− ArithSeq {} -> notImplemented "ArithSeq"

237− HsSCC {} -> notImplemented "HsSCC"

238− HsCoreAnn {} -> notImplemented "HsCoreAnn"

281+ RecordCon {..} -> do

282+ located rcon_con_name atom

283+ breakpoint

284+ let HsRecFields {..} = rcon_flds

285+ fields = located' p_hsRecField <$> rec_flds

286+ dotdot =

287+ case rec_dotdot of

288+ Just {} -> [txt ".."]

289+ Nothing -> []

290+ inci $ braces $ velt (withSep comma id (fields <> dotdot))

291+ RecordUpd {..} -> do

292+ located rupd_expr p_hsExpr

293+ breakpoint

294+ inci $ braces $ velt (withSep comma (located' p_hsRecField) rupd_flds)

295+ ExprWithTySig affix x -> do

296+ located x p_hsExpr

297+ breakpoint

298+ inci $ do

299+ txt ":: "

300+ let HsWC {..} = affix

301+ HsIB {..} = hswc_body

302+ located hsib_body p_hsType

303+ ArithSeq NoExt _ x ->

304+ case x of

305+ From from -> brackets $ do

306+ located from p_hsExpr

307+ breakpoint

308+ txt ".."

309+ FromThen from next -> brackets $ do

310+ velt (withSep comma (located' p_hsExpr) [from, next])

311+ breakpoint

312+ txt ".."

313+ FromTo from to -> brackets $ do

314+ located from p_hsExpr

315+ breakpoint

316+ txt ".. "

317+ located to p_hsExpr

318+ FromThenTo from next to -> brackets $ do

319+ velt (withSep comma (located' p_hsExpr) [from, next])

320+ breakpoint

321+ txt ".. "

322+ located to p_hsExpr

323+ HsSCC NoExt _ name x -> do

324+ txt "{-# SCC "

325+ atom name

326+ txt " #-}"

327+ breakpoint

328+ located x p_hsExpr

329+ HsCoreAnn NoExt _ value x -> do

330+ txt "{-# CORE "

331+ atom value

332+ txt " #-}"

333+ breakpoint

334+ located x p_hsExpr

239335 HsBracket {} -> notImplemented "HsBracket"

240336 HsRnBracketOut {} -> notImplemented "HsRnBracketOut"

241337 HsTcBracketOut {} -> notImplemented "HsTcBracketOut"

@@ -244,13 +340,13 @@ p_hsExpr = \case

244340 HsStatic _ e -> do

245341 txt "static"

246342 breakpoint

247− inci $ located e p_hsExpr

343+ inci (located e p_hsExpr)

248344 HsArrApp {} -> notImplemented "HsArrApp"

249345 HsArrForm {} -> notImplemented "HsArrForm"

250346 HsTick {} -> notImplemented "HsTick"

251347 HsBinTick {} -> notImplemented "HsBinTick"

252348 HsTickPragma {} -> notImplemented "HsTickPragma"

253− EWildPat NoExt -> notImplemented "EWildPat"

349+ EWildPat NoExt -> txt "_"

254350 EAsPat {} -> notImplemented "EAsPat"

255351 EViewPat {} -> notImplemented "EViewPat"

256352 ELazyPat {} -> notImplemented "ELazyPat"