45e25a1 · ormolu · git.iko.soy

git.iko.soy/ormolu

on master help sign in

Implement rendering of most types of expressions

45e25a1yumiova7 years ago

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

compare with master

unifiedsplit

@@ -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

8where

10import Bag (bagToList)

11+import BasicTypes

11import Control.Monad

12import Control.Monad

13+import Data.Data

12import Data.List (sortOn)

14import Data.List (sortOn)

13import GHC

15import GHC

14import Ormolu.Printer.Combinators

16import Ormolu.Printer.Combinators

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

18import Ormolu.Printer.Meat.Declaration.Signature

20import Ormolu.Printer.Meat.Declaration.Signature

19import Ormolu.Utils

21import Ormolu.Utils

20import SrcLoc (isOneLineSpan)

22import SrcLoc (isOneLineSpan)

23+import Outputable (Outputable (..))

21import qualified Data.List.NonEmpty as NE

24import qualified Data.List.NonEmpty as NE

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

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

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

108 case style of

111 case style of

109 Lambda -> return ()

112 Lambda -> return ()

110 _ -> breakpoint

113 _ -> breakpoint

111− newlineSep (located' p_grhs) grhssGRHSs

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

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

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

113 newline

116 newline

114 line (txt "where")

117 line (txt "where")

115 inci (located grhssLocalBinds p_hsLocalBinds)

118 inci (located grhssLocalBinds p_hsLocalBinds)

116

119

120+data GroupStyle

121+ = Pattern

122+ | MultiIf

123+

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

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

118−p_grhs (GRHS NoExt guards body) =

125+p_grhs style (GRHS NoExt guards body) =

119 case guards of

126 case guards of

120 [] -> p_body

127 [] -> p_body

121 xs -> do

128 xs -> do

122 txt "| "

129 txt "| "

123 velt $ withSep comma (located' p_stmt) xs

130 velt $ withSep comma (located' p_stmt) xs

124− txt " ="

131+ space

132+ txt $ case style of

133+ Pattern -> "="

134+ MultiIf -> "->"

125 breakpoint

135 breakpoint

126 inci p_body

136 inci p_body

127 where

137 where

128 p_body = located body p_hsExpr

138 p_body = located body p_hsExpr

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

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

130

140

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

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

132p_stmt = \case

142p_stmt = \case

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

156 EmptyLocalBinds NoExt -> return ()

166 EmptyLocalBinds NoExt -> return ()

157 XHsLocalBindsLR _ -> notImplemented "XHsLocalBindsLR"

167 XHsLocalBindsLR _ -> notImplemented "XHsLocalBindsLR"

158

168

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+

159p_hsExpr :: HsExpr GhcPs -> R ()

185p_hsExpr :: HsExpr GhcPs -> R ()

160p_hsExpr = \case

186p_hsExpr = \case

161 HsVar NoExt name -> p_rdrName name

187 HsVar NoExt name -> p_rdrName name

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

166 Unambiguous NoExt name -> p_rdrName name

192 Unambiguous NoExt name -> p_rdrName name

167 Ambiguous NoExt name -> p_rdrName name

193 Ambiguous NoExt name -> p_rdrName name

168 XAmbiguousFieldOcc NoExt -> notImplemented "XAmbiguousFieldOcc"

194 XAmbiguousFieldOcc NoExt -> notImplemented "XAmbiguousFieldOcc"

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

195+ HsOverLabel NoExt _ v -> do

196+ txt "#"

197+ atom v

170 HsIPVar NoExt (HsIPName name) -> atom name

198 HsIPVar NoExt (HsIPName name) -> atom name

171 HsOverLit NoExt v -> atom (ol_val v)

199 HsOverLit NoExt v -> atom (ol_val v)

172 HsLit NoExt lit -> atom lit

200 HsLit NoExt lit -> atom lit

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

197 txt "-"

225 txt "-"

198 located e p_hsExpr

226 located e p_hsExpr

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

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

200− SectionL {} -> notImplemented "SectionL"

228+ SectionL NoExt x op -> do

201− SectionR {} -> notImplemented "SectionR"

229+ located x p_hsExpr

202− ExplicitTuple {} -> notImplemented "ExplicitTuple"

230+ breakpoint

203− ExplicitSum {} -> notImplemented "ExplicitSum"

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)

204 HsCase NoExt e mgroup -> do

248 HsCase NoExt e mgroup -> do

205 txt "case "

249 txt "case "

206 located e p_hsExpr

250 located e p_hsExpr

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

220 located else' $ \x -> do

264 located else' $ \x -> do

221 breakpoint

265 breakpoint

222 inci (p_hsExpr x)

266 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)

224 HsLet NoExt localBinds e -> do

272 HsLet NoExt localBinds e -> do

225 txt "let "

273 txt "let "

226 sitcc (located localBinds p_hsLocalBinds)

274 sitcc (located localBinds p_hsLocalBinds)

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

230 HsDo {} -> notImplemented "HsDo"

278 HsDo {} -> notImplemented "HsDo"

231 ExplicitList _ _ xs -> do

279 ExplicitList _ _ xs -> do

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

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

233− RecordCon {} -> notImplemented "RecordCon"

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))

234− RecordUpd {} -> notImplemented "RecordUpd"

291+ RecordUpd {..} -> do

292+ located rupd_expr p_hsExpr

293+ breakpoint

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

235− ExprWithTySig {} -> notImplemented "ExprWithTySig"

295+ ExprWithTySig affix x -> do

236− ArithSeq {} -> notImplemented "ArithSeq"

296+ located x p_hsExpr

237− HsSCC {} -> notImplemented "HsSCC"

297+ breakpoint

238− HsCoreAnn {} -> notImplemented "HsCoreAnn"

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

239 HsBracket {} -> notImplemented "HsBracket"

335 HsBracket {} -> notImplemented "HsBracket"

240 HsRnBracketOut {} -> notImplemented "HsRnBracketOut"

336 HsRnBracketOut {} -> notImplemented "HsRnBracketOut"

241 HsTcBracketOut {} -> notImplemented "HsTcBracketOut"

337 HsTcBracketOut {} -> notImplemented "HsTcBracketOut"

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

244 HsStatic _ e -> do

340 HsStatic _ e -> do

245 txt "static"

341 txt "static"

246 breakpoint

342 breakpoint

247− inci $ located e p_hsExpr

343+ inci (located e p_hsExpr)

248 HsArrApp {} -> notImplemented "HsArrApp"

344 HsArrApp {} -> notImplemented "HsArrApp"

249 HsArrForm {} -> notImplemented "HsArrForm"

345 HsArrForm {} -> notImplemented "HsArrForm"

250 HsTick {} -> notImplemented "HsTick"

346 HsTick {} -> notImplemented "HsTick"

251 HsBinTick {} -> notImplemented "HsBinTick"

347 HsBinTick {} -> notImplemented "HsBinTick"

252 HsTickPragma {} -> notImplemented "HsTickPragma"

348 HsTickPragma {} -> notImplemented "HsTickPragma"

253− EWildPat NoExt -> notImplemented "EWildPat"

349+ EWildPat NoExt -> txt "_"

254 EAsPat {} -> notImplemented "EAsPat"

350 EAsPat {} -> notImplemented "EAsPat"

255 EViewPat {} -> notImplemented "EViewPat"

351 EViewPat {} -> notImplemented "EViewPat"

256 ELazyPat {} -> notImplemented "ELazyPat"

352 ELazyPat {} -> notImplemented "ELazyPat"