{-# LANGUAGE CPP                 #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}

#if MIN_VERSION_GHC(8,10)
#define GHC_IMPORT(NAME) GHC.Hs.NAME
#else
#define GHC_IMPORT(NAME) Hs ## NAME
#endif


-- | Generate tags from @'HsModule' 'GhcPs'@ representation.
--
module GhcTags.Ghc
  ( GhcTag (..)
  , GhcTags
  , GhcTagKind (..)
  , getGhcTags
  , hsDeclsToGhcTags
  ) where


import           Data.Maybe    (mapMaybe)
#if MIN_VERSION_GHC(9,0)
import           Data.Maybe    (maybeToList)
#endif
#if MIN_VERSION_GHC(9,6)
import qualified Data.List.NonEmpty as NonEmpty
#endif
import           Data.Foldable (foldl', toList)
import           Data.ByteString (ByteString)

-- Ghc imports
#if   MIN_VERSION_GHC(9,2)
import           GHC.Types.SourceText (SourceText (..))
#elif MIN_VERSION_GHC(9,0)
import           GHC.Types.Basic (SourceText (..))
#else
import           BasicTypes      (SourceText (..))
#endif
#if   MIN_VERSION_GHC(9,0)
import           GHC.Data.FastString (bytesFS)
#else
import           FastString          (bytesFS)
#endif
#if   MIN_VERSION_GHC(9,0) && !MIN_VERSION_GHC(9,2)
import           GHC.Types.FieldLabel (FieldLbl (..))
#elif !MIN_VERSION_GHC(9,0)
import           FieldLabel           (FieldLbl (..))
#endif
import           GHC_IMPORT(Binds)
                              ( HsBindLR (..)
                              , PatSynBind (..)
                              , Sig (..)
                              )
import           GHC_IMPORT(Decls)
                              ( ForeignImport (..)
                              , ClsInstDecl (..)
                              , ConDecl (..)
                              , DataFamInstDecl (..)
                              , FamEqn (..)
                              , FamilyDecl (..)
                              , FamilyInfo (..)
                              , FamilyResultSig (..)
                              , ForeignDecl (..)
                              , LHsDecl
#if   MIN_VERSION_GHC(9,2)
                              , HsConDeclH98Details
#else
                              , HsConDeclDetails
#endif
                              , HsDecl (..)
                              , HsDataDefn (..)
                              , InstDecl (..)
                              , TyClDecl (..)
                              , TyFamInstDecl (..)
                              )
import           GHC.Hs.Decls ( StandaloneKindSig (..) )
import           GHC_IMPORT(ImpExp)
                              ( IE (..)
                              , IEWildcard (..)
                              , ieWrappedName
                              )
import           GHC_IMPORT(Extension)
                              ( GhcPs
                              )

#if   MIN_VERSION_GHC(9,0)
import           GHC.Hs.Type
#else
import           GHC.Hs.Types
#endif
                              ( ConDeclField (..)
                              , FieldOcc (..)
                              , HsConDetails (..)
#if   !MIN_VERSION_GHC(9,2)
                              , HsImplicitBndrs (..)
#endif
                              , HsKind
                              , HsTyVarBndr (..)
                              , HsType (..)
                              , HsWildCardBndrs
                              , LConDeclField
                              , LFieldOcc
                              , LHsQTyVars (..)
                              , LHsSigType
                              , LHsType
                              )

#if   MIN_VERSION_GHC(9,0)
import           GHC.Types.SrcLoc
                                ( GenLocated (..)
                                , Located
                                , SrcSpan (..)
                                , unLoc
                                )
import           GHC.Types.Name.Reader
                                ( RdrName (..)
                                , rdrNameOcc
                                )
import           GHC.Types.Name ( nameOccName
                                , occNameFS
                                )
#else
import           SrcLoc         ( GenLocated (..)
                                , Located
                                , SrcSpan (..)
                                , unLoc
                                )
import           RdrName        ( RdrName (..)
                                , rdrNameOcc
                                )
import           Name           ( nameOccName
                                , occNameFS
                                )
#endif
#if   MIN_VERSION_GHC(9,2)
import           GHC.Hs       ( HsConDeclGADTDetails (..)
                              , HsModule (..)
                              , HsSigType (..)
#if   MIN_VERSION_GHC(9,6)
                              , CImportSpec (..) 
#endif
                              )
#if   MIN_VERSION_GHC(9,6)
import           GHC.Types.ForeignCall (CCallTarget (..))
#endif
import           GHC.Parser.Annotation (SrcSpanAnn' (..))
#else
import           GHC.Hs       ( HsModule (..) )
#endif
import           GHC.Hs       ( GRHSs (..)
                              , HsLocalBinds
                              , HsLocalBindsLR (..)
                              , HsValBindsLR (..)
                              , Match (..)
                              , MatchGroup (..)
                              )
#if MIN_VERSION_GHC(9,6)
import           Language.Haskell.Syntax.Module.Name (moduleNameFS)
#elif MIN_VERSION_GHC(9,0)
import           GHC.Unit.Module.Name (moduleNameFS)
#endif

#if !MIN_VERSION_GHC(9,2)
type HsConDeclH98Details ps = HsConDeclDetails ps
#endif

#if MIN_VERSION_GHC(9,6)
type GhcPsModule = HsModule GhcPs
type GhcPsHsTyVarBndr = HsTyVarBndr () GhcPs
#elif MIN_VERSION_GHC(9,0)
type GhcPsModule = HsModule
type GhcPsHsTyVarBndr = HsTyVarBndr () GhcPs
#else
type GhcPsModule = HsModule GhcPs
type GhcPsHsTyVarBndr = HsTyVarBndr    GhcPs
#endif


-- | Kind of the term.
--
data GhcTagKind
    = GtkModule
    | GtkTerm
    | GtkFunction
    | GtkTypeConstructor        (Maybe (HsKind GhcPs))

    -- | H98 data constructor
    | GtkDataConstructor               (ConDecl GhcPs)

    -- | GADT constructor with its type
    | GtkGADTConstructor               (ConDecl GhcPs)
    | GtkRecordField
    | GtkTypeSynonym                   (HsType GhcPs)
    | GtkTypeSignature                 (HsWildCardBndrs GhcPs (LHsSigType GhcPs))
    | GtkTypeKindSignature             (LHsSigType GhcPs)
    | GtkPatternSynonym
    | GtkTypeClass
    | GtkTypeClassMember               (HsType GhcPs)
    | GtkTypeClassInstance             (HsType GhcPs)
    | GtkTypeClassInstanceMember       (HsType GhcPs)
    | GtkTypeFamily             (Maybe ([GhcPsHsTyVarBndr], Either (HsKind GhcPs) GhcPsHsTyVarBndr))
    -- ghc-8.6.5 does not provide 'TyFamInstDecl' for associated type families
    | GtkTypeFamilyInstance     (Maybe (TyFamInstDecl GhcPs))
    | GtkDataTypeFamily         (Maybe ([GhcPsHsTyVarBndr], Either (HsKind GhcPs) GhcPsHsTyVarBndr))
    | GtkDataTypeFamilyInstance (Maybe (HsKind GhcPs))
    | GtkForeignImport
    | GtkForeignExport


-- | We can read names from using fields of type 'GHC.Hs.Extensions.IdP' (a type
-- family) which for @'Parsed@ resolved to 'RdrName'
--
data GhcTag = GhcTag {
    GhcTag -> SrcSpan
gtSrcSpan    :: !SrcSpan
    -- ^ term location
  , GhcTag -> ByteString
gtTag        :: !ByteString
    -- ^ utf8 encoded tag's name
  , GhcTag -> GhcTagKind
gtKind       :: !GhcTagKind
    -- ^ tag's kind
  , GhcTag -> Bool
gtIsExported :: !Bool
    -- ^ 'True' iff the term is exported
  , GhcTag -> Maybe String
gtFFI        :: !(Maybe String)
    -- ^ @ffi@ import
  }

type GhcTags = [GhcTag]


-- | Check if an identifier is exported.
--
isExported :: Maybe [IE GhcPs] -> Located RdrName -> Bool
isExported :: Maybe [IE GhcPs] -> Located RdrName -> Bool
isExported Maybe [IE GhcPs]
Nothing   Located RdrName
_name = Bool
True
isExported (Just [IE GhcPs]
ies) (L SrcSpan
_ RdrName
name) =
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\IE GhcPs
ie -> IE GhcPs -> Maybe RdrName
ieName IE GhcPs
ie forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just RdrName
name) [IE GhcPs]
ies
  where
    -- TODO: the GHC's one is partial, and I got a panic error.
    ieName :: IE GhcPs -> Maybe RdrName
    ieName :: IE GhcPs -> Maybe RdrName
ieName (IEVar XIEVar GhcPs
_ (L SrcSpanAnnA
_ IEWrappedName (IdP GhcPs)
n))              = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
n
    ieName (IEThingAbs  XIEThingAbs GhcPs
_ (L SrcSpanAnnA
_ IEWrappedName (IdP GhcPs)
n))        = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
n
#if !MIN_VERSION_GHC(9,2)
    ieName (IEThingWith _ (L _ n) _ _ _)  = Just $ ieWrappedName n
#else
    ieName (IEThingWith XIEThingWith GhcPs
_ (L SrcSpanAnnA
_ IEWrappedName (IdP GhcPs)
n) IEWildcard
_ [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
_)    = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
n
#endif
    ieName (IEThingAll  XIEThingAll GhcPs
_ (L SrcSpanAnnA
_ IEWrappedName (IdP GhcPs)
n))        = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
n
    ieName IE GhcPs
_ = forall a. Maybe a
Nothing


-- | Check if a class member or a type constructors is exported.
--
isMemberExported :: Maybe [IE GhcPs]
                 -> Located RdrName -- member name / constructor name
                 -> Located RdrName -- type class name / type constructor name
                 -> Bool
isMemberExported :: Maybe [IE GhcPs] -> Located RdrName -> Located RdrName -> Bool
isMemberExported Maybe [IE GhcPs]
Nothing    Located RdrName
_memberName Located RdrName
_className = Bool
True
isMemberExported (Just [IE GhcPs]
ies) Located RdrName
memberName  Located RdrName
className  = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any IE GhcPs -> Bool
go [IE GhcPs]
ies
  where
    go :: IE GhcPs -> Bool

    go :: IE GhcPs -> Bool
go (IEVar XIEVar GhcPs
_ (L SrcSpanAnnA
_ IEWrappedName (IdP GhcPs)
n)) = forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
n forall a. Eq a => a -> a -> Bool
== forall l e. GenLocated l e -> e
unLoc Located RdrName
memberName

    go (IEThingAbs XIEThingAbs GhcPs
_ GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
_)  = Bool
False

    go (IEThingAll XIEThingAll GhcPs
_ (L SrcSpanAnnA
_ IEWrappedName (IdP GhcPs)
n)) = forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
n forall a. Eq a => a -> a -> Bool
== forall l e. GenLocated l e -> e
unLoc Located RdrName
className

#if !MIN_VERSION_GHC(9,2)
    go (IEThingWith _ _ IEWildcard{} _ _) = True
#else
    go (IEThingWith XIEThingWith GhcPs
_ GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
_ IEWildcard{} [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
_)   = Bool
True
#endif

#if !MIN_VERSION_GHC(9,2)
    go (IEThingWith _ (L _ n) NoIEWildcard ns lfls) =
#else
    go (IEThingWith XIEThingWith GhcPs
_ (L SrcSpanAnnA
_ IEWrappedName (IdP GhcPs)
n) IEWildcard
NoIEWildcard [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
ns) =
#endif
            forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName (IdP GhcPs)
n forall a. Eq a => a -> a -> Bool
== forall l e. GenLocated l e -> e
unLoc Located RdrName
className
#if !MIN_VERSION_GHC(9,2)
         && (isInWrappedNames || isInFieldLbls)
#else
         Bool -> Bool -> Bool
&&  Bool
isInWrappedNames
#endif
      where
        -- the 'NameSpace' does not agree between things that are in the 'IE'
        -- list and passed member or type class names (constructor / type
        -- constructor names, respectively)
        isInWrappedNames :: Bool
isInWrappedNames = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc (forall l e. GenLocated l e -> e
unLoc Located RdrName
memberName))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name. IEWrappedName name -> name
ieWrappedName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
ns
#if !MIN_VERSION_GHC(9,2)
        isInFieldLbls    = any ((== occNameFS (rdrNameOcc (unLoc memberName))) . occNameFS . rdrNameOcc . flSelector. unLoc) lfls
#endif

    go IE GhcPs
_ = Bool
False


-- | Create a 'GhcTag', effectively a smart constructor.
--
mkGhcTag :: Located RdrName
         -- ^ @RdrName ~ IdP GhcPs@ it *must* be a name of a top level identifier.
         -> GhcTagKind
         -- ^ tag's kind
         -> Bool
         -- ^ is term exported
         -> GhcTag
mkGhcTag :: Located RdrName -> GhcTagKind -> Bool -> GhcTag
mkGhcTag (L SrcSpan
gtSrcSpan RdrName
rdrName) GhcTagKind
gtKind Bool
gtIsExported =
    case RdrName
rdrName of
      Unqual OccName
occName ->
        GhcTag { gtTag :: ByteString
gtTag = FastString -> ByteString
bytesFS (OccName -> FastString
occNameFS OccName
occName)
               , SrcSpan
gtSrcSpan :: SrcSpan
gtSrcSpan :: SrcSpan
gtSrcSpan
               , GhcTagKind
gtKind :: GhcTagKind
gtKind :: GhcTagKind
gtKind
               , Bool
gtIsExported :: Bool
gtIsExported :: Bool
gtIsExported
               , gtFFI :: Maybe String
gtFFI = forall a. Maybe a
Nothing
               }

      Qual ModuleName
_ OccName
occName ->
        GhcTag { gtTag :: ByteString
gtTag = FastString -> ByteString
bytesFS (OccName -> FastString
occNameFS OccName
occName)
               , SrcSpan
gtSrcSpan :: SrcSpan
gtSrcSpan :: SrcSpan
gtSrcSpan
               , GhcTagKind
gtKind :: GhcTagKind
gtKind :: GhcTagKind
gtKind
               , Bool
gtIsExported :: Bool
gtIsExported :: Bool
gtIsExported
               , gtFFI :: Maybe String
gtFFI = forall a. Maybe a
Nothing
               }

      -- Orig is the only one we are interested in
      Orig Module
_ OccName
occName ->
        GhcTag { gtTag :: ByteString
gtTag = FastString -> ByteString
bytesFS (OccName -> FastString
occNameFS OccName
occName)
               , SrcSpan
gtSrcSpan :: SrcSpan
gtSrcSpan :: SrcSpan
gtSrcSpan
               , GhcTagKind
gtKind :: GhcTagKind
gtKind :: GhcTagKind
gtKind
               , Bool
gtIsExported :: Bool
gtIsExported :: Bool
gtIsExported
               , gtFFI :: Maybe String
gtFFI = forall a. Maybe a
Nothing
               }

      Exact Name
eName ->
        GhcTag { gtTag :: ByteString
gtTag = FastString -> ByteString
bytesFS (OccName -> FastString
occNameFS (Name -> OccName
nameOccName Name
eName))
               , SrcSpan
gtSrcSpan :: SrcSpan
gtSrcSpan :: SrcSpan
gtSrcSpan
               , GhcTagKind
gtKind :: GhcTagKind
gtKind :: GhcTagKind
gtKind
               , Bool
gtIsExported :: Bool
gtIsExported :: Bool
gtIsExported
               , gtFFI :: Maybe String
gtFFI = forall a. Maybe a
Nothing
               }


-- | Generate tags for a module - simple walk over the syntax tree.
--
-- Supported identifiers:
--
--  * /module name/
--  * /top level terms/
--  * /local bindings/
--  * /data types/
--  * /record fields/
--  * /type synonyms/
--  * /type classes/
--  * /type class members/
--  * /type class instances/
--  * /type class instance members/
--  * /type families/
--  * /type family instances/
--  * /data type families/
--  * /data type families instances/
--  * /data type family instances constructors/
--
getGhcTags :: Located GhcPsModule
           -> GhcTags
#if MIN_VERSION_GHC(9,0)
getGhcTags :: Located GhcPsModule -> GhcTags
getGhcTags (L SrcSpan
_ HsModule { Maybe (LocatedA ModuleName)
hsmodName :: GhcPsModule -> Maybe (LocatedA ModuleName)
hsmodName :: Maybe (LocatedA ModuleName)
hsmodName, [LHsDecl GhcPs]
hsmodDecls :: GhcPsModule -> [LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls, Maybe (LocatedL [LIE GhcPs])
hsmodExports :: GhcPsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodExports :: Maybe (LocatedL [LIE GhcPs])
hsmodExports }) =
       forall a. Maybe a -> [a]
maybeToList (forall {a}. GenLocated (SrcSpanAnn' a) ModuleName -> GhcTag
mkModNameTag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LocatedA ModuleName)
hsmodName)
    forall a. [a] -> [a] -> [a]
++
#else
getGhcTags (L _ HsModule {            hsmodDecls, hsmodExports }) =
#endif
       Maybe [IE GhcPs] -> [LHsDecl GhcPs] -> GhcTags
hsDeclsToGhcTags Maybe [IE GhcPs]
mies [LHsDecl GhcPs]
hsmodDecls
  where
    mies :: Maybe [IE GhcPs]
    mies :: Maybe [IE GhcPs]
mies = forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LocatedL [LIE GhcPs])
hsmodExports

#if MIN_VERSION_GHC(9,0)
    mkModNameTag :: GenLocated (SrcSpanAnn' a) ModuleName -> GhcTag
mkModNameTag (L SrcSpanAnn' a
loc ModuleName
modName) =
      GhcTag { gtSrcSpan :: SrcSpan
gtSrcSpan =
#if MIN_VERSION_GHC(9,2)
                 forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
loc
#else
                 loc
#endif
             , gtTag :: ByteString
gtTag        = FastString -> ByteString
bytesFS forall a b. (a -> b) -> a -> b
$ ModuleName -> FastString
moduleNameFS ModuleName
modName
             , gtKind :: GhcTagKind
gtKind       = GhcTagKind
GtkModule
             , gtIsExported :: Bool
gtIsExported = Bool
True
             , gtFFI :: Maybe String
gtFFI        = forall a. Maybe a
Nothing
             }
#endif


hsDeclsToGhcTags :: Maybe [IE GhcPs]
                 -> [LHsDecl GhcPs]
                 -> GhcTags
hsDeclsToGhcTags :: Maybe [IE GhcPs] -> [LHsDecl GhcPs] -> GhcTags
hsDeclsToGhcTags Maybe [IE GhcPs]
mies =
    forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' GhcTags -> LHsDecl GhcPs -> GhcTags
go []
  where
    fixLoc :: SrcSpan -> GhcTag -> GhcTag
    fixLoc :: SrcSpan -> GhcTag -> GhcTag
fixLoc SrcSpan
loc gt :: GhcTag
gt@GhcTag { gtSrcSpan :: GhcTag -> SrcSpan
gtSrcSpan = UnhelpfulSpan {} } = GhcTag
gt { gtSrcSpan :: SrcSpan
gtSrcSpan = SrcSpan
loc }
    fixLoc SrcSpan
_   GhcTag
gt                                      = GhcTag
gt

    -- like 'mkGhcTag' but checks if the identifier is exported
    mkGhcTag' :: SrcSpan
              -- ^ declaration's location; it is useful when the term does not
              -- contain useful information (e.g. code generated from template
              -- haskell splices).
              ->  Located RdrName
              --  ^ @RdrName ~ IdP GhcPs@ it *must* be a name of a top level
              --  identifier.
              -> GhcTagKind
              -- ^ tag's kind
              -> GhcTag
    mkGhcTag' :: SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
l Located RdrName
a GhcTagKind
k = SrcSpan -> GhcTag -> GhcTag
fixLoc SrcSpan
l forall a b. (a -> b) -> a -> b
$ Located RdrName -> GhcTagKind -> Bool -> GhcTag
mkGhcTag Located RdrName
a GhcTagKind
k (Maybe [IE GhcPs] -> Located RdrName -> Bool
isExported Maybe [IE GhcPs]
mies Located RdrName
a)


    mkGhcTagForMember :: SrcSpan
                      -- ^ declaration's 'SrcSpan'
                      -> Located RdrName -- member name
                      -> Located RdrName -- class name
                      -> GhcTagKind
                      -> GhcTag
    mkGhcTagForMember :: SrcSpan
-> Located RdrName -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTagForMember SrcSpan
decLoc Located RdrName
memberName Located RdrName
className GhcTagKind
kind =
      SrcSpan -> GhcTag -> GhcTag
fixLoc SrcSpan
decLoc forall a b. (a -> b) -> a -> b
$ Located RdrName -> GhcTagKind -> Bool -> GhcTag
mkGhcTag Located RdrName
memberName GhcTagKind
kind
                               (Maybe [IE GhcPs] -> Located RdrName -> Located RdrName -> Bool
isMemberExported Maybe [IE GhcPs]
mies Located RdrName
memberName Located RdrName
className)

    -- Main routine which traverse all top level declarations.
    --
    go :: GhcTags -> LHsDecl GhcPs -> GhcTags
    go :: GhcTags -> LHsDecl GhcPs -> GhcTags
go GhcTags
tags (L SrcSpanAnnA
decLoc' HsDecl GhcPs
hsDecl) = let decLoc :: SrcSpan
decLoc = forall a. SrcSpanAnn' a -> SrcSpan
locAnn SrcSpanAnnA
decLoc' in case HsDecl GhcPs
hsDecl of

      -- type or class declaration
      TyClD XTyClD GhcPs
_ TyClDecl GhcPs
tyClDecl ->
        case TyClDecl GhcPs
tyClDecl of

          -- type family declarations
          FamDecl { FamilyDecl GhcPs
tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam :: FamilyDecl GhcPs
tcdFam } ->
            case SrcSpan
-> FamilyDecl GhcPs -> Maybe (Located RdrName) -> Maybe GhcTag
mkFamilyDeclTags SrcSpan
decLoc FamilyDecl GhcPs
tcdFam forall a. Maybe a
Nothing of
              Just GhcTag
tag -> GhcTag
tag forall a. a -> [a] -> [a]
: GhcTags
tags
              Maybe GhcTag
Nothing  ->       GhcTags
tags

          -- type synonyms
          SynDecl { LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName :: LIdP GhcPs
tcdLName, tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = L SrcSpanAnnA
_ HsType GhcPs
hsType } ->
            SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
tcdLName) (HsType GhcPs -> GhcTagKind
GtkTypeSynonym HsType GhcPs
hsType) forall a. a -> [a] -> [a]
: GhcTags
tags

          -- data declaration:
          --   type,
          --   constructors,
          --   record fields
          --
          DataDecl { LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName, HsDataDefn GhcPs
tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn :: HsDataDefn GhcPs
tcdDataDefn } ->
            case HsDataDefn GhcPs
tcdDataDefn of
              HsDataDefn { [LConDecl GhcPs]
dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons :: [LConDecl GhcPs]
dd_cons, Maybe (LHsType GhcPs)
dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig :: Maybe (LHsType GhcPs)
dd_kindSig } ->
                     SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
tcdLName) (Maybe (HsType GhcPs) -> GhcTagKind
GtkTypeConstructor (forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LHsType GhcPs)
dd_kindSig))
                   forall a. a -> [a] -> [a]
: (SrcSpan -> Located RdrName -> ConDecl GhcPs -> GhcTags
mkConsTags SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
tcdLName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
`concatMap` [LConDecl GhcPs]
dd_cons
                  forall a. [a] -> [a] -> [a]
++ GhcTags
tags

#if !MIN_VERSION_GHC(9,0)
              XHsDataDefn {} -> tags
#endif

          -- Type class declaration:
          --   type class name,
          --   type class members,
          --   default methods,
          --   default data type instance
          --
          ClassDecl { LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName, [LSig GhcPs]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs :: [LSig GhcPs]
tcdSigs, LHsBinds GhcPs
tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths :: LHsBinds GhcPs
tcdMeths, [LFamilyDecl GhcPs]
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs :: [LFamilyDecl GhcPs]
tcdATs, [LTyFamDefltDecl GhcPs]
tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs :: [LTyFamDefltDecl GhcPs]
tcdATDefs } ->
               -- class name
               SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
tcdLName) GhcTagKind
GtkTypeClass
               -- class methods
             forall a. a -> [a] -> [a]
: (SrcSpan -> Located RdrName -> Sig GhcPs -> GhcTags
mkClsMemberTags SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
tcdLName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
`concatMap` [LSig GhcPs]
tcdSigs
               -- default methods
            forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\GhcTags
tags' GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
hsBind -> SrcSpan -> HsBindLR GhcPs GhcPs -> GhcTags
mkHsBindLRTags SrcSpan
decLoc (forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
hsBind) forall a. [a] -> [a] -> [a]
++ GhcTags
tags')
                     []
                     LHsBinds GhcPs
tcdMeths
            -- associated types
            forall a. [a] -> [a] -> [a]
++ ((\FamilyDecl GhcPs
a -> SrcSpan
-> FamilyDecl GhcPs -> Maybe (Located RdrName) -> Maybe GhcTag
mkFamilyDeclTags SrcSpan
decLoc FamilyDecl GhcPs
a (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
tcdLName)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) forall a b. (a -> Maybe b) -> [a] -> [b]
`mapMaybe` [LFamilyDecl GhcPs]
tcdATs
            -- associated type defaults (data type families, type families
            -- (open or closed)
            forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
#if !MIN_VERSION_GHC(9,2)
                (\tags' (L _ decl'@(TyFamInstDecl HsIB { hsib_body = tyFamDeflEqn })) ->
                  let decl = Just decl' in
#else
                (\GhcTags
tags' (L SrcSpanAnnA
_ decl' :: TyFamInstDecl GhcPs
decl'@(TyFamInstDecl { tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_eqn = TyFamInstEqn GhcPs
tyFamDeflEqn })) ->
                  let decl :: Maybe (TyFamInstDecl GhcPs)
decl = forall a. a -> Maybe a
Just TyFamInstDecl GhcPs
decl' in
#endif
                    case TyFamInstEqn GhcPs
tyFamDeflEqn of
                      FamEqn { feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = L SrcSpanAnnA
_ HsType GhcPs
hsType } ->
                        case HsType GhcPs -> Maybe (Located RdrName)
hsTypeTagName HsType GhcPs
hsType of
                          -- TODO: add a `default` field
                          Just Located RdrName
a  -> SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc Located RdrName
a (Maybe (TyFamInstDecl GhcPs) -> GhcTagKind
GtkTypeFamilyInstance Maybe (TyFamInstDecl GhcPs)
decl) forall a. a -> [a] -> [a]
: GhcTags
tags'
                          Maybe (Located RdrName)
Nothing -> GhcTags
tags'
#if !MIN_VERSION_GHC(9,0)
                      XFamEqn {} -> tags'
#endif
                )
                [] [LTyFamDefltDecl GhcPs]
tcdATDefs
            forall a. [a] -> [a] -> [a]
++ GhcTags
tags

#if !MIN_VERSION_GHC(9,0)
          XTyClDecl {} -> tags
#endif

      -- Instance declarations
      --  class instances
      --  type family instance
      --  data type family instances
      --
      InstD XInstD GhcPs
_ InstDecl GhcPs
instDecl ->
        case InstDecl GhcPs
instDecl of
          -- class instance declaration
          ClsInstD { ClsInstDecl GhcPs
cid_inst :: forall pass. InstDecl pass -> ClsInstDecl pass
cid_inst :: ClsInstDecl GhcPs
cid_inst } ->
            case ClsInstDecl GhcPs
cid_inst of
#if !MIN_VERSION_GHC(9,0)
              XClsInstDecl {} -> tags
#endif

              ClsInstDecl { LHsSigType GhcPs
cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty :: LHsSigType GhcPs
cid_poly_ty, [LTyFamDefltDecl GhcPs]
cid_tyfam_insts :: forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_tyfam_insts :: [LTyFamDefltDecl GhcPs]
cid_tyfam_insts, [LDataFamInstDecl GhcPs]
cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts :: [LDataFamInstDecl GhcPs]
cid_datafam_insts, LHsBinds GhcPs
cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_binds :: LHsBinds GhcPs
cid_binds, [LSig GhcPs]
cid_sigs :: forall pass. ClsInstDecl pass -> [LSig pass]
cid_sigs :: [LSig GhcPs]
cid_sigs } ->
                  case LHsSigType GhcPs
cid_poly_ty of
#if !MIN_VERSION_GHC(9,0)
                    XHsImplicitBndrs {} ->
                      tyFamTags ++ dataFamTags ++ tags
#endif

                    -- TODO: @hsbib_body :: LHsType GhcPs@
#if !MIN_VERSION_GHC(9,2)
                    HsIB { hsib_body = body } ->
#else
                    L SrcSpanAnnA
_ HsSig { sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
body } ->
#endif
                      case SrcSpan -> LHsType GhcPs -> Maybe GhcTag
mkLHsTypeTag SrcSpan
decLoc LHsType GhcPs
body of
                        Maybe GhcTag
Nothing  ->       forall a b. (a -> b) -> [a] -> [b]
map (HsType GhcPs -> GhcTag -> GhcTag
fixTagKind (forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
body)) (GhcTags
tyFamTags forall a. [a] -> [a] -> [a]
++ GhcTags
dataFamTags forall a. [a] -> [a] -> [a]
++ GhcTags
bindsTags forall a. [a] -> [a] -> [a]
++ GhcTags
sigsTags) forall a. [a] -> [a] -> [a]
++ GhcTags
tags
                        Just GhcTag
tag -> GhcTag
tag forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (HsType GhcPs -> GhcTag -> GhcTag
fixTagKind (forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
body)) (GhcTags
tyFamTags forall a. [a] -> [a] -> [a]
++ GhcTags
dataFamTags forall a. [a] -> [a] -> [a]
++ GhcTags
bindsTags forall a. [a] -> [a] -> [a]
++ GhcTags
sigsTags) forall a. [a] -> [a] -> [a]
++ GhcTags
tags
                where
                  -- associated type and data type family instances
                  dataFamTags :: GhcTags
dataFamTags = (SrcSpan -> DataFamInstDecl GhcPs -> GhcTags
mkDataFamInstDeclTag SrcSpan
decLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
`concatMap` [LDataFamInstDecl GhcPs]
cid_datafam_insts
                  tyFamTags :: GhcTags
tyFamTags   = (SrcSpan -> TyFamInstDecl GhcPs -> Maybe GhcTag
mkTyFamInstDeclTag   SrcSpan
decLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) forall a b. (a -> Maybe b) -> [a] -> [b]
`mapMaybe`  [LTyFamDefltDecl GhcPs]
cid_tyfam_insts
                  bindsTags :: GhcTags
bindsTags   = (SrcSpan -> HsBindLR GhcPs GhcPs -> GhcTags
mkHsBindLRTags SrcSpan
decLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
`concatMap` LHsBinds GhcPs
cid_binds
                  sigsTags :: GhcTags
sigsTags    = (SrcSpan -> Sig GhcPs -> GhcTags
mkSigTags SrcSpan
decLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
`concatMap` [LSig GhcPs]
cid_sigs

                  fixTagKind :: HsType GhcPs -> GhcTag -> GhcTag
fixTagKind HsType GhcPs
body GhcTag
a = GhcTag
a { gtKind :: GhcTagKind
gtKind = HsType GhcPs -> GhcTagKind
GtkTypeClassInstanceMember HsType GhcPs
body }

          -- data family instance
          DataFamInstD { DataFamInstDecl GhcPs
dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
dfid_inst :: DataFamInstDecl GhcPs
dfid_inst } ->
            SrcSpan -> DataFamInstDecl GhcPs -> GhcTags
mkDataFamInstDeclTag SrcSpan
decLoc DataFamInstDecl GhcPs
dfid_inst forall a. [a] -> [a] -> [a]
++ GhcTags
tags

          -- type family instance
          TyFamInstD { TyFamInstDecl GhcPs
tfid_inst :: forall pass. InstDecl pass -> TyFamInstDecl pass
tfid_inst :: TyFamInstDecl GhcPs
tfid_inst } ->
            case SrcSpan -> TyFamInstDecl GhcPs -> Maybe GhcTag
mkTyFamInstDeclTag SrcSpan
decLoc TyFamInstDecl GhcPs
tfid_inst of
              Maybe GhcTag
Nothing  ->       GhcTags
tags
              Just GhcTag
tag -> GhcTag
tag forall a. a -> [a] -> [a]
: GhcTags
tags

#if !MIN_VERSION_GHC(9,0)
          XInstDecl {} -> tags
#endif

      -- deriving declaration
      DerivD {} -> GhcTags
tags

      -- value declaration
      ValD XValD GhcPs
_ HsBindLR GhcPs GhcPs
hsBind  -> SrcSpan -> HsBindLR GhcPs GhcPs -> GhcTags
mkHsBindLRTags SrcSpan
decLoc HsBindLR GhcPs GhcPs
hsBind forall a. [a] -> [a] -> [a]
++ GhcTags
tags

      -- signature declaration
      SigD XSigD GhcPs
_ Sig GhcPs
sig -> SrcSpan -> Sig GhcPs -> GhcTags
mkSigTags SrcSpan
decLoc Sig GhcPs
sig forall a. [a] -> [a] -> [a]
++ GhcTags
tags

      -- standalone kind signatures
      KindSigD XKindSigD GhcPs
_ StandaloneKindSig GhcPs
stdKindSig ->
        case StandaloneKindSig GhcPs
stdKindSig of
          StandaloneKindSig XStandaloneKindSig GhcPs
_ LIdP GhcPs
ksName LHsSigType GhcPs
sigType ->
           SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
ksName)  (LHsSigType GhcPs -> GhcTagKind
GtkTypeKindSignature LHsSigType GhcPs
sigType) forall a. a -> [a] -> [a]
: GhcTags
tags

#if !MIN_VERSION_GHC(9,0)
          XStandaloneKindSig {} -> tags
#endif

      -- default declaration
      DefD {} -> GhcTags
tags

      -- foreign declaration
      ForD XForD GhcPs
_ ForeignDecl GhcPs
foreignDecl ->
        case ForeignDecl GhcPs
foreignDecl of
#if MIN_VERSION_GHC(9,6)
          ForeignImport { fd_fi = CImport _ _ _mheader _ CLabel {} } -> tags
          ForeignImport { fd_fi = CImport _ _ _mheader _ CWrapper } -> tags
          ForeignImport { fd_fi = CImport _ _ _mheader _ (CFunction DynamicTarget) } -> tags
          ForeignImport { fd_fi = CImport _ _ _mheader _ (CFunction ((StaticTarget sourceText _ _ _))), fd_name } ->
#else
          ForeignImport { LIdP GhcPs
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name :: LIdP GhcPs
fd_name, fd_fi :: forall pass. ForeignDecl pass -> ForeignImport
fd_fi = CImport Located CCallConv
_ Located Safety
_ Maybe Header
_mheader CImportSpec
_ (L SrcSpan
_ SourceText
sourceText) } ->
#endif
                case SourceText
sourceText of
                  SourceText
NoSourceText -> GhcTag
tag
                  -- TODO: add header information from '_mheader'
                  SourceText String
s -> GhcTag
tag { gtFFI :: Maybe String
gtFFI = forall a. a -> Maybe a
Just String
s }
              forall a. a -> [a] -> [a]
: GhcTags
tags
            where
              tag :: GhcTag
tag = SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
fd_name) GhcTagKind
GtkForeignImport

          ForeignExport { LIdP GhcPs
fd_name :: LIdP GhcPs
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name } ->
              SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
fd_name) GhcTagKind
GtkForeignExport
            forall a. a -> [a] -> [a]
: GhcTags
tags

#if !MIN_VERSION_GHC(9,0)
          XForeignDecl {} -> tags
#endif

      WarningD {}   -> GhcTags
tags
      AnnD {}       -> GhcTags
tags

      -- TODO: Rules are named it would be nice to get them too
      RuleD {}      -> GhcTags
tags
      SpliceD {}    -> GhcTags
tags
      DocD {}       -> GhcTags
tags
      RoleAnnotD {} -> GhcTags
tags
#if !MIN_VERSION_GHC(9,0)
      XHsDecl {}    -> tags
#endif


    -- generate tags of all constructors of a type
    --
    mkConsTags :: SrcSpan
               -> Located RdrName
               -- name of the type
               -> ConDecl GhcPs
               -- constructor declaration
               -> GhcTags

#if !MIN_VERSION_GHC(9,2)
    mkConsTags decLoc tyName con@ConDeclGADT { con_names, con_args } =
#else
    mkConsTags :: SrcSpan -> Located RdrName -> ConDecl GhcPs -> GhcTags
mkConsTags SrcSpan
decLoc Located RdrName
tyName con :: ConDecl GhcPs
con@ConDeclGADT { [LIdP GhcPs]
con_names :: forall pass. ConDecl pass -> [LIdP pass]
con_names :: [LIdP GhcPs]
con_names, con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = HsConDeclGADTDetails GhcPs
con_args } =
#endif
         ( (\Located RdrName
n -> SrcSpan
-> Located RdrName -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTagForMember SrcSpan
decLoc Located RdrName
n Located RdrName
tyName (ConDecl GhcPs -> GhcTagKind
GtkGADTConstructor ConDecl GhcPs
con))
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn )
         forall a b. (a -> b) -> [a] -> [b]
`map` [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
con_names'
      forall a. [a] -> [a] -> [a]
++ SrcSpan -> Located RdrName -> HsConDeclGADTDetails GhcPs -> GhcTags
mkHsConDeclGADTDetails SrcSpan
decLoc Located RdrName
tyName HsConDeclGADTDetails GhcPs
con_args
      where
#if MIN_VERSION_GHC(9,6)
        con_names' = NonEmpty.toList con_names
#else
        con_names' :: [LIdP GhcPs]
con_names' = [LIdP GhcPs]
con_names
#endif

    mkConsTags SrcSpan
decLoc Located RdrName
tyName con :: ConDecl GhcPs
con@ConDeclH98  { LIdP GhcPs
con_name :: forall pass. ConDecl pass -> LIdP pass
con_name :: LIdP GhcPs
con_name, HsConDeclH98Details GhcPs
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args :: HsConDeclH98Details GhcPs
con_args } =
        SrcSpan
-> Located RdrName -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTagForMember SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
con_name) Located RdrName
tyName
          (ConDecl GhcPs -> GhcTagKind
GtkDataConstructor ConDecl GhcPs
con)
      forall a. a -> [a] -> [a]
: SrcSpan -> Located RdrName -> HsConDeclH98Details GhcPs -> GhcTags
mkHsConDeclH98Details SrcSpan
decLoc Located RdrName
tyName HsConDeclH98Details GhcPs
con_args

#if !MIN_VERSION_GHC(9,0)
    mkConsTags _ _ XConDecl {} = []
#endif

    mkHsLocalBindsTags :: SrcSpan -> HsLocalBinds GhcPs -> [GhcTag]
    mkHsLocalBindsTags :: SrcSpan -> HsLocalBinds GhcPs -> GhcTags
mkHsLocalBindsTags SrcSpan
decLoc (HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
_ LHsBinds GhcPs
hsBindsLR [LSig GhcPs]
sigs)) =
         -- where clause bindings
         forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SrcSpan -> HsBindLR GhcPs GhcPs -> GhcTags
mkHsBindLRTags SrcSpan
decLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList LHsBinds GhcPs
hsBindsLR)
      forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SrcSpan -> Sig GhcPs -> GhcTags
