76c4f52 · ormolu · git.iko.soy

git.iko.soy/ormolu

Fix rendering of unnamed fields of data constructors

commit76c4f523d7edc91ea5ab330358361c9e87fbdbb1 authorMark Karpov <markkarpov92@gmail.com> dateWed 13 May 2020, 15:14 (6 years ago) parenta5c4d6c

9 files changed+55−19

compare with master

unifiedsplit

CHANGELOG.md+4 data/examples/declaration/data/unnamed-field-comment-0-out.hs+7 data/examples/declaration/data/unnamed-field-comment-0.hs+5 data/examples/declaration/data/unnamed-field-comment-1-out.hs+5 data/examples/declaration/data/unnamed-field-comment-1.hs+4 expected-failures/Agda.txt−5 src/Ormolu/Printer/Meat/Common.hs+5−4 src/Ormolu/Printer/Meat/Declaration/Data.hs+1−1 src/Ormolu/Printer/Meat/Type.hs+24−9

CHANGELOG.md+4

@@ -28,6 +28,10 @@

2828* Fixed rendering of comment around if expressions. [Issue

2929 458](https://github.com/tweag/ormolu/issues/458).

3030

31+* Unnamed fields of data constructors are now documented using the `-- ^`

32+ syntax. [Issue 445](https://github.com/tweag/ormolu/issues/445) and [Issue

33+ 428](https://github.com/tweag/ormolu/issues/428).

34+

3135* Renamed the `--check-idempotency` flag to `--check-idempotence`.

3236 Apparently only the latter is correct.

3337

data/examples/declaration/data/unnamed-field-comment-0-out.hsnew file+7

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

1+data Foo

2+ = -- | Bar

3+ Bar

4+ Field1

5+ -- ^ Field 1

6+ Field2

7+ -- ^ Field 2

data/examples/declaration/data/unnamed-field-comment-0.hsnew file+5

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

1+data Foo

2+ = -- | Bar

3+ Bar

4+ Field1 -- ^ Field 1

5+ Field2 -- ^ Field 2

data/examples/declaration/data/unnamed-field-comment-1-out.hsnew file+5

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

1+data X

2+ = B

3+ !Int

4+ -- ^ y

5+ C

data/examples/declaration/data/unnamed-field-comment-1.hsnew file+4

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

1+data X

2+ = B

3+ !Int -- ^ y

4+ C

expected-failures/Agda.txt−5

@@ -4,11 +4,6 @@ Formatting is not idempotent:

44 after: " =\n "

55Please, consider reporting the bug.

7−Parsing of formatted code failed:

8− src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs<rendered>:524:7-13

9− parse error on input `C.QName'

10−Please, consider reporting the bug.

11−

127Formatting is not idempotent:

138 src/full/Agda/Syntax/Translation/InternalToAbstract.hs<rendered>:745:4

149 before: " nes\n\n "

src/Ormolu/Printer/Meat/Common.hs+5−4

@@ -154,10 +154,11 @@ p_hsDocString ::

154154 LHsDocString ->

155155 R ()

156156p_hsDocString hstyle needsNewline (L l str) = do

157− goesAfterComment <- getSpanMark >>= \case

158− Just (HaddockSpan _ _) -> return True

159− Just (CommentSpan _) -> return True

160− _ -> return False

157+ let isCommentSpan = \case

158+ HaddockSpan _ _ -> True

159+ CommentSpan _ -> True

160+ _ -> False

161+ goesAfterComment <- maybe False isCommentSpan <$> getSpanMark

161162 -- Make sure the Haddock is separated by a newline from other comments.

162163 when goesAfterComment newline

163164 forM_ (zip (splitDocString str) (True : repeat False)) $ \(x, isFirst) -> do

src/Ormolu/Printer/Meat/Declaration/Data.hs+1−1

@@ -153,7 +153,7 @@ p_conDecl singleConstRec = \case

153153 PrefixCon xs -> do

154154 p_rdrName con_name

155155 unless (null xs) breakpoint

156− inci . sitcc $ sep breakpoint (sitcc . located' p_hsType) xs

156+ inci . sitcc $ sep breakpoint (sitcc . located' p_hsTypePostDoc) xs

157157 RecCon l -> do

158158 p_rdrName con_name

159159 breakpoint

src/Ormolu/Printer/Meat/Type.hs+24−9

@@ -5,6 +5,7 @@

55-- | Rendering of types.

66module Ormolu.Printer.Meat.Type

77 ( p_hsType,

8+ p_hsTypePostDoc,

89 hasDocStrings,

910 p_hsContext,

1011 p_hsTyVarBndr,

@@ -23,14 +24,22 @@ import Ormolu.Printer.Operators

2324import Ormolu.Utils

2425

2526p_hsType :: HsType GhcPs -> R ()

26−p_hsType t = p_hsType' (hasDocStrings t) t

27+p_hsType t = p_hsType' (hasDocStrings t) PipeStyle t

2728

28−p_hsType' :: Bool -> HsType GhcPs -> R ()

29−p_hsType' multilineArgs = \case

29+p_hsTypePostDoc :: HsType GhcPs -> R ()

30+p_hsTypePostDoc t = p_hsType' (hasDocStrings t) CaretStyle t

31+

32+-- | How to render Haddocks associated with a type.

33+data TypeDocStyle

34+ = PipeStyle

35+ | CaretStyle

36+

37+p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R ()

38+p_hsType' multilineArgs docStyle = \case

3039 HsForAllTy NoExtField visibility bndrs t -> do

3140 p_forallBndrs visibility p_hsTyVarBndr bndrs

3241 interArgBreak

33− p_hsType' multilineArgs (unLoc t)

42+ p_hsTypeR (unLoc t)

3443 HsQualTy NoExtField qs t -> do

3544 located qs p_hsContext

3645 space

@@ -114,9 +123,15 @@ p_hsType' multilineArgs = \case

114123 space

115124 inci (located k p_hsType)

116125 HsSpliceTy NoExtField splice -> p_hsSplice splice

117− HsDocTy NoExtField t str -> do

118− p_hsDocString Pipe True str

119− located t p_hsType

126+ HsDocTy NoExtField t str ->

127+ case docStyle of

128+ PipeStyle -> do

129+ p_hsDocString Pipe True str

130+ located t p_hsType

131+ CaretStyle -> do

132+ located t p_hsType

133+ newline

134+ p_hsDocString Caret False str

120135 HsBangTy NoExtField (HsSrcBang _ u s) t -> do

121136 case u of

122137 SrcUnpack -> txt "{-# UNPACK #-}" >> space

@@ -156,14 +171,14 @@ p_hsType' multilineArgs = \case

156171 where

157172 isPromoted = \case

158173 HsTyVar _ IsPromoted _ -> True

159− HsExplicitListTy {} -> True

160174 HsExplicitTupleTy {} -> True

175+ HsExplicitListTy {} -> True

161176 _ -> False

162177 interArgBreak =

163178 if multilineArgs

164179 then newline

165180 else breakpoint

166− p_hsTypeR = p_hsType' multilineArgs

181+ p_hsTypeR = p_hsType' multilineArgs docStyle

167182

168183-- | Return 'True' if at least one argument in 'HsType' has a doc string

169184-- attached to it.