-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE CPP               #-}
{-# LANGUAGE ConstraintKinds   #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms   #-}
{-# OPTIONS -Wno-incomplete-uni-patterns -Wno-dodgy-imports #-}

-- | Attempt at hiding the GHC version differences we can.
module Development.IDE.GHC.Compat(
    NameCacheUpdater(..),
    hPutStringBuffer,
    addIncludePathsQuote,
    getModuleHash,
    setUpTypedHoles,
    upNameCache,
    disableWarningsAsErrors,
    reLoc,
    reLocA,
    getMessages',
    pattern PFailedWithErrorMessages,

#if !MIN_VERSION_ghc(9,0,1)
    RefMap,
#endif

#if MIN_VERSION_ghc(9,2,0)
    extendModSummaryNoDeps,
    emsModSummary,
#endif

    nodeInfo',
    getNodeIds,
    nodeInfoFromSource,
    isAnnotationInNodeInfo,
    mkAstNode,
    combineRealSrcSpans,

    isQualifiedImport,
    GhcVersion(..),
    ghcVersion,
    ghcVersionStr,
    -- * HIE Compat
    HieFileResult(..),
    HieFile(..),
    hieExportNames,
    mkHieFile',
    enrichHie,
    writeHieFile,
    readHieFile,
    supportsHieFiles,
    setHieDir,
    dontWriteHieFiles,
    module Compat.HieTypes,
    module Compat.HieUtils,
    -- * Compat modules
    module Development.IDE.GHC.Compat.Core,
    module Development.IDE.GHC.Compat.Env,
    module Development.IDE.GHC.Compat.ExactPrint,
    module Development.IDE.GHC.Compat.Iface,
    module Development.IDE.GHC.Compat.Logger,
    module Development.IDE.GHC.Compat.Outputable,
    module Development.IDE.GHC.Compat.Parser,
    module Development.IDE.GHC.Compat.Plugins,
    module Development.IDE.GHC.Compat.Units,
    -- * Extras that rely on compat modules
    -- * SysTools
    Option (..),
    runUnlit,
    runPp,
    ) where

import           Development.IDE.GHC.Compat.Core
import           Development.IDE.GHC.Compat.Env
import           Development.IDE.GHC.Compat.ExactPrint
import           Development.IDE.GHC.Compat.Iface
import           Development.IDE.GHC.Compat.Logger
import           Development.IDE.GHC.Compat.Outputable
import           Development.IDE.GHC.Compat.Parser
import           Development.IDE.GHC.Compat.Plugins
import           Development.IDE.GHC.Compat.Units
import           Development.IDE.GHC.Compat.Util
import           GHC                                   hiding (HasSrcSpan,
                                                        ModLocation,
                                                        RealSrcSpan, getLoc,
                                                        lookupName)

#if MIN_VERSION_ghc(9,0,0)
import           GHC.Data.StringBuffer
import           GHC.Driver.Session                    hiding (ExposePackage)
import qualified GHC.Types.SrcLoc                      as SrcLoc
import           GHC.Utils.Error
#if MIN_VERSION_ghc(9,2,0)
import           Data.Bifunctor
import           GHC.Driver.Env                        as Env
import           GHC.Unit.Module.ModIface
import           GHC.Unit.Module.ModSummary
#else
import           GHC.Driver.Types
#endif
import           GHC.Iface.Env
import           GHC.Iface.Make                        (mkIfaceExports)
import qualified GHC.SysTools.Tasks                    as SysTools
import qualified GHC.Types.Avail                       as Avail
#else
import qualified Avail
import           DynFlags                              hiding (ExposePackage)
import           HscTypes
import           MkIface                               hiding (writeIfaceFile)

#if MIN_VERSION_ghc(8,8,0)
import           StringBuffer                          (hPutStringBuffer)
#endif
import qualified SysTools

#if !MIN_VERSION_ghc(8,8,0)
import qualified EnumSet
import           SrcLoc                                (RealLocated)

import           Foreign.ForeignPtr
import           System.IO
#endif
#endif

import           Compat.HieAst                         (enrichHie)
import           Compat.HieBin
import           Compat.HieTypes
import           Compat.HieUtils
import qualified Data.ByteString                       as BS
import           Data.IORef

import           Data.List                             (foldl')
import qualified Data.Map                              as Map
import qualified Data.Set                              as Set

#if MIN_VERSION_ghc(9,0,0)
import qualified Data.Set                              as S
#endif

#if !MIN_VERSION_ghc(8,10,0)
import           Bag                                   (unitBag)
#endif

#if !MIN_VERSION_ghc(9,2,0)
reLoc :: Located a -> Located a
reLoc :: Located a -> Located a
reLoc = Located a -> Located a
forall a. a -> a
id

reLocA :: Located a -> Located a
reLocA :: Located a -> Located a
reLocA = Located a -> Located a
forall a. a -> a
id
#endif

#if !MIN_VERSION_ghc(8,8,0)
hPutStringBuffer :: Handle -> StringBuffer -> IO ()
hPutStringBuffer hdl (StringBuffer buf len cur)
    = withForeignPtr (plusForeignPtr buf cur) $ \ptr ->
             hPutBuf hdl ptr len
#endif

#if MIN_VERSION_ghc(9,2,0)
type ErrMsg  = MsgEnvelope DecoratedSDoc
#endif

getMessages' :: PState -> DynFlags -> (Bag WarnMsg, Bag ErrMsg)
getMessages' :: PState -> DynFlags -> (Bag WarnMsg, Bag WarnMsg)
getMessages' PState
pst DynFlags
dflags =
#if MIN_VERSION_ghc(9,2,0)
                 bimap (fmap pprWarning) (fmap pprError) $
#endif
                 PState -> DynFlags -> (Bag WarnMsg, Bag WarnMsg)
getMessages PState
pst
#if !MIN_VERSION_ghc(9,2,0)
                   DynFlags
dflags
#endif

#if MIN_VERSION_ghc(9,2,0)
pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a
pattern PFailedWithErrorMessages msgs
     <- PFailed (const . fmap pprError . getErrorMessages -> msgs)
#elif MIN_VERSION_ghc(8,10,0)
pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a
pattern $mPFailedWithErrorMessages :: forall r a.
ParseResult a
-> ((DynFlags -> Bag WarnMsg) -> r) -> (Void# -> r) -> r
PFailedWithErrorMessages msgs
     <- PFailed (getErrorMessages -> msgs)
#else
pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a
pattern PFailedWithErrorMessages msgs
     <- ((fmap.fmap) unitBag . mkPlainErrMsgIfPFailed -> Just msgs)

mkPlainErrMsgIfPFailed (PFailed _ pst err) = Just (\dflags -> mkPlainErrMsg dflags pst err)
mkPlainErrMsgIfPFailed _ = Nothing
#endif
{-# COMPLETE PFailedWithErrorMessages #-}

supportsHieFiles :: Bool
supportsHieFiles :: Bool
supportsHieFiles = Bool
True

hieExportNames :: HieFile -> [(SrcSpan, Name)]
hieExportNames :: HieFile -> [(SrcSpan, Name)]
hieExportNames = [AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails ([AvailInfo] -> [(SrcSpan, Name)])
-> (HieFile -> [AvailInfo]) -> HieFile -> [(SrcSpan, Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> [AvailInfo]
hie_exports


upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
#if MIN_VERSION_ghc(8,8,0)
upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
upNameCache = IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
forall c. IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
updNameCache
#else
upNameCache ref upd_fn
  = atomicModifyIORef' ref upd_fn
#endif

#if !MIN_VERSION_ghc(9,0,1)
type RefMap a = Map.Map Identifier [(Span, IdentifierDetails a)]
#endif

mkHieFile' :: ModSummary
           -> [Avail.AvailInfo]
           -> HieASTs Type
           -> BS.ByteString
           -> Hsc HieFile
mkHieFile' :: ModSummary
-> [AvailInfo] -> HieASTs Type -> ByteString -> Hsc HieFile
mkHieFile' ModSummary
ms [AvailInfo]
exports HieASTs Type
asts ByteString
src = do
  let Just FilePath
src_file = ModLocation -> Maybe FilePath
ml_hs_file (ModLocation -> Maybe FilePath) -> ModLocation -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
ms
      (HieASTs TypeIndex
asts',Array TypeIndex HieTypeFlat
arr) = HieASTs Type -> (HieASTs TypeIndex, Array TypeIndex HieTypeFlat)
compressTypes HieASTs Type
asts
  HieFile -> Hsc HieFile
forall (m :: * -> *) a. Monad m => a -> m a
return (HieFile -> Hsc HieFile) -> HieFile -> Hsc HieFile
forall a b. (a -> b) -> a -> b
$ HieFile :: FilePath
-> Module
-> Array TypeIndex HieTypeFlat
-> HieASTs TypeIndex
-> [AvailInfo]
-> ByteString
-> HieFile
HieFile
      { hie_hs_file :: FilePath
hie_hs_file = FilePath
src_file
      , hie_module :: Module
hie_module = ModSummary -> Module
ms_mod ModSummary
ms
      , hie_types :: Array TypeIndex HieTypeFlat
hie_types = Array TypeIndex HieTypeFlat
arr
      , hie_asts :: HieASTs TypeIndex
hie_asts = HieASTs TypeIndex
asts'
      -- mkIfaceExports sorts the AvailInfos for stability
      , hie_exports :: [AvailInfo]
hie_exports = [AvailInfo] -> [AvailInfo]
mkIfaceExports [AvailInfo]
exports
      , hie_hs_src :: ByteString
hie_hs_src = ByteString
src
      }

addIncludePathsQuote :: FilePath -> DynFlags -> DynFlags
addIncludePathsQuote :: FilePath -> DynFlags -> DynFlags
addIncludePathsQuote FilePath
path DynFlags
x = DynFlags
x{includePaths :: IncludeSpecs
includePaths = IncludeSpecs -> IncludeSpecs
f (IncludeSpecs -> IncludeSpecs) -> IncludeSpecs -> IncludeSpecs
forall a b. (a -> b) -> a -> b
$ DynFlags -> IncludeSpecs
includePaths DynFlags
x}
    where f :: IncludeSpecs -> IncludeSpecs
f IncludeSpecs
i = IncludeSpecs
i{includePathsQuote :: [FilePath]
includePathsQuote = FilePath
path FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: IncludeSpecs -> [FilePath]
includePathsQuote IncludeSpecs
i}

setHieDir :: FilePath -> DynFlags -> DynFlags
setHieDir :: FilePath -> DynFlags -> DynFlags
setHieDir FilePath
_f DynFlags
d =
#if MIN_VERSION_ghc(8,8,0)
    DynFlags
d { hieDir :: Maybe FilePath
hieDir     = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
_f}
#else
    d
#endif

dontWriteHieFiles :: DynFlags -> DynFlags
dontWriteHieFiles :: DynFlags -> DynFlags
dontWriteHieFiles DynFlags
d =
#if MIN_VERSION_ghc(8,8,0)
    DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
d GeneralFlag
Opt_WriteHie
#else
    d
#endif

setUpTypedHoles ::DynFlags -> DynFlags
setUpTypedHoles :: DynFlags -> DynFlags
setUpTypedHoles DynFlags
df
  = (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_AbstractRefHoleFits    -- too spammy
#if MIN_VERSION_ghc(8,8,0)
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowDocsOfHoleFits     -- not used
#endif
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowMatchesOfHoleFits  -- nice but broken (forgets module qualifiers)
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowProvOfHoleFits     -- not used
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeAppOfHoleFits  -- not used
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeAppVarsOfHoleFits -- not used
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeOfHoleFits     -- massively simplifies parsing
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_set   GeneralFlag
Opt_SortBySubsumHoleFits   -- very nice and fast enough in most cases
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_SortValidHoleFits
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_UnclutterValidHoleFits
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags
df
  { refLevelHoleFits :: Maybe TypeIndex
refLevelHoleFits = TypeIndex -> Maybe TypeIndex
forall a. a -> Maybe a
Just TypeIndex
1   -- becomes slow at higher levels
  , maxRefHoleFits :: Maybe TypeIndex
maxRefHoleFits   = TypeIndex -> Maybe TypeIndex
forall a. a -> Maybe a
Just TypeIndex
10  -- quantity does not impact speed
  , maxValidHoleFits :: Maybe TypeIndex
maxValidHoleFits = Maybe TypeIndex
forall a. Maybe a
Nothing  -- quantity does not impact speed
  }


nameListFromAvails :: [Avail.AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails :: [AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails [AvailInfo]
as =
  (Name -> (SrcSpan, Name)) -> [Name] -> [(SrcSpan, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
n -> (Name -> SrcSpan
nameSrcSpan Name
n, Name
n)) ((AvailInfo -> [Name]) -> [AvailInfo] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [Name]
Avail.availNames [AvailInfo]
as)


getModuleHash :: ModIface -> Fingerprint
#if MIN_VERSION_ghc(8,10,0)
getModuleHash :: ModIface -> Fingerprint
getModuleHash = ModIfaceBackend -> Fingerprint
mi_mod_hash (ModIfaceBackend -> Fingerprint)
-> (ModIface -> ModIfaceBackend) -> ModIface -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> ModIfaceBackend
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts
#else
getModuleHash = mi_mod_hash
#endif


disableWarningsAsErrors :: DynFlags -> DynFlags
disableWarningsAsErrors :: DynFlags -> DynFlags
disableWarningsAsErrors DynFlags
df =
    (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_WarnIsError (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> WarningFlag -> DynFlags)
-> DynFlags -> [WarningFlag] -> DynFlags
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DynFlags -> WarningFlag -> DynFlags
wopt_unset_fatal DynFlags
df [TypeIndex -> WarningFlag
forall a. Enum a => TypeIndex -> a
toEnum TypeIndex
0 ..]

#if !MIN_VERSION_ghc(8,8,0)
wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
wopt_unset_fatal dfs f
    = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }
#endif

isQualifiedImport :: ImportDecl a -> Bool
#if MIN_VERSION_ghc(8,10,0)
isQualifiedImport :: ImportDecl a -> Bool
isQualifiedImport ImportDecl{ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
NotQualified} = Bool
False
isQualifiedImport ImportDecl{}                              = Bool
True
#else
isQualifiedImport ImportDecl{ideclQualified}                = ideclQualified
#endif
isQualifiedImport ImportDecl a
_                                         = Bool
False



#if MIN_VERSION_ghc(9,0,0)
getNodeIds :: HieAST a -> Map.Map Identifier (IdentifierDetails a)
getNodeIds = Map.foldl' combineNodeIds Map.empty . getSourcedNodeInfo . sourcedNodeInfo

combineNodeIds :: Map.Map Identifier (IdentifierDetails a)
                        -> NodeInfo a -> Map.Map Identifier (IdentifierDetails a)
ad `combineNodeIds` (NodeInfo _ _ bd) = Map.unionWith (<>) ad bd

--  Copied from GHC and adjusted to accept TypeIndex instead of Type
-- nodeInfo' :: Ord a => HieAST a -> NodeInfo a
nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
nodeInfo' = Map.foldl' combineNodeInfo' emptyNodeInfo . getSourcedNodeInfo . sourcedNodeInfo

combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
(NodeInfo as ai ad) `combineNodeInfo'` (NodeInfo bs bi bd) =
  NodeInfo (S.union as bs) (mergeSorted ai bi) (Map.unionWith (<>) ad bd)
  where
    mergeSorted :: Ord a => [a] -> [a] -> [a]
    mergeSorted la@(a:as) lb@(b:bs) = case compare a b of
                                        LT -> a : mergeSorted as lb
                                        EQ -> a : mergeSorted as bs
                                        GT -> b : mergeSorted la bs
    mergeSorted as [] = as
    mergeSorted [] bs = bs

#else

getNodeIds :: HieAST a -> NodeIdentifiers a
getNodeIds :: HieAST a -> NodeIdentifiers a
getNodeIds = NodeInfo a -> NodeIdentifiers a
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo a -> NodeIdentifiers a)
-> (HieAST a -> NodeInfo a) -> HieAST a -> NodeIdentifiers a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> NodeInfo a
forall a. HieAST a -> NodeInfo a
nodeInfo
-- import qualified FastString as FS

-- nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
nodeInfo' :: Ord a => HieAST a -> NodeInfo a
nodeInfo' :: HieAST a -> NodeInfo a
nodeInfo' = HieAST a -> NodeInfo a
forall a. HieAST a -> NodeInfo a
nodeInfo
-- type Unit = UnitId
-- moduleUnit :: Module -> Unit
-- moduleUnit = moduleUnitId
-- unhelpfulSpanFS :: FS.FastString -> FS.FastString
-- unhelpfulSpanFS = id
#endif

nodeInfoFromSource :: HieAST a -> Maybe (NodeInfo a)
#if MIN_VERSION_ghc(9,0,0)
nodeInfoFromSource = Map.lookup SourceInfo . getSourcedNodeInfo . sourcedNodeInfo
#else
nodeInfoFromSource :: HieAST a -> Maybe (NodeInfo a)
nodeInfoFromSource = NodeInfo a -> Maybe (NodeInfo a)
forall a. a -> Maybe a
Just (NodeInfo a -> Maybe (NodeInfo a))
-> (HieAST a -> NodeInfo a) -> HieAST a -> Maybe (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> NodeInfo a
forall a. HieAST a -> NodeInfo a
nodeInfo
#endif

data GhcVersion
  = GHC86
  | GHC88
  | GHC810
  | GHC90
  | GHC92
  deriving (GhcVersion -> GhcVersion -> Bool
(GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool) -> Eq GhcVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhcVersion -> GhcVersion -> Bool
$c/= :: GhcVersion -> GhcVersion -> Bool
== :: GhcVersion -> GhcVersion -> Bool
$c== :: GhcVersion -> GhcVersion -> Bool
Eq, Eq GhcVersion
Eq GhcVersion
-> (GhcVersion -> GhcVersion -> Ordering)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> GhcVersion)
-> (GhcVersion -> GhcVersion -> GhcVersion)
-> Ord GhcVersion
GhcVersion -> GhcVersion -> Bool
GhcVersion -> GhcVersion -> Ordering
GhcVersion -> GhcVersion -> GhcVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GhcVersion -> GhcVersion -> GhcVersion
$cmin :: GhcVersion -> GhcVersion -> GhcVersion
max :: GhcVersion -> GhcVersion -> GhcVersion
$cmax :: GhcVersion -> GhcVersion -> GhcVersion
>= :: GhcVersion -> GhcVersion -> Bool
$c>= :: GhcVersion -> GhcVersion -> Bool
> :: GhcVersion -> GhcVersion -> Bool
$c> :: GhcVersion -> GhcVersion -> Bool
<= :: GhcVersion -> GhcVersion -> Bool
$c<= :: GhcVersion -> GhcVersion -> Bool
< :: GhcVersion -> GhcVersion -> Bool
$c< :: GhcVersion -> GhcVersion -> Bool
compare :: GhcVersion -> GhcVersion -> Ordering
$ccompare :: GhcVersion -> GhcVersion -> Ordering
$cp1Ord :: Eq GhcVersion
Ord, TypeIndex -> GhcVersion -> ShowS
[GhcVersion] -> ShowS
GhcVersion -> FilePath
(TypeIndex -> GhcVersion -> ShowS)
-> (GhcVersion -> FilePath)
-> ([GhcVersion] -> ShowS)
-> Show GhcVersion
forall a.
(TypeIndex -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GhcVersion] -> ShowS
$cshowList :: [GhcVersion] -> ShowS
show :: GhcVersion -> FilePath
$cshow :: GhcVersion -> FilePath
showsPrec :: TypeIndex -> GhcVersion -> ShowS
$cshowsPrec :: TypeIndex -> GhcVersion -> ShowS
Show)

ghcVersionStr :: String
ghcVersionStr :: FilePath
ghcVersionStr = VERSION_ghc

ghcVersion :: GhcVersion
#if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
ghcVersion = GHC92
#elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
ghcVersion = GHC90
#elif MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)
ghcVersion :: GhcVersion
ghcVersion = GhcVersion
GHC810
#elif MIN_VERSION_GLASGOW_HASKELL(8,8,0,0)
ghcVersion = GHC88
#elif MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
ghcVersion = GHC86
#endif

runUnlit :: Logger -> DynFlags -> [Option] -> IO ()
runUnlit :: Logger -> DynFlags -> [Option] -> IO ()
runUnlit =
#if MIN_VERSION_ghc(9,2,0)
    SysTools.runUnlit
#else
    (DynFlags -> [Option] -> IO ())
-> Logger -> DynFlags -> [Option] -> IO ()
forall a b. a -> b -> a
const DynFlags -> [Option] -> IO ()
SysTools.runUnlit
#endif

runPp :: Logger -> DynFlags -> [Option] -> IO ()
runPp :: Logger -> DynFlags -> [Option] -> IO ()
runPp =
#if MIN_VERSION_ghc(9,2,0)
    SysTools.runPp
#else
    (DynFlags -> [Option] -> IO ())
-> Logger -> DynFlags -> [Option] -> IO ()
forall a b. a -> b -> a
const DynFlags -> [Option] -> IO ()
SysTools.runPp
#endif

isAnnotationInNodeInfo :: (FastString, FastString) -> NodeInfo a -> Bool
#if MIN_VERSION_ghc(9,2,0)
isAnnotationInNodeInfo (ctor, typ) = Set.member (NodeAnnotation ctor typ) . nodeAnnotations
#else
isAnnotationInNodeInfo :: (FastString, FastString) -> NodeInfo a -> Bool
isAnnotationInNodeInfo (FastString, FastString)
p = (FastString, FastString) -> Set (FastString, FastString) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (FastString, FastString)
p (Set (FastString, FastString) -> Bool)
-> (NodeInfo a -> Set (FastString, FastString))
-> NodeInfo a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> Set (FastString, FastString)
forall a. NodeInfo a -> Set (FastString, FastString)
nodeAnnotations
#endif

mkAstNode :: NodeInfo a -> Span -> [HieAST a] -> HieAST a
#if MIN_VERSION_ghc(9,0,0)
mkAstNode n = Node (SourcedNodeInfo $ Map.singleton GeneratedInfo n)
#else
mkAstNode :: NodeInfo a -> Span -> [HieAST a] -> HieAST a
mkAstNode = NodeInfo a -> Span -> [HieAST a] -> HieAST a
forall a. NodeInfo a -> Span -> [HieAST a] -> HieAST a
Node
#endif

combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
#if MIN_VERSION_ghc(9,2,0)
combineRealSrcSpans = SrcLoc.combineRealSrcSpans
#else
combineRealSrcSpans :: Span -> Span -> Span
combineRealSrcSpans Span
span1 Span
span2
  = RealSrcLoc -> RealSrcLoc -> Span
mkRealSrcSpan (FastString -> TypeIndex -> TypeIndex -> RealSrcLoc
mkRealSrcLoc FastString
file TypeIndex
line_start TypeIndex
col_start) (FastString -> TypeIndex -> TypeIndex -> RealSrcLoc
mkRealSrcLoc FastString
file TypeIndex
line_end TypeIndex
col_end)
  where
    (TypeIndex
line_start, TypeIndex
col_start) = (TypeIndex, TypeIndex)
-> (TypeIndex, TypeIndex) -> (TypeIndex, TypeIndex)
forall a. Ord a => a -> a -> a
min (Span -> TypeIndex
srcSpanStartLine Span
span1, Span -> TypeIndex
srcSpanStartCol Span
span1)
                                  (Span -> TypeIndex
srcSpanStartLine Span
span2, Span -> TypeIndex
srcSpanStartCol Span
span2)
    (TypeIndex
line_end, TypeIndex
col_end)     = (TypeIndex, TypeIndex)
-> (TypeIndex, TypeIndex) -> (TypeIndex, TypeIndex)
forall a. Ord a => a -> a -> a
max (Span -> TypeIndex
srcSpanEndLine Span
span1, Span -> TypeIndex
srcSpanEndCol Span
span1)
                                  (Span -> TypeIndex
srcSpanEndLine Span
span2, Span -> TypeIndex
srcSpanEndCol Span
span2)
    file :: FastString
file = Span -> FastString
srcSpanFile Span
span1
#endif