module Hix.Managed.Cabal.Resources where

import Control.Monad.Trans.Reader (asks)
import Distribution.Client.IndexUtils (getInstalledPackages, getSourcePackages)
import qualified Distribution.Client.NixStyleOptions
import Distribution.Client.Setup (configCompilerAux', withRepoContext)
import Distribution.Simple (PackageDB (GlobalPackageDB), PackageDBStack, compilerInfo)
import Distribution.Solver.Types.PkgConfigDb (readPkgConfigDb)
import Distribution.Verbosity (lessVerbose, silent, verbose)

import qualified Hix.Data.Monad
import Hix.Data.Monad (M (M))
import qualified Hix.Log as Log
import Hix.Managed.Cabal.Data.Config (CabalConfig, GhcDb (GhcDbSynthetic, GhcDbSystem), SolveConfig (..))
import qualified Hix.Managed.Cabal.Data.SolveResources
import Hix.Managed.Cabal.Data.SolveResources (SolveResources (SolveResources))
import qualified Hix.Managed.Cabal.Init
import Hix.Managed.Cabal.Init (initialize)
import Hix.Managed.Cabal.Mock (mockSolveResources)
import qualified Hix.Managed.Cabal.Mock.SourcePackage as SourcePackage
import Hix.Managed.Data.ManagedPackage (ManagedPackage)
import Hix.Managed.Data.Packages (Packages)
import Hix.Monad (tryIOM)

packageDbs :: PackageDBStack
packageDbs :: PackageDBStack
packageDbs = [PackageDB
Item PackageDBStack
GlobalPackageDB]

-- | This adds the 'ManagedPackage's to the source package DB, which is the set of available package IDs.
-- This means that the solver will find our local packages (for targets that depend on packages in other envs) like it
-- finds Hackage packages, and therefore local deps will be included in the plan.
--
-- Because we don't want local packages in the plan (as they are not mutable, but static in the Nix build), it would be
-- tempting to add 'ManagedPackage's to the installed package index instead, which would exclude them from the plan's
-- overrides.
-- However, their metadata must include concrete unit IDs for their dependencies with fixed versions, which would
-- require us to choose versions for them and might interfere with solving.
--
-- Maybe the basic installed package index could be queried to determine the dep versions.
-- Not sure this would be better than just filtering the plan.
resources ::
  Packages ManagedPackage ->
  SolveConfig ->
  M SolveResources
resources :: Packages ManagedPackage -> SolveConfig -> M SolveResources
resources Packages ManagedPackage
packages SolveConfig
conf = do
  SolveFlags
flags <- SolveConfig -> M SolveFlags
initialize SolveConfig
conf
  Text -> M ()
Log.debug Text
"Acquiring Cabal resources."
  IO SolveResources -> M SolveResources
forall a. IO a -> M a
tryIOM (IO SolveResources -> M SolveResources)
-> IO SolveResources -> M SolveResources
forall a b. (a -> b) -> a -> b
$ Verbosity
-> GlobalFlags
-> (RepoContext -> IO SolveResources)
-> IO SolveResources
forall a. Verbosity -> GlobalFlags -> (RepoContext -> IO a) -> IO a
withRepoContext SolveConfig
conf.verbosity SolveFlags
flags.global \ RepoContext
repoContext -> do
    (Compiler
compiler, Platform
platform, ProgramDb
progdb) <- ConfigFlags -> IO (Compiler, Platform, ProgramDb)
configCompilerAux' SolveFlags
flags.main.configFlags
    PkgConfigDb
pkgConfigDb <- Verbosity -> ProgramDb -> IO PkgConfigDb
readPkgConfigDb SolveConfig
conf.verbosity ProgramDb
progdb
    InstalledPackageIndex
installedPkgIndex <- Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages SolveConfig
conf.verbosity Compiler
compiler PackageDBStack
packageDbs ProgramDb
progdb
    SourcePackageDb
sourcePkgDb <- Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages SolveConfig
conf.verbosity RepoContext
repoContext
    pure SolveResources {
      $sel:compiler:SolveResources :: CompilerInfo
compiler = Compiler -> CompilerInfo
compilerInfo Compiler
compiler,
      $sel:installedPkgIndex:SolveResources :: InstalledPackageIndex
installedPkgIndex = InstalledPackageIndex
installedPkgIndex,
      $sel:sourcePkgDb:SolveResources :: SourcePackageDb
sourcePkgDb = Packages ManagedPackage -> SourcePackageDb -> SourcePackageDb
SourcePackage.dbWithManaged Packages ManagedPackage
packages SourcePackageDb
sourcePkgDb,
      $sel:solverParams:SolveResources :: DepResolverParams -> DepResolverParams
solverParams = DepResolverParams -> DepResolverParams
forall a. a -> a
id,
      Platform
PkgConfigDb
SolveConfig
SolveFlags
conf :: SolveConfig
flags :: SolveFlags
platform :: Platform
pkgConfigDb :: PkgConfigDb
$sel:conf:SolveResources :: SolveConfig
$sel:flags:SolveResources :: SolveFlags
$sel:platform:SolveResources :: Platform
$sel:pkgConfigDb:SolveResources :: PkgConfigDb
..
    }

-- TODO The Packages ManagedPackage are added in 'resources' as well as in 'mockSolveResources', which is probably ok since they
-- now come from @processProject@ and not from the tests, I think. still would be better to unify those
--
-- just add the managed packages to the result.
acquire ::
  Packages ManagedPackage ->
  CabalConfig ->
  GhcDb ->
  M SolveResources
acquire :: Packages ManagedPackage -> CabalConfig -> GhcDb -> M SolveResources
acquire Packages ManagedPackage
packages CabalConfig
cabal = \case
  GhcDbSystem Maybe GhcPath
ghc -> do
    Verbosity
verbosity <- ReaderT AppResources (ExceptT Error IO) Bool -> M Bool
forall a. ReaderT AppResources (ExceptT Error IO) a -> M a
M ((AppResources -> Bool)
-> ReaderT AppResources (ExceptT Error IO) Bool
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (.debug)) M Bool -> (Bool -> Verbosity) -> M Verbosity
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Bool
True -> Verbosity
verbose
      Bool
False -> Verbosity -> Verbosity
lessVerbose Verbosity
silent
    Packages ManagedPackage -> SolveConfig -> M SolveResources
resources Packages ManagedPackage
packages SolveConfig
forall a. Default a => a
def {Verbosity
verbosity :: Verbosity
$sel:verbosity:SolveConfig :: Verbosity
verbosity, Maybe GhcPath
ghc :: Maybe GhcPath
$sel:ghc:SolveConfig :: Maybe GhcPath
ghc, CabalConfig
cabal :: CabalConfig
$sel:cabal:SolveConfig :: CabalConfig
cabal}
  GhcDbSynthetic GhcPackages
db ->
    SolveResources -> M SolveResources
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Packages ManagedPackage -> GhcPackages -> SolveResources
mockSolveResources Packages ManagedPackage
packages GhcPackages
db)