mkSigTags SrcSpan
decLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [LSig GhcPs]
sigs

    mkHsLocalBindsTags SrcSpan
_ HsLocalBinds GhcPs
_ = []

    mkHsConDeclH98Details :: SrcSpan
                          -> Located RdrName
                          -> HsConDeclH98Details GhcPs
                          -> GhcTags
    mkHsConDeclH98Details :: SrcSpan -> Located RdrName -> HsConDeclH98Details GhcPs -> GhcTags
mkHsConDeclH98Details SrcSpan
decLoc Located RdrName
tyName (RecCon (L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields)) =
        forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' GhcTags -> LConDeclField GhcPs -> GhcTags
f [] [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields
      where
        f :: GhcTags -> LConDeclField GhcPs -> GhcTags
        f :: GhcTags -> LConDeclField GhcPs -> GhcTags
f GhcTags
ts (L SrcSpanAnnA
_ ConDeclField { [LFieldOcc GhcPs]
cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_names }) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' GhcTags -> LFieldOcc GhcPs -> GhcTags
g GhcTags
ts [LFieldOcc GhcPs]
cd_fld_names
#if !MIN_VERSION_GHC(9,0)
        f ts _ = ts
#endif

        g :: GhcTags -> LFieldOcc GhcPs -> GhcTags
        g :: GhcTags -> LFieldOcc GhcPs -> GhcTags
g GhcTags
ts (L SrcSpan
_ fo :: FieldOcc GhcPs
fo@FieldOcc {}) =
#if MIN_VERSION_GHC(9,4)
            mkGhcTagForMember decLoc (unSpanAnn $ foLabel fo) tyName GtkRecordField
#else
            SrcSpan
-> Located RdrName -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTagForMember SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn forall a b. (a -> b) -> a -> b
$ forall pass.
FieldOcc pass -> GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
rdrNameFieldOcc FieldOcc GhcPs
fo) Located RdrName
tyName GhcTagKind
GtkRecordField
#endif
          forall a. a -> [a] -> [a]
