module Hix.Managed.Lower.Optimize where

import Exon (exon)

import Hix.Data.Monad (M)
import qualified Hix.Data.PackageId
import Hix.Data.PackageId (PackageId (PackageId))
import Hix.Data.VersionBounds (fromUpper)
import Hix.Managed.Build (processQuery)
import Hix.Managed.Cabal.Data.SolverState (solverState)
import Hix.Managed.Constraints (fromVersions)
import Hix.Managed.Data.BuildConfig (BuildConfig)
import qualified Hix.Managed.Data.Constraints
import Hix.Managed.Data.Constraints (MutationConstraints (MutationConstraints))
import qualified Hix.Managed.Data.EnvContext
import Hix.Managed.Data.Initial (Initial (Initial))
import Hix.Managed.Data.Mutable (MutableDep)
import Hix.Managed.Data.MutableId (MutableId)
import qualified Hix.Managed.Data.MutationState
import Hix.Managed.Data.MutationState (MutationState (MutationState))
import qualified Hix.Managed.Data.ProjectContext
import Hix.Managed.Data.ProjectContext (ProjectContext)
import Hix.Managed.Data.ProjectResult (ProjectResult)
import qualified Hix.Managed.Data.StageContext
import Hix.Managed.Data.StageContext (StageContext (StageContext))
import Hix.Managed.Data.StageResult (StageResult)
import Hix.Managed.Data.StageState (BuildSuccess)
import Hix.Managed.Flow (Flow, runStage_)
import qualified Hix.Managed.Handlers.Build
import Hix.Managed.Handlers.Build (BuildHandlers)
import qualified Hix.Managed.Handlers.Mutation.Lower as Mutation
import Hix.Managed.Lower.Candidates (candidatesOptimize)
import Hix.Managed.Lower.Data.LowerMode (lowerOptimizeMode)
import Hix.Managed.Process (processProject)
import Hix.Managed.Report (describeIterations)
import Hix.Managed.StageResult (stageResult)

lowerOptimizeUpdate :: Bool -> MutableId -> PackageId -> MutationConstraints -> MutationConstraints
lowerOptimizeUpdate :: Bool
-> MutableId
-> PackageId
-> MutationConstraints
-> MutationConstraints
lowerOptimizeUpdate Bool
_ 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
fromUpper 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
..}

success :: Map MutableDep BuildSuccess -> Natural -> Text
success :: Map MutableDep BuildSuccess -> Natural -> Text
success Map MutableDep BuildSuccess
_ Natural
iterations =
  [exon|Found optimal lower bounds for all deps after #{describeIterations iterations}.|]

failure :: Natural -> Text
failure :: Natural -> Text
failure Natural
iterations =
  [exon|Couldn't find working lower bounds for some deps after #{describeIterations iterations}.|]

lowerOptimize ::
  BuildHandlers ->
  BuildConfig ->
  StageContext ->
  M StageResult
lowerOptimize :: BuildHandlers -> BuildConfig -> StageContext -> M StageResult
lowerOptimize BuildHandlers
handlers BuildConfig
conf context :: StageContext
context@StageContext {EnvContext
env :: EnvContext
env :: StageContext -> EnvContext
env, state :: StageContext -> Initial MutationState
state = Initial MutationState {MutableVersions
versions :: MutableVersions
versions :: MutationState -> MutableVersions
versions}} =
  (Map MutableDep BuildSuccess -> Natural -> Text)
-> (Natural -> Text) -> StageState Lower SolverState -> StageResult
forall a s.
Pretty a =>
(Map MutableDep BuildSuccess -> Natural -> Text)
-> (Natural -> Text) -> StageState a s -> StageResult
stageResult Map MutableDep BuildSuccess -> Natural -> Text
success Natural -> Text
failure (StageState Lower SolverState -> StageResult)
-> M (StageState Lower SolverState) -> M StageResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QueryDep -> M (Maybe (DepMutation Lower)))
-> MutationHandlers Lower SolverState
-> BuildConfig
-> StageContext
-> SolverState
-> M (StageState Lower SolverState)
forall a s.
Pretty a =>
(QueryDep -> M (Maybe (DepMutation a)))
-> MutationHandlers a s
-> BuildConfig
-> StageContext
-> s
-> M (StageState a s)
processQuery QueryDep -> M (Maybe (DepMutation Lower))
candidates MutationHandlers Lower SolverState
mutationHandlers BuildConfig
conf StageContext
context SolverState
ext
  where
    candidates :: QueryDep -> M (Maybe (DepMutation Lower))
candidates = (PackageName -> M [Version])
-> MutableVersions -> QueryDep -> M (Maybe (DepMutation Lower))
candidatesOptimize BuildHandlers
handlers.versions StageContext
context.initial

    mutationHandlers :: MutationHandlers Lower SolverState
mutationHandlers = BuildConfig
-> LowerMode
-> (Bool
    -> MutableId
    -> PackageId
    -> MutationConstraints
    -> MutationConstraints)
-> MutationHandlers Lower SolverState
Mutation.handlersLower BuildConfig
conf LowerMode
lowerOptimizeMode Bool
-> MutableId
-> PackageId
-> MutationConstraints
-> MutationConstraints
lowerOptimizeUpdate

    ext :: SolverState
ext = Ranges -> EnvDeps -> EnvConstraints -> SolverFlags -> SolverState
solverState EnvContext
env.solverBounds EnvContext
env.deps ((Version -> VersionBounds) -> MutableVersions -> EnvConstraints
fromVersions Version -> VersionBounds
fromUpper MutableVersions
versions) SolverFlags
forall a. Default a => a
def

lowerOptimizeStage ::
  BuildHandlers ->
  BuildConfig ->
  Flow ()
lowerOptimizeStage :: BuildHandlers -> BuildConfig -> Flow ()
lowerOptimizeStage BuildHandlers
handlers BuildConfig
conf =
  Text -> (StageContext -> M StageResult) -> Flow ()
runStage_ Text
"optimize" (BuildHandlers -> BuildConfig -> StageContext -> M StageResult
lowerOptimize BuildHandlers
handlers BuildConfig
conf)

lowerOptimizeMain ::
  BuildHandlers ->
  ProjectContext ->
  M ProjectResult
lowerOptimizeMain :: BuildHandlers -> ProjectContext -> M ProjectResult
lowerOptimizeMain BuildHandlers
handlers ProjectContext
project =
  BuildHandlers -> ProjectContext -> Flow () -> M ProjectResult
processProject BuildHandlers
handlers ProjectContext
project (BuildHandlers -> BuildConfig -> Flow ()
lowerOptimizeStage BuildHandlers
handlers ProjectContext
project.build)