module Hix.Managed.Build.Mutation where

import Control.Lens ((.~))
import Exon (exon)

import Hix.Class.Map (nAdjust, nAmendWithKey)
import Hix.Data.Monad (M)
import qualified Hix.Data.PackageId
import Hix.Data.PackageId (PackageId (PackageId))
import Hix.Data.Version (Version)
import Hix.Data.VersionBounds (VersionBounds, exactVersion)
import qualified Hix.Log as Log
import Hix.Managed.Cabal.Data.SolverState (SolverState, updateSolverState)
import Hix.Managed.Data.Constraints (EnvConstraints, MutationConstraints)
import Hix.Managed.Data.Mutable (MutableDep, depName, mutRelax)
import qualified Hix.Managed.Data.MutableId
import Hix.Managed.Data.MutableId (MutableId (MutableId))
import qualified Hix.Managed.Data.Mutation
import Hix.Managed.Data.Mutation (BuildMutation (BuildMutation))
import qualified Hix.Managed.Data.MutationState
import Hix.Managed.Data.MutationState (MutationState)
import Hix.Managed.Data.Packages (Deps)
import Hix.Pretty (showP)

candidateMutation ::
  SolverState ->
  MutableId ->
  (Version -> VersionBounds -> VersionBounds) ->
  BuildMutation
candidateMutation :: SolverState
-> MutableId
-> (Version -> VersionBounds -> VersionBounds)
-> BuildMutation
candidateMutation SolverState
solverState MutableId
candidate Version -> VersionBounds -> VersionBounds
updateBound =
  BuildMutation {
    description :: Text
description = MutableId -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP MutableId
candidate,
    SolverState
solverState :: SolverState
solverState :: SolverState
solverState,
    Version -> VersionBounds -> VersionBounds
updateBound :: Version -> VersionBounds -> VersionBounds
updateBound :: Version -> VersionBounds -> VersionBounds
updateBound
  }

candidateConstraints :: MutableId -> EnvConstraints -> EnvConstraints
candidateConstraints :: MutableId -> EnvConstraints -> EnvConstraints
candidateConstraints MutableId {Version
MutableDep
name :: MutableDep
version :: Version
version :: MutableId -> Version
name :: MutableId -> MutableDep
..} EnvConstraints
constraints =
  PackageName
-> EnvConstraints
-> (MutationConstraints -> MutationConstraints)
-> EnvConstraints
forall map k v sort.
NMap map k v sort =>
k -> map -> (v -> v) -> map
nAdjust (MutableDep -> PackageName
depName MutableDep
name) EnvConstraints
constraints (ASetter
  MutationConstraints MutationConstraints VersionBounds VersionBounds
#mutation ASetter
  MutationConstraints MutationConstraints VersionBounds VersionBounds
-> VersionBounds -> MutationConstraints -> MutationConstraints
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Version -> VersionBounds
exactVersion Version
version)

updateConstraints ::
  (MutableId -> PackageId -> MutationConstraints -> MutationConstraints) ->
  MutableId ->
  MutationState ->
  EnvConstraints ->
  EnvConstraints
updateConstraints :: (MutableId
 -> PackageId -> MutationConstraints -> MutationConstraints)
-> MutableId -> MutationState -> EnvConstraints -> EnvConstraints
updateConstraints MutableId
-> PackageId -> MutationConstraints -> MutationConstraints
impl MutableId
candidate MutationState
state =
  (PackageName
 -> Maybe Version -> MutationConstraints -> MutationConstraints)
-> Deps (Maybe Version) -> EnvConstraints -> EnvConstraints
forall map1 map2 k v1 v2 s1 s2.
(NMap map1 k v1 s1, NMap map2 k v2 s2) =>
(k -> v1 -> v2 -> v2) -> map1 -> map2 -> map2
nAmendWithKey PackageName
-> Maybe Version -> MutationConstraints -> MutationConstraints
update (MutableVersions -> Deps (Maybe Version)
forall map1 v s1 map2 s2.
(NMap map1 MutableDep v s1, NMap map2 PackageName v s2) =>
map1 -> map2
mutRelax MutationState
state.versions :: Deps (Maybe Version))
  where
    update :: PackageName
