module Hix.Managed.Build.Solve where

import qualified Data.Set as Set
import Distribution.Pretty (pretty)
import Exon (exon)
import Text.PrettyPrint (hang)

import Hix.Class.Map (nRestrictKeys)
import Hix.Data.Monad (M)
import qualified Hix.Data.PackageId
import Hix.Data.PackageId (PackageId (PackageId))
import Hix.Data.PackageName (isLocalPackage)
import Hix.Data.Version (packageIdVersions)
import qualified Hix.Log as Log
import qualified Hix.Managed.Cabal.Changes
import Hix.Managed.Cabal.Changes (SolverChanges (SolverChanges), SolverPlan (SolverPlan))
import Hix.Managed.Cabal.Data.SolverState (SolverState)
import qualified Hix.Managed.Data.EnvContext
import Hix.Managed.Data.EnvContext (EnvDeps)
import Hix.Managed.Data.Mutable (depName)
import qualified Hix.Managed.Handlers.Cabal
import Hix.Managed.Handlers.Cabal (CabalHandlers)
import Hix.Pretty (showPL)

logNonReinstallable :: NonEmpty PackageId -> M ()
logNonReinstallable :: NonEmpty PackageId -> M ()
logNonReinstallable NonEmpty PackageId
ids =
  Text -> M ()
Log.verbose [exon|NOTE: Cabal solver suggested new versions for non-reinstallable packages: #{showPL ids}|]

-- TODO Do we need to filter locals out of @matching@ or can those not be in there?
processSolverPlan ::
  EnvDeps ->
  SolverPlan ->
  M SolverChanges
processSolverPlan :: EnvDeps -> SolverPlan -> M SolverChanges
processSolverPlan EnvDeps
deps SolverPlan {[PackageId]
Maybe (NonEmpty PackageId)
changes :: [PackageId]
matching :: [PackageId]
nonReinstallable :: Maybe (NonEmpty PackageId)
$sel:changes:SolverPlan :: SolverPlan -> [PackageId]
$sel:matching:SolverPlan :: SolverPlan -> [PackageId]
$sel:nonReinstallable:SolverPlan :: SolverPlan -> Maybe (NonEmpty PackageId)
..} = do
  Doc -> M ()
Log.debugP (Doc -> Int -> Doc -> Doc
hang Doc
"New project deps from solver:" Int
2 (Versions -> Doc
forall a. Pretty a => a -> Doc
pretty Versions
projectDeps))
  (NonEmpty PackageId -> M ()) -> Maybe (NonEmpty PackageId) -> M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ NonEmpty PackageId -> M ()
logNonReinstallable Maybe (NonEmpty PackageId)
nonReinstallable
  pure SolverChanges {Versions
versions :: Versions
$sel:versions:SolverChanges :: Versions
versions, [PackageId]
overrides :: [PackageId]
$sel:overrides:SolverChanges :: [PackageId]
overrides, Versions
projectDeps :: Versions
$sel:projectDeps:SolverChanges :: Versions
projectDeps}
  where
    projectDeps :: Versions
projectDeps = Set PackageName -> Versions -> Versions
forall map k v sort. NMap map k v sort => Set k -> map -> map
nRestrictKeys Set PackageName
mutablePIds Versions
versions
    versions :: Versions
versions = [PackageId] -> Versions
packageIdVersions ([PackageId]
overrides [PackageId] -> [PackageId] -> [PackageId]
forall a. [a] -> [a] -> [a]
++ [PackageId]
matching)
    overrides :: [PackageId]
overrides = (PackageId -> Bool) -> [PackageId] -> [PackageId]
forall a. (a -> Bool) -> [a] -> [a]
filter PackageId -> Bool
notLocal [PackageId]
changes
    notLocal :: PackageId -> Bool
notLocal PackageId {PackageName
name :: PackageName
$sel:name:PackageId :: PackageId -> PackageName
name} = Bool -> Bool
not (Set LocalPackage -> PackageName -> Bool
isLocalPackage EnvDeps
deps.local PackageName
name)
    mutablePIds :: Set PackageName
mutablePIds = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
Set.fromList (MutableDep -> PackageName
depName (MutableDep -> PackageName) -> [MutableDep] -> [PackageName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set MutableDep -> [MutableDep]
forall a. Set a -> [a]
Set.toList EnvDeps
deps.mutable)

solveMutation ::
  CabalHandlers ->
  EnvDeps ->
  SolverState ->
  M (Maybe SolverChanges)
solveMutation :: CabalHandlers -> EnvDeps -> SolverState -> M (Maybe SolverChanges)
solveMutation CabalHandlers
cabal EnvDeps
deps SolverState
state =
  (SolverPlan -> M SolverChanges)
-> Maybe SolverPlan -> M (Maybe SolverChanges)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (EnvDeps -> SolverPlan -> M SolverChanges
processSolverPlan EnvDeps
deps) (Maybe SolverPlan -> M (Maybe SolverChanges))
-> M (Maybe SolverPlan) -> M (Maybe SolverChanges)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CabalHandlers
cabal.solveForVersion SolverState
state