: GhcTags
ts
#if !MIN_VERSION_GHC(9,0)
        g ts _ = ts
#endif

    mkHsConDeclH98Details SrcSpan
_ Located RdrName
_ HsConDeclH98Details GhcPs
_ = []

    mkHsConDeclGADTDetails :: SrcSpan
                           -> Located RdrName
#if !MIN_VERSION_GHC(9,2)
                           -> HsConDeclH98Details  GhcPs
#else
                           -> HsConDeclGADTDetails GhcPs
#endif
                           -> GhcTags
#if !MIN_VERSION_GHC(9,2)
    mkHsConDeclGADTDetails = mkHsConDeclH98Details
#else
#if !MIN_VERSION_GHC(9,4)
    mkHsConDeclGADTDetails :: SrcSpan -> Located RdrName -> HsConDeclGADTDetails GhcPs -> GhcTags
mkHsConDeclGADTDetails SrcSpan
decLoc Located RdrName
tyName (RecConGADT (L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields)) =
#else
    mkHsConDeclGADTDetails decLoc tyName (RecConGADT (L _ fields) _) =
#endif
        forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' GhcTags -> LConDeclField GhcPs -> GhcTags
f [] [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields
      where
        f :: GhcTags -> LConDeclField GhcPs -> GhcTags
        f :: GhcTags -> LConDeclField GhcPs -> GhcTags
f GhcTags
ts (L SrcSpanAnnA
_ ConDeclField { [LFieldOcc GhcPs]
cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names }) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' GhcTags -> LFieldOcc GhcPs -> GhcTags
g GhcTags
ts [LFieldOcc GhcPs]
cd_fld_names

        g :: GhcTags -> LFieldOcc GhcPs -> GhcTags
        g :: GhcTags -> LFieldOcc GhcPs -> GhcTags
g GhcTags
ts (L SrcSpan
_ FieldOcc GhcPs
fo) =
#if MIN_VERSION_GHC(9,4)
            mkGhcTagForMember decLoc (unSpanAnn $ foLabel fo) tyName GtkRecordField
#else
            SrcSpan
-> Located RdrName -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTagForMember SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn forall a b. (a -> b) -> a -> b
$ forall pass.
FieldOcc pass -> GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
rdrNameFieldOcc FieldOcc GhcPs
fo) Located RdrName
tyName GhcTagKind
GtkRecordField
#endif
          forall a. a -> [a] -> [a]
