{-# LANGUAGE CPP             #-}
{-# LANGUAGE PatternSynonyms #-}

-- | Compat module for 'UnitState' and 'UnitInfo'.
module Development.IDE.GHC.Compat.Units (
    -- * UnitState
    UnitState,
    initUnits,
    unitState,
    getUnitName,
    explicitUnits,
    preloadClosureUs,
    listVisibleModuleNames,
    LookupResult(..),
    lookupModuleWithSuggestions,
    -- * UnitInfoMap
    UnitInfoMap,
    getUnitInfoMap,
    lookupUnit,
    lookupUnit',
    -- * UnitInfo
    UnitInfo,
    unitExposedModules,
    unitDepends,
    unitHaddockInterfaces,
    unitInfoId,
    unitPackageNameString,
    unitPackageVersion,
    -- * UnitId helpers
    UnitId,
    Unit,
    unitString,
    stringToUnit,
#if !MIN_VERSION_ghc(9,0,0)
    pattern RealUnit,
#endif
    definiteUnitId,
    defUnitId,
    installedModule,
    -- * Module
    toUnitId,
    moduleUnitId,
    moduleUnit,
    -- * ExternalPackageState
    ExternalPackageState(..),
    -- * Utils
    filterInplaceUnits,
    FinderCache,
    showSDocForUser',
    ) where

#if MIN_VERSION_ghc(9,0,0)
#if MIN_VERSION_ghc(9,2,0)
import qualified GHC.Data.ShortText              as ST
import           GHC.Driver.Env                  (hsc_unit_dbs)
import           GHC.Driver.Ppr
import           GHC.Unit.Env
import           GHC.Unit.External
import           GHC.Unit.Finder
#else
import           GHC.Driver.Types
#endif
import           GHC.Data.FastString
import qualified GHC.Driver.Session              as DynFlags
import           GHC.Types.Unique.Set
import qualified GHC.Unit.Info                   as UnitInfo
import           GHC.Unit.State                  (LookupResult, UnitInfo,
                                                  UnitState (unitInfoMap))
import qualified GHC.Unit.State                  as State
import           GHC.Unit.Types                  hiding (moduleUnit, toUnitId)
import qualified GHC.Unit.Types                  as Unit
import           GHC.Utils.Outputable
#else
import qualified DynFlags
import           FastString
import           GhcPlugins                      (SDoc, showSDocForUser)
import           HscTypes
import           Module                          hiding (moduleUnitId)
import qualified Module
import           Packages                        (InstalledPackageInfo (haddockInterfaces, packageName),
                                                  LookupResult, PackageConfig,
                                                  PackageConfigMap,
                                                  PackageState,
                                                  getPackageConfigMap,
                                                  lookupPackage')
import qualified Packages
#endif

import           Development.IDE.GHC.Compat.Core
import           Development.IDE.GHC.Compat.Env
#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0)
import           Data.Map                        (Map)
#endif
import           Data.Either
import           Data.Version
import qualified GHC

#if MIN_VERSION_ghc(9,0,0)
type PreloadUnitClosure = UniqSet UnitId
#if MIN_VERSION_ghc(9,2,0)
type UnitInfoMap = State.UnitInfoMap
#else
type UnitInfoMap = Map UnitId UnitInfo
#endif
#else
type UnitState = PackageState
type UnitInfo = PackageConfig
type UnitInfoMap = PackageConfigMap
type PreloadUnitClosure = ()
type Unit = UnitId
#endif


#if !MIN_VERSION_ghc(9,0,0)
unitString :: Unit -> String
unitString :: Unit -> String
unitString = Unit -> String
Module.unitIdString

stringToUnit :: String -> Unit
stringToUnit :: String -> Unit
stringToUnit = String -> Unit
Module.stringToUnitId
#endif

unitState :: HscEnv -> UnitState
#if MIN_VERSION_ghc(9,2,0)
unitState = ue_units . hsc_unit_env
#elif MIN_VERSION_ghc(9,0,0)
unitState = DynFlags.unitState . hsc_dflags
#else
unitState :: HscEnv -> UnitState
unitState = DynFlags -> UnitState
DynFlags.pkgState (DynFlags -> UnitState)
-> (HscEnv -> DynFlags) -> HscEnv -> UnitState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> DynFlags
hsc_dflags
#endif

initUnits :: HscEnv -> IO HscEnv
initUnits :: HscEnv -> IO HscEnv
initUnits HscEnv
env = do
#if MIN_VERSION_ghc(9,2,0)
  let dflags1         = hsc_dflags env
  -- Copied from GHC.setSessionDynFlags
  let cached_unit_dbs = hsc_unit_dbs env
  (dbs,unit_state,home_unit,mconstants) <- State.initUnits (hsc_logger env) dflags1 cached_unit_dbs

  dflags <- DynFlags.updatePlatformConstants dflags1 mconstants


  let unit_env = UnitEnv
        { ue_platform  = targetPlatform dflags
        , ue_namever   = DynFlags.ghcNameVersion dflags
        , ue_home_unit = home_unit
        , ue_units     = unit_state
        }
  pure $ hscSetFlags dflags $ hscSetUnitEnv unit_env env
    { hsc_unit_dbs = Just dbs
    }
#elif MIN_VERSION_ghc(9,0,0)
  newFlags <- State.initUnits $ hsc_dflags env
  pure $ hscSetFlags newFlags env
#else
  DynFlags
newFlags <- ((DynFlags, [PreloadUnitId]) -> DynFlags)
-> IO (DynFlags, [PreloadUnitId]) -> IO DynFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynFlags, [PreloadUnitId]) -> DynFlags
forall a b. (a, b) -> a
fst (IO (DynFlags, [PreloadUnitId]) -> IO DynFlags)
-> (DynFlags -> IO (DynFlags, [PreloadUnitId]))
-> DynFlags
-> IO DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> IO (DynFlags, [PreloadUnitId])
Packages.initPackages (DynFlags -> IO DynFlags) -> DynFlags -> IO DynFlags
forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags
hsc_dflags HscEnv
env
  HscEnv -> IO HscEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HscEnv -> IO HscEnv) -> HscEnv -> IO HscEnv
forall a b. (a -> b) -> a -> b
$ DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
newFlags HscEnv
env
#endif

explicitUnits :: UnitState -> [Unit]
explicitUnits :: UnitState -> [Unit]
explicitUnits UnitState
ue =
#if MIN_VERSION_ghc(9,0,0)
  State.explicitUnits ue
#else
  UnitState -> [Unit]
Packages.explicitPackages UnitState
ue
#endif

listVisibleModuleNames :: HscEnv -> [ModuleName]
listVisibleModuleNames :: HscEnv -> [ModuleName]
listVisibleModuleNames HscEnv
env =
#if MIN_VERSION_ghc(9,0,0)
  State.listVisibleModuleNames $ unitState env
#else
  DynFlags -> [ModuleName]
Packages.listVisibleModuleNames (DynFlags -> [ModuleName]) -> DynFlags -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags
hsc_dflags HscEnv
env
#endif

getUnitName :: HscEnv -> UnitId -> Maybe PackageName
getUnitName :: HscEnv -> Unit -> Maybe PackageName
getUnitName HscEnv
env Unit
i =
#if MIN_VERSION_ghc(9,0,0)
  State.unitPackageName <$> State.lookupUnitId (unitState env) i
#else
  InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> PackageName
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> srcpkgname
packageName (InstalledPackageInfo
   ComponentId
   SourcePackageId
   PackageName
   PreloadUnitId
   Unit
   ModuleName
   Module
 -> PackageName)
-> Maybe
     (InstalledPackageInfo
        ComponentId
        SourcePackageId
        PackageName
        PreloadUnitId
        Unit
        ModuleName
        Module)
-> Maybe PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags
-> Unit
-> Maybe
     (InstalledPackageInfo
        ComponentId
        SourcePackageId
        PackageName
        PreloadUnitId
        Unit
        ModuleName
        Module)
Packages.lookupPackage (HscEnv -> DynFlags
hsc_dflags HscEnv
env) (DefUnitId -> Unit
definiteUnitId (Unit -> DefUnitId
defUnitId Unit
i))
#endif

lookupModuleWithSuggestions :: HscEnv -> ModuleName -> Maybe FastString -> LookupResult
lookupModuleWithSuggestions :: HscEnv -> ModuleName -> Maybe FastString -> LookupResult
lookupModuleWithSuggestions HscEnv
env ModuleName
modname Maybe FastString
mpkg =
#if MIN_VERSION_ghc(9,0,0)
  State.lookupModuleWithSuggestions (unitState env) modname mpkg
#else
  DynFlags -> ModuleName -> Maybe FastString -> LookupResult
Packages.lookupModuleWithSuggestions (HscEnv -> DynFlags
hsc_dflags HscEnv
env) ModuleName
modname Maybe FastString
mpkg
#endif

getUnitInfoMap :: HscEnv -> UnitInfoMap
getUnitInfoMap :: HscEnv -> UnitInfoMap
getUnitInfoMap =
#if MIN_VERSION_ghc(9,2,0)
  unitInfoMap . ue_units . hsc_unit_env
#elif MIN_VERSION_ghc(9,0,0)
  unitInfoMap . unitState
#else
  DynFlags -> UnitInfoMap
Packages.getPackageConfigMap (DynFlags -> UnitInfoMap)
-> (HscEnv -> DynFlags) -> HscEnv -> UnitInfoMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> DynFlags
hsc_dflags
#endif

lookupUnit :: HscEnv -> Unit -> Maybe UnitInfo
#if MIN_VERSION_ghc(9,0,0)
lookupUnit env pid = State.lookupUnit (unitState env) pid
#else
lookupUnit :: HscEnv
-> Unit
-> Maybe
     (InstalledPackageInfo
        ComponentId
        SourcePackageId
        PackageName
        PreloadUnitId
        Unit
        ModuleName
        Module)
lookupUnit HscEnv
env Unit
pid = DynFlags
-> Unit
-> Maybe
     (InstalledPackageInfo
        ComponentId
        SourcePackageId
        PackageName
        PreloadUnitId
        Unit
        ModuleName
        Module)
Packages.lookupPackage (HscEnv -> DynFlags
hsc_dflags HscEnv
env) Unit
pid
#endif

lookupUnit' :: Bool -> UnitInfoMap -> PreloadUnitClosure -> Unit -> Maybe UnitInfo
#if MIN_VERSION_ghc(9,0,0)
lookupUnit' = State.lookupUnit'
#else
lookupUnit' :: Bool
-> UnitInfoMap
-> PreloadUnitClosure
-> Unit
-> Maybe
     (InstalledPackageInfo
        ComponentId
        SourcePackageId
        PackageName
        PreloadUnitId
        Unit
        ModuleName
        Module)
lookupUnit' Bool
b UnitInfoMap
pcm PreloadUnitClosure
_ Unit
u = Bool
-> UnitInfoMap
-> Unit
-> Maybe
     (InstalledPackageInfo
        ComponentId
        SourcePackageId
        PackageName
        PreloadUnitId
        Unit
        ModuleName
        Module)
Packages.lookupPackage' Bool
b UnitInfoMap
pcm Unit
u
#endif

preloadClosureUs :: HscEnv -> PreloadUnitClosure
#if MIN_VERSION_ghc(9,2,0)
preloadClosureUs = State.preloadClosure . unitState
#elif MIN_VERSION_ghc(9,0,0)
preloadClosureUs = State.preloadClosure . unitState
#else
preloadClosureUs :: HscEnv -> PreloadUnitClosure
preloadClosureUs = PreloadUnitClosure -> HscEnv -> PreloadUnitClosure
forall a b. a -> b -> a
const ()
#endif

unitExposedModules :: UnitInfo -> [(ModuleName, Maybe Module)]
unitExposedModules :: InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> [(ModuleName, Maybe Module)]
unitExposedModules InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
ue =
#if MIN_VERSION_ghc(9,0,0)
  UnitInfo.unitExposedModules ue
#else
  InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> [(ModuleName, Maybe Module)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, Maybe mod)]
