{-# LANGUAGE CPP #-}

-- | Parser compaibility module.
module Development.IDE.GHC.Compat.Parser (
    initParserOpts,
    initParserState,
#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0)
    -- in GHC == 9.2 the type doesn't exist
    -- In GHC == 9.0 it is a data-type
    -- and GHC < 9.0 it is type-def
    --
    -- Export data-type here, otherwise only the simple type.
    Anno.ApiAnns(..),
#else
    ApiAnns,
#endif
    mkHsParsedModule,
    mkParsedModule,
    mkApiAnns,
    -- * API Annotations
    Anno.AnnKeywordId(..),
    Anno.AnnotationComment(..),
    ) where

#if MIN_VERSION_ghc(9,0,0)
import qualified GHC.Parser.Lexer                as Lexer
#if MIN_VERSION_ghc(9,2,0)
import qualified GHC.Driver.Config               as Config
import           GHC.Parser.Lexer                hiding (initParserState)
#else
import qualified GHC.Parser.Annotation           as Anno
#endif
#else
import qualified ApiAnnotation                   as Anno
import           Lexer
import qualified SrcLoc
#endif
import           Development.IDE.GHC.Compat.Core
import           Development.IDE.GHC.Compat.Util

#if !MIN_VERSION_ghc(9,2,0)
import qualified Data.Map                        as Map
#endif

#if !MIN_VERSION_ghc(9,0,0)
type ParserOpts = DynFlags
#elif !MIN_VERSION_ghc(9,2,0)
type ParserOpts = Lexer.ParserFlags
#endif

initParserOpts :: DynFlags -> ParserOpts
initParserOpts :: DynFlags -> DynFlags
initParserOpts =
#if MIN_VERSION_ghc(9,2,0)
  Config.initParserOpts
#elif MIN_VERSION_ghc(9,0,0)
  Lexer.mkParserFlags
#else
  DynFlags -> DynFlags
forall a. a -> a
id
#endif

initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState
initParserState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState
initParserState =
#if MIN_VERSION_ghc(9,2,0)
  Lexer.initParserState
#elif MIN_VERSION_ghc(9,0,0)
  Lexer.mkPStatePure
#else
  DynFlags -> StringBuffer -> RealSrcLoc -> PState
Lexer.mkPState
#endif

#if MIN_VERSION_ghc(9,2,0)
type ApiAnns = ()
#else
type ApiAnns = Anno.ApiAnns
#endif


mkHsParsedModule :: ParsedSource -> [FilePath] -> ApiAnns -> HsParsedModule
mkHsParsedModule :: ParsedSource -> [FilePath] -> ApiAnns -> HsParsedModule
mkHsParsedModule ParsedSource
parsed [FilePath]
fps ApiAnns
hpm_annotations =
  ParsedSource -> [FilePath] -> ApiAnns -> HsParsedModule
HsParsedModule
    ParsedSource
parsed
    [FilePath]
fps
#if !MIN_VERSION_ghc(9,2,0)
    ApiAnns
hpm_annotations
#endif


mkParsedModule :: ModSummary -> ParsedSource -> [FilePath] -> ApiAnns -> ParsedModule
mkParsedModule :: ModSummary -> ParsedSource -> [FilePath] -> ApiAnns -> ParsedModule
mkParsedModule ModSummary
ms ParsedSource
parsed [FilePath]
extra_src_files ApiAnns
_hpm_annotations =
  ParsedModule :: ModSummary -> ParsedSource -> [FilePath] -> ApiAnns -> ParsedModule
ParsedModule {
    pm_mod_summary :: ModSummary
pm_mod_summary = ModSummary
ms
  , pm_parsed_source :: ParsedSource
pm_parsed_source = ParsedSource
parsed
  , pm_extra_src_files :: [FilePath]
pm_extra_src_files = [FilePath]
extra_src_files
#if !MIN_VERSION_ghc(9,2,0)
  , pm_annotations :: ApiAnns
pm_annotations = ApiAnns
_hpm_annotations
#endif
  }

mkApiAnns :: PState -> ApiAnns
#if MIN_VERSION_ghc(9,2,0)
mkApiAnns = const ()
#else
mkApiAnns :: PState -> ApiAnns
mkApiAnns PState
pst =
#if MIN_VERSION_ghc(9,0,1)
    -- Copied from GHC.Driver.Main
    Anno.ApiAnns {
            apiAnnItems = Map.fromListWith (++) $ annotations pst,
            apiAnnEofPos = eof_pos pst,
            apiAnnComments = Map.fromList (annotations_comments pst),
            apiAnnRogueComments = comment_q pst
        }
#else
    (([SrcSpan] -> [SrcSpan] -> [SrcSpan])
-> [(ApiAnnKey, [SrcSpan])] -> Map ApiAnnKey [SrcSpan]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
(++) ([(ApiAnnKey, [SrcSpan])] -> Map ApiAnnKey [SrcSpan])
-> [(ApiAnnKey, [SrcSpan])] -> Map ApiAnnKey [SrcSpan]
forall a b. (a -> b) -> a -> b
$ PState -> [(ApiAnnKey, [SrcSpan])]
annotations PState
pst,
     [(SrcSpan, [Located AnnotationComment])]
-> Map SrcSpan [Located AnnotationComment]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((SrcSpan
SrcLoc.noSrcSpan,PState -> [Located AnnotationComment]
comment_q PState
pst)
                  (SrcSpan, [Located AnnotationComment])
-> [(SrcSpan, [Located AnnotationComment])]
-> [(SrcSpan, [Located AnnotationComment])]
forall a. a -> [a] -> [a]
:PState -> [(SrcSpan, [Located AnnotationComment])]
annotations_comments PState
pst))
#endif
#endif