module Hix.Managed.Handlers.Mutation.Bump where

import Hix.Data.Monad (M)
import qualified Hix.Data.PackageId
import Hix.Data.PackageId (PackageId (PackageId))
import Hix.Data.Version (Version)
import qualified Hix.Data.VersionBounds as VersionBounds
import Hix.Data.VersionBounds (VersionBounds, fromLower)
import Hix.Managed.Build.Mutation (buildCandidate)
import Hix.Managed.Cabal.Data.SolverState (SolverState)
import qualified Hix.Managed.Data.Bump
import Hix.Managed.Data.Bump (Bump (Bump))
import qualified Hix.Managed.Data.Constraints
import Hix.Managed.Data.Constraints (MutationConstraints (MutationConstraints))
import Hix.Managed.Data.MutableId (MutableId)
import qualified Hix.Managed.Data.Mutation
import Hix.Managed.Data.Mutation (
  BuildMutation,
  DepMutation (DepMutation),
  MutationResult (MutationFailed, MutationSuccess),
  )
import Hix.Managed.Data.MutationState (MutationState)
import qualified Hix.Managed.Handlers.Mutation
import Hix.Managed.Handlers.Mutation (MutationHandlers (MutationHandlers))
import Hix.Version (nextMajor)

updateConstraintsBump :: MutableId -> PackageId -> MutationConstraints -> MutationConstraints
updateConstraintsBump :: MutableId
-> PackageId -> MutationConstraints -> MutationConstraints
updateConstraintsBump MutableId
_ PackageId {Version
version :: Version
version :: PackageId -> Version
version} MutationConstraints {Maybe Bool
Maybe VersionRange
VersionBounds
mutation :: VersionBounds
oldest :: Maybe Bool
installed :: Maybe Bool
force :: Maybe VersionRange
prefer :: Maybe VersionRange
prefer :: MutationConstraints -> Maybe VersionRange
force :: MutationConstraints -> Maybe VersionRange
installed :: MutationConstraints -> Maybe Bool
oldest :: MutationConstraints -> Maybe Bool
mutation :: MutationConstraints -> VersionBounds
..} =
  MutationConstraints {mutation :: VersionBounds
mutation = Version -> VersionBounds
fromLower Version
version, Maybe Bool
Maybe VersionRange
oldest :: Maybe Bool
installed :: Maybe Bool
force :: Maybe VersionRange
prefer :: Maybe VersionRange
prefer :: Maybe VersionRange
force :: Maybe VersionRange
installed :: Maybe Bool
oldest :: Maybe Bool
..}

updateBound :: Version -> VersionBounds -> VersionBounds
updateBound :: Version -> VersionBounds -> VersionBounds
updateBound = Version -> VersionBounds -> VersionBounds
VersionBounds.withUpper (Version -> VersionBounds -> VersionBounds)
-> (Version -> Version)
-> Version
-> VersionBounds
-> VersionBounds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Version
nextMajor

-- TODO Avoid building unchanged candidates after the first build of the same set of deps.
processMutationBump ::
  SolverState ->
  DepMutation Bump ->
  (BuildMutation -> M (Maybe (MutationState, Set PackageId))) ->
  M (MutationResult SolverState)
processMutationBump :: SolverState
-> DepMutation Bump
-> (BuildMutation -> M (Maybe (MutationState, Set PackageId)))
-> M (MutationResult SolverState)
processMutationBump SolverState
solver DepMutation {MutableDep
package :: MutableDep
package :: forall a. DepMutation a -> MutableDep
package, mutation :: forall a. DepMutation a -> a
mutation = Bump {Version
version :: Version
version :: Bump -> Version
version, Bool
changed :: Bool
changed :: Bump -> Bool
changed}} BuildMutation -> M (Maybe (MutationState, Set PackageId))
build =
  Version
-> M (Maybe (MutableId, SolverState, MutationState, Set PackageId))
builder Version
version M (Maybe (MutableId, SolverState, MutationState, Set PackageId))
-> (Maybe (MutableId, SolverState, MutationState, Set PackageId)
    -> MutationResult SolverState)
-> M (MutationResult SolverState)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Just (MutableId
candidate, SolverState
ext, MutationState
state, Set PackageId
revisions) ->
      MutationSuccess {MutableId
candidate :: MutableId
candidate :: MutableId
candidate, Bool
changed :: Bool
changed :: Bool
changed, MutationState
state :: MutationState
state :: MutationState
state, Set PackageId
revisions :: Set PackageId
revisions :: Set PackageId
revisions, SolverState
ext :: SolverState
ext :: SolverState
ext}
    Maybe (MutableId, SolverState, MutationState, Set PackageId)
Nothing ->
      MutationResult SolverState
forall s. MutationResult s
MutationFailed
  where
    builder :: Version
-> M (Maybe (MutableId, SolverState, MutationState, Set PackageId))
builder = (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
updateBound MutableId
-> PackageId -> MutationConstraints -> MutationConstraints
updateConstraintsBump SolverState
solver MutableDep
package

handlersBump :: MutationHandlers Bump SolverState
handlersBump :: MutationHandlers Bump SolverState
handlersBump = MutationHandlers {process :: SolverState
-> DepMutation Bump
-> (BuildMutation -> M (Maybe (MutationState, Set PackageId)))
-> M (MutationResult SolverState)
process = SolverState
-> DepMutation Bump
-> (BuildMutation -> M (Maybe (MutationState, Set PackageId)))
-> M (MutationResult SolverState)
processMutationBump}