{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}

-- | Comment handling around an AST node
module HIndent.Pretty.NodeComments
  ( CommentExtraction(..)
  , emptyNodeComments
  ) where

import Data.Maybe
import Data.Void
import GHC.Core.Coercion
import GHC.Data.BooleanFormula
import GHC.Hs
import GHC.Stack
import GHC.Types.Basic
import GHC.Types.Fixity
import GHC.Types.ForeignCall
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import HIndent.Ast.NodeComments
import HIndent.Pragma
import HIndent.Pretty.SigBindFamily
import HIndent.Pretty.Types
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
import GHC.Core.DataCon
#else
import GHC.Unit
#endif
-- | An interface to extract comments from an AST node.
class CommentExtraction a where
  nodeComments :: a -> NodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (HsModule GhcPs) where
  nodeComments :: HsModule GhcPs -> NodeComments
nodeComments =
    EpAnn AnnsModule -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments (EpAnn AnnsModule -> NodeComments)
-> (HsModule GhcPs -> EpAnn AnnsModule)
-> HsModule GhcPs
-> NodeComments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpAnn AnnsModule -> EpAnn AnnsModule
forall {ann}. EpAnn ann -> EpAnn ann
filterOutEofAndPragmasFromAnn (EpAnn AnnsModule -> EpAnn AnnsModule)
-> (HsModule GhcPs -> EpAnn AnnsModule)
-> HsModule GhcPs
-> EpAnn AnnsModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XModulePs -> EpAnn AnnsModule
hsmodAnn (XModulePs -> EpAnn AnnsModule)
-> (HsModule GhcPs -> XModulePs)
-> HsModule GhcPs
-> EpAnn AnnsModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule GhcPs -> XCModule GhcPs
HsModule GhcPs -> XModulePs
forall p. HsModule p -> XCModule p
hsmodExt
    where
      filterOutEofAndPragmasFromAnn :: EpAnn ann -> EpAnn ann
filterOutEofAndPragmasFromAnn EpAnn {ann
EpaLocation
EpAnnComments
entry :: EpaLocation
anns :: ann
comments :: EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
anns :: forall ann. EpAnn ann -> ann
entry :: forall ann. EpAnn ann -> EpaLocation
..} =
        EpAnn {comments :: EpAnnComments
comments = EpAnnComments -> EpAnnComments
filterOutEofAndPragmasFromComments EpAnnComments
comments, ann
EpaLocation
entry :: EpaLocation
anns :: ann
anns :: ann
entry :: EpaLocation
..}
      filterOutEofAndPragmasFromComments :: EpAnnComments -> EpAnnComments
filterOutEofAndPragmasFromComments EpAnnComments
comments =
        EpaCommentsBalanced
          { priorComments :: [LEpaComment]
priorComments = [LEpaComment] -> [LEpaComment]
forall {l}. [GenLocated l EpaComment] -> [GenLocated l EpaComment]
filterOutEofAndPragmas ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
comments
          , followingComments :: [LEpaComment]
followingComments =
              [LEpaComment] -> [LEpaComment]
forall {l}. [GenLocated l EpaComment] -> [GenLocated l EpaComment]
filterOutEofAndPragmas ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
comments
          }
      filterOutEofAndPragmas :: [GenLocated l EpaComment] -> [GenLocated l EpaComment]
filterOutEofAndPragmas = (GenLocated l EpaComment -> Bool)
-> [GenLocated l EpaComment] -> [GenLocated l EpaComment]
forall a. (a -> Bool) -> [a] -> [a]
filter GenLocated l EpaComment -> Bool
forall {l}. GenLocated l EpaComment -> Bool
isNeitherEofNorPragmaComment
      isNeitherEofNorPragmaComment :: GenLocated l EpaComment -> Bool
isNeitherEofNorPragmaComment (L l
_ (EpaComment EpaCommentTok
tok RealSrcSpan
_)) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ EpaCommentTok -> Bool
isPragma EpaCommentTok
tok
#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)
instance CommentExtraction (HsModule GhcPs) where
  nodeComments =
    nodeComments . filterOutEofAndPragmasFromAnn . hsmodAnn . hsmodExt
    where
      filterOutEofAndPragmasFromAnn EpAnn {..} =
        EpAnn {comments = filterOutEofAndPragmasFromComments comments, ..}
      filterOutEofAndPragmasFromAnn EpAnnNotUsed = EpAnnNotUsed
      filterOutEofAndPragmasFromComments comments =
        EpaCommentsBalanced
          { priorComments = filterOutEofAndPragmas $ priorComments comments
          , followingComments =
              filterOutEofAndPragmas $ getFollowingComments comments
          }
      filterOutEofAndPragmas = filter isNeitherEofNorPragmaComment
      isNeitherEofNorPragmaComment (L _ (EpaComment EpaEofComment _)) = False
      isNeitherEofNorPragmaComment (L _ (EpaComment tok _)) = not $ isPragma tok
#else
instance CommentExtraction HsModule where
  nodeComments = nodeComments . filterOutEofAndPragmasFromAnn . hsmodAnn
    where
      filterOutEofAndPragmasFromAnn EpAnn {..} =
        EpAnn {comments = filterOutEofAndPragmasFromComments comments, ..}
      filterOutEofAndPragmasFromAnn EpAnnNotUsed = EpAnnNotUsed
      filterOutEofAndPragmasFromComments comments =
        EpaCommentsBalanced
          { priorComments = filterOutEofAndPragmas $ priorComments comments
          , followingComments =
              filterOutEofAndPragmas $ getFollowingComments comments
          }
      filterOutEofAndPragmas = filter isNeitherEofNorPragmaComment
      isNeitherEofNorPragmaComment (L _ (EpaComment EpaEofComment _)) = False
      isNeitherEofNorPragmaComment (L _ (EpaComment tok _)) = not $ isPragma tok
#endif
instance CommentExtraction l => CommentExtraction (GenLocated l e) where
  nodeComments :: GenLocated l e -> NodeComments
nodeComments (L l
l e
_) = l -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments l
l

instance CommentExtraction (HsDecl GhcPs) where
  nodeComments :: HsDecl GhcPs -> NodeComments
nodeComments TyClD {} = NodeComments
emptyNodeComments
  nodeComments InstD {} = NodeComments
emptyNodeComments
  nodeComments DerivD {} = NodeComments
emptyNodeComments
  nodeComments ValD {} = NodeComments
emptyNodeComments
  nodeComments SigD {} = NodeComments
emptyNodeComments
  nodeComments KindSigD {} = NodeComments
emptyNodeComments
  nodeComments DefD {} = NodeComments
emptyNodeComments
  nodeComments ForD {} = NodeComments
emptyNodeComments
  nodeComments WarningD {} = NodeComments
emptyNodeComments
  nodeComments AnnD {} = NodeComments
emptyNodeComments
  nodeComments RuleD {} = NodeComments
emptyNodeComments
  nodeComments SpliceD {} = NodeComments
emptyNodeComments
  nodeComments DocD {} =
    [Char] -> NodeComments
forall a. HasCallStack => [Char] -> a
error [Char]
"Document comments should be treated as normal ones."
  nodeComments RoleAnnotD {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 0)
instance CommentExtraction (TyClDecl GhcPs) where
  nodeComments :: TyClDecl GhcPs -> NodeComments