: GhcTags
ts
    mkHsConDeclGADTDetails SrcSpan
_ Located RdrName
_ HsConDeclGADTDetails GhcPs
_ = []
#endif


    mkHsBindLRTags :: SrcSpan
                   -- ^ declaration's 'SrcSpan'
                   -> HsBindLR GhcPs GhcPs
                   -> GhcTags
    mkHsBindLRTags :: SrcSpan -> HsBindLR GhcPs GhcPs -> GhcTags
mkHsBindLRTags SrcSpan
decLoc HsBindLR GhcPs GhcPs
hsBind =
      case HsBindLR GhcPs GhcPs
hsBind of
        FunBind { LIdP GhcPs
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id :: LIdP GhcPs
fun_id, MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches :: MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches } ->
          let binds :: [HsLocalBinds GhcPs]
binds = forall a b. (a -> b) -> [a] -> [b]
map (forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p body. Match p body -> GRHSs p body
m_grhss forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc)
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts
                    forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches
          in   SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
fun_id) GhcTagKind
GtkFunction
             forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
#if MIN_VERSION_GHC(9,2)
                 (SrcSpan -> HsLocalBinds GhcPs -> GhcTags
mkHsLocalBindsTags SrcSpan
decLoc)
#else
                 (mkHsLocalBindsTags decLoc . unLoc)
