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 {
    $sel:description:BuildMutation :: Text
description = MutableId -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP MutableId
candidate,
    SolverState
solverState :: SolverState
$sel:solverState:BuildMutation :: SolverState
solverState,
    Version -> VersionBounds -> VersionBounds
updateBound :: Version -> VersionBounds -> VersionBounds
$sel:updateBound:BuildMutation :: Version -> VersionBounds -> VersionBounds
updateBound
  }

candidateConstraints :: MutableId -> EnvConstraints -> EnvConstraints
candidateConstraints :: MutableId -> EnvConstraints -> EnvConstraints
candidateConstraints MutableId {Version
MutableDep
name :: MutableDep
version :: Version
$sel:name:MutableId :: MutableId -> MutableDep
$sel:version:MutableId :: MutableId -> Version
..} 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
$sel:name:PackageId :: PackageName
$sel:version:PackageId :: Version
..}
      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)) ->
  (Version -> VersionBounds -> VersionBounds) ->
  (MutableId -> PackageId -> MutationConstraints -> MutationConstraints) ->
  SolverState ->
  MutableDep ->
  Version ->
  M (Maybe (MutableId, SolverState, MutationState))
buildCandidate :: (BuildMutation -> M (Maybe MutationState))
-> (Version -> VersionBounds -> VersionBounds)
-> (MutableId
    -> PackageId -> MutationConstraints -> MutationConstraints)
-> SolverState
-> MutableDep
-> Version
-> M (Maybe (MutableId, SolverState, MutationState))
buildCandidate BuildMutation -> M (Maybe MutationState)
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 -> (MutableId, SolverState, MutationState))
-> Maybe MutationState
-> Maybe (MutableId, SolverState, MutationState)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MutationState -> (MutableId, SolverState, MutationState)
result (Maybe MutationState
 -> Maybe (MutableId, SolverState, MutationState))
-> M (Maybe MutationState)
-> M (Maybe (MutableId, SolverState, MutationState))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuildMutation -> M (Maybe MutationState)
build (SolverState
-> MutableId
-> (Version -> VersionBounds -> VersionBounds)
-> BuildMutation
candidateMutation SolverState
mutationSolverState MutableId
candidate Version -> VersionBounds -> VersionBounds
updateStateBound)
  where
    result :: MutationState -> (MutableId, SolverState, MutationState)
result MutationState
newState = (MutableId
candidate, MutationState -> SolverState
newSolverState MutationState
newState, MutationState
newState)

    candidate :: MutableId
candidate = MutableId {$sel:name:MutableId :: MutableDep
name = MutableDep
package, Version
$sel:version:MutableId :: 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