-> Maybe Version -> MutationConstraints -> MutationConstraints
update PackageName
name = \case
      Just Version
version -> MutableId
-> PackageId -> MutationConstraints -> MutationConstraints
impl MutableId
candidate PackageId {Version
PackageName
name :: PackageName
version :: Version
version :: Version
name :: PackageName
..}
      Maybe Version
Nothing -> MutationConstraints -> MutationConstraints
forall a. a -> a
id

-- | Boilerplate for mutation handlers, could be better.
--
-- TODO If we'd use the @retract@ field from @DepMutation@ and the target bound here, we could probably use a universal
-- bounds updater without leaking implementation...investigate.
buildCandidate ::
  (BuildMutation -> M (Maybe (MutationState, Set PackageId))) ->
  (Version -> VersionBounds -> VersionBounds) ->
  (MutableId -> PackageId -> MutationConstraints -> MutationConstraints) ->
  SolverState ->
  MutableDep ->
  Version ->
  M (Maybe (MutableId, SolverState, MutationState, Set PackageId))
buildCandidate :: (BuildMutation -> M (Maybe (MutationState, Set PackageId)))
-> (Version -> VersionBounds -> VersionBounds)
-> (MutableId
    -> PackageId -> MutationConstraints -> MutationConstraints)
-> SolverState
-> MutableDep
-> Version
-> M (Maybe (MutableId, SolverState, MutationState, Set PackageId))
buildCandidate BuildMutation -> M (Maybe (MutationState, Set PackageId))
build Version -> VersionBounds -> VersionBounds
updateStateBound MutableId
-> PackageId -> MutationConstraints -> MutationConstraints
updateConstraintBound SolverState
solverState MutableDep
package Version
version = do
  Text -> M ()
Log.debug [exon|Mutation constraints for #{showP candidate}: #{showP mutationSolverState.constraints}|]
  ((MutationState, Set PackageId)
 -> (MutableId, SolverState, MutationState, Set PackageId))
-> Maybe (MutationState, Set PackageId)
-> Maybe (MutableId, SolverState, MutationState, Set PackageId)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MutationState, Set PackageId)
-> (MutableId, SolverState, MutationState, Set PackageId)
result (Maybe (MutationState, Set PackageId)
 -> Maybe (MutableId, SolverState, MutationState, Set PackageId))
-> M (Maybe (MutationState, Set PackageId))
-> M (Maybe (MutableId, SolverState, MutationState, Set PackageId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuildMutation -> M (Maybe (MutationState, Set PackageId))
build (SolverState
-> MutableId
-> (Version -> VersionBounds -> VersionBounds)
-> BuildMutation
candidateMutation SolverState
mutationSolverState MutableId
candidate Version -> VersionBounds -> VersionBounds
updateStateBound)
  where
    result :: (MutationState, Set PackageId)
-> (MutableId, SolverState, MutationState, Set PackageId)
result (MutationState
newState, Set PackageId
revisions) = (MutableId
candidate, MutationState -> SolverState
newSolverState MutationState
newState, MutationState
newState, Set PackageId
revisions)

    candidate :: MutableId
candidate = MutableId {name :: MutableDep
name = MutableDep
package, Version
version :: Version
version :: Version
version}

    mutationSolverState :: SolverState
mutationSolverState = (EnvConstraints -> EnvConstraints) -> SolverState -> SolverState
updateSolverState (MutableId -> EnvConstraints -> EnvConstraints
candidateConstraints MutableId
candidate) SolverState
solverState

    newSolverState :: MutationState -> SolverState
newSolverState MutationState
newState =
      (EnvConstraints -> EnvConstraints) -> SolverState -> SolverState
updateSolverState ((MutableId
 -> PackageId -> MutationConstraints -> MutationConstraints)
-> MutableId -> MutationState -> EnvConstraints -> EnvConstraints
updateConstraints MutableId
-> PackageId -> MutationConstraints -> MutationConstraints
updateConstraintBound MutableId
candidate MutationState
newState) SolverState
solverState