09afebb · ormolu · git.iko.soy

git.iko.soy/ormolu

Implement rendering of simplest value-level constructs

commit09afebbd9cc620600616b4d1c8aa85f6999fed54 authormrkkrp <mark.karpov@tweag.io> dateThu 16 May 2019, 16:33 (7 years ago) parentae3ea9b

41 files changed+597−30

compare with master

unifiedsplit

data/examples/declaration/value/function/case-multi-line-out.hsnew file+25

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

1+foo :: Int -> Int

2+foo x =

3+ case x of

4+ 5 -> 10

5+ _ -> 12

7+bar :: Int -> Int

8+bar x =

9+ case x of

10+ 5 ->

11+ if x > 5

12+ then 10

13+ else 12

14+ _ -> 12

15+

16+baz :: Int -> Int

17+baz x =

18+ case x of

19+ 5 -> 10

20+ _ -> 12

21+

22+quux :: Int -> Int

23+quux x =

24+ case x of

25+ x -> x

data/examples/declaration/value/function/case-multi-line.hsnew file+19

@@ -0,0 +1,19 @@

1+foo :: Int -> Int

2+foo x = case x of

3+ 5 -> 10

4+ _ -> 12

6+bar :: Int -> Int

7+bar x =

8+ case x of

9+ 5 -> if x > 5

10+ then 10 else 12

11+ _ -> 12

12+

13+baz :: Int -> Int

14+baz x = case x of 5 -> 10

15+ _ -> 12

16+

17+quux :: Int -> Int

18+quux x = case x of

19+ x -> x

data/examples/declaration/value/function/case-single-line-out.hsnew file+2

@@ -0,0 +1,2 @@

1+foo :: Int -> Int

2+foo x = case x of x -> x

data/examples/declaration/value/function/case-single-line.hsnew file+2

@@ -0,0 +1,2 @@

1+foo :: Int -> Int

2+foo x = case x of x -> x

data/examples/declaration/value/function/if-multi-line-out.hsnew file+5

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

1+foo :: Int -> Int

2+foo x =

3+ if x > 5

4+ then 10

5+ else 12

data/examples/declaration/value/function/if-multi-line.hsnew file+3

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

1+foo :: Int -> Int

2+foo x = if x > 5 then 10

3+ else 12

data/examples/declaration/value/function/if-single-line-out.hsnew file+5

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

1+foo :: Int -> Int

2+foo x = if x > 5 then 10 else 12

4+bar :: Int -> Int

5+bar x = if x > 5 then 10 else 12

data/examples/declaration/value/function/if-single-line.hsnew file+6

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

1+foo :: Int -> Int

2+foo x = if x > 5 then 10 else 12

4+bar :: Int -> Int

5+bar x =

6+ if x > 5 then 10 else 12

data/examples/declaration/value/function/lambda-case-out.hsnew file+6

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

