module Hix.Managed.Handlers.Cabal.Prod where

import qualified Data.Map.Strict as Map
import Distribution.Client.Dependency (PackagesPreferenceDefault (PreferAllOldest), setPreferenceDefault)
import qualified Distribution.Client.Types
import Distribution.Client.Types (SourcePackageDb (SourcePackageDb), UnresolvedSourcePackage)
import qualified Distribution.Solver.Types.PackageIndex as PackageIndex
import Distribution.Solver.Types.PackageIndex (PackageIndex)
import Distribution.Version (laterVersion)

import Hix.Data.Monad (M)
import qualified Hix.Data.PackageId
import Hix.Data.PackageId (PackageId (PackageId))
import qualified Hix.Data.PackageName as PackageName
import Hix.Data.PackageName (PackageName)
import Hix.Managed.Cabal.Data.Config (CabalConfig, GhcDb)
import qualified Hix.Managed.Cabal.Data.SolveResources as SolveResources
import Hix.Managed.Cabal.Data.SolveResources (SolveResources (SolveResources, solverParams))
import Hix.Managed.Cabal.Installed (installedVersion)
import qualified Hix.Managed.Cabal.Resources as SolveResources
import Hix.Managed.Cabal.Solve (solveWithCabal)
import Hix.Managed.Cabal.Sort (sortMutations)
import Hix.Managed.Cabal.Source (sourcePackage)
import Hix.Managed.Data.ManagedPackage (ManagedPackage)
import Hix.Managed.Data.Packages (Packages)
import Hix.Managed.Handlers.Cabal (CabalHandlers (..))
import Hix.Zip (zipApplyL)

handlersWith ::
  (SolveResources -> SolveResources) ->
  CabalConfig ->
  Bool ->
  Packages ManagedPackage ->
  GhcDb ->
  M CabalHandlers
handlersWith :: (SolveResources -> SolveResources)
-> CabalConfig
-> Bool
-> Packages ManagedPackage
-> GhcDb
-> M CabalHandlers
handlersWith SolveResources -> SolveResources
trans CabalConfig
cabalConf Bool
oldest Packages ManagedPackage
packages GhcDb
ghc = do
  SolveResources
solveResources <- SolveResources -> SolveResources
trans (SolveResources -> SolveResources)
-> M SolveResources -> M SolveResources
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Packages ManagedPackage -> CabalConfig -> GhcDb -> M SolveResources
SolveResources.acquire Packages ManagedPackage
packages CabalConfig
cabalConf GhcDb
ghc
  pure CabalHandlers {
    solveForVersion :: SolverState -> M (Maybe SolverPlan)
solveForVersion = SolveResources -> SolverState -> M (Maybe SolverPlan)
solveWithCabal SolveResources
solveResources {solverParams},
    installedVersion :: PackageName -> Maybe Version
installedVersion = InstalledPackageIndex -> PackageName -> Maybe Version
installedVersion SolveResources
solveResources.installedPkgIndex,
    sourcePackage :: PackageId -> Maybe PackageDescription
sourcePackage = SourcePackageDb -> PackageId -> Maybe PackageDescription
sourcePackage SolveResources
solveResources.sourcePkgDb,
    sortMutations :: forall a. [DepMutation a] -> M [DepMutation a]
sortMutations = SolveResources -> [DepMutation a] -> M [DepMutation a]
forall a. SolveResources -> [DepMutation a] -> M [DepMutation a]
sortMutations SolveResources
solveResources
  }
  where
    solverParams :: DepResolverParams -> DepResolverParams
solverParams | Bool
oldest = PackagesPreferenceDefault -> DepResolverParams -> DepResolverParams
setPreferenceDefault PackagesPreferenceDefault
PreferAllOldest
                 | Bool
otherwise = DepResolverParams -> DepResolverParams
forall a. a -> a
id

handlersProd ::
  CabalConfig ->
  Bool ->
  Packages ManagedPackage ->
  GhcDb ->
  M CabalHandlers
handlersProd :: CabalConfig
-> Bool -> Packages ManagedPackage -> GhcDb -> M CabalHandlers
handlersProd =
  (SolveResources -> SolveResources)
-> CabalConfig
-> Bool
-> Packages ManagedPackage
-> GhcDb
-> M CabalHandlers
handlersWith SolveResources -> SolveResources
forall a. a -> a
id

testPackagesBump :: Map PackageName PackageId
testPackagesBump :: Map PackageName PackageId
testPackagesBump =
  [(PackageName, PackageId)] -> Map PackageName PackageId
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PackageName, PackageId)] -> Map PackageName PackageId)
-> [(PackageName, PackageId)] -> Map PackageName PackageId
forall a b. (a -> b) -> a -> b
$ (PackageId -> PackageName)
-> [PackageId] -> [(PackageName, PackageId)]
forall a b. (a -> b) -> [a] -> [(b, a)]
zipApplyL (.name) [
    PackageId {name :: PackageName
name = PackageName
"aeson", version :: Version
version = [Int
Item Version
2, Int
Item Version
2, Int
Item Version
0, Int
Item Version
0]},
    PackageId {name :: PackageName
name = PackageName
"base", version :: Version
version = [Int
Item Version
4, Int
Item Version
17, Int
Item Version
2, Int
Item Version
0]},
    PackageId {name :: PackageName
name = PackageName
"extra", version :: Version
version = [Int
Item Version
1, Int
Item Version
7, Int
Item Version
14]},
    PackageId {name :: PackageName
name = PackageName
"th-abstraction", version :: Version
version = [Int
Item Version
0, Int
Item Version
5, Int
Item Version
0, Int
Item Version
0]},
    PackageId {name :: PackageName
name = PackageName
"path", version :: Version
version = [Int
Item Version
0, Int
Item Version
9, Int
Item Version
5]},
    PackageId {name :: PackageName
name = PackageName
"multi-fail1", version :: Version
version = [Int
Item Version
0, Int
Item Version
1, Int
Item Version
0]},
    PackageId {name :: PackageName
name = PackageName
"multi-fail2", version :: Version
version = [Int
Item Version
0, Int
Item Version
1, Int
Item Version
0]}
  ]

