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
$sel:version:PackageId :: PackageId -> Version
version} MutationConstraints {Maybe Bool
Maybe VersionRange
VersionBounds
mutation :: VersionBounds
oldest :: Maybe Bool
installed :: Maybe Bool
force :: Maybe VersionRange
prefer :: Maybe VersionRange
$sel:mutation:MutationConstraints :: MutationConstraints -> VersionBounds
$sel:oldest:MutationConstraints :: MutationConstraints -> Maybe Bool
$sel:installed:MutationConstraints :: MutationConstraints -> Maybe Bool
$sel:force:MutationConstraints :: MutationConstraints -> Maybe VersionRange
$sel:prefer:MutationConstraints :: MutationConstraints -> Maybe VersionRange
..} =
  MutationConstraints {$sel:mutation:MutationConstraints :: VersionBounds
mutation = Version -> VersionBounds
fromLower Version
version, Maybe Bool
Maybe VersionRange
oldest :: Maybe Bool
installed :: Maybe Bool
force :: Maybe VersionRange
prefer :: Maybe VersionRange
$sel:oldest:MutationConstraints :: Maybe Bool
$sel:installed:MutationConstraints :: Maybe Bool
$sel:force:MutationConstraints :: Maybe VersionRange
$sel:prefer:MutationConstraints :: Maybe VersionRange
..}

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)) ->
  M (MutationResult SolverState)
processMutationBump :: SolverState
-> DepMutation Bump
-> (BuildMutation -> M (Maybe MutationState))
-> M (MutationResult SolverState)
processMutationBump SolverState
solver DepMutation {MutableDep
package :: MutableDep
$sel:package:DepMutation :: forall a. DepMutation a -> MutableDep
package, $sel:mutation:DepMutation :: forall a. DepMutation a -> a
mutation = Bump {Version
version :: Version
$sel:version:Bump :: Bump -> Version
version, Bool
changed :: Bool
$sel:changed:Bump :: Bump -> Bool
changed}} BuildMutation -> M (Maybe MutationState)
build =
  Version -> M (Maybe (MutableId, SolverState, MutationState))
builder Version
version M (Maybe (MutableId, SolverState, MutationState))
-> (Maybe (MutableId, SolverState, MutationState)
    -> 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) ->
      MutationSuccess {MutableId
candidate :: MutableId
$sel:candidate:MutationSuccess :: MutableId
candidate, Bool
changed :: Bool
$sel:changed:MutationSuccess :: Bool
changed, MutationState
state :: MutationState
$sel:state:MutationSuccess :: MutationState
state, SolverState
ext :: SolverState
$sel:ext:MutationSuccess :: SolverState
ext}
    Maybe (MutableId, SolverState, MutationState)
Nothing ->
      MutationResult SolverState
forall s. MutationResult s
MutationFailed
  where
    builder :: Version -> M (Maybe (MutableId, SolverState, MutationState))
builder = (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
updateBound MutableId
-> PackageId -> MutationConstraints -> MutationConstraints
updateConstraintsBump SolverState
solver MutableDep
package

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