1+{-# LANGUAGE LambdaCase #-}

2+foo :: Int -> Int

3+foo =

4+ \case

5+ 5 -> 10

6+ _ -> 12

data/examples/declaration/value/function/lambda-case.hsnew file+6

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

1+{-# LANGUAGE LambdaCase #-}

3+foo :: Int -> Int

4+foo = \case

5+ 5 -> 10

6+ _ -> 12

data/examples/declaration/value/function/lambda-multi-line-out.hsnew file+11

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

1+foo :: a -> a -> a

2+foo x =

3+ \y ->

4+ x

6+bar :: Int -> Int -> Int

7+bar x =

8+ \y ->

9+ if x > y

10+ then 10

11+ else 12

data/examples/declaration/value/function/lambda-multi-line.hsnew file+9

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

1+foo :: a -> a -> a

2+foo x = \y ->

3+ x

5+bar :: Int -> Int -> Int

6+bar x = \y ->

7+ if x > y

8+ then 10

9+ else 12

data/examples/declaration/value/function/lambda-single-line-out.hsnew file+5

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

1+foo :: a -> a -> a

2+foo x = \y -> x

4+bar :: a -> a -> a

5+bar x = \y -> x

data/examples/declaration/value/function/lambda-single-line.hsnew file+6

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

1+foo :: a -> a -> a

2+foo x = \y -> x

4+bar :: a -> a -> a

5+bar x =

6+ \y -> x

data/examples/declaration/value/function/let-multi-line-out.hsnew file+12

@@ -0,0 +1,12 @@

1+foo :: Int -> Int

2+foo x =

3+ let z = y

4+ y = x

5+ in z + 100

7+bar :: Int -> Int

8+bar x =

9+ let z = y

10+ y = x

11+ in z

12+ + 100

data/examples/declaration/value/function/let-multi-line.hsnew file+12

@@ -0,0 +1,12 @@

1+foo :: Int -> Int

2+foo x =

3+ let z = y

4+ y = x

5+ in z + 100

7+bar :: Int -> Int

8+bar x =

9+ let z = y

10+ y = x

11+ in z

12+ + 100

data/examples/declaration/value/function/let-single-line-out.hsnew file+2

@@ -0,0 +1,2 @@

1+foo :: a -> a

2+foo x = let x = x in x

data/examples/declaration/value/function/let-single-line.hsnew file+2

@@ -0,0 +1,2 @@

1+foo :: a -> a

2+foo x = let x = x in x

data/examples/declaration/value/function/multiline-arguments-out.hsnew file+8

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

1+foo :: Int -> Int -> Int -> Int

2+foo

3+ (Foo g o)

4+ ( Bar

5+ x

6+ y

7+ )

8+ z = x

data/examples/declaration/value/function/multiline-arguments.hsnew file+4

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

1+foo :: Int -> Int -> Int -> Int

2+foo (Foo g o)

3+ (Bar

4+ x y) z = x

data/examples/declaration/value/function/multiple-matches-out.hsnew file+3

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

1+foo :: Int -> Int

2+foo 5 = 10

3+foo _ = 12

data/examples/declaration/value/function/multiple-matches.hsnew file+3

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

1+foo :: Int -> Int

2+foo 5 = 10

3+foo _ = 12

data/examples/declaration/value/function/negation-out.hsnew file+2

@@ -0,0 +1,2 @@

1+foo :: Int

2+foo = (-2)

data/examples/declaration/value/function/negation.hsnew file+2

@@ -0,0 +1,2 @@

1+foo :: Int

2+foo = (-2)

data/examples/declaration/value/function/simple-out.hsnew file+3

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

1+bar x = x

3+baz = x

data/examples/declaration/value/function/simple.hsnew file+2

@@ -0,0 +1,2 @@

1+bar x = x

2+baz = x

data/examples/declaration/value/function/where-out.hsnew file+17

@@ -0,0 +1,17 @@

1+foo :: Int -> Int

2+foo x = f x

3+ where

4+ f z = z

6+bar :: Int -> Int

7+bar x = f x

8+ where

9+ f :: Int -> Int

10+ f z = z

11+

12+baz :: Int -> Int

13+baz x = q

14+ where

15+ y = x

16+ z = y

17+ q = z

data/examples/declaration/value/function/where.hsnew file+15

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

1+foo :: Int -> Int

2+foo x = f x where f z = z

4+bar :: Int -> Int

5+bar x = f x

6+ where

7+ f :: Int -> Int

8+ f z = z

10+baz :: Int -> Int

11+baz x = q

12+ where

13+ y = x

14+ z = y

15+ q = z

data/examples/declaration/value/other/line-multi-line-out.hsnew file+6

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

1+x :: [Int]

2+x =

3+ [ 1

4+ , 2

5+ , somethingSomething 3

6+ ]

data/examples/declaration/value/other/line-multi-line.hsnew file+6

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

1+x :: [Int]

2+x = [

3+ 1

4+ , 2

5+ , somethingSomething 3

6+ ]

data/examples/declaration/value/other/line-single-line-out.hsnew file+2

@@ -0,0 +1,2 @@

1+x :: [Int]

2+x = [1, 2, 3]

data/examples/declaration/value/other/line-single-line.hsnew file+2

@@ -0,0 +1,2 @@

1+x :: [Int]

2+x = [1,2,3]

ormolu.cabal+2

@@ -60,9 +60,11 @@ library

6060 , Ormolu.Printer.Meat.Common

6161 , Ormolu.Printer.Meat.Declaration

6262 , Ormolu.Printer.Meat.Declaration.Data

63+ , Ormolu.Printer.Meat.Declaration.Pat

6364 , Ormolu.Printer.Meat.Declaration.Signature

6465 , Ormolu.Printer.Meat.Declaration.Type

6566 , Ormolu.Printer.Meat.Declaration.TypeFamily

67+ , Ormolu.Printer.Meat.Declaration.Value

6668 , Ormolu.Printer.Meat.ImportExport

6769 , Ormolu.Printer.Meat.Module

6870 , Ormolu.Printer.Meat.Type

src/Ormolu/Printer/Internal.hs+5−4

@@ -245,15 +245,16 @@ enterLayout l (R m) = do

245245 let modRC rc = rc

246246 { rcLayout = l

247247 }

248− R (local modRC m)

248+ x <- R (local modRC m)

249249 traceR ("lend_" ++ label) Nothing

250+ return x

250251

251252-- | Do one or another thing depending on current 'Layout'.

252253

253254vlayout

254− :: R () -- ^ Single line

255− -> R () -- ^ Multi line

256− -> R ()

255+ :: R a -- ^ Single line

256+ -> R a -- ^ Multi line

257+ -> R a

257258vlayout sline mline = do

258259 l <- R (asks rcLayout)

259260 case l of

src/Ormolu/Printer/Meat/Declaration.hs+5−2

@@ -14,16 +14,19 @@ import Ormolu.Printer.Meat.Declaration.Data

1414import Ormolu.Printer.Meat.Declaration.Signature

1515import Ormolu.Printer.Meat.Declaration.Type

1616import Ormolu.Printer.Meat.Declaration.TypeFamily

17+import Ormolu.Printer.Meat.Declaration.Value

18+import Ormolu.Utils

1719

1820p_hsDecl :: HsDecl GhcPs -> R ()

1921p_hsDecl = \case

2022 TyClD x -> p_tyClDecl x

23+ ValD x -> p_valDecl x

2124 SigD x -> p_sigDecl x

22− _ -> error "this is not yet supported"

25+ _ -> notImplemented "certain kinds of declarations"

2326

2427p_tyClDecl :: TyClDecl GhcPs -> R ()

2528p_tyClDecl = \case

2629 FamDecl x -> p_famDecl x

2730 SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs

2831 DataDecl {..} -> p_dataDecl tcdLName tcdTyVars tcdDataDefn

29− _ -> error "this is not yet supported"

32+ _ -> notImplemented "certain kinds of declarations"

src/Ormolu/Printer/Meat/Declaration/Pat.hsnew file+76

@@ -0,0 +1,76 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE RecordWildCards #-}

5+module Ormolu.Printer.Meat.Declaration.Pat

6+ ( p_pat

7+ )

8+where

10+import BasicTypes

11+import Control.Monad

12+import GHC

13+import Ormolu.Printer.Combinators

14+import Ormolu.Printer.Meat.Common

15+import Ormolu.Utils

16+

17+p_pat :: Pat GhcPs -> R ()

18+p_pat = \case

19+ WildPat _ -> txt "_"

20+ VarPat name -> located name p_rdrName

21+ LazyPat pat -> do

22+ txt "~"

23+ located pat p_pat

24+ AsPat name pat -> do

25+ located name p_rdrName

26+ txt "@"

27+ located pat p_pat

28+ ParPat pat ->

29+ located pat (parens . p_pat)

30+ BangPat pat -> do

31+ txt "!"

32+ located pat p_pat

33+ ListPat pats _ _ -> do

34+ brackets $ velt (withSep comma (located' p_pat) pats)

35+ TuplePat pats boxing _ -> do

36+ let f =

37+ case boxing of

38+ Boxed -> parens

39+ Unboxed -> parensHash

40+ f $ velt (withSep comma (located' p_pat) pats)

41+ SumPat pat _ _ _ -> do

42+ -- XXX I'm not sure about this one.

43+ located pat p_pat

44+ PArrPat pats _ -> do

45+ bracketsPar $ velt (withSep comma (located' p_pat) pats)

46+ ConPatIn pat details ->

47+ case details of

48+ PrefixCon xs -> do

49+ located pat p_rdrName

50+ unless (null xs) . inci . inci $ do

51+ breakpoint

52+ velt' (located' p_pat <$> xs)

53+ RecCon (HsRecFields fields dotdot) -> do

54+ located pat p_rdrName

55+ case dotdot of

56+ Nothing -> txt " {..}"

57+ Just _ -> do

58+ braces $ velt (withSep comma (located' p_hsRecField) fields)

59+ InfixCon x y -> do

60+ located x p_pat

61+ located pat (backticks . p_rdrName)

62+ located y p_pat

63+ ConPatOut {} -> notImplemented "ConPatOut"

64+ ViewPat {} -> notImplemented "ViewPat"

65+ SplicePat {} -> notImplemented "SplicePat"

66+ LitPat p -> atom p

67+ NPat v _ _ _ -> located v (atom . ol_val)

68+ NPlusKPat {} -> notImplemented "NPlusKPat"

69+ SigPatIn {} -> notImplemented "SigPatIn"

70+ SigPatOut {} -> notImplemented "SigPatOut"

71+ CoPat {} -> notImplemented "CoPat"

72+

73+p_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()

74+p_hsRecField HsRecField {..} =

75+ located hsRecFieldLbl $ \x ->

76+ located (rdrNameFieldOcc x) p_rdrName

src/Ormolu/Printer/Meat/Declaration/Signature.hs+10−4

@@ -5,18 +5,24 @@

55-- | Type signature declarations.

77module Ormolu.Printer.Meat.Declaration.Signature

8− ( p_sigDecl )

8+ ( p_sigDecl

9+ , p_sigDecl'

10+ )

911where

1012

1113import GHC

1214import Ormolu.Printer.Combinators

1315import Ormolu.Printer.Meat.Common

1416import Ormolu.Printer.Meat.Type

17+import Ormolu.Utils

1518

1619p_sigDecl :: Sig GhcPs -> R ()

17−p_sigDecl = \case

18− TypeSig names hswc -> line (p_typeSig names hswc)

19− _ -> error "Ormolu.Printer.Meat.Declaration.Signature: unimplemented signatures"

20+p_sigDecl = line . p_sigDecl'

21+

22+p_sigDecl' :: Sig GhcPs -> R ()

23+p_sigDecl' = \case

24+ TypeSig names hswc -> p_typeSig names hswc

25+ _ -> notImplemented "certain types of signature declarations"

2026

2127p_typeSig

2228 :: [Located RdrName]

src/Ormolu/Printer/Meat/Declaration/Value.hsnew file+235

@@ -0,0 +1,235 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE RecordWildCards #-}

5+module Ormolu.Printer.Meat.Declaration.Value

6+ ( p_valDecl

7+ )

8+where

10+import Bag (bagToList)

11+import Control.Monad

12+import Data.List (sortOn)

13+import GHC

14+import Ormolu.Printer.Combinators

15+import Ormolu.Printer.Meat.Common

16+import Ormolu.Printer.Meat.Declaration.Pat

17+import Ormolu.Printer.Meat.Declaration.Signature

18+import Ormolu.Utils

19+import SrcLoc (isOneLineSpan)

20+import qualified Data.List.NonEmpty as NE

21+

22+p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

23+p_valDecl = line . p_valDecl'

24+

25+p_valDecl' :: HsBindLR GhcPs GhcPs -> R ()

26+p_valDecl' = \case

27+ FunBind funId funMatches _ _ _ -> p_funBind funId funMatches

28+ _ -> notImplemented "certain kinds of binding declarations"

29+

30+p_funBind

31+ :: Located RdrName -- ^

32+ -> MatchGroup GhcPs (LHsExpr GhcPs) -- ^

33+ -> R ()

34+p_funBind name mgroup =

35+ p_matchGroup (Function (unL name)) mgroup

36+

37+data MatchGroupStyle

38+ = Function RdrName

39+ | Case

40+ | Lambda

41+ | LambdaCase

42+

43+p_matchGroup

44+ :: MatchGroupStyle

45+ -> MatchGroup GhcPs (LHsExpr GhcPs)

46+ -> R ()

47+p_matchGroup style MG {..} =

48+ locatedVia Nothing mg_alts $

49+ newlineSep (located' (p_match style))

50+

51+p_match

52+ :: MatchGroupStyle

53+ -> Match GhcPs (LHsExpr GhcPs)

54+ -> R ()

55+p_match style Match {..} = do

56+ case style of

57+ Function name -> p_rdrName name

58+ _ -> return ()

59+ -- NOTE Normally, since patterns may be placed in a multi-line layout, it

60+ -- is necessary to bump indentation for the pattern group so it's more

61+ -- indented than function name. This in turn means that indentation for

62+ -- the body should also be bumped. Normally this would mean that bodies

63+ -- would start with two indentation steps applied, which is ugly, so we

64+ -- need to be a bit more clever here and bump indentation level only when

65+ -- pattern group is multiline.

66+ inci' <- case NE.nonEmpty m_pats of

67+ Nothing -> return id

68+ Just ne_pats -> do

69+ let combinedSpans = combineSrcSpans' $

70+ getSpan <$> ne_pats

71+ inci' = if isOneLineSpan combinedSpans

72+ then id

73+ else inci

74+ switchLayout combinedSpans $ do

75+ case style of

76+ Function _ -> breakpoint

77+ Case -> return ()

78+ Lambda -> txt "\\"

79+ LambdaCase -> return ()

80+ inci' (velt' (located' p_pat <$> m_pats))

81+ return inci'

82+ inci' $ do

83+ space

84+ let GRHSs {..} = m_grhss

85+ unless (length grhssGRHSs > 1) . txt $

86+ case style of

87+ Function _ -> "="

88+ _ -> "->"

89+ let combinedSpans = combineSrcSpans' $

90+ getGRHSSpan . unL <$> NE.fromList grhssGRHSs

91+ case style of

92+ Lambda -> breakpoint

93+ _ -> return ()

94+ switchLayout combinedSpans . inci $ do

95+ case style of

96+ Lambda -> return ()

97+ _ -> breakpoint

98+ newlineSep (located' p_grhs) grhssGRHSs

99+ unless (GHC.isEmptyLocalBinds (unL grhssLocalBinds)) $ do

100+ newline

101+ line (txt "where")

102+ inci (located grhssLocalBinds p_hsLocalBinds)

103+

104+getGRHSSpan :: GRHS GhcPs (LHsExpr GhcPs) -> SrcSpan

105+getGRHSSpan (GRHS _ body) = getSpan body

106+

107+p_grhs :: GRHS GhcPs (LHsExpr GhcPs) -> R ()

108+p_grhs (GRHS guards body) =

109+ case guards of

110+ [] -> p_body

111+ xs -> do

112+ txt "| "

113+ velt $ withSep comma (located' p_stmt) xs

114+ txt " ->"

115+ breakpoint

116+ p_body

117+ where

118+ p_body = located body p_hsExpr

119+

120+p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()

121+p_stmt = \case

122+ LastStmt {} -> notImplemented "do notation"

123+ BindStmt {} -> notImplemented "do notation"

124+ ApplicativeStmt {} -> notImplemented "applicative stmt"

125+ BodyStmt body _ _ _ -> located body p_hsExpr

126+ LetStmt binds -> located binds p_hsLocalBinds

127+ ParStmt {} -> notImplemented "ParStmt"

128+ TransStmt {} -> notImplemented "TransStmt"

129+ RecStmt {} -> notImplemented "RecStmt"

130+

131+p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()

132+p_hsLocalBinds = \case

133+ HsValBinds (ValBindsIn bag lsigs) -> do

134+ let ssStart = either

135+ (srcSpanStart . getSpan)

136+ (srcSpanStart . getSpan)

137+ items =

138+ (Left <$> bagToList bag) ++ (Right <$> lsigs)

139+ p_item (Left x) = located x p_valDecl'

140+ p_item (Right x) = located x p_sigDecl'

141+ newlineSep p_item (sortOn ssStart items)

142+ HsValBinds _ -> notImplemented "HsValBinds"

143+ HsIPBinds _ -> notImplemented "HsIPBinds"

144+ EmptyLocalBinds -> return ()

145+

146+p_hsExpr :: HsExpr GhcPs -> R ()

147+p_hsExpr = \case

148+ HsVar name -> located name p_rdrName'

149+ HsUnboundVar _ -> notImplemented "HsUnboundVar"

150+ HsConLikeOut _ -> notImplemented "HsConLikeOut"

151+ HsRecFld x ->

152+ case x of

153+ Unambiguous name _ -> located name p_rdrName'

154+ Ambiguous name _ -> located name p_rdrName'

155+ HsOverLabel _ _ -> notImplemented "HsOverLabel"

156+ HsIPVar (HsIPName name) -> atom name

157+ HsOverLit v -> atom (ol_val v)

158+ HsLit lit -> atom lit

159+ HsLam mgroup ->

160+ p_matchGroup Lambda mgroup

161+ HsLamCase mgroup -> do

162+ txt "\\case"

163+ newline

164+ inci (p_matchGroup LambdaCase mgroup)

165+ HsApp f x -> do

166+ located f p_hsExpr

167+ breakpoint

168+ inci (located x p_hsExpr)

169+ HsAppType {} -> notImplemented "HsAppType"

170+ HsAppTypeOut {} -> notImplemented "HsAppTypeOut"

171+ OpApp x op _ y -> do

172+ located x p_hsExpr

173+ breakpoint

174+ inci $ do

175+ located op p_hsExpr

176+ space

177+ located y p_hsExpr

178+ NegApp e _ -> do

179+ txt "-"

180+ located e p_hsExpr

181+ HsPar e -> parens (located e p_hsExpr)

182+ SectionL {} -> notImplemented "SectionL"

183+ SectionR {} -> notImplemented "SectionR"

184+ ExplicitTuple {} -> notImplemented "ExplicitTuple"

185+ ExplicitSum {} -> notImplemented "ExplicitSum"

186+ HsCase e mgroup -> do

187+ txt "case "

188+ located e p_hsExpr

189+ txt " of"

190+ breakpoint

191+ inci (p_matchGroup Case mgroup)

192+ HsIf _ if' then' else' -> do

193+ txt "if "

194+ located if' p_hsExpr

195+ breakpoint

196+ inci (txt "then ")

197+ located then' p_hsExpr

198+ breakpoint

199+ inci (txt "else ")

200+ located else' p_hsExpr

201+ HsMultiIf {} -> notImplemented "MulitiIf"

202+ HsLet localBinds e -> do

203+ txt "let "

204+ inci (located localBinds p_hsLocalBinds)

205+ breakpoint

206+ txt "in "

207+ located e p_hsExpr

208+ HsDo {} -> notImplemented "HsDo"

209+ ExplicitList _ _ xs -> do

210+ brackets $ velt (withSep comma (located' p_hsExpr) xs)

211+ ExplicitPArr {} -> notImplemented "ExplicitPArr"

212+ RecordCon {} -> notImplemented "RecordCon"

213+ RecordUpd {} -> notImplemented "RecordUpd"

214+ ExprWithTySig {} -> notImplemented "ExprWithTySig"

215+ ExprWithTySigOut {} -> notImplemented "ExprWithTySigOut"

216+ ArithSeq {} -> notImplemented "ArithSeq"

217+ PArrSeq {} -> notImplemented "PArrSeq"

218+ HsSCC {} -> notImplemented "HsSCC"

219+ HsCoreAnn {} -> notImplemented "HsCoreAnn"

220+ HsBracket {} -> notImplemented "HsBracket"

221+ HsRnBracketOut {} -> notImplemented "HsRnBracketOut"

222+ HsTcBracketOut {} -> notImplemented "HsTcBracketOut"

223+ HsSpliceE {} -> notImplemented "HsSpliceE"

224+ HsProc {} -> notImplemented "HsProc"

225+ HsStatic {} -> notImplemented "HsStatic"

226+ HsArrApp {} -> notImplemented "HsArrApp"

227+ HsArrForm {} -> notImplemented "HsArrForm"

228+ HsTick {} -> notImplemented "HsTick"

229+ HsBinTick {} -> notImplemented "HsBinTick"

230+ HsTickPragma {} -> notImplemented "HsTickPragma"

231+ EWildPat -> notImplemented "EWildPat"

232+ EAsPat {} -> notImplemented "EAsPat"

233+ EViewPat {} -> notImplemented "EViewPat"

234+ ELazyPat {} -> notImplemented "ELazyPat"

235+ HsWrap {} -> notImplemented "HsWrap"

src/Ormolu/Printer/Meat/Module.hs+22−2

@@ -10,13 +10,14 @@ where

1010

1111import Control.Monad

1212import Data.Maybe (isJust)

13−import GHC hiding (GhcPs, IE)

13+import GHC

1414import Ormolu.Imports

1515import Ormolu.Printer.Combinators

1616import Ormolu.Printer.Comments

1717import Ormolu.Printer.Meat.Common

1818import Ormolu.Printer.Meat.Declaration

1919import Ormolu.Printer.Meat.ImportExport

20+import Ormolu.Utils

2021import SrcLoc (combineSrcSpans)

2122

2223p_hsModule :: ParsedSource -> R ()

@@ -43,7 +44,26 @@ p_hsModule loc@(L moduleSpan hsModule) = do

4344 when (not (null hsmodImports) || not (null hsmodDecls)) newline

4445 forM_ (sortImports hsmodImports) (located' p_hsmodImport)

4546 when (not (null hsmodImports) && not (null hsmodDecls)) newline

46− newlineSep (located' p_hsDecl) hsmodDecls

47+

48+ forM_ (zip hsmodDecls ((Just <$> drop 1 hsmodDecls) ++ [Nothing])) $

49+ \(d, md) -> do

50+ case md of

51+ Nothing -> located d p_hsDecl

52+ Just d' ->

53+ if separatedDecls (unL d) (unL d')

54+ then line (located d p_hsDecl)

55+ else located d p_hsDecl

56+

4757 trailingComments <- hasMoreComments

4858 when (trailingComments && isJust hsmodName) newline

4959 spitRemainingComments

60+

61+-- | Determine if these declarations should be separated by a blank line.

62+

63+separatedDecls

64+ :: HsDecl GhcPs

65+ -> HsDecl GhcPs

66+ -> Bool

67+separatedDecls (SigD (TypeSig (n:_) _)) (ValD (FunBind n' _ _ _ _)) =

68+ unL n /= unL n'

69+separatedDecls _ _ = True

src/Ormolu/Utils.hs+6

@@ -5,6 +5,7 @@ module Ormolu.Utils

55 , isModule

66 , unL

77 , getSpan

8+ , notImplemented

89 )

910where

1011

@@ -31,3 +32,8 @@ unL (L _ e) = e

3132

3233getSpan :: GenLocated l e -> l

3334getSpan (L spn _) = spn

35+

36+-- | Placeholder for things that are not yet implemented.

37+

38+notImplemented :: String -> a

39+notImplemented msg = error $ "not implemented yet: " ++ msg

tests/Ormolu/PrinterSpec.hs+23−18

@@ -23,21 +23,21 @@ spec = do

2323

2424checkExample :: Path Rel File -> Spec

2525checkExample srcPath' = it (fromRelFile srcPath' ++ " works") $ do

26− let srcPath = examplesDir </> srcPath'

27− expectedOutputPath <- deriveOutput srcPath

28− -- 1. Given input snippet of source code parse it and pretty print it.

29− -- 2. Parse the result of pretty-printing again and make sure that AST

30− -- is the same as AST of the original snippet. (This happens in

31− -- 'ormoluFile' automatically.)

32− formatted0 <- ormoluFile defaultConfig (fromRelFile srcPath)

33− -- 3. Check the output against expected output. Thus all tests should

34− -- include two files: input and expected output.

35− expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath

36− formatted0 `shouldMatch` expected

37− -- 4. Check that running the formatter on the output produces the same

38− -- output again (the transformation is idempotent).

39− formatted1 <- ormolu defaultConfig "<formatted>" (T.unpack formatted0)

40− formatted1 `shouldMatch` formatted0

26+ let srcPath = examplesDir </> srcPath'

27+ expectedOutputPath <- deriveOutput srcPath

28+ -- 1. Given input snippet of source code parse it and pretty print it.

29+ -- 2. Parse the result of pretty-printing again and make sure that AST

30+ -- is the same as AST of the original snippet. (This happens in

31+ -- 'ormoluFile' automatically.)

32+ formatted0 <- ormoluFile defaultConfig (fromRelFile srcPath)

33+ -- 3. Check the output against expected output. Thus all tests should

34+ -- include two files: input and expected output.

35+ expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath

36+ shouldMatch False formatted0 expected

37+ -- 4. Check that running the formatter on the output produces the same

38+ -- output again (the transformation is idempotent).

39+ formatted1 <- ormolu defaultConfig "<formatted>" (T.unpack formatted0)

40+ shouldMatch True formatted1 formatted0

4141

4242-- | Build list of examples for testing.

4343

@@ -63,14 +63,19 @@ deriveOutput path = parseRelFile $

6363-- | A version of 'shouldBe' that is specialized to comparing 'Text' values.

6464-- It also prints multi-line snippets in a more readable form.

6565

66−shouldMatch :: Text -> Text -> Expectation

67−shouldMatch actual expected =

66+shouldMatch :: Bool -> Text -> Text -> Expectation

67+shouldMatch idempotencyTest actual expected =

6868 when (actual /= expected) . expectationFailure $ unlines

69− [ "expected:"

69+ [ "expected (" ++ pass ++ "):"

7070 , T.unpack expected

7171 , "but got:"

7272 , T.unpack actual

7373 ]

74+ where

75+ pass =

76+ if idempotencyTest

77+ then "idempotency pass"

78+ else "first pass"

7479

7580examplesDir :: Path Rel Dir

7681examplesDir = $(mkRelDir "data/examples")