nodeComments FamDecl {} = NodeComments
emptyNodeComments
  nodeComments SynDecl {XSynDecl GhcPs
LIdP GhcPs
LHsType GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdSExt :: XSynDecl GhcPs
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdRhs :: LHsType GhcPs
tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdSExt :: forall pass. TyClDecl pass -> XSynDecl pass
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XSynDecl GhcPs
tcdSExt
  nodeComments DataDecl {XDataDecl GhcPs
LIdP GhcPs
LexicalFixity
LHsQTyVars GhcPs
HsDataDefn GhcPs
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdDExt :: XDataDecl GhcPs
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdDataDefn :: HsDataDefn GhcPs
tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDExt :: forall pass. TyClDecl pass -> XDataDecl pass
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XDataDecl GhcPs
tcdDExt
  nodeComments ClassDecl {tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdCExt = ([AddEpAnn]
x, EpLayout
_, AnnSortKey DeclTag
_)} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
x
#elif MIN_VERSION_ghc_lib_parser(9, 6, 0)
instance CommentExtraction (TyClDecl GhcPs) where
  nodeComments FamDecl {} = emptyNodeComments
  nodeComments SynDecl {..} = nodeComments tcdSExt
  nodeComments DataDecl {..} = nodeComments tcdDExt
  nodeComments ClassDecl {tcdCExt = (x, _)} = nodeComments x
#else
instance CommentExtraction (TyClDecl GhcPs) where
  nodeComments FamDecl {} = emptyNodeComments
  nodeComments SynDecl {..} = nodeComments tcdSExt
  nodeComments DataDecl {..} = nodeComments tcdDExt
  nodeComments ClassDecl {tcdCExt = (x, _, _)} = nodeComments x
#endif
instance CommentExtraction (InstDecl GhcPs) where
  nodeComments :: InstDecl GhcPs -> NodeComments
nodeComments = InstDecl GhcPs -> NodeComments
nodeCommentsInstDecl

nodeCommentsInstDecl :: InstDecl GhcPs -> NodeComments
nodeCommentsInstDecl :: InstDecl GhcPs -> NodeComments
nodeCommentsInstDecl ClsInstD {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9,4,1)
nodeCommentsInstDecl DataFamInstD {} = NodeComments
emptyNodeComments
#else
nodeCommentsInstDecl DataFamInstD {..} = nodeComments dfid_ext
#endif
nodeCommentsInstDecl TyFamInstD {} = NodeComments
emptyNodeComments

instance CommentExtraction (HsBind GhcPs) where
  nodeComments :: HsBind GhcPs -> NodeComments
nodeComments = HsBind GhcPs -> NodeComments
nodeCommentsHsBind

nodeCommentsHsBind :: HsBind GhcPs -> NodeComments
nodeCommentsHsBind :: HsBind GhcPs -> NodeComments
nodeCommentsHsBind FunBind {XFunBind GhcPs GhcPs
LIdP GhcPs
MatchGroup GhcPs (LHsExpr GhcPs)
fun_ext :: XFunBind GhcPs GhcPs
fun_id :: LIdP GhcPs
fun_matches :: MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
..} = GenLocated SrcSpanAnnN RdrName -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fun_id
#if MIN_VERSION_ghc_lib_parser(9, 10, 0)
nodeCommentsHsBind PatBind {} = NodeComments
emptyNodeComments
#else
nodeCommentsHsBind PatBind {..} = nodeComments pat_ext
#endif
nodeCommentsHsBind VarBind {} = NodeComments
emptyNodeComments
#if !MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsHsBind AbsBinds {} = emptyNodeComments
#endif
nodeCommentsHsBind PatSynBind {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 0)
instance CommentExtraction (Sig GhcPs) where
  nodeComments :: Sig GhcPs -> NodeComments
nodeComments (TypeSig XTypeSig GhcPs
x [LIdP GhcPs]
_ LHsSigWcType GhcPs
_) = AnnSig -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XTypeSig GhcPs
AnnSig
x
  nodeComments (PatSynSig XPatSynSig GhcPs
x [LIdP GhcPs]
_ LHsSigType GhcPs
_) = AnnSig -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XPatSynSig GhcPs
AnnSig
x
  nodeComments (ClassOpSig XClassOpSig GhcPs
x Bool
_ [LIdP GhcPs]
_ LHsSigType GhcPs
_) = AnnSig -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XClassOpSig GhcPs
AnnSig
x
  nodeComments (FixSig XFixSig GhcPs
x FixitySig GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XFixSig GhcPs
x
  nodeComments (InlineSig XInlineSig GhcPs
x LIdP GhcPs
_ InlinePragma
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XInlineSig GhcPs
x
  nodeComments (SpecSig XSpecSig GhcPs
x LIdP GhcPs
_ [LHsSigType GhcPs]
_ InlinePragma
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XSpecSig GhcPs
x
  nodeComments (SpecInstSig XSpecInstSig GhcPs
x LHsSigType GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments ([AddEpAnn] -> [NodeComments]) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> a -> b
$ ([AddEpAnn], SourceText) -> [AddEpAnn]
forall a b. (a, b) -> a
fst ([AddEpAnn], SourceText)
XSpecInstSig GhcPs
x
  nodeComments (MinimalSig XMinimalSig GhcPs
x LBooleanFormula (LIdP GhcPs)
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments ([AddEpAnn] -> [NodeComments]) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> a -> b
$ ([AddEpAnn], SourceText) -> [AddEpAnn]
forall a b. (a, b) -> a
fst ([AddEpAnn], SourceText)
XMinimalSig GhcPs
x
  nodeComments (SCCFunSig XSCCFunSig GhcPs
x LIdP GhcPs
_ Maybe (XRec GhcPs StringLiteral)
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments ([AddEpAnn] -> [NodeComments]) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> a -> b
$ ([AddEpAnn], SourceText) -> [AddEpAnn]
forall a b. (a, b) -> a
fst ([AddEpAnn], SourceText)
XSCCFunSig GhcPs
x
  nodeComments (CompleteMatchSig XCompleteMatchSig GhcPs
x [LIdP GhcPs]
_ Maybe (LIdP GhcPs)
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments ([AddEpAnn] -> [NodeComments]) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> a -> b
$ ([AddEpAnn], SourceText) -> [AddEpAnn]
forall a b. (a, b) -> a
fst ([AddEpAnn], SourceText)
XCompleteMatchSig GhcPs
x
#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)
instance CommentExtraction (Sig GhcPs) where
  nodeComments (TypeSig x _ _) = nodeComments x
  nodeComments (PatSynSig x _ _) = nodeComments x
  nodeComments (ClassOpSig x _ _ _) = nodeComments x
  nodeComments (FixSig x _) = nodeComments x
  nodeComments (InlineSig x _ _) = nodeComments x
  nodeComments (SpecSig x _ _ _) = nodeComments x
  nodeComments (SpecInstSig x _) = nodeComments $ fst x
  nodeComments (MinimalSig x _) = nodeComments $ fst x
  nodeComments (SCCFunSig x _ _) = nodeComments $ fst x
  nodeComments (CompleteMatchSig x _ _) = nodeComments $ fst x
#else
instance CommentExtraction (Sig GhcPs) where
  nodeComments (TypeSig x _ _) = nodeComments x
  nodeComments (PatSynSig x _ _) = nodeComments x
  nodeComments (ClassOpSig x _ _ _) = nodeComments x
  nodeComments IdSig {} = emptyNodeComments
  nodeComments (FixSig x _) = nodeComments x
  nodeComments (InlineSig x _ _) = nodeComments x
  nodeComments (SpecSig x _ _ _) = nodeComments x
  nodeComments (SpecInstSig x _ _) = nodeComments x
  nodeComments (MinimalSig x _ _) = nodeComments x
  nodeComments (SCCFunSig x _ _ _) = nodeComments x
  nodeComments (CompleteMatchSig x _ _ _) = nodeComments x
#endif
instance CommentExtraction (HsDataDefn GhcPs) where
  nodeComments :: HsDataDefn GhcPs -> NodeComments
nodeComments HsDataDefn {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 0)
instance CommentExtraction (ClsInstDecl GhcPs) where
  nodeComments :: ClsInstDecl GhcPs -> NodeComments
nodeComments ClsInstDecl {cid_ext :: forall pass. ClsInstDecl pass -> XCClsInstDecl pass
cid_ext = (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
x, [AddEpAnn]
_, AnnSortKey DeclTag
_)} =
    NodeComments -> Maybe NodeComments -> NodeComments
forall a. a -> Maybe a -> a
fromMaybe NodeComments
forall a. Monoid a => a
mempty (Maybe NodeComments -> NodeComments)
-> Maybe NodeComments -> NodeComments
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnP (WarningTxt GhcPs) -> NodeComments)
-> Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
-> Maybe NodeComments
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnP (WarningTxt GhcPs) -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
x
#else
instance CommentExtraction (ClsInstDecl GhcPs) where
  nodeComments ClsInstDecl {cid_ext = (x, _)} = nodeComments x
#endif
instance CommentExtraction (MatchGroup GhcPs a) where
  nodeComments :: MatchGroup GhcPs a -> NodeComments
nodeComments MG {} = NodeComments
emptyNodeComments

instance CommentExtraction (HsExpr GhcPs) where
  nodeComments :: HsExpr GhcPs -> NodeComments
nodeComments = HsExpr GhcPs -> NodeComments
nodeCommentsHsExpr

instance CommentExtraction LambdaCase where
  nodeComments :: LambdaCase -> NodeComments
nodeComments (LambdaCase MatchGroup GhcPs (LHsExpr GhcPs)
x CaseOrCases
_) = MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x

instance CommentExtraction DoOrMdo where
  nodeComments :: DoOrMdo -> NodeComments
nodeComments = NodeComments -> DoOrMdo -> NodeComments
forall a b. a -> b -> a
const NodeComments
emptyNodeComments

instance CommentExtraction QualifiedDo where
  nodeComments :: QualifiedDo -> NodeComments
nodeComments = NodeComments -> QualifiedDo -> NodeComments
forall a b. a -> b -> a
const NodeComments
emptyNodeComments

nodeCommentsHsExpr :: HsExpr GhcPs -> NodeComments
nodeCommentsHsExpr :: HsExpr GhcPs -> NodeComments
nodeCommentsHsExpr HsVar {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr (HsUnboundVar XUnboundVar GhcPs
x RdrName
_) = NodeComments -> Maybe NodeComments -> NodeComments
forall a. a -> Maybe a -> a
fromMaybe NodeComments
forall a. Monoid a => a
mempty (Maybe NodeComments -> NodeComments)
-> Maybe NodeComments -> NodeComments
forall a b. (a -> b) -> a -> b
$ (EpAnnUnboundVar -> NodeComments)
-> Maybe EpAnnUnboundVar -> Maybe NodeComments
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EpAnnUnboundVar -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments Maybe EpAnnUnboundVar
XUnboundVar GhcPs
x
#else
nodeCommentsHsExpr (HsUnboundVar x _) = nodeComments x
#endif
#if !MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsHsExpr HsConLikeOut {} = emptyNodeComments
nodeCommentsHsExpr HsRecFld {} = emptyNodeComments
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr HsOverLabel {} = NodeComments
emptyNodeComments
#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)
nodeCommentsHsExpr (HsOverLabel x _ _) = nodeComments x
#else
nodeCommentsHsExpr (HsOverLabel x _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr HsIPVar {} = NodeComments
emptyNodeComments
#else
nodeCommentsHsExpr (HsIPVar x _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr HsOverLit {} = NodeComments
emptyNodeComments
#else
nodeCommentsHsExpr (HsOverLit x _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr HsLit {} = NodeComments
emptyNodeComments
#else
nodeCommentsHsExpr (HsLit x _) = nodeComments x
#endif
nodeCommentsHsExpr HsLam {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
-- No `HsLamCase` since 9.10.1.
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsHsExpr (HsLamCase x _ _) = nodeComments x
#else
nodeCommentsHsExpr (HsLamCase x _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr HsApp {} = NodeComments
emptyNodeComments
#else
nodeCommentsHsExpr (HsApp x _ _) = nodeComments x
#endif
nodeCommentsHsExpr HsAppType {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr (OpApp XOpApp GhcPs
x LHsExpr GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XOpApp GhcPs
x
#else
nodeCommentsHsExpr (OpApp x _ _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr (NegApp XNegApp GhcPs
x LHsExpr GhcPs
_ SyntaxExpr GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XNegApp GhcPs
x
#else
nodeCommentsHsExpr (NegApp x _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr HsPar {} = NodeComments
emptyNodeComments
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsHsExpr (HsPar x _ _ _) = nodeComments x
#else
nodeCommentsHsExpr (HsPar x _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr SectionL {} = NodeComments
emptyNodeComments
#else
nodeCommentsHsExpr (SectionL x _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr SectionR {} = NodeComments
emptyNodeComments
#else
nodeCommentsHsExpr (SectionR x _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr (ExplicitTuple XExplicitTuple GhcPs
x [HsTupArg GhcPs]
_ Boxity
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XExplicitTuple GhcPs
x
#else
nodeCommentsHsExpr (ExplicitTuple x _ _) = nodeComments x
#endif
nodeCommentsHsExpr (ExplicitSum XExplicitSum GhcPs
x ConTag
_ ConTag
_ LHsExpr GhcPs
_) = AnnExplicitSum -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XExplicitSum GhcPs
AnnExplicitSum
x
nodeCommentsHsExpr (HsCase XCase GhcPs
x LHsExpr GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
_) = EpAnnHsCase -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XCase GhcPs
EpAnnHsCase
x
nodeCommentsHsExpr (HsIf XIf GhcPs
x LHsExpr GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
_) = AnnsIf -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XIf GhcPs
AnnsIf
x
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr (HsMultiIf XMultiIf GhcPs
x [LGRHS GhcPs (LHsExpr GhcPs)]
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XMultiIf GhcPs
x
#else
nodeCommentsHsExpr (HsMultiIf x _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr HsLet {} = NodeComments
emptyNodeComments
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsHsExpr (HsLet x _ _ _ _) = nodeComments x
#else
nodeCommentsHsExpr (HsLet x _ _) = nodeComments x
#endif
nodeCommentsHsExpr (HsDo XDo GhcPs
x HsDoFlavour
_ XRec GhcPs [ExprLStmt GhcPs]
_) = AnnList -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XDo GhcPs
AnnList
x
nodeCommentsHsExpr (ExplicitList XExplicitList GhcPs
x [LHsExpr GhcPs]
_) = AnnList -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XExplicitList GhcPs
AnnList
x
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr RecordCon {XRecordCon GhcPs
XRec GhcPs (ConLikeP GhcPs)
HsRecordBinds GhcPs
rcon_ext :: XRecordCon GhcPs
rcon_con :: XRec GhcPs (ConLikeP GhcPs)
rcon_flds :: HsRecordBinds GhcPs
rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_con :: forall p. HsExpr p -> XRec p (ConLikeP p)
rcon_ext :: forall p. HsExpr p -> XRecordCon p
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XRecordCon GhcPs
rcon_ext
#else
nodeCommentsHsExpr RecordCon {..} = nodeComments rcon_ext
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr RecordUpd {XRecordUpd GhcPs
LHsExpr GhcPs
LHsRecUpdFields GhcPs
rupd_ext :: XRecordUpd GhcPs
rupd_expr :: LHsExpr GhcPs
rupd_flds :: LHsRecUpdFields GhcPs
rupd_flds :: forall p. HsExpr p -> LHsRecUpdFields p
rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_ext :: forall p. HsExpr p -> XRecordUpd p
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XRecordUpd GhcPs
rupd_ext
#else
nodeCommentsHsExpr RecordUpd {..} = nodeComments rupd_ext
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr HsGetField {} = NodeComments
emptyNodeComments
#else
nodeCommentsHsExpr HsGetField {..} = nodeComments gf_ext
#endif
nodeCommentsHsExpr HsProjection {NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
XProjection GhcPs
proj_ext :: XProjection GhcPs
proj_flds :: NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
proj_flds :: forall p. HsExpr p -> NonEmpty (XRec p (DotFieldOcc p))
proj_ext :: forall p. HsExpr p -> XProjection p
..} = AnnProjection -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XProjection GhcPs
AnnProjection
proj_ext
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr (ExprWithTySig XExprWithTySig GhcPs
x LHsExpr GhcPs
_ LHsSigWcType (NoGhcTc GhcPs)
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XExprWithTySig GhcPs
x
#else
nodeCommentsHsExpr (ExprWithTySig x _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr (ArithSeq XArithSeq GhcPs
x Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XArithSeq GhcPs
x
#else
nodeCommentsHsExpr (ArithSeq x _ _) = nodeComments x
#endif
#if !MIN_VERSION_ghc_lib_parser(9,4,1)
nodeCommentsHsExpr (HsBracket x _) = nodeComments x
nodeCommentsHsExpr HsRnBracketOut {} = notUsedInParsedStage
nodeCommentsHsExpr HsTcBracketOut {} = notUsedInParsedStage
#endif
#if !MIN_VERSION_ghc_lib_parser(9,6,1)
nodeCommentsHsExpr (HsSpliceE x _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr (HsProc XProc GhcPs
x LPat GhcPs
_ LHsCmdTop GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XProc GhcPs
x
#else
nodeCommentsHsExpr (HsProc x _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr (HsStatic XStatic GhcPs
x LHsExpr GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XStatic GhcPs
x
#else
nodeCommentsHsExpr (HsStatic x _) = nodeComments x
#endif
#if !MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsHsExpr HsTick {} = emptyNodeComments
nodeCommentsHsExpr HsBinTick {} = emptyNodeComments
#endif
nodeCommentsHsExpr HsPragE {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsHsExpr HsRecSel {} = NodeComments
emptyNodeComments
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr (HsTypedBracket XTypedBracket GhcPs
x LHsExpr GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XTypedBracket GhcPs
x
nodeCommentsHsExpr (HsUntypedBracket XUntypedBracket GhcPs
x HsQuote GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XUntypedBracket GhcPs
x
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsHsExpr (HsTypedBracket x _) = nodeComments x
nodeCommentsHsExpr (HsUntypedBracket x _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsExpr (HsTypedSplice XTypedSplice GhcPs
x LHsExpr GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XTypedSplice GhcPs
x
nodeCommentsHsExpr HsUntypedSplice {} = NodeComments
emptyNodeComments
#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)
nodeCommentsHsExpr (HsTypedSplice (x, y) _) = nodeComments x <> nodeComments y
nodeCommentsHsExpr (HsUntypedSplice x _) = nodeComments x
#endif
instance CommentExtraction (HsSigType GhcPs) where
  nodeComments :: HsSigType GhcPs -> NodeComments
nodeComments HsSig {} = NodeComments
emptyNodeComments

instance CommentExtraction HsSigType' where
  nodeComments :: HsSigType' -> NodeComments
nodeComments (HsSigType' HsTypeFor
_ HsTypeDir
_ HsSig {}) = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (ConDecl GhcPs) where
  nodeComments :: ConDecl GhcPs -> NodeComments
nodeComments ConDeclGADT {Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
NonEmpty (LIdP GhcPs)
XConDeclGADT GhcPs
LHsType GhcPs
XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
HsConDeclGADTDetails GhcPs
con_g_ext :: XConDeclGADT GhcPs
con_names :: NonEmpty (LIdP GhcPs)
con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_g_args :: HsConDeclGADTDetails GhcPs
con_res_ty :: LHsType GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments ([AddEpAnn] -> [NodeComments]) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> a -> b
$ (EpUniToken "::" "\8759", [AddEpAnn]) -> [AddEpAnn]
forall a b. (a, b) -> b
snd (EpUniToken "::" "\8759", [AddEpAnn])
XConDeclGADT GhcPs
con_g_ext
  nodeComments ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDeclH98Details GhcPs
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDeclH98Details GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_forall :: forall pass. ConDecl pass -> Bool
con_name :: forall pass. ConDecl pass -> LIdP pass
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XConDeclH98 GhcPs
con_ext
#else
instance CommentExtraction (ConDecl GhcPs) where
  nodeComments ConDeclGADT {..} = nodeComments con_g_ext
  nodeComments ConDeclH98 {..} = nodeComments con_ext
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (Match GhcPs a) where
  nodeComments :: Match GhcPs a -> NodeComments
nodeComments Match {[LPat GhcPs]
XCMatch GhcPs a
GRHSs GhcPs a
HsMatchContext (LIdP (NoGhcTc GhcPs))
m_ext :: XCMatch GhcPs a
m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs GhcPs a
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ext :: forall p body. Match p body -> XCMatch p body
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XCMatch GhcPs a
m_ext
#else
instance CommentExtraction (Match GhcPs a) where
  nodeComments Match {..} = nodeComments m_ext
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction
           (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  nodeComments :: StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> NodeComments
nodeComments LastStmt {} = NodeComments
emptyNodeComments
  nodeComments (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x LPat GhcPs
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x
  nodeComments ApplicativeStmt {} = NodeComments
emptyNodeComments
  nodeComments BodyStmt {} = NodeComments
emptyNodeComments
  nodeComments (LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x HsLocalBindsLR GhcPs GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x
  nodeComments ParStmt {} = NodeComments
emptyNodeComments
  nodeComments TransStmt {[(IdP GhcPs, IdP GhcPs)]
[ExprLStmt GhcPs]
Maybe (LHsExpr GhcPs)
XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
LHsExpr GhcPs
SyntaxExpr GhcPs
HsExpr GhcPs
TransForm
trS_ext :: XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
trS_form :: TransForm
trS_stmts :: [ExprLStmt GhcPs]
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_using :: LHsExpr GhcPs
trS_by :: Maybe (LHsExpr GhcPs)
trS_ret :: SyntaxExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_fmap :: HsExpr GhcPs
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
trS_ext
  nodeComments RecStmt {[IdP GhcPs]
XRecStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
XRec
  GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
SyntaxExpr GhcPs
recS_ext :: XRecStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
recS_stmts :: XRec
  GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
recS_later_ids :: [IdP GhcPs]
recS_rec_ids :: [IdP GhcPs]
recS_bind_fn :: SyntaxExpr GhcPs
recS_ret_fn :: SyntaxExpr GhcPs
recS_mfix_fn :: SyntaxExpr GhcPs
recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
..} = AnnList -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XRecStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
AnnList
recS_ext
#else
instance CommentExtraction
           (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  nodeComments LastStmt {} = emptyNodeComments
  nodeComments (BindStmt x _ _) = nodeComments x
  nodeComments ApplicativeStmt {} = emptyNodeComments
  nodeComments BodyStmt {} = emptyNodeComments
  nodeComments (LetStmt x _) = nodeComments x
  nodeComments ParStmt {} = emptyNodeComments
  nodeComments TransStmt {..} = nodeComments trS_ext
  nodeComments RecStmt {..} = nodeComments recS_ext
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction
           (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where
  nodeComments :: StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> NodeComments
nodeComments LastStmt {} = NodeComments
emptyNodeComments
  nodeComments (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
x LPat GhcPs
_ GenLocated SrcSpanAnnA (HsCmd GhcPs)
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
x
  nodeComments ApplicativeStmt {} = NodeComments
emptyNodeComments
  nodeComments BodyStmt {} = NodeComments
emptyNodeComments
  nodeComments (LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
x HsLocalBindsLR GhcPs GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
x
  nodeComments ParStmt {} = NodeComments
emptyNodeComments
  nodeComments TransStmt {[(IdP GhcPs, IdP GhcPs)]
[ExprLStmt GhcPs]
Maybe (LHsExpr GhcPs)
XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
LHsExpr GhcPs
SyntaxExpr GhcPs
HsExpr GhcPs
TransForm
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_ext :: XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
trS_form :: TransForm
trS_stmts :: [ExprLStmt GhcPs]
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_using :: LHsExpr GhcPs
trS_by :: Maybe (LHsExpr GhcPs)
trS_ret :: SyntaxExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_fmap :: HsExpr GhcPs
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
trS_ext
  nodeComments RecStmt {[IdP GhcPs]
XRecStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
XRec
  GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
SyntaxExpr GhcPs
recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
recS_ext :: XRecStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
recS_stmts :: XRec
  GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
recS_later_ids :: [IdP GhcPs]
recS_rec_ids :: [IdP GhcPs]
recS_bind_fn :: SyntaxExpr GhcPs
recS_ret_fn :: SyntaxExpr GhcPs
recS_mfix_fn :: SyntaxExpr GhcPs
..} = AnnList -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XRecStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
AnnList
recS_ext
#else
instance CommentExtraction
           (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where
  nodeComments LastStmt {} = emptyNodeComments
  nodeComments (BindStmt x _ _) = nodeComments x
  nodeComments ApplicativeStmt {} = emptyNodeComments
  nodeComments BodyStmt {} = emptyNodeComments
  nodeComments (LetStmt x _) = nodeComments x
  nodeComments ParStmt {} = emptyNodeComments
  nodeComments TransStmt {..} = nodeComments trS_ext
  nodeComments RecStmt {..} = nodeComments recS_ext
#endif
instance CommentExtraction StmtLRInsideVerticalList where
  nodeComments :: StmtLRInsideVerticalList -> NodeComments
nodeComments (StmtLRInsideVerticalList StmtLR GhcPs GhcPs (LHsExpr GhcPs)
x) = StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments StmtLR GhcPs GhcPs (LHsExpr GhcPs)
StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x

-- | For pattern matching.
instance CommentExtraction
           (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))) where
  nodeComments :: HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
-> NodeComments
nodeComments HsRecFields {} = NodeComments
emptyNodeComments

-- | For record updates
instance CommentExtraction
           (HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  nodeComments :: HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> NodeComments
nodeComments HsRecFields {} = NodeComments
emptyNodeComments

instance CommentExtraction (HsType GhcPs) where
  nodeComments :: HsType GhcPs -> NodeComments
nodeComments = HsType' -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments (HsType' -> NodeComments)
-> (HsType GhcPs -> HsType') -> HsType GhcPs -> NodeComments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsTypeFor -> HsTypeDir -> HsType GhcPs -> HsType'
HsType' HsTypeFor
HsTypeForNormalDecl HsTypeDir
HsTypeNoDir
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction HsType' where
  nodeComments :: HsType' -> NodeComments
nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ HsForAllTy {}) = NodeComments
emptyNodeComments
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ HsQualTy {}) = NodeComments
emptyNodeComments
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsTyVar XTyVar GhcPs
x PromotionFlag
_ LIdP GhcPs
_)) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XTyVar GhcPs
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ HsAppTy {}) = NodeComments
emptyNodeComments
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ HsAppKindTy {}) = NodeComments
emptyNodeComments
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ HsFunTy {}) = NodeComments
emptyNodeComments
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsListTy XListTy GhcPs
x LHsType GhcPs
_)) = AnnParen -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XListTy GhcPs
AnnParen
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsTupleTy XTupleTy GhcPs
x HsTupleSort
_ [LHsType GhcPs]
_)) = AnnParen -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XTupleTy GhcPs
AnnParen
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsSumTy XSumTy GhcPs
x [LHsType GhcPs]
_)) = AnnParen -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XSumTy GhcPs
AnnParen
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ HsOpTy {}) = NodeComments
emptyNodeComments
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsParTy XParTy GhcPs
x LHsType GhcPs
_)) = AnnParen -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XParTy GhcPs
AnnParen
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsIParamTy XIParamTy GhcPs
x XRec GhcPs HsIPName
_ LHsType GhcPs
_)) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XIParamTy GhcPs
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ HsStarTy {}) = NodeComments
emptyNodeComments
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsKindSig XKindSig GhcPs
x LHsType GhcPs
_ LHsType GhcPs
_)) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XKindSig GhcPs
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ HsSpliceTy {}) = NodeComments
emptyNodeComments
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsDocTy XDocTy GhcPs
x LHsType GhcPs
_ LHsDoc GhcPs
_)) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XDocTy GhcPs
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsBangTy XBangTy GhcPs
x HsSrcBang
_ LHsType GhcPs
_)) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XBangTy GhcPs
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsRecTy XRecTy GhcPs
x [LConDeclField GhcPs]
_)) = AnnList -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XRecTy GhcPs
AnnList
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsExplicitListTy XExplicitListTy GhcPs
x PromotionFlag
_ [LHsType GhcPs]
_)) =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XExplicitListTy GhcPs
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ (HsExplicitTupleTy XExplicitTupleTy GhcPs
x [LHsType GhcPs]
_)) =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XExplicitTupleTy GhcPs
x
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ HsTyLit {}) = NodeComments
emptyNodeComments
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ HsWildCardTy {}) = NodeComments
emptyNodeComments
  nodeComments (HsType' HsTypeFor
_ HsTypeDir
_ XHsType {}) = NodeComments
emptyNodeComments
#else
instance CommentExtraction HsType' where
  nodeComments (HsType' _ _ HsForAllTy {}) = emptyNodeComments
  nodeComments (HsType' _ _ HsQualTy {}) = emptyNodeComments
  nodeComments (HsType' _ _ (HsTyVar x _ _)) = nodeComments x
  nodeComments (HsType' _ _ HsAppTy {}) = emptyNodeComments
  nodeComments (HsType' _ _ HsAppKindTy {}) = emptyNodeComments
  nodeComments (HsType' _ _ (HsFunTy x _ _ _)) = nodeComments x
  nodeComments (HsType' _ _ (HsListTy x _)) = nodeComments x
  nodeComments (HsType' _ _ (HsTupleTy x _ _)) = nodeComments x
  nodeComments (HsType' _ _ (HsSumTy x _)) = nodeComments x
  nodeComments (HsType' _ _ HsOpTy {}) = emptyNodeComments
  nodeComments (HsType' _ _ (HsParTy x _)) = nodeComments x
  nodeComments (HsType' _ _ (HsIParamTy x _ _)) = nodeComments x
  nodeComments (HsType' _ _ HsStarTy {}) = emptyNodeComments
  nodeComments (HsType' _ _ (HsKindSig x _ _)) = nodeComments x
  nodeComments (HsType' _ _ HsSpliceTy {}) = emptyNodeComments
  nodeComments (HsType' _ _ (HsDocTy x _ _)) = nodeComments x
  nodeComments (HsType' _ _ (HsBangTy x _ _)) = nodeComments x
  nodeComments (HsType' _ _ (HsRecTy x _)) = nodeComments x
  nodeComments (HsType' _ _ (HsExplicitListTy x _ _)) = nodeComments x
  nodeComments (HsType' _ _ (HsExplicitTupleTy x _)) = nodeComments x
  nodeComments (HsType' _ _ HsTyLit {}) = emptyNodeComments
  nodeComments (HsType' _ _ HsWildCardTy {}) = emptyNodeComments
  nodeComments (HsType' _ _ XHsType {}) = emptyNodeComments
#endif
instance CommentExtraction (GRHSs GhcPs a) where
  nodeComments :: GRHSs GhcPs a -> NodeComments
nodeComments GRHSs {[LGRHS GhcPs a]
XCGRHSs GhcPs a
HsLocalBindsLR GhcPs GhcPs
grhssExt :: XCGRHSs GhcPs a
grhssGRHSs :: [LGRHS GhcPs a]
grhssLocalBinds :: HsLocalBindsLR GhcPs GhcPs
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
..} = NodeComments {[LEpaComment]
forall {a}. [a]
commentsBefore :: [LEpaComment]
commentsOnSameLine :: forall {a}. [a]
commentsAfter :: [LEpaComment]
commentsAfter :: [LEpaComment]
commentsOnSameLine :: [LEpaComment]
commentsBefore :: [LEpaComment]
..}
    where
      commentsBefore :: [LEpaComment]
commentsBefore = EpAnnComments -> [LEpaComment]
priorComments XCGRHSs GhcPs a
EpAnnComments
grhssExt
      commentsOnSameLine :: [a]
commentsOnSameLine = []
      commentsAfter :: [LEpaComment]
commentsAfter = EpAnnComments -> [LEpaComment]
getFollowingComments XCGRHSs GhcPs a
EpAnnComments
grhssExt

instance CommentExtraction GRHSsExpr where
  nodeComments :: GRHSsExpr -> NodeComments
nodeComments (GRHSsExpr {GRHSs GhcPs (LHsExpr GhcPs)
GRHSExprType
grhssExprType :: GRHSExprType
grhssExpr :: GRHSs GhcPs (LHsExpr GhcPs)
grhssExpr :: GRHSsExpr -> GRHSs GhcPs (LHsExpr GhcPs)
grhssExprType :: GRHSsExpr -> GRHSExprType
..}) = GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments GRHSs GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhssExpr
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (HsMatchContext (GenLocated SrcSpanAnnN RdrName)) where
  nodeComments :: HsMatchContext (GenLocated SrcSpanAnnN RdrName) -> NodeComments
nodeComments = HsMatchContext (GenLocated SrcSpanAnnN RdrName) -> NodeComments
nodeCommentsMatchContext

nodeCommentsMatchContext ::
     HsMatchContext (GenLocated SrcSpanAnnN RdrName) -> NodeComments
nodeCommentsMatchContext :: HsMatchContext (GenLocated SrcSpanAnnN RdrName) -> NodeComments
nodeCommentsMatchContext FunRhs {} = NodeComments
emptyNodeComments
#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsMatchContext LambdaExpr {} = emptyNodeComments
#endif
nodeCommentsMatchContext CaseAlt {} = NodeComments
emptyNodeComments
nodeCommentsMatchContext IfAlt {} = NodeComments
emptyNodeComments
nodeCommentsMatchContext ArrowMatchCtxt {} = NodeComments
emptyNodeComments
nodeCommentsMatchContext PatBindRhs {} = NodeComments
emptyNodeComments
nodeCommentsMatchContext PatBindGuards {} = NodeComments
emptyNodeComments
nodeCommentsMatchContext RecUpd {} = NodeComments
emptyNodeComments
nodeCommentsMatchContext StmtCtxt {} = NodeComments
emptyNodeComments
nodeCommentsMatchContext ThPatSplice {} = NodeComments
emptyNodeComments
nodeCommentsMatchContext ThPatQuote {} = NodeComments
emptyNodeComments
nodeCommentsMatchContext PatSyn {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9,4,1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsMatchContext LamCaseAlt {} = emptyNodeComments
#endif
#else
instance CommentExtraction (HsMatchContext GhcPs) where
  nodeComments = nodeCommentsMatchContext

nodeCommentsMatchContext :: HsMatchContext GhcPs -> NodeComments
nodeCommentsMatchContext FunRhs {} = emptyNodeComments
#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsMatchContext LambdaExpr {} = emptyNodeComments
#endif
nodeCommentsMatchContext CaseAlt {} = emptyNodeComments
nodeCommentsMatchContext IfAlt {} = emptyNodeComments
nodeCommentsMatchContext ArrowMatchCtxt {} = emptyNodeComments
nodeCommentsMatchContext PatBindRhs {} = emptyNodeComments
nodeCommentsMatchContext PatBindGuards {} = emptyNodeComments
nodeCommentsMatchContext RecUpd {} = emptyNodeComments
nodeCommentsMatchContext StmtCtxt {} = emptyNodeComments
nodeCommentsMatchContext ThPatSplice {} = emptyNodeComments
nodeCommentsMatchContext ThPatQuote {} = emptyNodeComments
nodeCommentsMatchContext PatSyn {} = emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9,4,1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsMatchContext LamCaseAlt {} = emptyNodeComments
#endif
#endif
instance CommentExtraction (ParStmtBlock GhcPs GhcPs) where
  nodeComments :: ParStmtBlock GhcPs GhcPs -> NodeComments
nodeComments ParStmtBlock {} = NodeComments
emptyNodeComments

instance CommentExtraction ParStmtBlockInsideVerticalList where
  nodeComments :: ParStmtBlockInsideVerticalList -> NodeComments
nodeComments (ParStmtBlockInsideVerticalList ParStmtBlock GhcPs GhcPs
x) = ParStmtBlock GhcPs GhcPs -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments ParStmtBlock GhcPs GhcPs
x

instance CommentExtraction RdrName where
  nodeComments :: RdrName -> NodeComments
nodeComments Unqual {} = NodeComments
emptyNodeComments
  nodeComments Qual {} = NodeComments
emptyNodeComments
  nodeComments Orig {} = NodeComments
emptyNodeComments
  nodeComments Exact {} = NodeComments
emptyNodeComments

instance CommentExtraction (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  nodeComments :: GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> NodeComments
nodeComments = GRHSExpr -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments (GRHSExpr -> NodeComments)
-> (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> GRHSExpr)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> NodeComments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRHSExprType -> GRHS GhcPs (LHsExpr GhcPs) -> GRHSExpr
GRHSExpr GRHSExprType
GRHSExprNormal

instance CommentExtraction GRHSExpr where
  nodeComments :: GRHSExpr -> NodeComments
nodeComments (GRHSExpr {grhsExpr :: GRHSExpr -> GRHS GhcPs (LHsExpr GhcPs)
grhsExpr = (GRHS XCGRHS GhcPs (LHsExpr GhcPs)
x [ExprLStmt GhcPs]
_ LHsExpr GhcPs
_)}) = EpAnn GrhsAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XCGRHS GhcPs (LHsExpr GhcPs)
EpAnn GrhsAnn
x

instance CommentExtraction GRHSProc where
  nodeComments :: GRHSProc -> NodeComments
nodeComments (GRHSProc (GRHS XCGRHS GhcPs (LHsCmd GhcPs)
x [ExprLStmt GhcPs]
_ LHsCmd GhcPs
_)) = EpAnn GrhsAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XCGRHS GhcPs (LHsCmd GhcPs)
EpAnn GrhsAnn
x

instance CommentExtraction EpaCommentTok where
  nodeComments :: EpaCommentTok -> NodeComments
nodeComments = NodeComments -> EpaCommentTok -> NodeComments
forall a b. a -> b -> a
const NodeComments
emptyNodeComments

instance CommentExtraction (SpliceDecl GhcPs) where
  nodeComments :: SpliceDecl GhcPs -> NodeComments
nodeComments SpliceDecl {} = NodeComments
emptyNodeComments
#if !MIN_VERSION_ghc_lib_parser(9,6,1)
instance CommentExtraction (HsSplice GhcPs) where
  nodeComments (HsTypedSplice x _ _ _) = nodeComments x
  nodeComments (HsUntypedSplice x _ _ _) = nodeComments x
  nodeComments HsQuasiQuote {} = emptyNodeComments
  nodeComments HsSpliced {} = emptyNodeComments
#endif
instance CommentExtraction (Pat GhcPs) where
  nodeComments :: Pat GhcPs -> NodeComments
nodeComments = Pat GhcPs -> NodeComments
nodeCommentsPat

instance CommentExtraction PatInsidePatDecl where
  nodeComments :: PatInsidePatDecl -> NodeComments
nodeComments (PatInsidePatDecl Pat GhcPs
x) = Pat GhcPs -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments Pat GhcPs
x

nodeCommentsPat :: Pat GhcPs -> NodeComments
nodeCommentsPat :: Pat GhcPs -> NodeComments
nodeCommentsPat WildPat {} = NodeComments
emptyNodeComments
nodeCommentsPat VarPat {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsPat (LazyPat XLazyPat GhcPs
x LPat GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XLazyPat GhcPs
x
#else
nodeCommentsPat (LazyPat x _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsPat AsPat {} = NodeComments
emptyNodeComments
#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)
nodeCommentsPat (AsPat x _ _ _) = nodeComments x
#else
nodeCommentsPat (AsPat x _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsPat ParPat {} = NodeComments
emptyNodeComments
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsPat (ParPat x _ _ _) = nodeComments x
#else
nodeCommentsPat (ParPat x _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsPat (BangPat XBangPat GhcPs
x LPat GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XBangPat GhcPs
x
#else
nodeCommentsPat (BangPat x _) = nodeComments x
#endif
nodeCommentsPat (ListPat XListPat GhcPs
x [LPat GhcPs]
_) = AnnList -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XListPat GhcPs
AnnList
x
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsPat (TuplePat XTuplePat GhcPs
x [LPat GhcPs]
_ Boxity
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XTuplePat GhcPs
x
#else
nodeCommentsPat (TuplePat x _ _) = nodeComments x
#endif
nodeCommentsPat (SumPat XSumPat GhcPs
x LPat GhcPs
_ ConTag
_ ConTag
_) = EpAnnSumPat -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XSumPat GhcPs
EpAnnSumPat
x
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsPat ConPat {XConPat GhcPs
XRec GhcPs (ConLikeP GhcPs)
HsConPatDetails GhcPs
pat_con_ext :: XConPat GhcPs
pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_args :: HsConPatDetails GhcPs
pat_args :: forall p. Pat p -> HsConPatDetails p
pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con_ext :: forall p. Pat p -> XConPat p
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XConPat GhcPs
pat_con_ext
#else
nodeCommentsPat ConPat {..} = nodeComments pat_con_ext
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsPat (ViewPat XViewPat GhcPs
x LHsExpr GhcPs
_ LPat GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XViewPat GhcPs
x
#else
nodeCommentsPat (ViewPat x _ _) = nodeComments x
#endif
nodeCommentsPat SplicePat {} = NodeComments
emptyNodeComments
nodeCommentsPat LitPat {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsPat (NPat XNPat GhcPs
x XRec GhcPs (HsOverLit GhcPs)
_ Maybe (SyntaxExpr GhcPs)
_ SyntaxExpr GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XNPat GhcPs
x
#else
nodeCommentsPat (NPat x _ _ _) = nodeComments x
#endif
nodeCommentsPat (NPlusKPat XNPlusKPat GhcPs
x LIdP GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
_ HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XNPlusKPat GhcPs
EpaLocation
x
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsPat (SigPat XSigPat GhcPs
x LPat GhcPs
_ HsPatSigType (NoGhcTc GhcPs)
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XSigPat GhcPs
x
#else
nodeCommentsPat (SigPat x _ _) = nodeComments x
#endif
instance CommentExtraction RecConPat where
  nodeComments :: RecConPat -> NodeComments
nodeComments (RecConPat HsRecFields GhcPs (LPat GhcPs)
x) = HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
-> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments HsRecFields GhcPs (LPat GhcPs)
HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
x
#if !MIN_VERSION_ghc_lib_parser(9, 4, 1)
instance CommentExtraction (HsBracket GhcPs) where
  nodeComments ExpBr {} = emptyNodeComments
  nodeComments PatBr {} = emptyNodeComments
  nodeComments DecBrL {} = emptyNodeComments
  nodeComments DecBrG {} = emptyNodeComments
  nodeComments TypBr {} = emptyNodeComments
  nodeComments VarBr {} = emptyNodeComments
  nodeComments TExpBr {} = emptyNodeComments
#endif
instance CommentExtraction SigBindFamily where
  nodeComments :: SigBindFamily -> NodeComments
nodeComments (Sig Sig GhcPs
x) = Sig GhcPs -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments Sig GhcPs
x
  nodeComments (Bind HsBind GhcPs
x) = HsBind GhcPs -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments HsBind GhcPs
x
  nodeComments (TypeFamily FamilyDecl GhcPs
x) = FamilyDecl GhcPs -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments FamilyDecl GhcPs
x
  nodeComments (TyFamInst TyFamInstDecl GhcPs
x) = TyFamInstDecl GhcPs -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments TyFamInstDecl GhcPs
x
  nodeComments (DataFamInst DataFamInstDecl GhcPs
x) = DataFamInstDecl GhcPs -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments DataFamInstDecl GhcPs
x

instance CommentExtraction EpaComment where
  nodeComments :: EpaComment -> NodeComments
nodeComments EpaComment {} = NodeComments
emptyNodeComments
#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction Anchor where
  nodeComments Anchor {} = emptyNodeComments

instance CommentExtraction (SrcAnn a) where
  nodeComments (SrcSpanAnn ep _) = nodeComments ep
#endif
instance CommentExtraction SrcSpan where
  nodeComments :: SrcSpan -> NodeComments
nodeComments RealSrcSpan {} = NodeComments
emptyNodeComments
  nodeComments UnhelpfulSpan {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (EpAnn a) where
  nodeComments :: EpAnn a -> NodeComments
nodeComments (EpAnn EpaLocation
ann a
_ EpAnnComments
cs) = NodeComments {[LEpaComment]
commentsAfter :: [LEpaComment]
commentsOnSameLine :: [LEpaComment]
commentsBefore :: [LEpaComment]
commentsBefore :: [LEpaComment]
commentsOnSameLine :: [LEpaComment]
commentsAfter :: [LEpaComment]
..}
    where
      commentsBefore :: [LEpaComment]
commentsBefore = EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs
      commentsOnSameLine :: [LEpaComment]
commentsOnSameLine = (LEpaComment -> Bool) -> [LEpaComment] -> [LEpaComment]
forall a. (a -> Bool) -> [a] -> [a]
filter LEpaComment -> Bool
forall {a} {e}. GenLocated (EpaLocation' a) e -> Bool
isCommentOnSameLine ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cs
      commentsAfter :: [LEpaComment]
commentsAfter =
        (LEpaComment -> Bool) -> [LEpaComment] -> [LEpaComment]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (LEpaComment -> Bool) -> LEpaComment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LEpaComment -> Bool
forall {a} {e}. GenLocated (EpaLocation' a) e -> Bool
isCommentOnSameLine) ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cs
      isCommentOnSameLine :: GenLocated (EpaLocation' a) e -> Bool
isCommentOnSameLine (L EpaLocation' a
comAnn e
_) =
        RealSrcSpan -> ConTag
srcSpanEndLine (EpaLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor EpaLocation
ann) ConTag -> ConTag -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> ConTag
srcSpanStartLine (EpaLocation' a -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor EpaLocation' a
comAnn)
#else
instance CommentExtraction (EpAnn a) where
  nodeComments (EpAnn ann _ cs) = NodeComments {..}
    where
      commentsBefore = priorComments cs
      commentsOnSameLine = filter isCommentOnSameLine $ getFollowingComments cs
      commentsAfter =
        filter (not . isCommentOnSameLine) $ getFollowingComments cs
      isCommentOnSameLine (L comAnn _) =
        srcSpanEndLine (anchor ann) == srcSpanStartLine (anchor comAnn)
  nodeComments EpAnnNotUsed = emptyNodeComments
#endif
instance CommentExtraction (HsLocalBindsLR GhcPs GhcPs) where
  nodeComments :: HsLocalBindsLR GhcPs GhcPs -> NodeComments
nodeComments (HsValBinds XHsValBinds GhcPs GhcPs
x HsValBindsLR GhcPs GhcPs
_) = EpAnn AnnList -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XHsValBinds GhcPs GhcPs
EpAnn AnnList
x
  nodeComments (HsIPBinds XHsIPBinds GhcPs GhcPs
x HsIPBinds GhcPs
_) = EpAnn AnnList -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XHsIPBinds GhcPs GhcPs
EpAnn AnnList
x
  nodeComments EmptyLocalBinds {} = NodeComments
emptyNodeComments

instance CommentExtraction (HsValBindsLR GhcPs GhcPs) where
  nodeComments :: HsValBindsLR GhcPs GhcPs -> NodeComments
nodeComments ValBinds {} = NodeComments
emptyNodeComments
  nodeComments XValBindsLR {} = NodeComments
forall a. HasCallStack => a
notUsedInParsedStage
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (HsTupArg GhcPs) where
  nodeComments :: HsTupArg GhcPs -> NodeComments
nodeComments Present {} = NodeComments
emptyNodeComments
  nodeComments (Missing XMissing GhcPs
x) = EpAnn Bool -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XMissing GhcPs
EpAnn Bool
x
#else
instance CommentExtraction (HsTupArg GhcPs) where
  nodeComments (Present x _) = nodeComments x
  nodeComments (Missing x) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 4, 1)
instance CommentExtraction RecConField where
  nodeComments :: RecConField -> NodeComments
nodeComments (RecConField HsFieldBind (LFieldOcc GhcPs) (LPat GhcPs)
x) = HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (Pat GhcPs))
-> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments HsFieldBind (LFieldOcc GhcPs) (LPat GhcPs)
HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (Pat GhcPs))
x
#else
-- | For pattern matching against a record.
instance CommentExtraction
           (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))) where
  nodeComments HsRecField {..} = nodeComments hsRecFieldAnn

-- | For record updates.
instance CommentExtraction
           (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  nodeComments HsRecField {..} = nodeComments hsRecFieldAnn
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction
           (HsFieldBind
              (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
              (GenLocated SrcSpanAnnA (Pat GhcPs))) where
  nodeComments :: HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (Pat GhcPs))
-> NodeComments
nodeComments HsFieldBind {Bool
XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
GenLocated SrcSpanAnnA (Pat GhcPs)
GenLocated SrcSpanAnnA (FieldOcc GhcPs)
hfbAnn :: XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
hfbLHS :: GenLocated SrcSpanAnnA (FieldOcc GhcPs)
hfbRHS :: GenLocated SrcSpanAnnA (Pat GhcPs)
hfbPun :: Bool
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
hfbAnn

instance CommentExtraction
           (HsFieldBind
              (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
              (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  nodeComments :: HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> NodeComments
nodeComments HsFieldBind {Bool
XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
GenLocated SrcSpanAnnA (HsExpr GhcPs)
GenLocated SrcSpanAnnA (FieldOcc GhcPs)
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbAnn :: XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
hfbLHS :: GenLocated SrcSpanAnnA (FieldOcc GhcPs)
hfbRHS :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
hfbPun :: Bool
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
hfbAnn
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
-- | For pattern matchings against records.
instance CommentExtraction
           (HsFieldBind
              (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
              (GenLocated SrcSpanAnnA (Pat GhcPs))) where
  nodeComments HsFieldBind {..} = nodeComments hfbAnn

-- | For record updates.
instance CommentExtraction
           (HsFieldBind
              (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
              (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  nodeComments HsFieldBind {..} = nodeComments hfbAnn
#else
instance CommentExtraction RecConField where
  nodeComments (RecConField x) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance CommentExtraction (FieldOcc GhcPs) where
  nodeComments :: FieldOcc GhcPs -> NodeComments
nodeComments FieldOcc {} = NodeComments
emptyNodeComments
#else
instance CommentExtraction (FieldOcc GhcPs) where
  nodeComments FieldOcc {} = emptyNodeComments
#endif
-- HsConDeclH98Details
instance CommentExtraction
           (HsConDetails
              Void
              (HsScaled GhcPs (GenLocated SrcSpanAnnA (BangType GhcPs)))
              (GenLocated
                 SrcSpanAnnL
                 [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])) where
  nodeComments :: HsConDetails
  Void
  (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
  (GenLocated
     (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
-> NodeComments
nodeComments PrefixCon {} = NodeComments
emptyNodeComments
  nodeComments RecCon {} = NodeComments
emptyNodeComments
  nodeComments InfixCon {} = NodeComments
emptyNodeComments

instance CommentExtraction (HsScaled GhcPs a) where
  nodeComments :: HsScaled GhcPs a -> NodeComments
nodeComments HsScaled {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (ConDeclField GhcPs) where
  nodeComments :: ConDeclField GhcPs -> NodeComments
nodeComments ConDeclField {[LFieldOcc GhcPs]
Maybe (LHsDoc GhcPs)
XConDeclField GhcPs
LHsType GhcPs
cd_fld_ext :: XConDeclField GhcPs
cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_type :: LHsType GhcPs
cd_fld_doc :: Maybe (LHsDoc GhcPs)
cd_fld_doc :: forall pass. ConDeclField pass -> Maybe (LHsDoc pass)
cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_ext :: forall pass. ConDeclField pass -> XConDeclField pass
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XConDeclField GhcPs
cd_fld_ext
#else
instance CommentExtraction (ConDeclField GhcPs) where
  nodeComments ConDeclField {..} = nodeComments cd_fld_ext
#endif
instance CommentExtraction InfixExpr where
  nodeComments :: InfixExpr -> NodeComments
nodeComments (InfixExpr LHsExpr GhcPs
x) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x

instance CommentExtraction InfixApp where
  nodeComments :: InfixApp -> NodeComments
nodeComments InfixApp {} = NodeComments
emptyNodeComments

instance CommentExtraction (BooleanFormula a) where
  nodeComments :: BooleanFormula a -> NodeComments
nodeComments Var {} = NodeComments
emptyNodeComments
  nodeComments And {} = NodeComments
emptyNodeComments
  nodeComments Or {} = NodeComments
emptyNodeComments
  nodeComments Parens {} = NodeComments
emptyNodeComments

instance CommentExtraction (FieldLabelStrings GhcPs) where
  nodeComments :: FieldLabelStrings GhcPs -> NodeComments
nodeComments FieldLabelStrings {} = NodeComments
emptyNodeComments

instance CommentExtraction (AmbiguousFieldOcc GhcPs) where
  nodeComments :: AmbiguousFieldOcc GhcPs -> NodeComments
nodeComments Unambiguous {} = NodeComments
emptyNodeComments
  nodeComments Ambiguous {} = NodeComments
emptyNodeComments

instance CommentExtraction (ImportDecl GhcPs) where
  nodeComments :: ImportDecl GhcPs -> NodeComments
nodeComments ImportDecl {Bool
Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
ImportDeclPkgQual GhcPs
XCImportDecl GhcPs
XRec GhcPs ModuleName
IsBootInterface
ImportDeclQualifiedStyle
ideclExt :: XCImportDecl GhcPs
ideclName :: XRec GhcPs ModuleName
ideclPkgQual :: ImportDeclPkgQual GhcPs
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImportList :: Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
..} = XImportDeclPass -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XCImportDecl GhcPs
XImportDeclPass
ideclExt
#if MIN_VERSION_ghc_lib_parser(9,6,1)
instance CommentExtraction XImportDeclPass where
  nodeComments :: XImportDeclPass -> NodeComments
nodeComments XImportDeclPass {Bool
SourceText
EpAnn EpAnnImportDecl
ideclAnn :: EpAnn EpAnnImportDecl
ideclSourceText :: SourceText
ideclImplicit :: Bool
ideclImplicit :: XImportDeclPass -> Bool
ideclSourceText :: XImportDeclPass -> SourceText
ideclAnn :: XImportDeclPass -> EpAnn EpAnnImportDecl
..} = EpAnn EpAnnImportDecl -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments EpAnn EpAnnImportDecl
ideclAnn
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (HsDerivingClause GhcPs) where
  nodeComments :: HsDerivingClause GhcPs -> NodeComments
nodeComments HsDerivingClause {Maybe (LDerivStrategy GhcPs)
XCHsDerivingClause GhcPs
LDerivClauseTys GhcPs
deriv_clause_ext :: XCHsDerivingClause GhcPs
deriv_clause_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_clause_tys :: LDerivClauseTys GhcPs
deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
..} =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XCHsDerivingClause GhcPs
deriv_clause_ext
#else
instance CommentExtraction (HsDerivingClause GhcPs) where
  nodeComments HsDerivingClause {..} = nodeComments deriv_clause_ext
#endif
instance CommentExtraction (DerivClauseTys GhcPs) where
  nodeComments :: DerivClauseTys GhcPs -> NodeComments
nodeComments DctSingle {} = NodeComments
emptyNodeComments
  nodeComments DctMulti {} = NodeComments
emptyNodeComments

instance CommentExtraction OverlapMode where
  nodeComments :: OverlapMode -> NodeComments
nodeComments NoOverlap {} = NodeComments
emptyNodeComments
  nodeComments Overlappable {} = NodeComments
emptyNodeComments
  nodeComments Overlapping {} = NodeComments
emptyNodeComments
  nodeComments Overlaps {} = NodeComments
emptyNodeComments
  nodeComments Incoherent {} = NodeComments
emptyNodeComments

instance CommentExtraction StringLiteral where
  nodeComments :: StringLiteral -> NodeComments
nodeComments StringLiteral {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
-- | This instance is for type family declarations inside a class declaration.
instance CommentExtraction (FamilyDecl GhcPs) where
  nodeComments :: FamilyDecl GhcPs -> NodeComments
nodeComments FamilyDecl {Maybe (LInjectivityAnn GhcPs)
XCFamilyDecl GhcPs
LIdP GhcPs
LFamilyResultSig GhcPs
TopLevelFlag
LexicalFixity
LHsQTyVars GhcPs
FamilyInfo GhcPs
fdExt :: XCFamilyDecl GhcPs
fdInfo :: FamilyInfo GhcPs
fdTopLevel :: TopLevelFlag
fdLName :: LIdP GhcPs
fdTyVars :: LHsQTyVars GhcPs
fdFixity :: LexicalFixity
fdResultSig :: LFamilyResultSig GhcPs
fdInjectivityAnn :: Maybe (LInjectivityAnn GhcPs)
fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdFixity :: forall pass. FamilyDecl pass -> LexicalFixity
fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdTopLevel :: forall pass. FamilyDecl pass -> TopLevelFlag
fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdExt :: forall pass. FamilyDecl pass -> XCFamilyDecl pass
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XCFamilyDecl GhcPs
fdExt
#else
-- | This instance is for type family declarations inside a class declaration.
instance CommentExtraction (FamilyDecl GhcPs) where
  nodeComments FamilyDecl {..} = nodeComments fdExt
#endif
instance CommentExtraction (FamilyResultSig GhcPs) where
  nodeComments :: FamilyResultSig GhcPs -> NodeComments
nodeComments NoSig {} = NodeComments
emptyNodeComments
  nodeComments KindSig {} = NodeComments
emptyNodeComments
  nodeComments TyVarSig {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (HsTyVarBndr a GhcPs) where
  nodeComments :: HsTyVarBndr a GhcPs -> NodeComments
nodeComments (UserTyVar XUserTyVar GhcPs
x a
_ LIdP GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XUserTyVar GhcPs
x
  nodeComments (KindedTyVar XKindedTyVar GhcPs
x a
_ LIdP GhcPs
_ LHsType GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XKindedTyVar GhcPs
x
#else
instance CommentExtraction (HsTyVarBndr a GhcPs) where
  nodeComments (UserTyVar x _ _) = nodeComments x
  nodeComments (KindedTyVar x _ _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (InjectivityAnn GhcPs) where
  nodeComments :: InjectivityAnn GhcPs -> NodeComments
nodeComments (InjectivityAnn XCInjectivityAnn GhcPs
x LIdP GhcPs
_ [LIdP GhcPs]
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XCInjectivityAnn GhcPs
x
#else
instance CommentExtraction (InjectivityAnn GhcPs) where
  nodeComments (InjectivityAnn x _ _) = nodeComments x
#endif
instance CommentExtraction (ArithSeqInfo GhcPs) where
  nodeComments :: ArithSeqInfo GhcPs -> NodeComments
nodeComments From {} = NodeComments
emptyNodeComments
  nodeComments FromThen {} = NodeComments
emptyNodeComments
  nodeComments FromTo {} = NodeComments
emptyNodeComments
  nodeComments FromThenTo {} = NodeComments
emptyNodeComments

instance CommentExtraction (HsForAllTelescope GhcPs) where
  nodeComments :: HsForAllTelescope GhcPs -> NodeComments
nodeComments HsForAllVis {[LHsTyVarBndr () GhcPs]
XHsForAllVis GhcPs
hsf_xvis :: XHsForAllVis GhcPs
hsf_vis_bndrs :: [LHsTyVarBndr () GhcPs]
hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_xvis :: forall pass. HsForAllTelescope pass -> XHsForAllVis pass
..} = EpAnnForallTy -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XHsForAllVis GhcPs
EpAnnForallTy
hsf_xvis
  nodeComments HsForAllInvis {[LHsTyVarBndr Specificity GhcPs]
XHsForAllInvis GhcPs
hsf_xinvis :: XHsForAllInvis GhcPs
hsf_invis_bndrs :: [LHsTyVarBndr Specificity GhcPs]
hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_xinvis :: forall pass. HsForAllTelescope pass -> XHsForAllInvis pass
..} = EpAnnForallTy -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XHsForAllInvis GhcPs
EpAnnForallTy
hsf_xinvis

instance CommentExtraction InfixOp where
  nodeComments :: InfixOp -> NodeComments
nodeComments (InfixOp RdrName
x) = RdrName -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments RdrName
x

instance CommentExtraction PrefixOp where
  nodeComments :: PrefixOp -> NodeComments
nodeComments (PrefixOp RdrName
x) = RdrName -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments RdrName
x

instance CommentExtraction Context where
  nodeComments :: Context -> NodeComments
nodeComments Context {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance CommentExtraction HorizontalContext where
  nodeComments :: HorizontalContext -> NodeComments
nodeComments HorizontalContext {} = NodeComments
emptyNodeComments

instance CommentExtraction VerticalContext where
  nodeComments :: VerticalContext -> NodeComments
nodeComments VerticalContext {} = NodeComments
emptyNodeComments
#else
instance CommentExtraction HorizontalContext where
  nodeComments HorizontalContext {} = emptyNodeComments

instance CommentExtraction VerticalContext where
  nodeComments VerticalContext {} = emptyNodeComments
#endif
-- Wrap a value of this type with 'ModulenameWithPrefix' to print it with
-- the "module " prefix.
instance CommentExtraction ModuleName where
  nodeComments :: ModuleName -> NodeComments
nodeComments = NodeComments -> ModuleName -> NodeComments
forall a b. a -> b -> a
const NodeComments
emptyNodeComments

instance CommentExtraction ModuleNameWithPrefix where
  nodeComments :: ModuleNameWithPrefix -> NodeComments
nodeComments ModuleNameWithPrefix {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (IE GhcPs) where
  nodeComments :: IE GhcPs -> NodeComments
nodeComments IEVar {} = NodeComments
emptyNodeComments
  nodeComments (IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
x Maybe (LHsDoc GhcPs)
_) = GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
x
  nodeComments (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
x Maybe (LHsDoc GhcPs)
_) = GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
x
  nodeComments (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
x IEWildcard
_ [LIEWrappedName GhcPs]
_ Maybe (LHsDoc GhcPs)
_) = GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
x
  nodeComments (IEModuleContents (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
x, [AddEpAnn]
y) XRec GhcPs ModuleName
_) =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ Maybe NodeComments -> [NodeComments]
forall a. Maybe a -> [a]
maybeToList ((GenLocated SrcSpanAnnP (WarningTxt GhcPs) -> NodeComments)
-> Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
-> Maybe NodeComments
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnP (WarningTxt GhcPs) -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
x) [NodeComments] -> [NodeComments] -> [NodeComments]
forall a. Semigroup a => a -> a -> a
<> (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
y
  nodeComments IEGroup {} = NodeComments
emptyNodeComments
  nodeComments IEDoc {} = NodeComments
emptyNodeComments
  nodeComments IEDocNamed {} = NodeComments
emptyNodeComments
#elif MIN_VERSION_ghc_lib_parser(9, 8, 1)
instance CommentExtraction (IE GhcPs) where
  nodeComments IEVar {} = emptyNodeComments
  nodeComments (IEThingAbs (_, x) _) = nodeComments x
  nodeComments (IEThingAll (_, x) _) = nodeComments x
  nodeComments (IEThingWith (_, x) _ _ _) = nodeComments x
  nodeComments (IEModuleContents (_, x) _) = nodeComments x
  nodeComments IEGroup {} = emptyNodeComments
  nodeComments IEDoc {} = emptyNodeComments
  nodeComments IEDocNamed {} = emptyNodeComments
#else
instance CommentExtraction (IE GhcPs) where
  nodeComments IEVar {} = emptyNodeComments
  nodeComments (IEThingAbs x _) = nodeComments x
  nodeComments (IEThingAll x _) = nodeComments x
  nodeComments (IEThingWith x _ _ _) = nodeComments x
  nodeComments (IEModuleContents x _) = nodeComments x
  nodeComments IEGroup {} = emptyNodeComments
  nodeComments IEDoc {} = emptyNodeComments
  nodeComments IEDocNamed {} = emptyNodeComments
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction
           (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where
  nodeComments :: FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> NodeComments
nodeComments FamEqn {HsFamEqnPats GhcPs
XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
LIdP GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
LexicalFixity
HsOuterFamEqnTyVarBndrs GhcPs
feqn_ext :: XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
feqn_tycon :: LIdP GhcPs
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_pats :: HsFamEqnPats GhcPs
feqn_fixity :: LexicalFixity
feqn_rhs :: GenLocated SrcSpanAnnA (HsType GhcPs)
feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
feqn_ext
#else
instance CommentExtraction
           (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where
  nodeComments FamEqn {..} = nodeComments feqn_ext
#endif
instance CommentExtraction FamEqn' where
  nodeComments :: FamEqn' -> NodeComments
nodeComments FamEqn' {FamEqn GhcPs (HsDataDefn GhcPs)
DataFamInstDeclFor
famEqnFor :: DataFamInstDeclFor
famEqn :: FamEqn GhcPs (HsDataDefn GhcPs)
famEqn :: FamEqn' -> FamEqn GhcPs (HsDataDefn GhcPs)
famEqnFor :: FamEqn' -> DataFamInstDeclFor
..} = FamEqn GhcPs (HsDataDefn GhcPs) -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments FamEqn GhcPs (HsDataDefn GhcPs)
famEqn
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
-- | Pretty-print a data instance.
instance CommentExtraction (FamEqn GhcPs (HsDataDefn GhcPs)) where
  nodeComments :: FamEqn GhcPs (HsDataDefn GhcPs) -> NodeComments
nodeComments FamEqn {HsFamEqnPats GhcPs
XCFamEqn GhcPs (HsDataDefn GhcPs)
LIdP GhcPs
LexicalFixity
HsOuterFamEqnTyVarBndrs GhcPs
HsDataDefn GhcPs
feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_tycon :: LIdP GhcPs
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_pats :: HsFamEqnPats GhcPs
feqn_fixity :: LexicalFixity
feqn_rhs :: HsDataDefn GhcPs
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_ext
#else
-- | Pretty-print a data instance.
instance CommentExtraction (FamEqn GhcPs (HsDataDefn GhcPs)) where
  nodeComments FamEqn {..} = nodeComments feqn_ext
#endif
-- | HsArg (LHsType GhcPs) (LHsType GhcPs)
#if MIN_VERSION_ghc_lib_parser(9,8,1)
instance CommentExtraction
           (HsArg
              GhcPs
              (GenLocated SrcSpanAnnA (HsType GhcPs))
              (GenLocated SrcSpanAnnA (HsType GhcPs))) where
  nodeComments :: HsArg
  GhcPs
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> NodeComments
nodeComments HsValArg {} = NodeComments
emptyNodeComments
  nodeComments HsTypeArg {} = NodeComments
emptyNodeComments
  nodeComments HsArgPar {} = NodeComments
emptyNodeComments
#else
instance CommentExtraction
           (HsArg
              (GenLocated SrcSpanAnnA (HsType GhcPs))
              (GenLocated SrcSpanAnnA (HsType GhcPs))) where
  nodeComments HsValArg {} = emptyNodeComments
  nodeComments HsTypeArg {} = emptyNodeComments
  nodeComments HsArgPar {} = emptyNodeComments
#endif
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance CommentExtraction (HsQuote GhcPs) where
  nodeComments :: HsQuote GhcPs -> NodeComments
nodeComments ExpBr {} = NodeComments
emptyNodeComments
  nodeComments PatBr {} = NodeComments
emptyNodeComments
  nodeComments DecBrL {} = NodeComments
emptyNodeComments
  nodeComments DecBrG {} = NodeComments
emptyNodeComments
  nodeComments TypBr {} = NodeComments
emptyNodeComments
  nodeComments VarBr {} = NodeComments
emptyNodeComments
#endif

#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (WarnDecls GhcPs) where
  nodeComments :: WarnDecls GhcPs -> NodeComments
nodeComments Warnings {[LWarnDecl GhcPs]
XWarnings GhcPs
wd_ext :: XWarnings GhcPs
wd_warnings :: [LWarnDecl GhcPs]
wd_warnings :: forall pass. WarnDecls pass -> [LWarnDecl pass]
wd_ext :: forall pass. WarnDecls pass -> XWarnings pass
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments ([AddEpAnn] -> [NodeComments]) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> a -> b
$ ([AddEpAnn], SourceText) -> [AddEpAnn]
forall a b. (a, b) -> a
fst ([AddEpAnn], SourceText)
XWarnings GhcPs
wd_ext
#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)
instance CommentExtraction (WarnDecls GhcPs) where
  nodeComments Warnings {..} = nodeComments $ fst wd_ext
#else
instance CommentExtraction (WarnDecls GhcPs) where
  nodeComments Warnings {..} = nodeComments wd_ext
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (WarnDecl GhcPs) where
  nodeComments :: WarnDecl GhcPs -> NodeComments
nodeComments (Warning (NamespaceSpecifier
_, [AddEpAnn]
x) [LIdP GhcPs]
_ WarningTxt GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
x
#else
instance CommentExtraction (WarnDecl GhcPs) where
  nodeComments (Warning x _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance CommentExtraction (WithHsDocIdentifiers StringLiteral GhcPs) where
  nodeComments :: WithHsDocIdentifiers StringLiteral GhcPs -> NodeComments
nodeComments WithHsDocIdentifiers {} = NodeComments
emptyNodeComments
#endif
#if MIN_VERSION_ghc_lib_parser(9,6,1)
instance CommentExtraction (IEWrappedName GhcPs) where
  nodeComments :: IEWrappedName GhcPs -> NodeComments
nodeComments IEName {} = NodeComments
emptyNodeComments
  nodeComments IEPattern {} = NodeComments
emptyNodeComments
  nodeComments IEType {} = NodeComments
emptyNodeComments
#else
-- | 'Pretty' for 'LIEWrappedName (IdP GhcPs)'
instance CommentExtraction (IEWrappedName RdrName) where
  nodeComments IEName {} = emptyNodeComments
  nodeComments IEPattern {} = emptyNodeComments
  nodeComments IEType {} = emptyNodeComments
#endif
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance CommentExtraction (DotFieldOcc GhcPs) where
  nodeComments :: DotFieldOcc GhcPs -> NodeComments
nodeComments DotFieldOcc {XCDotFieldOcc GhcPs
XRec GhcPs FieldLabelString
dfoExt :: XCDotFieldOcc GhcPs
dfoLabel :: XRec GhcPs FieldLabelString
dfoLabel :: forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoExt :: forall p. DotFieldOcc p -> XCDotFieldOcc p
..} = AnnFieldLabel -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XCDotFieldOcc GhcPs
AnnFieldLabel
dfoExt
#else
instance CommentExtraction (HsFieldLabel GhcPs) where
  nodeComments HsFieldLabel {..} = nodeComments hflExt
#endif

#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (RuleDecls GhcPs) where
  nodeComments :: RuleDecls GhcPs -> NodeComments
nodeComments HsRules {[LRuleDecl GhcPs]
XCRuleDecls GhcPs
rds_ext :: XCRuleDecls GhcPs
rds_rules :: [LRuleDecl GhcPs]
rds_rules :: forall pass. RuleDecls pass -> [LRuleDecl pass]
rds_ext :: forall pass. RuleDecls pass -> XCRuleDecls pass
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments ([AddEpAnn] -> [NodeComments]) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> a -> b
$ ([AddEpAnn], SourceText) -> [AddEpAnn]
forall a b. (a, b) -> a
fst ([AddEpAnn], SourceText)
XCRuleDecls GhcPs
rds_ext
#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)
instance CommentExtraction (RuleDecls GhcPs) where
  nodeComments HsRules {..} = nodeComments $ fst rds_ext
#else
instance CommentExtraction (RuleDecls GhcPs) where
  nodeComments HsRules {..} = nodeComments rds_ext
#endif

#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
instance CommentExtraction (RuleDecl GhcPs) where
  nodeComments :: RuleDecl GhcPs -> NodeComments
nodeComments HsRule {[LRuleBndr GhcPs]
Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
XHsRule GhcPs
XRec GhcPs RuleName
LHsExpr GhcPs
Activation
rd_ext :: XHsRule GhcPs
rd_name :: XRec GhcPs RuleName
rd_act :: Activation
rd_tyvs :: Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
rd_tmvs :: [LRuleBndr GhcPs]
rd_lhs :: LHsExpr GhcPs
rd_rhs :: LHsExpr GhcPs
rd_rhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
rd_lhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
rd_tmvs :: forall pass. RuleDecl pass -> [LRuleBndr pass]
rd_tyvs :: forall pass.
RuleDecl pass -> Maybe [LHsTyVarBndr () (NoGhcTc pass)]
rd_act :: forall pass. RuleDecl pass -> Activation
rd_name :: forall pass. RuleDecl pass -> XRec pass RuleName
rd_ext :: forall pass. RuleDecl pass -> XHsRule pass
..} = HsRuleAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments (HsRuleAnn -> NodeComments) -> HsRuleAnn -> NodeComments
forall a b. (a -> b) -> a -> b
$ (HsRuleAnn, SourceText) -> HsRuleAnn
forall a b. (a, b) -> a
fst (HsRuleAnn, SourceText)
XHsRule GhcPs
rd_ext
#else
instance CommentExtraction (RuleDecl GhcPs) where
  nodeComments HsRule {..} = nodeComments rd_ext
#endif
instance CommentExtraction OccName where
  nodeComments :: OccName -> NodeComments
nodeComments = NodeComments -> OccName -> NodeComments
forall a b. a -> b -> a
const NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (DerivDecl GhcPs) where
  nodeComments :: DerivDecl GhcPs -> NodeComments
nodeComments DerivDecl {deriv_ext :: forall pass. DerivDecl pass -> XCDerivDecl pass
deriv_ext = (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
x, [AddEpAnn]
xs)} =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ Maybe NodeComments -> [NodeComments]
forall a. Maybe a -> [a]
maybeToList ((GenLocated SrcSpanAnnP (WarningTxt GhcPs) -> NodeComments)
-> Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
-> Maybe NodeComments
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnP (WarningTxt GhcPs) -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
x) [NodeComments] -> [NodeComments] -> [NodeComments]
forall a. Semigroup a => a -> a -> a
<> (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
xs
#else
instance CommentExtraction (DerivDecl GhcPs) where
  nodeComments DerivDecl {..} = nodeComments deriv_ext
#endif
-- | 'Pretty' for 'LHsSigWcType GhcPs'.
instance CommentExtraction
           (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))) where
  nodeComments :: HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> NodeComments
nodeComments HsWC {} = NodeComments
emptyNodeComments

-- | 'Pretty' for 'LHsWcType'
instance CommentExtraction
           (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where
  nodeComments :: HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> NodeComments
nodeComments HsWC {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (StandaloneKindSig GhcPs) where
  nodeComments :: StandaloneKindSig GhcPs -> NodeComments
nodeComments (StandaloneKindSig XStandaloneKindSig GhcPs
x LIdP GhcPs
_ LHsSigType GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XStandaloneKindSig GhcPs
x
#else
instance CommentExtraction (StandaloneKindSig GhcPs) where
  nodeComments (StandaloneKindSig x _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (DefaultDecl GhcPs) where
  nodeComments :: DefaultDecl GhcPs -> NodeComments
nodeComments (DefaultDecl XCDefaultDecl GhcPs
x [LHsType GhcPs]
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XCDefaultDecl GhcPs
x
#else
instance CommentExtraction (DefaultDecl GhcPs) where
  nodeComments (DefaultDecl x _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (ForeignDecl GhcPs) where
  nodeComments :: ForeignDecl GhcPs -> NodeComments
nodeComments ForeignImport {XForeignImport GhcPs
LIdP GhcPs
LHsSigType GhcPs
ForeignImport GhcPs
fd_i_ext :: XForeignImport GhcPs
fd_name :: LIdP GhcPs
fd_sig_ty :: LHsSigType GhcPs
fd_fi :: ForeignImport GhcPs
fd_fi :: forall pass. ForeignDecl pass -> ForeignImport pass
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_i_ext :: forall pass. ForeignDecl pass -> XForeignImport pass
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XForeignImport GhcPs
fd_i_ext
  nodeComments ForeignExport {XForeignExport GhcPs
LIdP GhcPs
LHsSigType GhcPs
ForeignExport GhcPs
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_e_ext :: XForeignExport GhcPs
fd_name :: LIdP GhcPs
fd_sig_ty :: LHsSigType GhcPs
fd_fe :: ForeignExport GhcPs
fd_fe :: forall pass. ForeignDecl pass -> ForeignExport pass
fd_e_ext :: forall pass. ForeignDecl pass -> XForeignExport pass
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XForeignExport GhcPs
fd_e_ext
#else
instance CommentExtraction (ForeignDecl GhcPs) where
  nodeComments ForeignImport {..} = nodeComments fd_i_ext
  nodeComments ForeignExport {..} = nodeComments fd_e_ext
#endif
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
instance CommentExtraction (ForeignImport GhcPs) where
  nodeComments :: ForeignImport GhcPs -> NodeComments
nodeComments CImport {} = NodeComments
emptyNodeComments
#else
instance CommentExtraction ForeignImport where
  nodeComments CImport {} = emptyNodeComments
#endif

#if MIN_VERSION_ghc_lib_parser(9,6,1)
instance CommentExtraction (ForeignExport GhcPs) where
  nodeComments :: ForeignExport GhcPs -> NodeComments
nodeComments CExport {} = NodeComments
emptyNodeComments
#else
instance CommentExtraction ForeignExport where
  nodeComments CExport {} = emptyNodeComments
#endif
instance CommentExtraction CExportSpec where
  nodeComments :: CExportSpec -> NodeComments
nodeComments CExportStatic {} = NodeComments
emptyNodeComments

instance CommentExtraction Safety where
  nodeComments :: Safety -> NodeComments
nodeComments Safety
PlaySafe = NodeComments
emptyNodeComments
  nodeComments Safety
PlayInterruptible = NodeComments
emptyNodeComments
  nodeComments Safety
PlayRisky = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9,6,1)
instance CommentExtraction (AnnDecl GhcPs) where
  nodeComments :: AnnDecl GhcPs -> NodeComments
nodeComments (HsAnnotation (AnnPragma
x, SourceText
_) AnnProvenance GhcPs
_ LHsExpr GhcPs
_) = AnnPragma -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments AnnPragma
x
#else
instance CommentExtraction (AnnDecl GhcPs) where
  nodeComments (HsAnnotation x _ _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (RoleAnnotDecl GhcPs) where
  nodeComments :: RoleAnnotDecl GhcPs -> NodeComments
nodeComments (RoleAnnotDecl XCRoleAnnotDecl GhcPs
x LIdP GhcPs
_ [XRec GhcPs (Maybe Role)]
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XCRoleAnnotDecl GhcPs
x
#else
instance CommentExtraction (RoleAnnotDecl GhcPs) where
  nodeComments (RoleAnnotDecl x _ _) = nodeComments x
#endif
instance CommentExtraction Role where
  nodeComments :: Role -> NodeComments
nodeComments Role
Nominal = NodeComments
emptyNodeComments
  nodeComments Role
Representational = NodeComments
emptyNodeComments
  nodeComments Role
Phantom = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (TyFamInstDecl GhcPs) where
  nodeComments :: TyFamInstDecl GhcPs -> NodeComments
nodeComments TyFamInstDecl {XCTyFamInstDecl GhcPs
TyFamInstEqn GhcPs
tfid_xtn :: XCTyFamInstDecl GhcPs
tfid_eqn :: TyFamInstEqn GhcPs
tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_xtn :: forall pass. TyFamInstDecl pass -> XCTyFamInstDecl pass
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XCTyFamInstDecl GhcPs
tfid_xtn
#else
instance CommentExtraction (TyFamInstDecl GhcPs) where
  nodeComments TyFamInstDecl {..} = nodeComments tfid_xtn
#endif
instance CommentExtraction TopLevelTyFamInstDecl where
  nodeComments :: TopLevelTyFamInstDecl -> NodeComments
nodeComments (TopLevelTyFamInstDecl TyFamInstDecl GhcPs
x) = TyFamInstDecl GhcPs -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments TyFamInstDecl GhcPs
x

instance CommentExtraction (DataFamInstDecl GhcPs) where
  nodeComments :: DataFamInstDecl GhcPs -> NodeComments
nodeComments DataFamInstDecl {} = NodeComments
emptyNodeComments

instance CommentExtraction DataFamInstDecl' where
  nodeComments :: DataFamInstDecl' -> NodeComments
nodeComments DataFamInstDecl' {DataFamInstDecl GhcPs
DataFamInstDeclFor
dataFamInstDeclFor :: DataFamInstDeclFor
dataFamInstDecl :: DataFamInstDecl GhcPs
dataFamInstDecl :: DataFamInstDecl' -> DataFamInstDecl GhcPs
dataFamInstDeclFor :: DataFamInstDecl' -> DataFamInstDeclFor
..} = DataFamInstDecl GhcPs -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments DataFamInstDecl GhcPs
dataFamInstDecl
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (PatSynBind GhcPs GhcPs) where
  nodeComments :: PatSynBind GhcPs GhcPs -> NodeComments
nodeComments PSB {XPSB GhcPs GhcPs
LIdP GhcPs
LPat GhcPs
HsPatSynDetails GhcPs
HsPatSynDir GhcPs
psb_ext :: XPSB GhcPs GhcPs
psb_id :: LIdP GhcPs
psb_args :: HsPatSynDetails GhcPs
psb_def :: LPat GhcPs
psb_dir :: HsPatSynDir GhcPs
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XPSB GhcPs GhcPs
psb_ext
#else
instance CommentExtraction (PatSynBind GhcPs GhcPs) where
  nodeComments PSB {..} = nodeComments psb_ext
#endif
-- | 'Pretty' for 'HsPatSynDetails'.
instance CommentExtraction
           (HsConDetails
              Void
              (GenLocated SrcSpanAnnN RdrName)
              [RecordPatSynField GhcPs]) where
  nodeComments :: HsConDetails
  Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField GhcPs]
-> NodeComments
nodeComments PrefixCon {} = NodeComments
emptyNodeComments
  nodeComments RecCon {} = NodeComments
emptyNodeComments
  nodeComments InfixCon {} = NodeComments
emptyNodeComments

instance CommentExtraction (FixitySig GhcPs) where
  nodeComments :: FixitySig GhcPs -> NodeComments
nodeComments FixitySig {} = NodeComments
emptyNodeComments

instance CommentExtraction Fixity where
  nodeComments :: Fixity -> NodeComments
nodeComments Fixity {} = NodeComments
emptyNodeComments

instance CommentExtraction FixityDirection where
  nodeComments :: FixityDirection -> NodeComments
nodeComments InfixL {} = NodeComments
emptyNodeComments
  nodeComments InfixR {} = NodeComments
emptyNodeComments
  nodeComments InfixN {} = NodeComments
emptyNodeComments

instance CommentExtraction InlinePragma where
  nodeComments :: InlinePragma -> NodeComments
nodeComments InlinePragma {} = NodeComments
emptyNodeComments

instance CommentExtraction InlineSpec where
  nodeComments :: InlineSpec -> NodeComments
nodeComments = InlineSpec -> NodeComments
nodeCommentsInlineSpec

nodeCommentsInlineSpec :: InlineSpec -> NodeComments
nodeCommentsInlineSpec :: InlineSpec -> NodeComments
nodeCommentsInlineSpec Inline {} = NodeComments
emptyNodeComments
nodeCommentsInlineSpec Inlinable {} = NodeComments
emptyNodeComments
nodeCommentsInlineSpec NoInline {} = NodeComments
emptyNodeComments
nodeCommentsInlineSpec NoUserInlinePrag {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9,4,1)
nodeCommentsInlineSpec Opaque {} = NodeComments
emptyNodeComments
#endif
instance CommentExtraction (HsPatSynDir GhcPs) where
  nodeComments :: HsPatSynDir GhcPs -> NodeComments
nodeComments HsPatSynDir GhcPs
Unidirectional = NodeComments
emptyNodeComments
  nodeComments HsPatSynDir GhcPs
ImplicitBidirectional = NodeComments
emptyNodeComments
  nodeComments ExplicitBidirectional {} = NodeComments
emptyNodeComments

instance CommentExtraction (HsOverLit GhcPs) where
  nodeComments :: HsOverLit GhcPs -> NodeComments
nodeComments OverLit {} = NodeComments
emptyNodeComments

instance CommentExtraction OverLitVal where
  nodeComments :: OverLitVal -> NodeComments
nodeComments HsIntegral {} = NodeComments
emptyNodeComments
  nodeComments HsFractional {} = NodeComments
emptyNodeComments
  nodeComments HsIsString {} = NodeComments
emptyNodeComments

instance CommentExtraction IntegralLit where
  nodeComments :: IntegralLit -> NodeComments
nodeComments IL {} = NodeComments
emptyNodeComments

instance CommentExtraction FractionalLit where
  nodeComments :: FractionalLit -> NodeComments
nodeComments FL {} = NodeComments
emptyNodeComments

instance CommentExtraction (HsLit GhcPs) where
  nodeComments :: HsLit GhcPs -> NodeComments
nodeComments HsChar {} = NodeComments
emptyNodeComments
  nodeComments HsCharPrim {} = NodeComments
emptyNodeComments
  nodeComments HsString {} = NodeComments
emptyNodeComments
  nodeComments HsStringPrim {} = NodeComments
emptyNodeComments
  nodeComments HsInt {} = NodeComments
emptyNodeComments
  nodeComments HsIntPrim {} = NodeComments
emptyNodeComments
  nodeComments HsWordPrim {} = NodeComments
emptyNodeComments
  nodeComments HsInt64Prim {} = NodeComments
emptyNodeComments
  nodeComments HsWord64Prim {} = NodeComments
emptyNodeComments
  nodeComments HsInteger {} = NodeComments
emptyNodeComments
  nodeComments HsRat {} = NodeComments
emptyNodeComments
  nodeComments HsFloatPrim {} = NodeComments
emptyNodeComments
  nodeComments HsDoublePrim {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9,6,1)
instance CommentExtraction (HsPragE GhcPs) where
  nodeComments :: HsPragE GhcPs -> NodeComments
nodeComments (HsPragSCC (AnnPragma
x, SourceText
_) StringLiteral
_) = AnnPragma -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments AnnPragma
x
#else
instance CommentExtraction (HsPragE GhcPs) where
  nodeComments (HsPragSCC x _ _) = nodeComments x
#endif
instance CommentExtraction HsIPName where
  nodeComments :: HsIPName -> NodeComments
nodeComments HsIPName {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9,6,1)
instance CommentExtraction (HsTyLit GhcPs) where
  nodeComments :: HsTyLit GhcPs -> NodeComments
nodeComments HsNumTy {} = NodeComments
emptyNodeComments
  nodeComments HsStrTy {} = NodeComments
emptyNodeComments
  nodeComments HsCharTy {} = NodeComments
emptyNodeComments
#else
instance CommentExtraction HsTyLit where
  nodeComments HsNumTy {} = emptyNodeComments
  nodeComments HsStrTy {} = emptyNodeComments
  nodeComments HsCharTy {} = emptyNodeComments
#endif
instance CommentExtraction (HsPatSigType GhcPs) where
  nodeComments :: HsPatSigType GhcPs -> NodeComments
nodeComments HsPS {XHsPS GhcPs
LHsType GhcPs
hsps_ext :: XHsPS GhcPs
hsps_body :: LHsType GhcPs
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
..} = EpAnnCO -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XHsPS GhcPs
EpAnnCO
hsps_ext

instance CommentExtraction (HsIPBinds GhcPs) where
  nodeComments :: HsIPBinds GhcPs -> NodeComments
nodeComments IPBinds {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (IPBind GhcPs) where
  nodeComments :: IPBind GhcPs -> NodeComments
nodeComments (IPBind XCIPBind GhcPs
x XRec GhcPs HsIPName
_ LHsExpr GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XCIPBind GhcPs
x
#else
instance CommentExtraction (IPBind GhcPs) where
  nodeComments (IPBind x _ _) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (DerivStrategy GhcPs) where
  nodeComments :: DerivStrategy GhcPs -> NodeComments
nodeComments (StockStrategy XStockStrategy GhcPs
x) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XStockStrategy GhcPs
x
  nodeComments (AnyclassStrategy XAnyClassStrategy GhcPs
x) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XAnyClassStrategy GhcPs
x
  nodeComments (NewtypeStrategy XNewtypeStrategy GhcPs
x) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XNewtypeStrategy GhcPs
x
  nodeComments (ViaStrategy XViaStrategy GhcPs
x) = XViaStrategyPs -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XViaStrategy GhcPs
XViaStrategyPs
x
#else
instance CommentExtraction (DerivStrategy GhcPs) where
  nodeComments (StockStrategy x) = nodeComments x
  nodeComments (AnyclassStrategy x) = nodeComments x
  nodeComments (NewtypeStrategy x) = nodeComments x
  nodeComments (ViaStrategy x) = nodeComments x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction XViaStrategyPs where
  nodeComments :: XViaStrategyPs -> NodeComments
nodeComments (XViaStrategyPs [AddEpAnn]
x LHsSigType GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
x
#else
instance CommentExtraction XViaStrategyPs where
  nodeComments (XViaStrategyPs x _) = nodeComments x
#endif
instance CommentExtraction (RecordPatSynField GhcPs) where
  nodeComments :: RecordPatSynField GhcPs -> NodeComments
nodeComments RecordPatSynField {} = NodeComments
emptyNodeComments

instance CommentExtraction (HsCmdTop GhcPs) where
  nodeComments :: HsCmdTop GhcPs -> NodeComments
nodeComments HsCmdTop {} = NodeComments
emptyNodeComments

instance CommentExtraction (HsCmd GhcPs) where
  nodeComments :: HsCmd GhcPs -> NodeComments
nodeComments = HsCmd GhcPs -> NodeComments
nodeCommentsHsCmd

nodeCommentsHsCmd :: HsCmd GhcPs -> NodeComments
nodeCommentsHsCmd :: HsCmd GhcPs -> NodeComments
nodeCommentsHsCmd (HsCmdArrApp XCmdArrApp GhcPs
x LHsExpr GhcPs
_ LHsExpr GhcPs
_ HsArrAppType
_ Bool
_) = AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XCmdArrApp GhcPs
AddEpAnn
x
nodeCommentsHsCmd (HsCmdArrForm XCmdArrForm GhcPs
x LHsExpr GhcPs
_ LexicalFixity
_ Maybe Fixity
_ [LHsCmdTop GhcPs]
_) = AnnList -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XCmdArrForm GhcPs
AnnList
x
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsCmd HsCmdApp {} = NodeComments
emptyNodeComments
#else
nodeCommentsHsCmd (HsCmdApp x _ _) = nodeComments x
#endif
nodeCommentsHsCmd HsCmdLam {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsCmd HsCmdPar {} = NodeComments
emptyNodeComments
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsHsCmd (HsCmdPar x _ _ _) = nodeComments x
#else
nodeCommentsHsCmd (HsCmdPar x _) = nodeComments x
#endif
nodeCommentsHsCmd (HsCmdCase XCmdCase GhcPs
x LHsExpr GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
_) = EpAnnHsCase -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XCmdCase GhcPs
EpAnnHsCase
x
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
-- No HsCmdLamCase since 9.10.1.
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsHsCmd (HsCmdLamCase x _ _) = nodeComments x
#else
nodeCommentsHsCmd (HsCmdLamCase x _) = nodeComments x
#endif
nodeCommentsHsCmd (HsCmdIf XCmdIf GhcPs
x SyntaxExpr GhcPs
_ LHsExpr GhcPs
_ LHsCmd GhcPs
_ LHsCmd GhcPs
_) = AnnsIf -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XCmdIf GhcPs
AnnsIf
x
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
nodeCommentsHsCmd HsCmdLet {} = NodeComments
emptyNodeComments
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
nodeCommentsHsCmd (HsCmdLet x _ _ _ _) = nodeComments x
#else
nodeCommentsHsCmd (HsCmdLet x _ _) = nodeComments x
#endif
nodeCommentsHsCmd (HsCmdDo XCmdDo GhcPs
x XRec GhcPs [CmdLStmt GhcPs]
_) = AnnList -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XCmdDo GhcPs
AnnList
x

instance CommentExtraction ListComprehension where
  nodeComments :: ListComprehension -> NodeComments
nodeComments ListComprehension {} = NodeComments
emptyNodeComments

instance CommentExtraction DoExpression where
  nodeComments :: DoExpression -> NodeComments
nodeComments DoExpression {} = NodeComments
emptyNodeComments

instance CommentExtraction LetIn where
  nodeComments :: LetIn -> NodeComments
nodeComments LetIn {} = NodeComments
emptyNodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (RuleBndr GhcPs) where
  nodeComments :: RuleBndr GhcPs -> NodeComments
nodeComments (RuleBndr XCRuleBndr GhcPs
x LIdP GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XCRuleBndr GhcPs
x
  nodeComments (RuleBndrSig XRuleBndrSig GhcPs
x LIdP GhcPs
_ HsPatSigType GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XRuleBndrSig GhcPs
x
#else
instance CommentExtraction (RuleBndr GhcPs) where
  nodeComments (RuleBndr x _) = nodeComments x
  nodeComments (RuleBndrSig x _ _) = nodeComments x
#endif
instance CommentExtraction CCallConv where
  nodeComments :: CCallConv -> NodeComments
nodeComments = NodeComments -> CCallConv -> NodeComments
forall a b. a -> b -> a
const NodeComments
emptyNodeComments

instance CommentExtraction HsSrcBang where
  nodeComments :: HsSrcBang -> NodeComments
nodeComments HsSrcBang {} = NodeComments
emptyNodeComments

instance CommentExtraction SrcUnpackedness where
  nodeComments :: SrcUnpackedness -> NodeComments
nodeComments SrcUnpackedness
SrcUnpack = NodeComments
emptyNodeComments
  nodeComments SrcUnpackedness
SrcNoUnpack = NodeComments
emptyNodeComments
  nodeComments SrcUnpackedness
NoSrcUnpack = NodeComments
emptyNodeComments

instance CommentExtraction SrcStrictness where
  nodeComments :: SrcStrictness -> NodeComments
nodeComments SrcStrictness
SrcLazy = NodeComments
emptyNodeComments
  nodeComments SrcStrictness
SrcStrict = NodeComments
emptyNodeComments
  nodeComments SrcStrictness
NoSrcStrict = NodeComments
emptyNodeComments

instance CommentExtraction (HsOuterSigTyVarBndrs GhcPs) where
  nodeComments :: HsOuterSigTyVarBndrs GhcPs -> NodeComments
nodeComments HsOuterImplicit {} = NodeComments
emptyNodeComments
  nodeComments HsOuterExplicit {[LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
XHsOuterExplicit GhcPs Specificity
hso_xexplicit :: XHsOuterExplicit GhcPs Specificity
hso_bndrs :: [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_xexplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterExplicit pass flag
..} = EpAnnForallTy -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments XHsOuterExplicit GhcPs Specificity
EpAnnForallTy
hso_xexplicit
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
instance CommentExtraction FieldLabelString where
  nodeComments :: FieldLabelString -> NodeComments
nodeComments = NodeComments -> FieldLabelString -> NodeComments
forall a b. a -> b -> a
const NodeComments
emptyNodeComments
#endif

#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (HsUntypedSplice GhcPs) where
  nodeComments :: HsUntypedSplice GhcPs -> NodeComments
nodeComments (HsUntypedSpliceExpr XUntypedSpliceExpr GhcPs
x LHsExpr GhcPs
_) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
XUntypedSpliceExpr GhcPs
x
  nodeComments HsQuasiQuote {} = NodeComments
emptyNodeComments
#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)
instance CommentExtraction (HsUntypedSplice GhcPs) where
  nodeComments (HsUntypedSpliceExpr x _) = nodeComments x
  nodeComments HsQuasiQuote {} = emptyNodeComments
#endif

#if MIN_VERSION_ghc_lib_parser(9,8,1)
instance CommentExtraction (LHsRecUpdFields GhcPs) where
  nodeComments :: LHsRecUpdFields GhcPs -> NodeComments
nodeComments RegularRecUpdFields {} = NodeComments
emptyNodeComments
  nodeComments OverloadedRecUpdFields {} = NodeComments
emptyNodeComments
#endif
instance CommentExtraction AddEpAnn where
  nodeComments :: AddEpAnn -> NodeComments
nodeComments (AddEpAnn AnnKeywordId
_ EpaLocation
x) = EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments EpaLocation
x

instance CommentExtraction EpaLocation where
  nodeComments :: EpaLocation -> NodeComments
nodeComments EpaSpan {} = NodeComments
emptyNodeComments
  nodeComments (EpaDelta DeltaPos
_ [LEpaComment]
x) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (LEpaComment -> NodeComments) -> [LEpaComment] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LEpaComment -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [LEpaComment]
x
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction (EpaLocation' NoComments) where
  nodeComments :: EpaLocation' NoComments -> NodeComments
nodeComments EpaSpan {} = NodeComments
emptyNodeComments
  nodeComments EpaDelta {} = NodeComments
emptyNodeComments
#endif
instance CommentExtraction AnnPragma where
  nodeComments :: AnnPragma -> NodeComments
nodeComments AnnPragma {[AddEpAnn]
AddEpAnn
apr_open :: AddEpAnn
apr_close :: AddEpAnn
apr_rest :: [AddEpAnn]
apr_rest :: AnnPragma -> [AddEpAnn]
apr_close :: AnnPragma -> AddEpAnn
apr_open :: AnnPragma -> AddEpAnn
..} =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments ([AddEpAnn] -> [NodeComments]) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> a -> b
$ AddEpAnn
apr_open AddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
: AddEpAnn
apr_close AddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
: [AddEpAnn]
apr_rest

instance CommentExtraction HsRuleAnn where
  nodeComments :: HsRuleAnn -> NodeComments
nodeComments HsRuleAnn {[AddEpAnn]
Maybe (AddEpAnn, AddEpAnn)
ra_tyanns :: Maybe (AddEpAnn, AddEpAnn)
ra_tmanns :: Maybe (AddEpAnn, AddEpAnn)
ra_rest :: [AddEpAnn]
ra_rest :: HsRuleAnn -> [AddEpAnn]
ra_tmanns :: HsRuleAnn -> Maybe (AddEpAnn, AddEpAnn)
ra_tyanns :: HsRuleAnn -> Maybe (AddEpAnn, AddEpAnn)
..} =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ Maybe (AddEpAnn, AddEpAnn) -> NodeComments
forall {a}. CommentExtraction a => Maybe (a, a) -> NodeComments
f Maybe (AddEpAnn, AddEpAnn)
ra_tyanns NodeComments -> [NodeComments] -> [NodeComments]
forall a. a -> [a] -> [a]
: Maybe (AddEpAnn, AddEpAnn) -> NodeComments
forall {a}. CommentExtraction a => Maybe (a, a) -> NodeComments
f Maybe (AddEpAnn, AddEpAnn)
ra_tmanns NodeComments -> [NodeComments] -> [NodeComments]
forall a. a -> [a] -> [a]
: (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
ra_rest
    where
      f :: Maybe (a, a) -> NodeComments
f (Just (a
x, a
y)) = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (a -> NodeComments) -> [a] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [a
x, a
y]
      f Maybe (a, a)
Nothing = NodeComments
emptyNodeComments

instance CommentExtraction AnnFieldLabel where
  nodeComments :: AnnFieldLabel -> NodeComments
nodeComments AnnFieldLabel {afDot :: AnnFieldLabel -> Maybe EpaLocation
afDot = Just EpaLocation
x} = EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments EpaLocation
x
  nodeComments AnnFieldLabel {afDot :: AnnFieldLabel -> Maybe EpaLocation
afDot = Maybe EpaLocation
Nothing} = NodeComments
emptyNodeComments

instance CommentExtraction EpAnnSumPat where
  nodeComments :: EpAnnSumPat -> NodeComments
nodeComments EpAnnSumPat {[EpaLocation]
[AddEpAnn]
sumPatParens :: [AddEpAnn]
sumPatVbarsBefore :: [EpaLocation]
sumPatVbarsAfter :: [EpaLocation]
sumPatVbarsAfter :: EpAnnSumPat -> [EpaLocation]
sumPatVbarsBefore :: EpAnnSumPat -> [EpaLocation]
sumPatParens :: EpAnnSumPat -> [AddEpAnn]
..} =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat
      ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
sumPatParens
          [NodeComments] -> [NodeComments] -> [NodeComments]
forall a. Semigroup a => a -> a -> a
<> (EpaLocation -> NodeComments) -> [EpaLocation] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [EpaLocation]
sumPatVbarsBefore
          [NodeComments] -> [NodeComments] -> [NodeComments]
forall a. Semigroup a => a -> a -> a
<> (EpaLocation -> NodeComments) -> [EpaLocation] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [EpaLocation]
sumPatVbarsAfter
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance CommentExtraction AnnList where
  nodeComments :: AnnList -> NodeComments
nodeComments AnnList {[TrailingAnn]
[AddEpAnn]
Maybe EpaLocation
Maybe AddEpAnn
al_anchor :: Maybe EpaLocation
al_open :: Maybe AddEpAnn
al_close :: Maybe AddEpAnn
al_rest :: [AddEpAnn]
al_trailing :: [TrailingAnn]
al_trailing :: AnnList -> [TrailingAnn]
al_rest :: AnnList -> [AddEpAnn]
al_close :: AnnList -> Maybe AddEpAnn
al_open :: AnnList -> Maybe AddEpAnn
al_anchor :: AnnList -> Maybe EpaLocation
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat [NodeComments
a, NodeComments
b, NodeComments
c, NodeComments
d, NodeComments
e]
    where
      a :: NodeComments
a = NodeComments
-> (EpaLocation -> NodeComments)
-> Maybe EpaLocation
-> NodeComments
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NodeComments
forall a. Monoid a => a
mempty EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments Maybe EpaLocation
al_anchor
      b :: NodeComments
b = NodeComments
-> (AddEpAnn -> NodeComments) -> Maybe AddEpAnn -> NodeComments
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NodeComments
forall a. Monoid a => a
mempty AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments Maybe AddEpAnn
al_open
      c :: NodeComments
c = NodeComments
-> (AddEpAnn -> NodeComments) -> Maybe AddEpAnn -> NodeComments
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NodeComments
forall a. Monoid a => a
mempty AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments Maybe AddEpAnn
al_close
      d :: NodeComments
d = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
al_rest
      e :: NodeComments
e = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (TrailingAnn -> NodeComments) -> [TrailingAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TrailingAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [TrailingAnn]
al_trailing

instance CommentExtraction TrailingAnn where
  nodeComments :: TrailingAnn -> NodeComments
nodeComments AddSemiAnn {EpaLocation
ta_location :: EpaLocation
ta_location :: TrailingAnn -> EpaLocation
..} = EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments EpaLocation
ta_location
  nodeComments AddCommaAnn {EpaLocation
ta_location :: TrailingAnn -> EpaLocation
ta_location :: EpaLocation
..} = EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments EpaLocation
ta_location
  nodeComments AddVbarAnn {EpaLocation
ta_location :: TrailingAnn -> EpaLocation
ta_location :: EpaLocation
..} = EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments EpaLocation
ta_location
  nodeComments AddDarrowAnn {EpaLocation
ta_location :: TrailingAnn -> EpaLocation
ta_location :: EpaLocation
..} = EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments EpaLocation
ta_location
  nodeComments AddDarrowUAnn {EpaLocation
ta_location :: TrailingAnn -> EpaLocation
ta_location :: EpaLocation
..} = EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments EpaLocation
ta_location

instance CommentExtraction AnnParen where
  nodeComments :: AnnParen -> NodeComments
nodeComments AnnParen {EpaLocation
ParenType
ap_adornment :: ParenType
ap_open :: EpaLocation
ap_close :: EpaLocation
ap_close :: AnnParen -> EpaLocation
ap_open :: AnnParen -> EpaLocation
ap_adornment :: AnnParen -> ParenType
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (EpaLocation -> NodeComments) -> [EpaLocation] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [EpaLocation
ap_open, EpaLocation
ap_close]
#endif
instance CommentExtraction AnnProjection where
  nodeComments :: AnnProjection -> NodeComments
nodeComments AnnProjection {EpaLocation
apOpen :: EpaLocation
apClose :: EpaLocation
apClose :: AnnProjection -> EpaLocation
apOpen :: AnnProjection -> EpaLocation
..} =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (EpaLocation -> NodeComments) -> [EpaLocation] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [EpaLocation
apOpen, EpaLocation
apClose]

instance CommentExtraction AnnsIf where
  nodeComments :: AnnsIf -> NodeComments
nodeComments AnnsIf {Maybe EpaLocation
EpaLocation
aiIf :: EpaLocation
aiThen :: EpaLocation
aiElse :: EpaLocation
aiThenSemi :: Maybe EpaLocation
aiElseSemi :: Maybe EpaLocation
aiElseSemi :: AnnsIf -> Maybe EpaLocation
aiThenSemi :: AnnsIf -> Maybe EpaLocation
aiElse :: AnnsIf -> EpaLocation
aiThen :: AnnsIf -> EpaLocation
aiIf :: AnnsIf -> EpaLocation
..} =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat
      ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (EpaLocation -> NodeComments) -> [EpaLocation] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments
      ([EpaLocation] -> [NodeComments])
-> [EpaLocation] -> [NodeComments]
forall a b. (a -> b) -> a -> b
$ EpaLocation
aiIf
          EpaLocation -> [EpaLocation] -> [EpaLocation]
forall a. a -> [a] -> [a]
: EpaLocation
aiThen
          EpaLocation -> [EpaLocation] -> [EpaLocation]
forall a. a -> [a] -> [a]
: EpaLocation
aiElse
          EpaLocation -> [EpaLocation] -> [EpaLocation]
forall a. a -> [a] -> [a]
: (Maybe EpaLocation -> [EpaLocation]
forall a. Maybe a -> [a]
maybeToList Maybe EpaLocation
aiThenSemi [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. Semigroup a => a -> a -> a
<> Maybe EpaLocation -> [EpaLocation]
forall a. Maybe a -> [a]
maybeToList Maybe EpaLocation
aiElseSemi)

instance CommentExtraction EpAnnHsCase where
  nodeComments :: EpAnnHsCase -> NodeComments
nodeComments EpAnnHsCase {[AddEpAnn]
EpaLocation
hsCaseAnnCase :: EpaLocation
hsCaseAnnOf :: EpaLocation
hsCaseAnnsRest :: [AddEpAnn]
hsCaseAnnsRest :: EpAnnHsCase -> [AddEpAnn]
hsCaseAnnOf :: EpAnnHsCase -> EpaLocation
hsCaseAnnCase :: EpAnnHsCase -> EpaLocation
..} =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat
      ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments EpaLocation
hsCaseAnnCase
          NodeComments -> [NodeComments] -> [NodeComments]
forall a. a -> [a] -> [a]
: EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments EpaLocation
hsCaseAnnOf
          NodeComments -> [NodeComments] -> [NodeComments]
forall a. a -> [a] -> [a]
: (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments [AddEpAnn]
hsCaseAnnsRest

instance CommentExtraction AnnExplicitSum where
  nodeComments :: AnnExplicitSum -> NodeComments
nodeComments AnnExplicitSum {[EpaLocation]
EpaLocation
aesOpen :: EpaLocation
aesBarsBefore :: [EpaLocation]
aesBarsAfter :: [EpaLocation]
aesClose :: EpaLocation
aesClose :: AnnExplicitSum -> EpaLocation
aesBarsAfter :: AnnExplicitSum -> [EpaLocation]
aesBarsBefore :: AnnExplicitSum -> [EpaLocation]
aesOpen :: AnnExplicitSum -> EpaLocation
..} =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat
      ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (EpaLocation -> NodeComments) -> [EpaLocation] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments
      ([EpaLocation] -> [NodeComments])
-> [EpaLocation] -> [NodeComments]
forall a b. (a -> b) -> a -> b
$ EpaLocation
aesOpen EpaLocation -> [EpaLocation] -> [EpaLocation]
forall a. a -> [a] -> [a]
: [EpaLocation]
aesBarsBefore [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. Semigroup a => a -> a -> a
<> [EpaLocation]
aesBarsAfter [EpaLocation] -> [EpaLocation] -> [EpaLocation]
forall a. Semigroup a => a -> a -> a
<> [EpaLocation
aesClose]

instance CommentExtraction EpAnnUnboundVar where
  nodeComments :: EpAnnUnboundVar -> NodeComments
nodeComments EpAnnUnboundVar {(EpaLocation, EpaLocation)
EpaLocation
hsUnboundBackquotes :: (EpaLocation, EpaLocation)
hsUnboundHole :: EpaLocation
hsUnboundHole :: EpAnnUnboundVar -> EpaLocation
hsUnboundBackquotes :: EpAnnUnboundVar -> (EpaLocation, EpaLocation)
..} =
    [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat
      ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (EpaLocation -> NodeComments) -> [EpaLocation] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          EpaLocation -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments
          [(EpaLocation, EpaLocation) -> EpaLocation
forall a b. (a, b) -> a
fst (EpaLocation, EpaLocation)
hsUnboundBackquotes, (EpaLocation, EpaLocation) -> EpaLocation
forall a b. (a, b) -> b
snd (EpaLocation, EpaLocation)
hsUnboundBackquotes, EpaLocation
hsUnboundHole]

instance CommentExtraction AnnSig where
  nodeComments :: AnnSig -> NodeComments
nodeComments AnnSig {[AddEpAnn]
AddEpAnn
asDcolon :: AddEpAnn
asRest :: [AddEpAnn]
asRest :: AnnSig -> [AddEpAnn]
asDcolon :: AnnSig -> AddEpAnn
..} = [NodeComments] -> NodeComments
forall a. Monoid a => [a] -> a
mconcat ([NodeComments] -> NodeComments) -> [NodeComments] -> NodeComments
forall a b. (a -> b) -> a -> b
$ (AddEpAnn -> NodeComments) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddEpAnn -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments ([AddEpAnn] -> [NodeComments]) -> [AddEpAnn] -> [NodeComments]
forall a b. (a -> b) -> a -> b
$ AddEpAnn
asDcolon AddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
: [AddEpAnn]
asRest

-- | Marks an AST node as never appearing in the AST.
--
-- Some AST node types are only used in the renaming or type-checking phase.
notUsedInParsedStage :: HasCallStack => a
notUsedInParsedStage :: forall a. HasCallStack => a
notUsedInParsedStage =
  [Char] -> a
forall a. HasCallStack => [Char] -> a
error
    [Char]
"This AST should never appears in an AST. It only appears in the renaming or type checked stages."

-- | A 'NodeComment' with no comments.
emptyNodeComments :: NodeComments
emptyNodeComments :: NodeComments
emptyNodeComments = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []