Haddock comment to the last data constructor is attached incorrectly

[Lev135]

Working around the stylish-haskell bug I was very surprised to see, that haddock comments in the AST produced by ghc-lib-parser are located in the such strange way: all comments, except the last one, are attached to the DataDecl, while the last one --- to the TyClD.

Consider the following declaration:

data Dat
  = Foo -- ^ foo
  | Bar -- ^ bar
  | Baz -- ^ baz

We get this AST:

L
  RealSrcSpan (@RealSrcSpan' <SrcLoc "<string>" 1 1> <SrcLoc "<string>" 1 1>) Nothing
  HsModule
    EpAnn
      Anchor (@RealSrcSpan' <SrcLoc "<string>" 1 1> <SrcLoc "<string>" 1 1>) UnchangedAnchor
      AnnsModule [] (AnnList Nothing Nothing Nothing [] [])
      EpaCommentsBalanced
        []
        [L
          Anchor (@RealSrcSpan' <SrcLoc "<string>" 5 1> <SrcLoc "<string>" 5 1>) UnchangedAnchor
          EpaComment EpaEofComment (@RealSrcSpan' <SrcLoc "<string>" 5 1> <SrcLoc "<string>" 5 1>)]
    VirtualBraces 1
    Nothing
    Nothing
    []
    [L
      SrcSpanAnn
        EpAnn
          Anchor (@RealSrcSpan' <SrcLoc "<string>" 1 1> <SrcLoc "<string>" 4 8>) UnchangedAnchor
          AnnListItem []
          EpaComments
            [L
              Anchor
                @RealSrcSpan' <SrcLoc "<string>" 4 9> <SrcLoc "<string>" 4 17>
                UnchangedAnchor
              EpaComment
                EpaLineComment "-- ^ baz"
                @RealSrcSpan' <SrcLoc "<string>" 4 5> <SrcLoc "<string>" 4 8>]
        RealSrcSpan
          @RealSrcSpan' <SrcLoc "<string>" 1 1> <SrcLoc "<string>" 4 8>
          Just (BufSpan (BufPos 0) (BufPos 50))
      TyClD
        NoExtField
        DataDecl
          EpAnn
            Anchor (@RealSrcSpan' <SrcLoc "<string>" 1 1> <SrcLoc "<string>" 4 8>) UnchangedAnchor
            [AddEpAnn
              AnnData
              EpaSpan (@RealSrcSpan' <SrcLoc "<string>" 1 1> <SrcLoc "<string>" 1 5>),
            AddEpAnn
              AnnEqual
              EpaSpan (@RealSrcSpan' <SrcLoc "<string>" 2 3> <SrcLoc "<string>" 2 4>)]
            EpaComments
              [L
                Anchor
                  @RealSrcSpan' <SrcLoc "<string>" 2 9> <SrcLoc "<string>" 2 17>
                  UnchangedAnchor
                EpaComment
                  EpaLineComment "-- ^ foo"
                  @RealSrcSpan' <SrcLoc "<string>" 2 5> <SrcLoc "<string>" 2 8>,
              L
                Anchor
                  @RealSrcSpan' <SrcLoc "<string>" 3 9> <SrcLoc "<string>" 3 17>
                  UnchangedAnchor
                EpaComment
                  EpaLineComment "-- ^ bar"
                  @RealSrcSpan' <SrcLoc "<string>" 3 5> <SrcLoc "<string>" 3 8>]
          L
            SrcSpanAnn
              EpAnnNotUsed
              RealSrcSpan
                @RealSrcSpan' <SrcLoc "<string>" 1 6> <SrcLoc "<string>" 1 9>
                Just (BufSpan (BufPos 5) (BufPos 8))
            Unqual (OccName <Dat>)
          HsQTvs NoExtField []
          Prefix
          HsDataDefn
            NoExtField
            DataType
            Nothing
            Nothing
            Nothing
            [L
              SrcSpanAnn
                EpAnn
                  Anchor
                    @RealSrcSpan' <SrcLoc "<string>" 2 5> <SrcLoc "<string>" 2 8>
                    UnchangedAnchor
                  AnnListItem
                    [AddVbarAnn
                      EpaSpan (@RealSrcSpan' <SrcLoc "<string>" 3 3> <SrcLoc "<string>" 3 4>)]
                  EpaComments []
                RealSrcSpan
                  @RealSrcSpan' <SrcLoc "<string>" 2 5> <SrcLoc "<string>" 2 8>
                  Just (BufSpan (BufPos 13) (BufPos 16))
              ConDeclH98
                EpAnn
                  Anchor
                    @RealSrcSpan' <SrcLoc "<string>" 2 5> <SrcLoc "<string>" 2 8>
                    UnchangedAnchor
                  []
                  EpaComments []
                L
                  SrcSpanAnn
                    EpAnnNotUsed
                    RealSrcSpan
                      @RealSrcSpan' <SrcLoc "<string>" 2 5> <SrcLoc "<string>" 2 8>
                      Just (BufSpan (BufPos 13) (BufPos 16))
                  Unqual (OccName <Foo>)
                False
                []
                Nothing
                PrefixCon [] []
                Nothing,
            L
              SrcSpanAnn
                EpAnn
                  Anchor
                    @RealSrcSpan' <SrcLoc "<string>" 3 5> <SrcLoc "<string>" 3 8>
                    UnchangedAnchor
                  AnnListItem
                    [AddVbarAnn
                      EpaSpan (@RealSrcSpan' <SrcLoc "<string>" 4 3> <SrcLoc "<string>" 4 4>)]
                  EpaComments []
                RealSrcSpan
                  @RealSrcSpan' <SrcLoc "<string>" 3 5> <SrcLoc "<string>" 3 8>
                  Just (BufSpan (BufPos 30) (BufPos 33))
              ConDeclH98
                EpAnn
                  Anchor
                    @RealSrcSpan' <SrcLoc "<string>" 3 5> <SrcLoc "<string>" 3 8>
                    UnchangedAnchor
                  []
                  EpaComments []
                L
                  SrcSpanAnn
                    EpAnnNotUsed
                    RealSrcSpan
                      @RealSrcSpan' <SrcLoc "<string>" 3 5> <SrcLoc "<string>" 3 8>
                      Just (BufSpan (BufPos 30) (BufPos 33))
                  Unqual (OccName <Bar>)
                False
                []
                Nothing
                PrefixCon [] []
                Nothing,
            L
              SrcSpanAnn
                EpAnnNotUsed
                RealSrcSpan
                  @RealSrcSpan' <SrcLoc "<string>" 4 5> <SrcLoc "<string>" 4 8>
                  Just (BufSpan (BufPos 47) (BufPos 50))
              ConDeclH98
                EpAnn
                  Anchor
                    @RealSrcSpan' <SrcLoc "<string>" 4 5> <SrcLoc "<string>" 4 8>
                    UnchangedAnchor
                  []
                  EpaComments []
                L
                  SrcSpanAnn
                    EpAnnNotUsed
                    RealSrcSpan
                      @RealSrcSpan' <SrcLoc "<string>" 4 5> <SrcLoc "<string>" 4 8>
                      Just (BufSpan (BufPos 47) (BufPos 50))
                  Unqual (OccName <Baz>)
                False
                []
                Nothing
                PrefixCon [] []
                Nothing]
            []]
    Nothing
    Nothing

[shayne-fletcher]

• what version of ghc-lib-parser does this relate to?
• what are the steps you took to produce that rendering of the AST?
• does this AST differ in some way from one produced by GHC itself?

it's hard to see how the parse tree produced by ghc-lib-parser can be different from GHC itself since it's the same source code cc @alanz

[Lev135]

Ok, I also thought so. I haven't tried to rewrite everything using ghc. If the output is identical to ghc its not an issue for ghc-lib, yes? If it's the case, should I ask if its expected behavior in ghc repo? I've tried to examine more complex examples with comments and it seems that the place of haddock comments in AST is quite chaotic, without coherence with the rules from haddock's documentation. So maybe it's expected behavior, although enough confusing.

This AST was produced by 9.4.3.20221104 version of ghc-lib-parser and printed by means of pretty-simple over a simple rose-tree like structure, constructed by gfoldl with some modifications -- something hand-made, but this problem is definitely not with AST rendering.

[shayne-fletcher]

Ok, I also thought so. I haven't tried to rewrite everything using ghc. If the output is identical to ghc its not an issue for ghc-lib, yes? If it's the case, should I ask if its expected behavior in ghc repo?

never say never of course but i'm confident this is something to be discussed in the ghc repo with alan zimmerman.

This AST was produced by 9.4.3.20221104 version of ghc-lib-parser and printed by means of pretty-simple over a simple rose-tree like structure, constructed by gfoldl with some modifications -- something hand-made, but this problem is definitely not with AST rendering.

in case it helps, i put your example program in a file Q.hs and issued this command: ghc -haddock -ddump-parsed-ast -fforce-recomp -c ~/Q.hs to get the following output:

==================== Parser AST ====================

(L
 { /Users/shayne/Q.hs:1:1 }
 (HsModule
  (EpAnn
   (Anchor
    { /Users/shayne/Q.hs:1:1 }
    (UnchangedAnchor))
   (AnnsModule
    []
    (AnnList
     (Nothing)
     (Nothing)
     (Nothing)
     []
     []))
   (EpaCommentsBalanced
    []
    [(L
      (Anchor
       { /Users/shayne/Q.hs:7:1 }
       (UnchangedAnchor))
      (EpaComment
       (EpaEofComment)
       { /Users/shayne/Q.hs:7:1 }))]))
  (VirtualBraces
   (1))
  (Nothing)
  (Nothing)
  []
  [(L
    (SrcSpanAnn (EpAnn
                 (Anchor
                  { /Users/shayne/Q.hs:(1,1)-(4,6) }
                  (UnchangedAnchor))
                 (AnnListItem
                  [])
                 (EpaComments
                  [])) { /Users/shayne/Q.hs:(1,1)-(4,6) })
    (TyClD
     (NoExtField)
     (DataDecl
      (EpAnn
       (Anchor
        { /Users/shayne/Q.hs:(1,1)-(4,6) }
        (UnchangedAnchor))
       [(AddEpAnn AnnData (EpaSpan { /Users/shayne/Q.hs:1:1-4 }))
       ,(AddEpAnn AnnEqual (EpaSpan { /Users/shayne/Q.hs:2:2 }))]
       (EpaComments
        []))
      (L
       (SrcSpanAnn (EpAnnNotUsed) { /Users/shayne/Q.hs:1:6-8 })
       (Unqual
        {OccName: Dat}))
      (HsQTvs
       (NoExtField)
       [])
      (Prefix)
      (HsDataDefn
       (NoExtField)
       (DataType)
       (Nothing)
       (Nothing)
       (Nothing)
       [(L
         (SrcSpanAnn (EpAnn
                      (Anchor
                       { /Users/shayne/Q.hs:2:4-6 }
                       (UnchangedAnchor))
                      (AnnListItem
                       [(AddVbarAnn
                         (EpaSpan { /Users/shayne/Q.hs:3:2 }))])
                      (EpaComments
                       [])) { /Users/shayne/Q.hs:2:4-6 })
         (ConDeclH98
          (EpAnn
           (Anchor
            { /Users/shayne/Q.hs:2:4-6 }
            (UnchangedAnchor))
           []
           (EpaComments
            []))
          (L
           (SrcSpanAnn (EpAnnNotUsed) { /Users/shayne/Q.hs:2:4-6 })
           (Unqual
            {OccName: Foo}))
          (False)
          []
          (Nothing)
          (PrefixCon
           []
           [])
          (Just
           (L
            { /Users/shayne/Q.hs:2:8-15 }
            (WithHsDocIdentifiers
             (MultiLineDocString
              (HsDocStringPrevious)
              (:|
               (L
                { /Users/shayne/Q.hs:2:12-15 }
                (HsDocStringChunk
                 " foo"))
               []))
             [])))))
       ,(L
         (SrcSpanAnn (EpAnn
                      (Anchor
                       { /Users/shayne/Q.hs:3:4-6 }
                       (UnchangedAnchor))
                      (AnnListItem
                       [(AddVbarAnn
                         (EpaSpan { /Users/shayne/Q.hs:4:2 }))])
                      (EpaComments
                       [])) { /Users/shayne/Q.hs:3:4-6 })
         (ConDeclH98
          (EpAnn
           (Anchor
            { /Users/shayne/Q.hs:3:4-6 }
            (UnchangedAnchor))
           []
           (EpaComments
            []))
          (L
           (SrcSpanAnn (EpAnnNotUsed) { /Users/shayne/Q.hs:3:4-6 })
           (Unqual
            {OccName: Bar}))
          (False)
          []
          (Nothing)
          (PrefixCon
           []
           [])
          (Just
           (L
            { /Users/shayne/Q.hs:3:8-15 }
            (WithHsDocIdentifiers
             (MultiLineDocString
              (HsDocStringPrevious)
              (:|
               (L
                { /Users/shayne/Q.hs:3:12-15 }
                (HsDocStringChunk
                 " bar"))
               []))
             [])))))
       ,(L
         (SrcSpanAnn (EpAnnNotUsed) { /Users/shayne/Q.hs:4:4-6 })
         (ConDeclH98
          (EpAnn
           (Anchor
            { /Users/shayne/Q.hs:4:4-6 }
            (UnchangedAnchor))
           []
           (EpaComments
            []))
          (L
           (SrcSpanAnn (EpAnnNotUsed) { /Users/shayne/Q.hs:4:4-6 })
           (Unqual
            {OccName: Baz}))
          (False)
          []
          (Nothing)
          (PrefixCon
           []
           [])
          (Just
           (L
            { /Users/shayne/Q.hs:4:8-15 }
            (WithHsDocIdentifiers
             (MultiLineDocString
              (HsDocStringPrevious)
              (:|
               (L
                { /Users/shayne/Q.hs:4:12-15 }
                (HsDocStringChunk
                 " baz"))
               []))
             [])))))]
       []))))
  ,(L
    (SrcSpanAnn (EpAnn
                 (Anchor
                  { /Users/shayne/Q.hs:6:1-16 }
                  (UnchangedAnchor))
                 (AnnListItem
                  [])
                 (EpaComments
                  [])) { /Users/shayne/Q.hs:6:1-16 })
    (ValD
     (NoExtField)
     (FunBind
      (NoExtField)
      (L
       (SrcSpanAnn (EpAnnNotUsed) { /Users/shayne/Q.hs:6:1-4 })
       (Unqual
        {OccName: main}))
      (MG
       (NoExtField)
       (L
        (SrcSpanAnn (EpAnnNotUsed) { /Users/shayne/Q.hs:6:1-16 })
        [(L
          (SrcSpanAnn (EpAnnNotUsed) { /Users/shayne/Q.hs:6:1-16 })
          (Match
           (EpAnn
            (Anchor
             { /Users/shayne/Q.hs:6:1-16 }
             (UnchangedAnchor))
            []
            (EpaComments
             []))
           (FunRhs
            (L
             (SrcSpanAnn (EpAnnNotUsed) { /Users/shayne/Q.hs:6:1-4 })
             (Unqual
              {OccName: main}))
            (Prefix)
            (NoSrcStrict))
           []
           (GRHSs
            (EpaComments
             [])
            [(L
              (SrcSpanAnn
               (EpAnnNotUsed)
               { /Users/shayne/Q.hs:6:6-16 })
              (GRHS
               (EpAnn
                (Anchor
                 { /Users/shayne/Q.hs:6:6-16 }
                 (UnchangedAnchor))
                (GrhsAnn
                 (Nothing)
                 (AddEpAnn AnnEqual (EpaSpan { /Users/shayne/Q.hs:6:6 })))
                (EpaComments
                 []))
               []
               (L
                (SrcSpanAnn (EpAnnNotUsed) { /Users/shayne/Q.hs:6:8-16 })
                (HsVar
                 (NoExtField)
                 (L
                  (SrcSpanAnn (EpAnnNotUsed) { /Users/shayne/Q.hs:6:8-16 })
                  (Unqual
                   {OccName: undefined}))))))]
            (EmptyLocalBinds
             (NoExtField)))))])
       (FromSource))
      [])))]
  (Nothing)
  (Nothing)))

i didn't look deeply but a quick glance suggest the haddock comments are associated with their respective data ctors? this was using ghc-9.4.2 (i don't expect ghc-9.4.3 to be any different). this output i think comes from showASTData.

[shayne-fletcher]

indeed, looks like the comments are associated with the con_doc fields of ConDeclH98 constructors of ConDecl elements
i don't expect ghc-lib-parser to produce anything different. it's more work to get a rendering of a parse tree produced with ghc-lib-parser for comparison but it can be done via showAstData.

[Lev135]

I found the problem: stylish-haskell (and my AST-printer) parsed the module without Opt_Haddock option. That's why haddock comments were treated as simple comments and were attached to incorrect places
Thank you!