#endif
                 [HsLocalBinds GhcPs]
binds

        -- TODO
        -- This is useful to generating tags for
        -- ````
        -- Just x = lhs
        -- ```
        PatBind {} -> []

        VarBind { IdP GhcPs
var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id :: IdP GhcPs
var_id, var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
var_rhs = L SrcSpanAnnA
srcSpan HsExpr GhcPs
_ } ->
          [SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
srcSpan IdP GhcPs
var_id) GhcTagKind
GtkTerm]

#if !MIN_VERSION_GHC(9,4)
        -- abstraction binding is only used after translation
        AbsBinds {} -> []
#endif

        PatSynBind XPatSynBind GhcPs GhcPs
_ PSB { LIdP GhcPs
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id :: LIdP GhcPs
psb_id } -> [SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
psb_id) GhcTagKind
GtkPatternSynonym]
#if !MIN_VERSION_GHC(9,0)
        PatSynBind _ XPatSynBind {} -> []
#endif

#if !MIN_VERSION_GHC(9,0)
        XHsBindsLR {} -> []
#endif


    mkClsMemberTags :: SrcSpan -> Located RdrName -> Sig GhcPs -> GhcTags
    mkClsMemberTags :: SrcSpan -> Located RdrName -> Sig GhcPs -> GhcTags
mkClsMemberTags SrcSpan
decLoc Located RdrName
clsName (TypeSig   XTypeSig GhcPs
_ [LIdP GhcPs]
lhs LHsSigWcType GhcPs
hsSigWcType) =
      ( (\Located RdrName
n -> SrcSpan
-> Located RdrName -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTagForMember SrcSpan
decLoc Located RdrName
n Located RdrName
clsName (LHsSigWcType GhcPs -> GhcTagKind
GtkTypeSignature LHsSigWcType GhcPs
hsSigWcType))
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn )
      forall a b. (a -> b) -> [a] -> [b]
`map` [LIdP GhcPs]
lhs
    mkClsMemberTags SrcSpan
decLoc Located RdrName
clsName (PatSynSig XPatSynSig GhcPs
_ [LIdP GhcPs]
lhs LHsSigType GhcPs
_) =
      ( (\Located RdrName
n -> SrcSpan
-> Located RdrName -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTagForMember SrcSpan
decLoc Located RdrName
n Located RdrName
clsName GhcTagKind
GtkPatternSynonym)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn )
      forall a b. (a -> b) -> [a] -> [b]
`map` [LIdP GhcPs]
lhs
#if !MIN_VERSION_GHC(9,2)
    mkClsMemberTags decLoc clsName (ClassOpSig _ _ lhs HsIB { hsib_body = L _ hsType}) =
#else
    mkClsMemberTags SrcSpan
decLoc Located RdrName
clsName (ClassOpSig XClassOpSig GhcPs
_ Bool
_ [LIdP GhcPs]
lhs (L SrcSpanAnnA
_ HsSigType GhcPs
hsType)) =
#endif
      ( (\Located RdrName
n -> SrcSpan
-> Located RdrName -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTagForMember SrcSpan
decLoc Located RdrName
n Located RdrName
clsName
                                (HsType GhcPs -> GhcTagKind
GtkTypeClassMember forall a b. (a -> b) -> a -> b
$ HsSigType GhcPs -> HsType GhcPs
hsSigTypeToHsType HsSigType GhcPs
hsType))
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn )
     forall a b. (a -> b) -> [a] -> [b]
`map` [LIdP GhcPs]
lhs
    mkClsMemberTags SrcSpan
_ Located RdrName
_ Sig GhcPs
_ = []


    mkSigTags :: SrcSpan -> Sig GhcPs -> GhcTags
    mkSigTags :: SrcSpan -> Sig GhcPs -> GhcTags
mkSigTags SrcSpan
decLoc (TypeSig   XTypeSig GhcPs
_ [LIdP GhcPs]
lhs LHsSigWcType GhcPs
hsSigWcType)
                                       = ( forall a b c. (a -> b -> c) -> b -> a -> c
flip (SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc)
                                                (LHsSigWcType GhcPs -> GhcTagKind
GtkTypeSignature LHsSigWcType GhcPs
hsSigWcType)
                                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn )
                                         forall a b. (a -> b) -> [a] -> [b]
`map` [LIdP GhcPs]
lhs
    mkSigTags SrcSpan
decLoc (PatSynSig XPatSynSig GhcPs
_ [LIdP GhcPs]
lhs LHsSigType GhcPs
_)
                                       = ( forall a b c. (a -> b -> c) -> b -> a -> c
flip (SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc) GhcTagKind
GtkPatternSynonym
                                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn )
                                         forall a b. (a -> b) -> [a] -> [b]
`map` [LIdP GhcPs]
lhs
#if !MIN_VERSION_GHC(9,2)
    mkSigTags decLoc (ClassOpSig _ _ lhs HsIB { hsib_body = L _ hsType })
#else
    mkSigTags SrcSpan
decLoc (ClassOpSig XClassOpSig GhcPs
_ Bool
_ [LIdP GhcPs]
lhs (L SrcSpanAnnA
_ HsSigType GhcPs
hsType))
#endif
                                       = ( forall a b c. (a -> b -> c) -> b -> a -> c
flip (SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc)
                                                ( HsType GhcPs -> GhcTagKind
GtkTypeClassMember
                                                forall a b. (a -> b) -> a -> b
$ HsSigType GhcPs -> HsType GhcPs
hsSigTypeToHsType HsSigType GhcPs
hsType )
                                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn
                                         )
                                         forall a b. (a -> b) -> [a] -> [b]
`map` [LIdP GhcPs]
lhs
#if !MIN_VERSION_GHC(9,0)
    mkSigTags _ (ClassOpSig _ _ _ XHsImplicitBndrs {})
                                       = []
#endif
#if !MIN_VERSION_GHC(9,6)
    mkSigTags SrcSpan
_ IdSig {}               = []
#endif
    -- TODO: generate theses with additional info (fixity)
    mkSigTags SrcSpan
_ FixSig {}              = []
    mkSigTags SrcSpan
_ InlineSig {}           = []
    -- SPECIALISE pragmas
    mkSigTags SrcSpan
_ SpecSig {}             = []
    mkSigTags SrcSpan
_ SpecInstSig {}         = []
    -- MINIMAL pragma
    mkSigTags SrcSpan
_ MinimalSig {}          = []
    -- SSC pragma
    mkSigTags SrcSpan
_ SCCFunSig {}           = []
    -- COMPLETE pragma
    mkSigTags SrcSpan
_ CompleteMatchSig {}    = []
#if !MIN_VERSION_GHC(9,0)
    mkSigTags _ XSig {}                = []
#endif


    mkFamilyDeclTags :: SrcSpan
                     -> FamilyDecl GhcPs
                     -- ^ declaration's 'SrcSpan'
                     -> Maybe (Located RdrName)
                     -- if this type family is associate, pass the name of the
                     -- associated class
                     -> Maybe GhcTag
    mkFamilyDeclTags :: SrcSpan
-> FamilyDecl GhcPs -> Maybe (Located RdrName) -> Maybe GhcTag
mkFamilyDeclTags SrcSpan
decLoc FamilyDecl { LIdP GhcPs
fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName :: LIdP GhcPs
fdLName, FamilyInfo GhcPs
fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo :: FamilyInfo GhcPs
fdInfo, LHsQTyVars GhcPs
fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars :: LHsQTyVars GhcPs
fdTyVars, fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdResultSig = L SrcSpan
_ FamilyResultSig GhcPs
familyResultSig } Maybe (Located RdrName)
assocClsName =
      case Maybe (Located RdrName)
assocClsName of
        Maybe (Located RdrName)
Nothing      -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
fdLName) GhcTagKind
tk
        Just Located RdrName
clsName -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SrcSpan
-> Located RdrName -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTagForMember SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
fdLName) Located RdrName
clsName GhcTagKind
tk
      where

        mb_fdvars :: Maybe [HsTyVarBndr () GhcPs]
mb_fdvars = case LHsQTyVars GhcPs
fdTyVars of
          HsQTvs { [LHsTyVarBndr () GhcPs]
hsq_explicit :: forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsq_explicit :: [LHsTyVarBndr () GhcPs]
hsq_explicit } -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> [a] -> [b]
`map` [LHsTyVarBndr () GhcPs]
hsq_explicit
#if !MIN_VERSION_GHC(9,0)
          XLHsQTyVars {} -> Nothing
#endif
        mb_resultsig :: Maybe (Either (HsType GhcPs) (HsTyVarBndr () GhcPs))
mb_resultsig = FamilyResultSig GhcPs
-> Maybe (Either (HsType GhcPs) (HsTyVarBndr () GhcPs))
famResultKindSignature FamilyResultSig GhcPs
familyResultSig

        mb_typesig :: Maybe
  ([HsTyVarBndr () GhcPs],
   Either (HsType GhcPs) (HsTyVarBndr () GhcPs))
mb_typesig = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [HsTyVarBndr () GhcPs]
mb_fdvars forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Either (HsType GhcPs) (HsTyVarBndr () GhcPs))
mb_resultsig

        tk :: GhcTagKind
tk = case FamilyInfo GhcPs
fdInfo of
              FamilyInfo GhcPs
DataFamily           -> Maybe
  ([HsTyVarBndr () GhcPs],
   Either (HsType GhcPs) (HsTyVarBndr () GhcPs))
-> GhcTagKind
GtkDataTypeFamily Maybe
  ([HsTyVarBndr () GhcPs],
   Either (HsType GhcPs) (HsTyVarBndr () GhcPs))
mb_typesig
              FamilyInfo GhcPs
OpenTypeFamily       -> Maybe
  ([HsTyVarBndr () GhcPs],
   Either (HsType GhcPs) (HsTyVarBndr () GhcPs))
-> GhcTagKind
GtkTypeFamily     Maybe
  ([HsTyVarBndr () GhcPs],
   Either (HsType GhcPs) (HsTyVarBndr () GhcPs))
mb_typesig
              ClosedTypeFamily {}  -> Maybe
  ([HsTyVarBndr () GhcPs],
   Either (HsType GhcPs) (HsTyVarBndr () GhcPs))
-> GhcTagKind
GtkTypeFamily     Maybe
  ([HsTyVarBndr () GhcPs],
   Either (HsType GhcPs) (HsTyVarBndr () GhcPs))
mb_typesig
#if !MIN_VERSION_GHC(9,0)
    mkFamilyDeclTags _ XFamilyDecl {} _ = Nothing
#endif


    -- used to generate tag of an instance declaration
    mkLHsTypeTag :: SrcSpan
                 -- declaration's 'SrcSpan'
                 -> LHsType GhcPs
                 -> Maybe GhcTag
    mkLHsTypeTag :: SrcSpan -> LHsType GhcPs -> Maybe GhcTag
mkLHsTypeTag SrcSpan
decLoc (L SrcSpanAnnA
_ HsType GhcPs
hsType) =
      (\Located RdrName
a -> SrcSpan -> GhcTag -> GhcTag
fixLoc SrcSpan
decLoc forall a b. (a -> b) -> a -> b
$ Located RdrName -> GhcTagKind -> Bool -> GhcTag
mkGhcTag Located RdrName
a (HsType GhcPs -> GhcTagKind
GtkTypeClassInstance HsType GhcPs
hsType) Bool
True)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsType GhcPs -> Maybe (Located RdrName)
hsTypeTagName HsType GhcPs
hsType


    hsTypeTagName :: HsType GhcPs -> Maybe (Located RdrName)
    hsTypeTagName :: HsType GhcPs -> Maybe (Located RdrName)
hsTypeTagName HsType GhcPs
hsType =
      case HsType GhcPs
hsType of
        HsForAllTy {LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_body :: LHsType GhcPs
hst_body} -> HsType GhcPs -> Maybe (Located RdrName)
hsTypeTagName (forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
hst_body)

        HsQualTy {LHsType GhcPs
hst_body :: LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_body}   -> HsType GhcPs -> Maybe (Located RdrName)
hsTypeTagName (forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
hst_body)

        HsTyVar XTyVar GhcPs
_ PromotionFlag
_ LIdP GhcPs
a         -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
a

        HsAppTy XAppTy GhcPs
_ LHsType GhcPs
a LHsType GhcPs
_         -> HsType GhcPs -> Maybe (Located RdrName)
hsTypeTagName (forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
a)
#if MIN_VERSION_GHC(9,4)
        HsOpTy _ _ _ a _      -> Just $ unSpanAnn a
#else
        HsOpTy XOpTy GhcPs
_ LHsType GhcPs
_ LIdP GhcPs
a LHsType GhcPs
_        -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
a
#endif
        HsKindSig XKindSig GhcPs
_ LHsType GhcPs
a LHsType GhcPs
_       -> HsType GhcPs -> Maybe (Located RdrName)
hsTypeTagName (forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
a)

        HsType GhcPs
_                     -> forall a. Maybe a
Nothing


    -- data family instance declaration
    --
    mkDataFamInstDeclTag :: SrcSpan -> DataFamInstDecl GhcPs -> GhcTags
    mkDataFamInstDeclTag :: SrcSpan -> DataFamInstDecl GhcPs -> GhcTags
mkDataFamInstDeclTag SrcSpan
decLoc DataFamInstDecl { FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
dfid_eqn :: FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn } =
      case FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn of
#if !MIN_VERSION_GHC(9,0)
        XHsImplicitBndrs {} -> []
#endif

#if !MIN_VERSION_GHC(9,2)
        HsIB { hsib_body = FamEqn { feqn_tycon, feqn_rhs } } ->
#else
        FamEqn { LIdP GhcPs
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon :: LIdP GhcPs
feqn_tycon, HsDataDefn GhcPs
feqn_rhs :: HsDataDefn GhcPs
feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs } ->
#endif
          case HsDataDefn GhcPs
feqn_rhs of
            HsDataDefn { [LConDecl GhcPs]
dd_cons :: [LConDecl GhcPs]
dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons, Maybe (LHsType GhcPs)
dd_kindSig :: Maybe (LHsType GhcPs)
dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig } ->
                SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
feqn_tycon)
                          (Maybe (HsType GhcPs) -> GhcTagKind
GtkDataTypeFamilyInstance
                            (forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LHsType GhcPs)
dd_kindSig))
              forall a. a -> [a] -> [a]
: (SrcSpan -> Located RdrName -> ConDecl GhcPs -> GhcTags
mkConsTags SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
feqn_tycon) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc)
                forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
`concatMap` [LConDecl GhcPs]
dd_cons

#if !MIN_VERSION_GHC(9,0)
            XHsDataDefn {} ->
              [mkGhcTag' decLoc feqn_tycon (GtkDataTypeFamilyInstance Nothing)]

        HsIB { hsib_body = XFamEqn {} } -> []
#endif


    -- type family instance declaration
    --
    mkTyFamInstDeclTag :: SrcSpan -> TyFamInstDecl GhcPs -> Maybe GhcTag
    mkTyFamInstDeclTag :: SrcSpan -> TyFamInstDecl GhcPs -> Maybe GhcTag
mkTyFamInstDeclTag SrcSpan
decLoc decl :: TyFamInstDecl GhcPs
decl@TyFamInstDecl { TyFamInstEqn GhcPs
tfid_eqn :: TyFamInstEqn GhcPs
tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_eqn } =
      case TyFamInstEqn GhcPs
tfid_eqn of
#if !MIN_VERSION_GHC(9,0)
        XHsImplicitBndrs {} -> Nothing
#endif

        -- TODO: should we check @feqn_rhs :: LHsType GhcPs@ as well?
#if !MIN_VERSION_GHC(9,2)
        HsIB { hsib_body = FamEqn { feqn_tycon } } ->
#else
        FamEqn { LIdP GhcPs
feqn_tycon :: LIdP GhcPs
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon } ->
#endif
          forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SrcSpan -> Located RdrName -> GhcTagKind -> GhcTag
mkGhcTag' SrcSpan
decLoc (forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn LIdP GhcPs
feqn_tycon) (Maybe (TyFamInstDecl GhcPs) -> GhcTagKind
GtkTypeFamilyInstance (forall a. a -> Maybe a
Just TyFamInstDecl GhcPs
decl))

#if !MIN_VERSION_GHC(9,0)
        HsIB { hsib_body = XFamEqn {} } -> Nothing
#endif

#if !MIN_VERSION_GHC(9,2)
unSpanAnn :: Located RdrName -> Located RdrName
unSpanAnn = id
#else
unSpanAnn :: GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn :: forall x. GenLocated (SrcSpanAnn' x) RdrName -> Located RdrName
unSpanAnn (L SrcSpanAnn' x
s RdrName
a) = forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' x
s) RdrName
a
#endif

#if !MIN_VERSION_GHC(9,2)
locAnn :: SrcSpan -> SrcSpan
locAnn = id
#else
locAnn :: SrcSpanAnn' a -> SrcSpan
locAnn :: forall a. SrcSpanAnn' a -> SrcSpan
locAnn = forall a. SrcSpanAnn' a -> SrcSpan
locA
#endif

#if !MIN_VERSION_GHC(9,2)
hsSigTypeToHsType :: HsType GhcPs -> HsType GhcPs
hsSigTypeToHsType = id
#else
hsSigTypeToHsType :: HsSigType GhcPs -> HsType GhcPs
hsSigTypeToHsType :: HsSigType GhcPs -> HsType GhcPs
hsSigTypeToHsType = forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. HsSigType pass -> LHsType pass
sig_body
#endif

--
--
--

famResultKindSignature :: FamilyResultSig GhcPs
                       -> Maybe (Either (HsKind GhcPs) GhcPsHsTyVarBndr)
famResultKindSignature :: FamilyResultSig GhcPs
-> Maybe (Either (HsType GhcPs) (HsTyVarBndr () GhcPs))
famResultKindSignature (NoSig XNoSig GhcPs
_)           = forall a. Maybe a
Nothing
famResultKindSignature (KindSig XCKindSig GhcPs
_ LHsType GhcPs
ki)      = forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
ki))
famResultKindSignature (TyVarSig XTyVarSig GhcPs
_ LHsTyVarBndr () GhcPs
bndr)   = forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (forall l e. GenLocated l e -> e
unLoc LHsTyVarBndr () GhcPs
bndr))
#if !MIN_VERSION_GHC(9,0)
famResultKindSignature XFamilyResultSig {} = Nothing
#endif