803f76a · ormolu · git.iko.soy

git.iko.soy/ormolu

Fix Haddock placement for function arguments

I'm not sure it's perfect, but it fixes the original issue and all the tests pass. The problem was in entering with locate (or some version of it) the same span twice. So the algorithm saw an element with identical enclosing element and the ‘commentFollowsElt’ function got confused. The solution is two first augment registration of enclosing spans to allow us to keep more than one item there. Then we can filter out spans which are just copies of current reference span to get to the “real” enclosing span. It seems to make sense to attach comments to child element if it starts exactly at the same position of parent element, hence the distance between start of enclosing/reference span and start of comment is the same, thus changing ‘>’ to ‘>=’ in ‘commentFollowsElt’.

commit803f76aab919d9918266d7f0c8aeac078b82ba1b authormrkkrp <mark.karpov@tweag.io> dateTue 11 Jun 2019, 22:04 (7 years ago) parent5165003

5 files changed+22−14

compare with master

unifiedsplit

data/examples/other/argument-comment-out.hs+4 data/examples/other/argument-comment.hs+4 src/Ormolu/Printer/Comments.hs+2−2 src/Ormolu/Printer/Internal.hs+7−6 src/Ormolu/Printer/Meat/Type.hs+5−6

data/examples/other/argument-comment-out.hsnew file+4

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

1+foo

2+ :: Int -- ^ Documentation

3+ -> Bool

4+foo _ = True

data/examples/other/argument-comment.hsnew file+4

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

1+foo

2+ :: Int -- ^ Documentation

3+ -> Bool

4+foo _ = True

src/Ormolu/Printer/Comments.hs+2−2

@@ -78,7 +78,7 @@ spitFollowingComment

7878 -> R (Maybe RealSrcSpan) -- ^ Location of this comment

7979spitFollowingComment (L ref a) mlastSpn = do

8080 mnSpn <- nextEltSpan

81− meSpn <- getEnclosingSpan

81+ meSpn <- getEnclosingSpan ref

8282 i <- getIndent

8383 withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastSpn) $ \l comment ->

8484 if theSameLine l ref && not (isModule a)

@@ -201,7 +201,7 @@ commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =

201201 Just espn ->

202202 let startColumn = srcLocCol . realSrcSpanStart

203203 in abs (startColumn espn - startColumn l)

204− > abs (startColumn ref - startColumn l)

204+ >= abs (startColumn ref - startColumn l)

205205 continuation = isJust mlastSpn

206206

207207-- | Output a 'Comment'. This is a low-level printing function.

src/Ormolu/Printer/Internal.hs+7−6

@@ -72,7 +72,7 @@ data RC = RC

7272 -- ^ Whether to relax aligning rules for comments

7373 , rcDebug :: Bool

7474 -- ^ Whether to print debugging info as we go

75− , rcEnclosingSpan :: Maybe RealSrcSpan

75+ , rcEnclosingSpans :: [RealSrcSpan]

7676 -- ^ Span of enclosing element of AST

7777 , rcAnns :: Anns

7878 -- ^ Collection of annotations

@@ -117,7 +117,7 @@ runR debug (R m) sstream cstream anns =

117117 , rcLayout = MultiLine

118118 , rcRelaxedComments = False

119119 , rcDebug = debug

120− , rcEnclosingSpan = Nothing

120+ , rcEnclosingSpans = []

121121 , rcAnns = anns

122122 }

123123 sc = SC

@@ -316,17 +316,18 @@ setIndent i m' = do

316316 R (local modRC m)

317317 traceR "set_indent_after" Nothing

318318

319−-- | Get 'RealSrcSpan' of enclosing span, if any.

319+-- | Get 'RealSrcSpan' of enclosing span for given referencne span.

320320

321−getEnclosingSpan :: R (Maybe RealSrcSpan)

322−getEnclosingSpan = R (asks rcEnclosingSpan)

321+getEnclosingSpan :: RealSrcSpan -> R (Maybe RealSrcSpan)

322+getEnclosingSpan r =

323+ listToMaybe . dropWhile (== r) <$> R (asks rcEnclosingSpans)

323324

324325-- | Set 'RealSrcSpan' of enclosing span for the given computation.

325326

326327withEnclosingSpan :: RealSrcSpan -> R () -> R ()

327328withEnclosingSpan spn (R m) = do

328329 let modRC rc = rc

329− { rcEnclosingSpan = Just spn

330+ { rcEnclosingSpans = spn : rcEnclosingSpans rc

330331 }

331332 R (local modRC m)

332333

src/Ormolu/Printer/Meat/Type.hs+5−6

@@ -38,14 +38,13 @@ p_hsType = \case

3838 located f p_hsType

3939 breakpoint

4040 inci (located x p_hsType)

41− HsFunTy NoExt f x@(L _ x') -> do

42− located f p_hsType

41+ HsFunTy NoExt x y@(L _ y') -> do

42+ located x p_hsType

4343 breakpoint

4444 txt "-> "

45− let located_ = case x' of

46− HsFunTy{} -> locatedVia Nothing

47− _ -> located

48− located_ x p_hsType

45+ case y' of

46+ HsFunTy{} -> p_hsType y'

47+ _ -> located y p_hsType

4948 HsListTy NoExt t -> located t (brackets . p_hsType)

5049 HsTupleTy NoExt tsort xs ->

5150 let parens' =