Packages.exposedModules InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
ue
#endif

unitDepends :: UnitInfo -> [UnitId]
#if MIN_VERSION_ghc(9,0,0)
unitDepends = State.unitDepends
#else
unitDepends :: InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> [Unit]
unitDepends = (PreloadUnitId -> Unit) -> [PreloadUnitId] -> [Unit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DefUnitId -> Unit
Module.DefiniteUnitId(DefUnitId -> Unit)
-> (PreloadUnitId -> DefUnitId) -> PreloadUnitId -> Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreloadUnitId -> DefUnitId
defUnitId') ([PreloadUnitId] -> [Unit])
-> (InstalledPackageInfo
      ComponentId
      SourcePackageId
      PackageName
      PreloadUnitId
      Unit
      ModuleName
      Module
    -> [PreloadUnitId])
-> InstalledPackageInfo
     ComponentId
     SourcePackageId
     PackageName
     PreloadUnitId
     Unit
     ModuleName
     Module
-> [Unit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> [PreloadUnitId]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [instunitid]
Packages.depends
#endif

unitPackageNameString :: UnitInfo -> String
unitPackageNameString :: InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> String
unitPackageNameString =
#if MIN_VERSION_ghc(9,0,0)
  UnitInfo.unitPackageNameString
#else
  InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> String
Packages.packageNameString
#endif

unitPackageVersion :: UnitInfo -> Version
unitPackageVersion :: InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> Version
unitPackageVersion =
#if MIN_VERSION_ghc(9,0,0)
  UnitInfo.unitPackageVersion
#else
  InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> Version
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Version
Packages.packageVersion
#endif

unitInfoId :: UnitInfo -> Unit
unitInfoId :: InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> Unit
unitInfoId =
#if MIN_VERSION_ghc(9,0,0)
  UnitInfo.mkUnit
#else
  InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> Unit
Packages.packageConfigId
#endif

unitHaddockInterfaces :: UnitInfo -> [FilePath]
unitHaddockInterfaces :: InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> [String]
unitHaddockInterfaces =
#if MIN_VERSION_ghc(9,2,0)
  fmap ST.unpack . UnitInfo.unitHaddockInterfaces
#elif MIN_VERSION_ghc(9,0,0)
  UnitInfo.unitHaddockInterfaces
#else
  InstalledPackageInfo
  ComponentId
  SourcePackageId
  PackageName
  PreloadUnitId
  Unit
  ModuleName
  Module
-> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
haddockInterfaces
#endif

-- ------------------------------------------------------------------
-- Backwards Compatible UnitState
-- ------------------------------------------------------------------

-- ------------------------------------------------------------------
-- Patterns and helpful definitions
-- ------------------------------------------------------------------

#if MIN_VERSION_ghc(9,2,0)
definiteUnitId :: Definite uid -> GenUnit uid
definiteUnitId         = RealUnit
defUnitId :: unit -> Definite unit
defUnitId              = Definite
installedModule :: unit -> ModuleName -> GenModule unit
installedModule        = Module

#elif MIN_VERSION_ghc(9,0,0)
definiteUnitId         = RealUnit
defUnitId              = Definite
installedModule        = Module

#else
pattern RealUnit :: Module.DefUnitId -> UnitId
pattern $bRealUnit :: DefUnitId -> Unit
$mRealUnit :: forall r. Unit -> (DefUnitId -> r) -> (Void# -> r) -> r
RealUnit x = Module.DefiniteUnitId x

definiteUnitId :: Module.DefUnitId -> UnitId
definiteUnitId :: DefUnitId -> Unit
definiteUnitId = DefUnitId -> Unit
Module.DefiniteUnitId

defUnitId :: UnitId -> Module.DefUnitId
defUnitId :: Unit -> DefUnitId
defUnitId = PreloadUnitId -> DefUnitId
Module.DefUnitId (PreloadUnitId -> DefUnitId)
-> (Unit -> PreloadUnitId) -> Unit -> DefUnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> PreloadUnitId
Module.toInstalledUnitId

defUnitId' :: Module.InstalledUnitId -> Module.DefUnitId
defUnitId' :: PreloadUnitId -> DefUnitId
defUnitId' = PreloadUnitId -> DefUnitId
Module.DefUnitId

installedModule :: UnitId -> ModuleName -> Module.InstalledModule
installedModule :: Unit -> ModuleName -> InstalledModule
installedModule Unit
uid ModuleName
modname = PreloadUnitId -> ModuleName -> InstalledModule
Module.InstalledModule (Unit -> PreloadUnitId
Module.toInstalledUnitId Unit
uid) ModuleName
modname
#endif

toUnitId :: Unit -> UnitId
toUnitId :: Unit -> Unit
toUnitId =
#if MIN_VERSION_ghc(9,0,0)
    Unit.toUnitId
#else
    Unit -> Unit
forall a. a -> a
id
#endif

moduleUnitId :: Module -> UnitId
moduleUnitId :: Module -> Unit
moduleUnitId =
#if MIN_VERSION_ghc(9,0,0)
    Unit.toUnitId . Unit.moduleUnit
#else
    Module -> Unit
Module.moduleUnitId
#endif

moduleUnit :: Module -> Unit
moduleUnit :: Module -> Unit
moduleUnit =
#if MIN_VERSION_ghc(9,0,0)
    Unit.moduleUnit
#else
    Module -> Unit
Module.moduleUnitId
#endif

filterInplaceUnits :: [UnitId] -> [PackageFlag] -> ([UnitId], [PackageFlag])
filterInplaceUnits :: [Unit] -> [PackageFlag] -> ([Unit], [PackageFlag])
filterInplaceUnits [Unit]
us [PackageFlag]
packageFlags =
  [Either Unit PackageFlag] -> ([Unit], [PackageFlag])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((PackageFlag -> Either Unit PackageFlag)
-> [PackageFlag] -> [Either Unit PackageFlag]
forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> Either Unit PackageFlag
isInplace [PackageFlag]
packageFlags)
  where
    isInplace :: PackageFlag -> Either UnitId PackageFlag
    isInplace :: PackageFlag -> Either Unit PackageFlag
isInplace p :: PackageFlag
p@(ExposePackage String
_ (UnitIdArg Unit
u) ModRenaming
_) =
#if MIN_VERSION_ghc(9,0,0)
      if toUnitId u `elem` us
        then Left $ toUnitId  u
        else Right p
#else
      if Unit
u Unit -> [Unit] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Unit]
us
        then Unit -> Either Unit PackageFlag
forall a b. a -> Either a b
Left Unit
u
        else PackageFlag -> Either Unit PackageFlag
forall a b. b -> Either a b
Right PackageFlag
p
#endif
    isInplace PackageFlag
p = PackageFlag -> Either Unit PackageFlag
forall a b. b -> Either a b
Right PackageFlag
p

showSDocForUser' :: HscEnv -> GHC.PrintUnqualified -> SDoc -> String
#if MIN_VERSION_ghc(9,2,0)
showSDocForUser' env = showSDocForUser (hsc_dflags env) (unitState env)
#else
showSDocForUser' :: HscEnv -> PrintUnqualified -> SDoc -> String
showSDocForUser' HscEnv
env = DynFlags -> PrintUnqualified -> SDoc -> String
showSDocForUser (HscEnv -> DynFlags
hsc_dflags HscEnv
env)
#endif