00b08ee · ormolu · git.iko.soy

data/examples/declaration/data/deriving-strategies-out.hsnew file+8

compare with master

unifiedsplit

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

1+-- | Something.

2+newtype Foo = Foo Int

3+ deriving stock (Eq, Show, Generic)

4+ deriving anyclass

5+ ( ToJSON

6+ , FromJSON

7+ )

8+ deriving newtype (Num)

data/examples/declaration/data/deriving-strategies.hsnew file+9

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

1+-- | Something.

2+

3+newtype Foo = Foo Int

4+ deriving stock (Eq, Show, Generic)

5+ deriving anyclass

6+ ( ToJSON

7+ , FromJSON

8+ )

9+ deriving newtype (Num)

data/examples/declaration/data/existential-multiline-out.hsnew file+4

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

1+{-# LANGUAGE ExistentialQuantification #-}

2+data Foo

3+ = forall a. MkFoo a (a -> Bool)

4+ | forall a. Eq a => MkBar a

data/examples/declaration/data/existential-multiline.hsnew file+5

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

1+{-# LANGUAGE ExistentialQuantification #-}

2+

3+data Foo

4+ = forall a. MkFoo a (a -> Bool)

5+ | forall a. Eq a => MkBar a

data/examples/declaration/data/existential-out.hsnew file+2

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

1+{-# LANGUAGE ExistentialQuantification #-}

2+data Foo = forall a. MkFoo a (a -> Bool)

data/examples/declaration/data/existential.hsnew file+3

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

1+{-# LANGUAGE ExistentialQuantification #-}

2+

3+data Foo = forall a. MkFoo a (a -> Bool)

data/examples/declaration/data/fat-multiline-out.hsnew file+11

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

1+-- | Something.

2+

3+data Foo

4+ = Foo

5+ Int

6+ Int

7+ -- ^ Foo

8+ | Bar

9+ Bool

10+ Bool

11+ -- ^ Bar

data/examples/declaration/data/fat-multiline.hsnew file+9

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

1+-- | Something.

2+

3+data Foo

4+ = Foo Int

5+ Int

6+ -- ^ Foo

7+ | Bar Bool

8+ Bool

9+ -- ^ Bar

data/examples/declaration/data/gadt-syntax-out.hsnew file+3

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

1+{-# LANUGAGE GADTSyntax #-}

2+data Foo where

3+ MKFoo :: a -> (a -> Bool) -> Foo

data/examples/declaration/data/gadt-syntax.hsnew file+3

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

1+{-# LANUGAGE GADTSyntax #-}

2+

3+data Foo where { MKFoo :: a -> (a->Bool) -> Foo }

data/examples/declaration/data/gadt/multiline-out.hsnew file+22

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

1+{-# LANGUAGE ExplicitForAll #-}

2+

3+-- | Here goes a comment.

4+data Foo a where

5+ -- | 'Foo' is wonderful.

6+ Foo

7+ :: forall a b. ( Show a

8+ , Eq b

9+ ) -- foo

10+ -- bar

11+ => a

12+ -> b

13+ -> Foo 'Int

14+ -- | But 'Bar' is also not too bad.

15+ Bar

16+ :: Int

17+ -> Maybe Text

18+ -> Foo 'Bool

19+ -- | So is 'Baz'.

20+ Baz

21+ :: forall a. a

22+ -> Foo 'String

data/examples/declaration/data/gadt/multiline.hsnew file+15

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

1+{-# LANGUAGE ExplicitForAll #-}

2+

3+-- | Here goes a comment.

4+

5+data Foo a where

6+ -- | 'Foo' is wonderful.

7+ Foo :: forall a b. (Show a, Eq b) -- foo

8+ -- bar

9+ => a -> b -> Foo 'Int

10+ -- | But 'Bar' is also not too bad.

11+ Bar

12+ :: Int -> Maybe Text -> Foo 'Bool

13+ -- | So is 'Baz'.

14+ Baz

15+ :: forall a. a -> Foo 'String

data/examples/declaration/data/gadt/record-out.hsnew file+11

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

1+-- | Something.

2+data Foo where

3+ Foo :: {fooX :: Int} -> Foo

4+ Bar

5+ :: { fooY :: Int

6+ , fooBar, fooBaz :: Bool

7+ , fooFoo

8+ , barBar

9+ :: Int

10+ }

11+ -> Foo

data/examples/declaration/data/gadt/record.hsnew file+9

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

1+-- | Something.

2+

3+data Foo where

4+ Foo :: { fooX :: Int } -> Foo

5+ Bar :: { fooY :: Int

6+ , fooBar, fooBaz :: Bool

7+ , fooFoo

8+ , barBar :: Int

9+ } -> Foo

data/examples/declaration/data/gadt/simple-out.hsnew file+8

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

1+{-# LANGUAGE ExplicitForAll #-}

2+

3+-- | Here goes a comment.

4+data Foo a where

5+ -- | 'Foo' is wonderful.

6+ Foo :: forall a b. (Show a, Eq b) => a -> b -> Foo 'Int

7+ Bar :: Int -> Text -> Foo 'Bool -- ^ But 'Bar' is also not too bad.

8+ Baz :: forall a. a -> Foo 'String -- ^ So is 'Baz'.

data/examples/declaration/data/gadt/simple.hsnew file+9

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

1+{-# LANGUAGE ExplicitForAll #-}

2+

3+-- | Here goes a comment.

4+

5+data Foo a where

6+ -- | 'Foo' is wonderful.

7+ Foo :: forall a b. (Show a, Eq b) => a -> b -> Foo 'Int

8+ Bar :: Int -> Text -> Foo 'Bool -- ^ But 'Bar' is also not too bad.

9+ Baz :: forall a. a -> Foo 'String -- ^ So is 'Baz'.

data/examples/declaration/data/gadt/strictness-out.hsnew file+2

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

1+data Foo a where

2+ Foo :: !Int -> {-# UNPACK #-} !Bool -> Foo Int

data/examples/declaration/data/gadt/strictness.hsnew file+2

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

1+data Foo a where

2+ Foo :: !Int -> {-# UNPACK #-} !Bool -> Foo Int

data/examples/declaration/data/infix-out.hsnew file+1

@@ -0,0 +1 @@

1+data Foo a b = a `Foo` b

data/examples/declaration/data/infix.hsnew file+1

@@ -0,0 +1 @@

1+data Foo a b = a `Foo` b

data/examples/declaration/data/multiline-out.hsnew file+6

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

1+-- | Here we have 'Foo'.

2+data Foo

3+ = Foo -- ^ One

4+ | Bar Int -- ^ Two

5+ | Baz -- ^ Three

6+ deriving (Eq, Show)

data/examples/declaration/data/multiline.hsnew file+7

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

1+-- | Here we have 'Foo'.

2+

3+data Foo

4+ = Foo -- ^ One

5+ | Bar Int -- ^ Two

6+ | Baz -- ^ Three

7+ deriving (Eq, Show)

data/examples/declaration/data/newline-out.hsnew file+3

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

1+-- | Something.

2+newtype Foo = Foo Int

3+ deriving (Eq, Show)

data/examples/declaration/data/newline.hsnew file+4

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

1+-- | Something.

2+

3+newtype Foo = Foo Int

4+ deriving (Eq, Show)

data/examples/declaration/data/record-out.hsnew file+11

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

1+-- | Something.

2+data Foo

3+ = Foo

4+ { fooX :: Int -- ^ X

5+ , fooY :: Int -- ^ Y

6+ , fooBar, fooBaz :: Bool -- ^ BarBaz

7+ , fooFoo

8+ , barBar

9+ :: Int -- ^ Huh!

10+ }

11+ deriving (Eq, Show)

data/examples/declaration/data/record-singleline-out.hsnew file+3

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

1+-- | Something.

2+data Foo = Foo {fooX :: Int, fooY :: Int}

3+ deriving (Eq, Show)

data/examples/declaration/data/record-singleline.hsnew file+4

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

1+-- | Something.

2+

3+data Foo = Foo { fooX :: Int , fooY :: Int }

4+ deriving (Eq, Show)

data/examples/declaration/data/record.hsnew file+9

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

1+-- | Something.

2+

3+data Foo = Foo

4+ { fooX :: Int -- ^ X

5+ , fooY :: Int -- ^ Y

6+ , fooBar, fooBaz :: Bool -- ^ BarBaz

7+ , fooFoo

8+ , barBar :: Int -- ^ Huh!

9+ } deriving (Eq, Show)

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

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

1+-- | And here we have 'Foo'.

2+data Foo = Foo | Bar Int | Baz

3+ deriving (Eq, Show)

data/examples/declaration/data/simple.hsnew file+4

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

1+-- | And here we have 'Foo'.

2+

3+data Foo = Foo | Bar Int | Baz

4+ deriving (Eq, Show)

data/examples/declaration/data/strictness-out.hsnew file+2

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

1+-- | Something.

2+data Foo = Foo !Int {-# UNPACK #-} !Bool {-# NOUNPACK #-} !String

data/examples/declaration/data/strictness.hsnew file+3

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

1+-- | Something.

2+

3+data Foo = Foo !Int {-# UNPACK #-} !Bool {-# NOUNPACK #-} !String

ormolu.cabal+1

@@ -50,6 +50,7 @@ library

50 , Ormolu.Printer.Internal

51 , Ormolu.Printer.Meat.Common

52 , Ormolu.Printer.Meat.Declaration

53+ , Ormolu.Printer.Meat.Declaration.Data

53 , Ormolu.Printer.Meat.Declaration.Type

54 , Ormolu.Printer.Meat.Declaration.Type

54 , Ormolu.Printer.Meat.Declaration.TypeFamily

55 , Ormolu.Printer.Meat.Declaration.TypeFamily

55 , Ormolu.Printer.Meat.ImportExport

56 , Ormolu.Printer.Meat.ImportExport

src/Ormolu/Printer/Combinators.hs+57−57

@@ -14,17 +14,21 @@ module Ormolu.Printer.Combinators

14 , atom

15 , newline

16 , inci

17+ , relaxComments

17 , located

18 , located

18 , locatedVia

19 , locatedVia

19 , located'

20 , located'

21+ , switchLayout

20 , velt

22 , velt

21 , velt'

23 , velt'

22 , vlayout

24 , vlayout

25+ , breakpoint

23 , withSep

26 , withSep

24 , spaceSep

27 , spaceSep

25 , newlineSep

28 , newlineSep

26 -- ** Wrapping

29 -- ** Wrapping

27 , line

30 , line

31+ , backticks

28 , braces

32 , braces

29 , brackets

33 , brackets

30 , bracketsPar

34 , bracketsPar

@@ -32,14 +36,11 @@ module Ormolu.Printer.Combinators

32 , parensHash

36 , parensHash

33 -- ** Literals

37 -- ** Literals

34 , comma

38 , comma

35− , ofType

36− , larrow

37− , rarrow

38− , darrow

39 , space

40 )

41where

42

43+import Data.Bool (bool)

43import Data.Data (Data)

44import Data.Data (Data)

44import Data.List (intersperse)

45import Data.List (intersperse)

45import Data.Text (Text)

46import Data.Text (Text)

@@ -86,47 +87,41 @@ locatedVia

86 -> R ()

87 -> R ()

87locatedVia ml loc@(L l a) f = do

88locatedVia ml loc@(L l a) f = do

88 mann <- lookupAnn loc

89 mann <- lookupAnn loc

89− layout <- currentLayout

90+ relaxed <- relaxedComments

90− let m = enterLayout

91− (case ml of

91+ let m = case ml of

92− Nothing -> layout

92+ Nothing -> f a

93− Just l' ->

93+ Just l' -> switchLayout l' (f a)

94− if isOneLineSpan l'

95− then SingleLine

96− else MultiLine)

97− (f a)

98 case mann of

94 case mann of

99 Nothing -> m

95 Nothing -> m

100− Just Ann {..} ->

96+ Just Ann {..} -> bool sitcc id relaxed $ do

101− sitcc $ do

102− -- There are three things in 'Ann' which contain comments:

97+ -- There are three things in 'Ann' which contain comments:

103

98

104− let cmode =

99+ let cmode =

105− if annGetConstr a == CN "HsModule"

100+ if annGetConstr a == CN "HsModule"

106− then Module

101+ then Module

107− else Other

102+ else Other

108− (before, after) = partitionDPs cmode l annsDP

103+ (before, after) = partitionDPs cmode l annsDP

109

104

110− -- 'annPriorComments' contains comments that were directly placed

105+ -- 'annPriorComments' contains comments that were directly placed

111− -- before entities such as comments (in both styles) before function

106+ -- before entities such as comments (in both styles) before function

112− -- definitions and inline comments before smaller things like types

107+ -- definitions and inline comments before smaller things like types

113− -- and literals.

108+ -- and literals.

114

109

115− spitComments (addDecoration cmode Before l <$> annPriorComments)

110+ spitComments (addDecoration cmode Before l <$> annPriorComments)

116

111

117− -- Comments inside 'annsDP' marked with 'AnnComment' are trickier,

112+ -- Comments inside 'annsDP' marked with 'AnnComment' are trickier,

118− -- they seem to contain everything that goes after the thing they

113+ -- they seem to contain everything that goes after the thing they

119− -- are attached to and in some cases (e.g. for modules) they contain

114+ -- are attached to and in some cases (e.g. for modules) they contain

120− -- comments that go before things. Exact location can only be

115+ -- comments that go before things. Exact location can only be

121− -- deduced by analyzing the associated span.

116+ -- deduced by analyzing the associated span.

122

117

123− spitComments before

118+ spitComments before

124− m

119+ m

125− spitComments after

120+ spitComments after

126

121

127− -- I wasn't able to find any case when 'annFollowingComments' is

122+ -- I wasn't able to find any case when 'annFollowingComments' is

128− -- populated, so we'll ignore that one for now and fix it when we

123+ -- populated, so we'll ignore that one for now and fix it when we

129− -- have an example of source code where it matters.

124+ -- have an example of source code where it matters.

130

125

131-- | A version of 'located' with arguments flipped.

126-- | A version of 'located' with arguments flipped.

132

127

@@ -137,6 +132,20 @@ located'

137 -> R ()

132 -> R ()

138located' = flip located

133located' = flip located

139

134

135+-- | Set layout according to given 'SrcSpan' for a given computation. Use

136+-- this only when you need to set layout based on e.g. combined span of

137+-- several elements when there is no corresponding 'Located' wrapper

138+-- provided by GHC AST.

139+

140+switchLayout

141+ :: SrcSpan -- ^ Span that controls layout

142+ -> R () -- ^ Computation to run with changed layout

143+ -> R ()

144+switchLayout spn = enterLayout

145+ (if isOneLineSpan spn

146+ then SingleLine

147+ else MultiLine)

148+

140-- | Element of variable layout. This means that the sub-components may be

149-- | Element of variable layout. This means that the sub-components may be

141-- rendered either on single line or each on its own line depending on

150-- rendered either on single line or each on its own line depending on

142-- current layout.

151-- current layout.

@@ -159,6 +168,12 @@ velt' xs = sitcc $ sequence_ (intersperse sep (sitcc <$> xs))

159 where

168 where

160 sep = vlayout (spit " ") newline

169 sep = vlayout (spit " ") newline

161

170

171+-- | Insert a space if enclosing layout is single-line, or newline if it's

172+-- multiline.

173+

174+breakpoint :: R ()

175+breakpoint = vlayout space newline

176+

162-- | Put separator between renderings of items of a list.

177-- | Put separator between renderings of items of a list.

163

178

164withSep

179withSep

@@ -198,6 +213,11 @@ line m = do

198 m

213 m

199 newline

214 newline

200

215

216+-- | Surround given entity by backticks.

217+

218+backticks :: R () -> R ()

219+backticks m = txt "`" >> m >> txt "`"

220+

201-- | Surround given entity by curly braces.

221-- | Surround given entity by curly braces.

202

222

203braces :: R () -> R ()

223braces :: R () -> R ()

@@ -252,26 +272,6 @@ ospaces m = vlayout m (txt " " >> m >> newline)

252comma :: R ()

272comma :: R ()

253comma = txt ", "

273comma = txt ", "

254

274

255−-- | Print @::@ followed by a space.

256−

257−ofType :: R ()

258−ofType = txt ":: "

259−

260−-- | Print @<-@ followed by a space.

261−

262−larrow :: R ()

263−larrow = txt "<- "

264−

265−-- | Print @->@ followed by a space.

266−

267−rarrow :: R ()

268−rarrow = txt "-> "

269−

270−-- | Print @=>@ followed by a space.

271−

272−darrow :: R ()

273−darrow = txt "=> "

274−

275-- | Print single space.

276

277space :: R ()

src/Ormolu/Printer/Internal.hs+23−1

@@ -16,10 +16,11 @@ module Ormolu.Printer.Internal

16 , ensureIndent

17 , inci

18 , sitcc

19+ , relaxComments

19 , Layout (..)

20 , Layout (..)

20 , enterLayout

21 , enterLayout

21 , vlayout

22 , vlayout

22− , currentLayout

23+ , relaxedComments

23 , lookupAnn

24 , lookupAnn

24 )

25 )

25where

26where

@@ -53,6 +54,8 @@ data RC = RC

53 -- newline if we break lines

54 -- newline if we break lines

54 , rcLayout :: Layout

55 , rcLayout :: Layout

55 -- ^ Current layout

56 -- ^ Current layout

57+ , rcRelaxedComments :: Bool

58+ -- ^ Whether to relax aligning rules for comments

56 , rcAnns :: Anns

59 , rcAnns :: Anns

57 -- ^ The collection of annotations obtained after parsing

60 -- ^ The collection of annotations obtained after parsing

58 , rcDebug :: Bool

61 , rcDebug :: Bool

@@ -88,6 +91,7 @@ runR debug (R m) anns =

88 rc = RC

91 rc = RC

89 { rcIndent = 0

92 { rcIndent = 0

90 , rcLayout = MultiLine

93 , rcLayout = MultiLine

94+ , rcRelaxedComments = False

91 , rcAnns = anns

95 , rcAnns = anns

92 , rcDebug = debug

96 , rcDebug = debug

93 }

97 }

@@ -168,6 +172,19 @@ sitcc m' = do

168 vlayout m' (R (local modRC m))

172 vlayout m' (R (local modRC m))

169 traceR "sitcc_ended" Nothing

173 traceR "sitcc_ended" Nothing

170

174

175+-- | Relax alignment rules for comments inside this block. This is usually

176+-- done to avoid bumping indentation level too aggressively. Important for

177+-- beautiful rendering of e.g. type signatures.

178+

179+relaxComments :: R () -> R ()

180+relaxComments (R m) = do

181+ traceR "relax_start" Nothing

182+ let modRC x = x

183+ { rcRelaxedComments = True

184+ }

185+ R (local modRC m)

186+ traceR "relax_end" Nothing

187+

171-- | Set 'Layout' for internal computation.

188-- | Set 'Layout' for internal computation.

172

189

173enterLayout :: Layout -> R () -> R ()

190enterLayout :: Layout -> R () -> R ()

@@ -200,6 +217,11 @@ vlayout sline mline = do

200currentLayout :: R Layout

217currentLayout :: R Layout

201currentLayout = R (asks rcLayout)

218currentLayout = R (asks rcLayout)

202

219

220+-- | Check whether we're in a region with relaxed comments placement.

221+

222+relaxedComments :: R Bool

223+relaxedComments = R (asks rcRelaxedComments)

224+

203-- | Lookup an annotation.

225-- | Lookup an annotation.

204

226

205lookupAnn :: Data a => Located a -> R (Maybe Annotation)

227lookupAnn :: Data a => Located a -> R (Maybe Annotation)

src/Ormolu/Printer/Meat/Common.hs+21

@@ -10,17 +10,23 @@ module Ormolu.Printer.Meat.Common

10 , p_rdrName'

11 , p_qualName

12 , p_ieWildcard

13+ -- * Helpers

13 , opParens

14 , opParens

15+ , combineSrcSpans'

16+ , getSpan

17+ , unL

14 )

18 )

15where

19where

16

20

17import Data.Char (isAlphaNum)

21import Data.Char (isAlphaNum)

22+import Data.List.NonEmpty (NonEmpty (..))

18import GHC hiding (GhcPs, IE)

23import GHC hiding (GhcPs, IE)

19import Module (Module (..))

24import Module (Module (..))

20import OccName (OccName (..))

25import OccName (OccName (..))

21import Ormolu.Printer.Combinators

26import Ormolu.Printer.Combinators

22import Outputable (Outputable (..), showSDocUnsafe)

27import Outputable (Outputable (..), showSDocUnsafe)

23import RdrName (RdrName (..), rdrNameOcc)

28import RdrName (RdrName (..), rdrNameOcc)

29+import SrcLoc (combineSrcSpans)

24

30

25p_hsmodName :: ModuleName -> R ()

31p_hsmodName :: ModuleName -> R ()

26p_hsmodName mname = do

32p_hsmodName mname = do

@@ -69,3 +75,18 @@ opParens x m =

69 if all (not . isAlphaNum) (showSDocUnsafe (ppr x))

75 if all (not . isAlphaNum) (showSDocUnsafe (ppr x))

70 then txt "(" >> m >> txt ")"

76 then txt "(" >> m >> txt ")"

71 else m

77 else m

78+

79+-- | Combine all source spans from the given list.

80+

81+combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan

82+combineSrcSpans' (x:|xs) = foldr combineSrcSpans x xs

83+

84+-- | Get source span from a 'Located' thing.

85+

86+getSpan :: Located e -> SrcSpan

87+getSpan (L spn _) = spn

88+

89+-- | Exact inner value from 'Located'.

90+

91+unL :: Located e -> e

92+unL (L _ e) = e

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

@@ -11,6 +11,7 @@ where

11import HsDecls

12import Language.Haskell.GHC.ExactPrint.Types

13import Ormolu.Printer.Combinators

14+import Ormolu.Printer.Meat.Declaration.Data

14import Ormolu.Printer.Meat.Declaration.Type

15import Ormolu.Printer.Meat.Declaration.Type

15import Ormolu.Printer.Meat.Declaration.TypeFamily

16import Ormolu.Printer.Meat.Declaration.TypeFamily

16

17

@@ -23,4 +24,5 @@ p_tyClDecl :: TyClDecl GhcPs -> R ()

23p_tyClDecl = \case

24p_tyClDecl = \case

24 FamDecl x -> p_famDecl x

25 FamDecl x -> p_famDecl x

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

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

27+ DataDecl {..} -> p_dataDecl tcdLName tcdTyVars tcdDataDefn

26 _ -> error "this is not yet supported"

28 _ -> error "this is not yet supported"

src/Ormolu/Printer/Meat/Declaration/Data.hsnew file+122

@@ -0,0 +1,122 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE RecordWildCards #-}

4+

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

6+ ( p_dataDecl

7+ )

8+where

9+

10+import BasicTypes (DerivStrategy (..))

11+import Control.Monad

12+import Data.List.NonEmpty (nonEmpty)

13+import Data.Maybe (isJust)

14+import GHC hiding (GhcPs, IE)

15+import Language.Haskell.GHC.ExactPrint.Types

16+import Ormolu.Printer.Combinators

17+import Ormolu.Printer.Meat.Common

18+import Ormolu.Printer.Meat.Type

19+import RdrName (RdrName (..))

20+import SrcLoc (Located)

21+

22+p_dataDecl

23+ :: Located RdrName -- ^ Type constructor

24+ -> LHsQTyVars GhcPs -- ^ Type variables

25+ -> HsDataDefn GhcPs -- ^ Data definition

26+ -> R ()

27+p_dataDecl name tvars HsDataDefn {..} = do

28+ let HsQTvs {..} = tvars

29+ txt $ case dd_ND of

30+ NewType -> "newtype "

31+ DataType -> "data "

32+ located name p_rdrName'

33+ unless (null hsq_explicit) space

34+ spaceSep (located' p_hsTyVarBndr) hsq_explicit

35+ case dd_kindSig of

36+ Nothing -> return ()

37+ Just k -> do

38+ space

39+ txt ":: "

40+ relaxComments (located k p_hsType)

41+ let gadt = isJust dd_kindSig || any (isGadt . unL) dd_cons

42+ case nonEmpty dd_cons of

43+ Nothing -> pure ()

44+ Just dd_cons_ne ->

45+ if gadt

46+ then do

47+ txt " where"

48+ newline

49+ inci $ newlineSep (located' p_conDecl) dd_cons

50+ else switchLayout (combineSrcSpans' (getSpan <$> dd_cons_ne)) $ do

51+ breakpoint

52+ inci $ do

53+ txt "= "

54+ let sep = vlayout (txt " | ") (txt "| ")

55+ velt $ withSep sep (located' p_conDecl) dd_cons

56+ newline

57+ inci . located dd_derivs $ \xs ->

58+ forM_ xs (line . located' p_hsDerivingClause)

59+

60+p_conDecl :: ConDecl GhcPs -> R ()

61+p_conDecl = \case

62+ ConDeclGADT {..} -> velt'

63+ [ spaceSep (located' p_rdrName') con_names

64+ , inci $ do

65+ txt ":: "

66+ relaxComments (locatedVia Nothing (hsib_body con_type) p_hsType)

67+ ]

68+ ConDeclH98 {..} -> do

69+ case hsq_explicit <$> con_qvars of

70+ Nothing -> return ()

71+ Just bndrs -> do

72+ txt "forall "

73+ spaceSep (located' p_hsTyVarBndr) bndrs

74+ txt "."

75+ breakpoint

76+ case con_cxt of

77+ Nothing -> return ()

78+ Just ctx -> located ctx $ \case

79+ [] -> pure ()

80+ xs -> do

81+ p_hsContext xs

82+ breakpoint

83+ txt "=> "

84+ case con_details of

85+ PrefixCon xs -> do

86+ located con_name p_rdrName'

87+ unless (null xs) breakpoint

88+ inci $ velt' (located' p_hsType <$> xs)

89+ RecCon l -> do

90+ located con_name p_rdrName'

91+ breakpoint

92+ inci $ located l p_conDeclFields

93+ InfixCon x y -> velt'

94+ [ located x p_hsType

95+ , inci $ velt'

96+ [ backticks (located con_name p_rdrName')

97+ , inci $ located y p_hsType

98+ ]

99+ ]

100+

101+isGadt :: ConDecl GhcPs -> Bool

102+isGadt = \case

103+ ConDeclGADT {} -> True

104+ ConDeclH98 {} -> False

105+

106+p_hsDerivingClause

107+ :: HsDerivingClause GhcPs

108+ -> R ()

109+p_hsDerivingClause HsDerivingClause {..} = do

110+ txt "deriving"

111+ case deriv_clause_strategy of

112+ Nothing -> return ()

113+ Just l -> do

114+ space

115+ located l $ \case

116+ StockStrategy -> txt "stock"

117+ AnyclassStrategy -> txt "anyclass"

118+ NewtypeStrategy -> txt "newtype"

119+ breakpoint

120+ inci . located deriv_clause_tys $ \case

121+ [] -> txt "()"

122+ xs -> parens . velt $ withSep comma (located' p_hsType . hsib_body) xs

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

@@ -28,5 +28,5 @@ p_synDecl name tvars t = line $ do

28 let HsQTvs {..} = tvars

29 unless (null hsq_explicit) space

30 spaceSep (located' p_hsTyVarBndr) hsq_explicit

31− vlayout space newline

31+ breakpoint

32− inci (txt "= " >> located t p_hsType)

32+ inci (txt "= " >> relaxComments (located t p_hsType))

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+6−6

@@ -33,7 +33,7 @@ p_famDecl FamilyDecl {..} = do

33 ++ (located' p_injectivityAnn <$> maybeToList fdInjectivityAnn)

34 spaceSep (located' p_hsTyVarBndr) hsq_explicit

35 unless (null items) $

36− vlayout space newline

36+ breakpoint

37 inci . inci $ spaceSep id items

38 case mmeqs of

39 Nothing -> newline

@@ -51,18 +51,18 @@ p_familyResultSigL injAnn l =

51 L _ a -> case a of

52 NoSig -> Nothing

53 KindSig k -> Just $ do

54− if injAnn then txt "= " else ofType

54+ if injAnn then txt "= " else txt ":: "

55− located k p_hsType

55+ relaxComments (located k p_hsType)

56 TyVarSig bndr -> Just $ do

57− if injAnn then txt "= " else ofType

57+ if injAnn then txt "= " else txt ":: "

58− located bndr p_hsTyVarBndr

58+ relaxComments (located bndr p_hsTyVarBndr)

59

60p_injectivityAnn :: InjectivityAnn GhcPs -> R ()

61p_injectivityAnn (InjectivityAnn a bs) = do

62 txt "| "

63 located a p_rdrName

64 space

65− rarrow

65+ txt "-> "

66 spaceSep (located' p_rdrName) bs

67

68p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()

src/Ormolu/Printer/Meat/ImportExport.hs+30−30

@@ -22,36 +22,36 @@ p_hsmodExports xs = do

22 parens . velt $ withSep comma (located' p_lie) xs

23

24p_hsmodImport :: ImportDecl GhcPs -> R ()

25−p_hsmodImport ImportDecl {..} = line . velt' $

25+p_hsmodImport ImportDecl {..} = line $ do

26− [ do txt "import "

26+ txt "import "

27− when ideclSource $

27+ when ideclSource $

28− txt "{-# SOURCE #-} "

28+ txt "{-# SOURCE #-} "

29− when ideclSafe $

29+ when ideclSafe $

30− txt "safe "

30+ txt "safe "

31− when ideclQualified $

31+ when ideclQualified $

32− txt "qualified "

32+ txt "qualified "

33− case ideclPkgQual of

33+ case ideclPkgQual of

34− Nothing -> return ()

34+ Nothing -> return ()

35− Just slit -> do

35+ Just slit -> do

36− atom slit

36+ atom slit

37− space

37+ space

38− located ideclName atom

38+ located ideclName atom

39− case ideclAs of

39+ case ideclAs of

40− Nothing -> return ()

40+ Nothing -> return ()

41− Just l -> do

41+ Just l -> do

42− txt " as "

42+ txt " as "

43− located l atom

43+ located l atom

44− case ideclHiding of

44+ case ideclHiding of

45− Nothing -> return ()

45+ Nothing -> return ()

46− Just (hiding, _) ->

46+ Just (hiding, _) ->

47− when hiding $

47+ when hiding $

48− txt " hiding"

48+ txt " hiding"

49− ] ++ (case ideclHiding of

49+ case ideclHiding of

50− Nothing -> []

50+ Nothing -> return ()

51− Just (_, l) ->

51+ Just (_, l) -> do

52+ breakpoint

52− [ inci . locatedVia Nothing l $

53+ inci . locatedVia Nothing l $

53− parens . velt . withSep comma (located' p_lie)

54+ parens . velt . withSep comma (located' p_lie)

54− ])

55

56p_lie :: IE GhcPs -> R ()

57p_lie = \case

src/Ormolu/Printer/Meat/Module.hs+9−10

@@ -29,16 +29,15 @@ p_hsModule loc@(L moduleSpan hsModule) = do

29 locatedVia (Just spn) loc $ \HsModule {..} -> do

30 case hsmodName of

31 Nothing -> pure ()

32− Just hsmodName' -> do

32+ Just hsmodName' -> line $ do

33− line . velt' $

34− [ located hsmodName' p_hsmodName ] ++

33+ located hsmodName' p_hsmodName

35− (case hsmodExports of

34+ case hsmodExports of

36− Nothing -> []

35+ Nothing -> return ()

37− Just hsmodExports' ->

36+ Just hsmodExports' -> do

37+ breakpoint

38− [ inci (locatedVia Nothing hsmodExports' p_hsmodExports)

38+ inci (locatedVia Nothing hsmodExports' p_hsmodExports)

39− ])

39+ breakpoint

40− ++ [ txt "where"

40+ txt "where"

41− ]

42 unless (null hsmodImports) newline

41 unless (null hsmodImports) newline

43 forM_ (sortImports hsmodImports) (located' p_hsmodImport)

42 forM_ (sortImports hsmodImports) (located' p_hsmodImport)

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

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

src/Ormolu/Printer/Meat/Type.hs+48−22

@@ -1,11 +1,14 @@

1{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE RecordWildCards #-}

3

4

4-- | Rendering of types.

5-- | Rendering of types.

5

6

6module Ormolu.Printer.Meat.Type

7module Ormolu.Printer.Meat.Type

7 ( p_hsType

8 ( p_hsType

9+ , p_hsContext

8 , p_hsTyVarBndr

10 , p_hsTyVarBndr

11+ , p_conDeclFields

9 )

12 )

10where

13where

11

14

@@ -16,25 +19,22 @@ import Ormolu.Printer.Meat.Common

16

19

17p_hsType :: HsType GhcPs -> R ()

20p_hsType :: HsType GhcPs -> R ()

18p_hsType = \case

21p_hsType = \case

19− HsForAllTy bndrs t -> velt'

22+ HsForAllTy bndrs t -> do

20− [ do txt "forall"

23+ txt "forall "

21− velt' (located' p_hsTyVarBndr <$> bndrs)

24+ spaceSep (located' p_hsTyVarBndr) bndrs

22− txt "."

25+ txt ". "

23− , located t p_hsType

26+ locatedVia Nothing t p_hsType

24− ]

25− HsQualTy qs t -> velt'

27+ HsQualTy qs t -> do

26− [ locatedVia Nothing qs $ \case

28+ locatedVia Nothing qs p_hsContext

29+ breakpoint

27− [] -> txt "()"

30+ txt "=> "

28− [x] -> located x p_hsType

31+ locatedVia Nothing t p_hsType

29− xs -> parens . velt $ withSep comma (located' p_hsType) xs

30− , inci $ darrow >> located t p_hsType

31− ]

32 HsTyVar p n -> do

33 case p of

34 Promoted -> txt "'"

35 NotPromoted -> return ()

36 located n p_rdrName

37− HsAppsTy apps -> do

37+ HsAppsTy apps ->

38 velt' $ case apps of

39 [] -> []

40 (x:xs) -> located' p_hsAppType x : (located' (inci . p_hsAppType) <$> xs)

@@ -42,10 +42,14 @@ p_hsType = \case

42 [ located f p_hsType

43 , inci $ located x p_hsType

44 ]

45− HsFunTy f x -> velt'

45+ HsFunTy f x@(L _ x') -> do

46− [ located f p_hsType

46+ located f p_hsType

47+ breakpoint

48+ txt "-> "

49+ let located_ = case x' of

50+ HsFunTy{} -> locatedVia Nothing

47− , inci $ rarrow >> located x p_hsType

51+ _ -> located

48− ]

52+ located_ x p_hsType

49 HsListTy t -> located t (brackets . p_hsType)

53 HsListTy t -> located t (brackets . p_hsType)

50 HsPArrTy t -> located t (bracketsPar . p_hsType)

54 HsPArrTy t -> located t (bracketsPar . p_hsType)

51 HsTupleTy tsort xs ->

55 HsTupleTy tsort xs ->

@@ -66,7 +70,7 @@ p_hsType = \case

66 parens (located t p_hsType)

70 parens (located t p_hsType)

67 HsIParamTy n t -> velt'

71 HsIParamTy n t -> velt'

68 [ located n atom

72 [ located n atom

69− , inci $ ofType >> located t p_hsType

73+ , inci $ txt ":: " >> located t p_hsType

70 ]

74 ]

71 HsEqTy x y -> velt'

75 HsEqTy x y -> velt'

72 [ located x p_hsType

76 [ located x p_hsType

@@ -74,7 +78,7 @@ p_hsType = \case

74 ]

78 ]

75 HsKindSig t k -> velt'

79 HsKindSig t k -> velt'

76 [ located t p_hsType

80 [ located t p_hsType

77− , inci $ ofType >> located k p_hsType

81+ , inci $ txt ":: " >> located k p_hsType

78 ]

82 ]

79 HsSpliceTy _ _ -> error "HsSpliceTy"

83 HsSpliceTy _ _ -> error "HsSpliceTy"

80 HsDocTy _ _ -> error "HsDocTy"

84 HsDocTy _ _ -> error "HsDocTy"

@@ -88,7 +92,8 @@ p_hsType = \case

88 SrcStrict -> txt "!"

92 SrcStrict -> txt "!"

89 NoSrcStrict -> return ()

93 NoSrcStrict -> return ()

90 located t p_hsType

94 located t p_hsType

91− HsRecTy _ -> error "HsRecTy"

95+ HsRecTy fields ->

96+ p_conDeclFields fields

92 HsCoreTy t -> atom t

97 HsCoreTy t -> atom t

93 HsExplicitListTy p _ xs -> do

98 HsExplicitListTy p _ xs -> do

94 case p of -- XXX not sure about this one

99 case p of -- XXX not sure about this one

@@ -101,13 +106,19 @@ p_hsType = \case

101 HsTyLit t -> atom t

106 HsTyLit t -> atom t

102 HsWildCardTy (AnonWildCard PlaceHolder) -> txt "_"

107 HsWildCardTy (AnonWildCard PlaceHolder) -> txt "_"

103

108

109+p_hsContext :: HsContext GhcPs -> R ()

110+p_hsContext = \case

111+ [] -> txt "()"

112+ [x] -> located x p_hsType

113+ xs -> parens . velt $ withSep comma (located' p_hsType) xs

114+

104p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

115p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

105p_hsTyVarBndr = \case

116p_hsTyVarBndr = \case

106 UserTyVar l ->

117 UserTyVar l ->

107 located l p_rdrName

118 located l p_rdrName

108 KindedTyVar l k -> parens $ velt'

119 KindedTyVar l k -> parens $ velt'

109 [ located l atom

120 [ located l atom

110− , inci $ ofType >> located k p_hsType

121+ , inci $ txt ":: " >> located k p_hsType

111 ]

122 ]

112

123

113p_hsAppType :: HsAppType GhcPs -> R ()

124p_hsAppType :: HsAppType GhcPs -> R ()

@@ -116,3 +127,18 @@ p_hsAppType = \case

116 located l p_rdrName'

127 located l p_rdrName'

117 HsAppPrefix l ->

128 HsAppPrefix l ->

118 located l p_hsType

129 located l p_hsType

130+

131+p_conDeclFields :: [LConDeclField GhcPs] -> R ()

132+p_conDeclFields =

133+ braces . velt . withSep comma (located' p_conDeclField)

134+

135+p_conDeclField :: ConDeclField GhcPs -> R ()

136+p_conDeclField ConDeclField {..} = velt'

137+ [ velt $ withSep

138+ comma

139+ (located' (located' p_rdrName . rdrNameFieldOcc))

140+ cd_fld_names

141+ , inci $ do

142+ txt ":: "

143+ relaxComments (locatedVia Nothing cd_fld_type p_hsType)

144+ ]

tests/Ormolu/Printer/CombinatorsSpec.hs+3−3

@@ -66,12 +66,12 @@ rFn :: R ()

66rFn = velt'

67 [ txt "foo"

68 , inci $ velt'

69− [ do ofType

69+ [ do txt ":: "

70 parens $ velt'

71 [ txt "Int"

72− , rarrow >> txt "Int"

72+ , txt "-> " >> txt "Int"

73 ]

74− , rarrow >> txt "Bool"

74+ , txt "-> " >> txt "Bool"

75 ]

76 ]

77