removeLaterVersions ::
  PackageId ->
  PackageIndex UnresolvedSourcePackage ->
  PackageIndex UnresolvedSourcePackage
removeLaterVersions :: PackageId
-> PackageIndex UnresolvedSourcePackage
-> PackageIndex UnresolvedSourcePackage
removeLaterVersions PackageId {Version
PackageName
name :: PackageId -> PackageName
version :: PackageId -> Version
name :: PackageName
version :: Version
..} =
  PackageName
-> VersionRange
-> PackageIndex UnresolvedSourcePackage
-> PackageIndex UnresolvedSourcePackage
forall pkg.
Package pkg =>
PackageName -> VersionRange -> PackageIndex pkg -> PackageIndex pkg
PackageIndex.deleteDependency (PackageName -> PackageName
PackageName.toCabal PackageName
name) (Version -> VersionRange
laterVersion Version
version)

testResources :: SolveResources -> SolveResources
testResources :: SolveResources -> SolveResources
testResources SolveResources {InstalledPackageIndex
CompilerInfo
Platform
SourcePackageDb
PkgConfigDb
SolveConfig
SolveFlags
DepResolverParams -> DepResolverParams
solverParams :: SolveResources -> DepResolverParams -> DepResolverParams
conf :: SolveConfig
flags :: SolveFlags
platform :: Platform
compiler :: CompilerInfo
pkgConfigDb :: PkgConfigDb
installedPkgIndex :: InstalledPackageIndex
sourcePkgDb :: SourcePackageDb
solverParams :: DepResolverParams -> DepResolverParams
sourcePkgDb :: SolveResources -> SourcePackageDb
installedPkgIndex :: SolveResources -> InstalledPackageIndex
pkgConfigDb :: SolveResources -> PkgConfigDb
compiler :: SolveResources -> CompilerInfo
platform :: SolveResources -> Platform
flags :: SolveResources -> SolveFlags
conf :: SolveResources -> SolveConfig
..} =
  SolveResources {sourcePkgDb :: SourcePackageDb
sourcePkgDb = SourcePackageDb -> SourcePackageDb
removeLaterTestPackageVersions SourcePackageDb
sourcePkgDb, InstalledPackageIndex
CompilerInfo
Platform
PkgConfigDb
SolveConfig
SolveFlags
DepResolverParams -> DepResolverParams
solverParams :: DepResolverParams -> DepResolverParams
conf :: SolveConfig
flags :: SolveFlags
platform :: Platform
compiler :: CompilerInfo
pkgConfigDb :: PkgConfigDb
installedPkgIndex :: InstalledPackageIndex
solverParams :: DepResolverParams -> DepResolverParams
installedPkgIndex :: InstalledPackageIndex
pkgConfigDb :: PkgConfigDb
compiler :: CompilerInfo
platform :: Platform
flags :: SolveFlags
conf :: SolveConfig
..}
  where
    removeLaterTestPackageVersions :: SourcePackageDb -> SourcePackageDb
removeLaterTestPackageVersions SourcePackageDb {Map PackageName VersionRange
PackageIndex UnresolvedSourcePackage
packageIndex :: PackageIndex UnresolvedSourcePackage
packagePreferences :: Map PackageName VersionRange
packagePreferences :: SourcePackageDb -> Map PackageName VersionRange
packageIndex :: SourcePackageDb -> PackageIndex UnresolvedSourcePackage
..} =
      SourcePackageDb {
        packageIndex :: PackageIndex UnresolvedSourcePackage
packageIndex = (PackageId
 -> PackageIndex UnresolvedSourcePackage
 -> PackageIndex UnresolvedSourcePackage)
-> PackageIndex UnresolvedSourcePackage
-> Map PackageName PackageId
-> PackageIndex UnresolvedSourcePackage
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr' PackageId
-> PackageIndex UnresolvedSourcePackage
-> PackageIndex UnresolvedSourcePackage
removeLaterVersions PackageIndex UnresolvedSourcePackage
packageIndex Map PackageName PackageId
testPackagesBump,
        Map PackageName VersionRange
packagePreferences :: Map PackageName VersionRange
packagePreferences :: Map PackageName VersionRange
..
      }

handlersTest ::
  CabalConfig ->
  Bool ->
  Packages ManagedPackage ->
  GhcDb ->
  M CabalHandlers
handlersTest :: CabalConfig
-> Bool -> Packages ManagedPackage -> GhcDb -> M CabalHandlers
handlersTest =
  (SolveResources -> SolveResources)
-> CabalConfig
-> Bool
-> Packages ManagedPackage
-> GhcDb
-> M CabalHandlers
handlersWith SolveResources -> SolveResources
testResources