diff --git a/lib/internal/env.nix b/lib/internal/env.nix index 265966cb..302a2fbe 100644 --- a/lib/internal/env.nix +++ b/lib/internal/env.nix @@ -65,7 +65,7 @@ Internal error: A managed override for '${package}' is missing the attribute '${missing}'. ''; - managedOverride = api: package: {version ? null, hash ? null, repo ? null, jailbreak ? null, local ? null}: let + managedOverride = api: package: {version ? null, hash ? null, repo ? null, jailbreak ? null, local ? null, ...}: let hackage = if repo == null then api.hackage else api.hackageConfGen (unknownHackage package) repo; in if version != null && hash != null diff --git a/packages/hix/lib/Hix/Data/Overrides.hs b/packages/hix/lib/Hix/Data/Overrides.hs index f435a1ea..b8f0c16b 100644 --- a/packages/hix/lib/Hix/Data/Overrides.hs +++ b/packages/hix/lib/Hix/Data/Overrides.hs @@ -15,11 +15,35 @@ import Hix.Data.Version (SourceHash) import Hix.Managed.Cabal.Data.HackageRepo (HackageName (..)) import Hix.Pretty (hpretty) +data IsRevision = + IsRevision + | + IsNotRevision + deriving stock (Eq, Show) + +isRevision :: IsRevision -> Bool +isRevision = \case + IsRevision -> True + IsNotRevision -> False + +toIsRevision :: Bool -> IsRevision +toIsRevision = \case + True -> IsRevision + False -> IsNotRevision + +instance FromJSON IsRevision where + parseJSON v = + toIsRevision <$> parseJSON v + +instance EncodeNix IsRevision where + encodeNix = encodeNix . isRevision + data Override = Override { version :: Version, hash :: SourceHash, - repo :: Maybe HackageName + repo :: Maybe HackageName, + revision :: Maybe IsRevision } | Jailbreak @@ -30,7 +54,7 @@ data Override = instance EncodeNix Override where encodeNix = \case Override {..} -> - ExprAttrs (static <> foldMap (pure . assoc "repo") repo) + ExprAttrs (static <> foldMap (pure . assoc "repo") repo <> foldMap (pure . assoc "revision") revision) where static = [assoc "version" version, assoc "hash" hash] @@ -43,7 +67,7 @@ instance EncodeNix Override where override :: Version -> SourceHash -> Override override version hash = - Override {repo = Nothing, ..} + Override {repo = Nothing, revision = Nothing, ..} instance FromJSON Override where parseJSON = @@ -54,6 +78,7 @@ instance FromJSON Override where JsonParsec version <- o .: "version" hash <- o .: "hash" repo <- o .:? "repo" + revision <- o .:? "revision" pure Override {..} jailbreak o = do @@ -68,13 +93,18 @@ instance FromJSON Override where instance Pretty Override where pretty = \case - Override {..} -> pretty version <+> brackets (pretty hash <> foldMap renderRepo repo) + Override {..} -> + pretty version <+> brackets (pretty hash <> foldMap renderRepo repo <> foldMap renderRevision revision) Jailbreak -> "jailbreak" Local -> "local" where renderRepo (HackageName name) = hcat [text ",", hpretty name] + renderRevision = \case + IsRevision -> ",rev" + IsNotRevision -> mempty + -- | Overrides can be either for mutable (direct, nonlocal) deps, or for transitive deps, so they must use -- 'PackageName'. newtype Overrides = diff --git a/packages/hix/lib/Hix/Managed/Build.hs b/packages/hix/lib/Hix/Managed/Build.hs index bea7e382..ff0f1fbc 100644 --- a/packages/hix/lib/Hix/Managed/Build.hs +++ b/packages/hix/lib/Hix/Managed/Build.hs @@ -2,23 +2,23 @@ module Hix.Managed.Build where import Control.Monad (foldM) import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import qualified Data.Text as Text import Distribution.Pretty (Pretty) import Exon (exon) import Text.PrettyPrint (vcat) +import Hix.Class.Map (nToMaybe) import qualified Hix.Color as Color import qualified Hix.Console import Hix.Console (color, colors) import Hix.Data.EnvName (EnvName) import Hix.Data.Monad (M) -import Hix.Data.Overrides (Overrides) -import qualified Hix.Data.PackageId -import Hix.Data.PackageId (PackageId) +import Hix.Data.Overrides (IsRevision (..), Override (..), Overrides) +import Hix.Data.PackageId (PackageId (..)) import Hix.Data.Version (Version, Versions) import Hix.Data.VersionBounds (VersionBounds) import qualified Hix.Log as Log -import Hix.Managed.Data.NixOutput (PackageDerivation (..)) import Hix.Managed.Build.Solve (solveMutation) import qualified Hix.Managed.Cabal.Changes import Hix.Managed.Cabal.Config (isNonReinstallableDep, isReinstallableId) @@ -32,6 +32,7 @@ import qualified Hix.Managed.Data.Mutation import Hix.Managed.Data.Mutation (BuildMutation (BuildMutation), DepMutation, MutationResult (..)) import qualified Hix.Managed.Data.MutationState import Hix.Managed.Data.MutationState (MutationState (MutationState), updateBoundsWith) +import Hix.Managed.Data.NixOutput (PackageDerivation (..)) import Hix.Managed.Data.Query (Query (Query)) import qualified Hix.Managed.Data.QueryDep import Hix.Managed.Data.QueryDep (QueryDep) @@ -107,12 +108,12 @@ buildVersions :: Bool -> Versions -> [PackageId] -> - M (Overrides, Set PackageId, BuildStatus) + M (Overrides, BuildStatus) buildVersions builder context description allowRevisions versions overrideVersions = do logBuildInputs context.env description reinstallable - (result, (overrides, revisions)) <- builder.buildTargets allowRevisions versions reinstallable + (result, overrides) <- builder.buildTargets allowRevisions versions reinstallable logBuildResult description result - pure (overrides, revisions, buildStatus result) + pure (overrides, buildStatus result) where reinstallable = filter isReinstallableId overrideVersions @@ -121,29 +122,32 @@ buildConstraints :: EnvContext -> Text -> Bool -> - Set PackageId -> + Overrides -> SolverState -> - M (Maybe (Versions, Overrides, Set PackageId, BuildStatus)) -buildConstraints builder context description allowRevisions prevRevisions state = + M (Maybe (Versions, Overrides, BuildStatus)) +buildConstraints builder context description allowRevisions prevOverrides state = solveMutation builder.cabal context.deps prevRevisions state >>= traverse \ changes -> do - (overrides, revisions, status) <- + (overrides, status) <- buildVersions builder context description allowRevisions changes.versions changes.overrides - pure (changes.versions, overrides, prevRevisions <> revisions, status) + pure (changes.versions, overrides, status) + where + prevRevisions = + Set.fromList $ nToMaybe prevOverrides \cases + name Override {version, revision = Just IsRevision} -> Just PackageId {..} + _ _ -> Nothing buildMutation :: EnvBuilder -> EnvContext -> MutationState -> - Set PackageId -> BuildMutation -> - M (Maybe (MutationState, Set PackageId)) -buildMutation builder context state prevRevisions BuildMutation {description, solverState, updateBound} = - result <$> buildConstraints builder context description True prevRevisions solverState + M (Maybe MutationState) +buildMutation builder context state BuildMutation {description, solverState, updateBound} = + result <$> buildConstraints builder context description True state.overrides solverState where result = \case - Just (versions, overrides, revisions, status) -> do - new <- justSuccess (updateMutationState updateBound versions overrides state) status - pure (new, revisions) + Just (versions, overrides, status) -> + justSuccess (updateMutationState updateBound versions overrides state) status Nothing -> Nothing logMutationResult :: @@ -177,7 +181,7 @@ validateMutation envBuilder context handlers stageState mutation = do then pure MutationKeep else handlers.process stageState.ext mutation build - build = buildMutation envBuilder context stageState.state stageState.revisions + build = buildMutation envBuilder context stageState.state convergeMutations :: Pretty a => diff --git a/packages/hix/lib/Hix/Managed/Build/Mutation.hs b/packages/hix/lib/Hix/Managed/Build/Mutation.hs index 725b8caf..52ca0ad9 100644 --- a/packages/hix/lib/Hix/Managed/Build/Mutation.hs +++ b/packages/hix/lib/Hix/Managed/Build/Mutation.hs @@ -56,18 +56,18 @@ updateConstraints impl candidate state = -- 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))) -> + (BuildMutation -> M (Maybe MutationState)) -> (Version -> VersionBounds -> VersionBounds) -> (MutableId -> PackageId -> MutationConstraints -> MutationConstraints) -> SolverState -> MutableDep -> Version -> - M (Maybe (MutableId, SolverState, MutationState, Set PackageId)) + M (Maybe (MutableId, SolverState, MutationState)) buildCandidate build updateStateBound updateConstraintBound solverState package version = do Log.debug [exon|Mutation constraints for #{showP candidate}: #{showP mutationSolverState.constraints}|] fmap result <$> build (candidateMutation mutationSolverState candidate updateStateBound) where - result (newState, revisions) = (candidate, newSolverState newState, newState, revisions) + result newState = (candidate, newSolverState newState, newState) candidate = MutableId {name = package, version} diff --git a/packages/hix/lib/Hix/Managed/Build/Single.hs b/packages/hix/lib/Hix/Managed/Build/Single.hs index 13327f22..4e3127fb 100644 --- a/packages/hix/lib/Hix/Managed/Build/Single.hs +++ b/packages/hix/lib/Hix/Managed/Build/Single.hs @@ -1,6 +1,7 @@ module Hix.Managed.Build.Single where import Hix.Data.Monad (M) +import Hix.Data.Overrides (Overrides) import Hix.Data.VersionBounds (exactVersion) import Hix.Managed.Build (buildConstraints) import Hix.Managed.Cabal.Data.SolverState (solverState) @@ -18,10 +19,11 @@ buildVersions :: EnvContext -> Text -> MutableVersions -> + Maybe Overrides -> M BuildStatus -buildVersions builder context description versions = - buildConstraints builder context description False [] solver <&> \case - Just (_, _, _, status) -> status +buildVersions builder context description versions prevOverrides = + buildConstraints builder context description False (fold prevOverrides) solver <&> \case + Just (_, _, status) -> status Nothing -> Failure where solver = solverState context.solverBounds context.deps (fromVersions exactVersion versions) def diff --git a/packages/hix/lib/Hix/Managed/Build/Solve.hs b/packages/hix/lib/Hix/Managed/Build/Solve.hs index 7f2e0905..cd32ae55 100644 --- a/packages/hix/lib/Hix/Managed/Build/Solve.hs +++ b/packages/hix/lib/Hix/Managed/Build/Solve.hs @@ -9,7 +9,7 @@ import Text.PrettyPrint (hang, ($$), (<+>)) import Hix.Class.Map (nRestrictKeys) import Hix.Data.Monad (M) -import Hix.Data.PackageId (PackageId (PackageId)) +import Hix.Data.PackageId (PackageId) import Hix.Data.Version (packageIdVersions) import qualified Hix.Log as Log import qualified Hix.Managed.Cabal.Changes @@ -28,6 +28,18 @@ logNonReinstallable :: NonEmpty PackageId -> M () logNonReinstallable ids = Log.verbose [exon|NOTE: Cabal solver suggested new versions for non-reinstallable packages: #{showPL ids}|] +-- | Forcing revisions means that any package that has a revision in the Hackage snapshot will be treated as an +-- override, i.e. it will be built from Hackage despite having the same version as the one installed in nixpkgs. +-- +-- The benefit of doing this is that often nixpkgs will be outdated in comparison with Hackage, and therefore have +-- tighter dependency bounds. +-- When Cabal resolves a plan based on revised bounds in packages whose versions match nixpkgs, but not their revisions, +-- the nix build will fail with bounds errors, requiring a restart with revisions. +-- +-- On the other hand, in many situations (like lower bound mutations), this is entirely irrelevant; in others, the +-- original bounds might just work for the current build; and most often nixpkgs actually has the latest revision, which +-- we cannot observe at this point. +-- Therefore, this feature is disabled until it can be refined. checkRevision :: Bool -> CabalHandlers -> @@ -62,13 +74,13 @@ processSolverPlan forceRevisions cabal deps prevRevisions SolverPlan {..} = do where projectDeps = nRestrictKeys mutablePIds versions versions = packageIdVersions (overrides ++ installed) - overrides = filter notLocal (changes ++ forcedRevisions ++ reusedRevisions) + overrides = changes ++ forcedRevisions ++ reusedRevisions + -- If a package has been selected for revision during a prior build, add it to the overrides despite its matching + -- version. + -- This simply ensures that the revision procedure can be skipped in this build, since the same version will likely + -- cause the same dependency bounds error that triggered the revision. (reusedRevisions, installed) = partition (flip Set.member prevRevisions) noForcedRevisions (noForcedRevisions, forcedRevisions) = partitionEithers (checkRevision forceRevisions cabal <$> matching) - -- notLocal PackageId {name} = not (isLocalPackage deps.local name) - -- TODO I assumed that targets hadn't been part of EnvDeps.local for a long time, so this shouldn't be effective - -- anymore, but verify anyway! - notLocal PackageId {} = True mutablePIds = Set.fromList (depName <$> Set.toList deps.mutable) -- TODO probably best to store the revisions in the SolverState diff --git a/packages/hix/lib/Hix/Managed/Build/Target.hs b/packages/hix/lib/Hix/Managed/Build/Target.hs index 34ea4b14..42a4e408 100644 --- a/packages/hix/lib/Hix/Managed/Build/Target.hs +++ b/packages/hix/lib/Hix/Managed/Build/Target.hs @@ -1,7 +1,6 @@ module Hix.Managed.Build.Target where import Control.Monad.Trans.State.Strict (StateT (runStateT)) -import qualified Data.Map.Strict as Map import Exon (exon) import Path (Abs, Dir, Path) @@ -26,7 +25,7 @@ import Hix.Managed.Data.Targets (Targets, firstMTargets) import Hix.Managed.Handlers.AvailableVersions (AvailableVersionsHandlers (..)) import Hix.Managed.Handlers.SourceHash (SourceHashHandlers) import Hix.Managed.Handlers.StateFile (StateFileHandlers) -import Hix.Managed.Overrides (packageOverride, packageOverrides) +import Hix.Managed.Overrides (packageOverrideRegular, packageOverrides, packageRevision) import Hix.Managed.StateFile (writeBuildStateFor, writeSolverStateFor) data BuilderResources = @@ -76,7 +75,7 @@ suggestRevision resources _ pkg = \cases Nothing (BoundsError _) | Just package <- failedPackageId pkg -> do - override <- packageOverride resources.hackage [] package + override <- packageRevision resources.hackage [] package pure (Just RetryPackage {package, ..}) _ _ -> pure Nothing @@ -92,9 +91,13 @@ suggestNothing _ _ _ _ = latestVersionFor :: BuilderResources -> PackageName -> M (Maybe RetryPackage) latestVersionFor resources target = resources.versions.latest target >>= traverse \ latest -> do - override <- packageOverride resources.hackage [] PackageId {name = target, version = latest} + override <- packageOverrideRegular resources.hackage [] PackageId {name = target, version = latest} pure RetryPackage {package = PackageId {name = target, version = override.version}, ..} +-- | This might seem wrong at first glance – it immediately jailbreaks the entire package even though a newer revision +-- might relax just the right bounds and leave the rest intact. +-- However, at this point bounds are entirely useless, since a) we already incorporated proper bounds in our plan by +-- running the solver, and b) nix cannot select between different versions anyway. suggestJailbreakAndLatestVersion :: BuilderResources -> FailureCounts -> @@ -130,11 +133,11 @@ buildTargets :: Bool -> Versions -> [PackageId] -> - M (BuildResult, (Overrides, Set PackageId)) + M (BuildResult, Overrides) buildTargets builder allowRevisions _ overrideVersions = do overrides <- packageOverrides builder.global.hackage builder.localUnavailable overrideVersions let build target = buildAdaptive (buildWithOverrides builder.global builder.env target) suggest s0 = (overrides, []) - second (second Map.keysSet) <$> runStateT (firstMTargets (BuildSuccess []) buildUnsuccessful build builder.targets) s0 + second fst <$> runStateT (firstMTargets (BuildSuccess []) buildUnsuccessful build builder.targets) s0 where suggest = if allowRevisions then suggestRevision builder.global else suggestNothing diff --git a/packages/hix/lib/Hix/Managed/Data/Mutation.hs b/packages/hix/lib/Hix/Managed/Data/Mutation.hs index 0750fd45..8dd330d1 100644 --- a/packages/hix/lib/Hix/Managed/Data/Mutation.hs +++ b/packages/hix/lib/Hix/Managed/Data/Mutation.hs @@ -4,7 +4,6 @@ import Distribution.Pretty (Pretty (pretty)) import qualified Text.PrettyPrint as PrettyPrint import Text.PrettyPrint (parens, (<+>)) -import Hix.Data.PackageId (PackageId) import Hix.Data.Version (Version) import Hix.Data.VersionBounds (VersionBounds) import Hix.Managed.Cabal.Data.SolverState (SolverState) @@ -41,7 +40,6 @@ data MutationResult s = candidate :: MutableId, changed :: Bool, state :: MutationState, - revisions :: Set PackageId, ext :: s } | diff --git a/packages/hix/lib/Hix/Managed/Data/StageState.hs b/packages/hix/lib/Hix/Managed/Data/StageState.hs index def9f5d1..f3433fe2 100644 --- a/packages/hix/lib/Hix/Managed/Data/StageState.hs +++ b/packages/hix/lib/Hix/Managed/Data/StageState.hs @@ -94,7 +94,6 @@ data StageState a s = success :: Map MutableDep BuildSuccess, failed :: [DepMutation a], state :: MutationState, - revisions :: Set PackageId, iterations :: Word, ext :: s } @@ -102,4 +101,4 @@ data StageState a s = initStageState :: Initial MutationState -> s -> StageState a s initStageState (Initial state) ext = - StageState {success = [], failed = [], revisions = [], iterations = 0, ..} + StageState {success = [], failed = [], iterations = 0, ..} diff --git a/packages/hix/lib/Hix/Managed/Handlers/Build.hs b/packages/hix/lib/Hix/Managed/Handlers/Build.hs index 2dcc38d8..4c9d9fb3 100644 --- a/packages/hix/lib/Hix/Managed/Handlers/Build.hs +++ b/packages/hix/lib/Hix/Managed/Handlers/Build.hs @@ -41,7 +41,7 @@ data EnvBuilder = EnvBuilder { state :: EnvState, cabal :: CabalHandlers, - buildTargets :: Bool -> Versions -> [PackageId] -> M (BuildResult, (Overrides, Set PackageId)) + buildTargets :: Bool -> Versions -> [PackageId] -> M (BuildResult, Overrides) } data Builder = @@ -61,7 +61,7 @@ data BuildHandlers = } testBuilder :: - (Bool -> Versions -> [PackageId] -> M (BuildResult, (Overrides, Set PackageId))) -> + (Bool -> Versions -> [PackageId] -> M (BuildResult, Overrides)) -> (Builder -> M a) -> M a testBuilder buildTargets use = @@ -77,7 +77,7 @@ versionsBuilder hackage build = testBuilder \ _ versions overrideVersions -> do overrides <- packageOverrides hackage mempty overrideVersions status <- build versions - pure (status, (overrides, mempty)) + pure (status, overrides) handlersNull :: BuildHandlers handlersNull = diff --git a/packages/hix/lib/Hix/Managed/Handlers/Maint/Prod.hs b/packages/hix/lib/Hix/Managed/Handlers/Maint/Prod.hs index 91b54e2f..d58fd9d2 100644 --- a/packages/hix/lib/Hix/Managed/Handlers/Maint/Prod.hs +++ b/packages/hix/lib/Hix/Managed/Handlers/Maint/Prod.hs @@ -2,7 +2,6 @@ module Hix.Managed.Handlers.Maint.Prod where import qualified Data.List.NonEmpty as NonEmpty import Exon (exon) -import Path (Abs, Dir, Path) import Hix.Data.EnvName (EnvName) import qualified Hix.Data.Monad @@ -12,11 +11,11 @@ import Hix.Http (httpManager) import Hix.Managed.BuildOutput (depChanges) import Hix.Managed.Bump.Optimize (bumpOptimizeMain) import Hix.Managed.Cabal.Data.Config (CabalConfig, HackagePurpose (ForPublish)) -import Hix.Managed.Data.BuildOutput (BuildOutput, DepChanges) +import Hix.Managed.Data.BuildOutput (DepChanges) import qualified Hix.Managed.Data.EnvContext import Hix.Managed.Data.MaintConfig (MaintConfig (..)) import Hix.Managed.Data.ProjectContext (ProjectContext (..)) -import Hix.Managed.Flake (flakeFailure, runFlake, runFlakeFor) +import Hix.Managed.Flake (flakeFailure, runFlakeFor) import Hix.Managed.Handlers.Build (BuildHandlers (..)) import qualified Hix.Managed.Handlers.Build.Prod as Build import qualified Hix.Managed.Handlers.Context as ContextHandlers @@ -29,10 +28,6 @@ import Hix.Managed.ProjectContext (updateProject) import qualified Hix.Managed.ProjectContextProto as ProjectContextProto import Hix.Monad (noteFatal) --- TODO remove -runBumpFlake :: Path Abs Dir -> M BuildOutput -runBumpFlake root = runFlake "Managed bounds" root ["run", ".#bump", "--", "--output=json", "--handlers=test-maint", "--build-output"] id - projectWithEnv :: EnvName -> ProjectContext -> M ProjectContext projectWithEnv target ProjectContext {..} = do newEnvs <- noteFatal [exon|Couldn't find env '##{target}' in the project context|] (nonEmpty updated) diff --git a/packages/hix/lib/Hix/Managed/Handlers/Mutation.hs b/packages/hix/lib/Hix/Managed/Handlers/Mutation.hs index 3a5b092e..0520dab0 100644 --- a/packages/hix/lib/Hix/Managed/Handlers/Mutation.hs +++ b/packages/hix/lib/Hix/Managed/Handlers/Mutation.hs @@ -1,7 +1,6 @@ module Hix.Managed.Handlers.Mutation where import Hix.Data.Monad (M) -import Hix.Data.PackageId (PackageId) import Hix.Managed.Data.Mutation (BuildMutation, DepMutation, MutationResult) import Hix.Managed.Data.MutationState (MutationState) @@ -10,6 +9,6 @@ data MutationHandlers a s = process :: s -> DepMutation a -> - (BuildMutation -> M (Maybe (MutationState, Set PackageId))) -> + (BuildMutation -> M (Maybe MutationState)) -> M (MutationResult s) } diff --git a/packages/hix/lib/Hix/Managed/Handlers/Mutation/Bump.hs b/packages/hix/lib/Hix/Managed/Handlers/Mutation/Bump.hs index db7afbdf..47e4d425 100644 --- a/packages/hix/lib/Hix/Managed/Handlers/Mutation/Bump.hs +++ b/packages/hix/lib/Hix/Managed/Handlers/Mutation/Bump.hs @@ -35,12 +35,12 @@ updateBound = VersionBounds.withUpper . nextMajor processMutationBump :: SolverState -> DepMutation Bump -> - (BuildMutation -> M (Maybe (MutationState, Set PackageId))) -> + (BuildMutation -> M (Maybe MutationState)) -> M (MutationResult SolverState) processMutationBump solver DepMutation {package, mutation = Bump {version, changed}} build = builder version <&> \case - Just (candidate, ext, state, revisions) -> - MutationSuccess {candidate, changed, state, revisions, ext} + Just (candidate, ext, state) -> + MutationSuccess {candidate, changed, state, ext} Nothing -> MutationFailed where diff --git a/packages/hix/lib/Hix/Managed/Handlers/Mutation/Lower.hs b/packages/hix/lib/Hix/Managed/Handlers/Mutation/Lower.hs index a4420249..9749baf6 100644 --- a/packages/hix/lib/Hix/Managed/Handlers/Mutation/Lower.hs +++ b/packages/hix/lib/Hix/Managed/Handlers/Mutation/Lower.hs @@ -38,12 +38,12 @@ processMutationLower :: (Bool -> MutableId -> PackageId -> MutationConstraints -> MutationConstraints) -> SolverState -> DepMutation Lower -> - (BuildMutation -> M (Maybe (MutationState, Set PackageId))) -> + (BuildMutation -> M (Maybe MutationState)) -> M (MutationResult SolverState) processMutationLower conf mode update solver DepMutation {package, retract, mutation = Lower {majors}} build = do foldM buildMajor (Right 0, Nothing) majors <&> \case - (_, Just (candidate, ext, state, revisions)) -> - MutationSuccess {candidate, changed = True, state, revisions, ext} + (_, Just (candidate, ext, state)) -> + MutationSuccess {candidate, changed = True, state, ext} (_, Nothing) -> mode.noSuccess where diff --git a/packages/hix/lib/Hix/Managed/Lower/Stabilize.hs b/packages/hix/lib/Hix/Managed/Lower/Stabilize.hs index 7e52dbaa..0e94b229 100644 --- a/packages/hix/lib/Hix/Managed/Lower/Stabilize.hs +++ b/packages/hix/lib/Hix/Managed/Lower/Stabilize.hs @@ -46,7 +46,7 @@ import Hix.Managed.StageResult (stageResult) buildLowerInit :: Flow BuildStatus buildLowerInit = do execStatelessStage "stabilize-initial" \ StageContext {env, initialVersions, builder} -> - buildVersions builder env "initial lower bounds" initialVersions <&> \case + buildVersions builder env "initial lower bounds" initialVersions Nothing <&> \case Success -> StageNoAction (Just "Env builds successfully with the initial bounds.") Failure -> StageFailure (FailedPrecondition msg) where @@ -111,10 +111,11 @@ stabilizeIfPossible handlers conf = validateCurrent :: Flow BuildStatus validateCurrent = - execStatelessStage "stabilize-current" \ StageContext {env, state = Initial MutationState {versions}, builder} -> - buildVersions builder env "current lower bounds" versions <&> \case - Success -> StageNoAction (Just "Env builds successfully with the current bounds.") - Failure -> StageFailure (FailedPrecondition ["Env does not build successfully with the current bounds."]) + execStatelessStage "stabilize-current" \ + StageContext {env, state = Initial MutationState {versions, overrides}, builder} -> + buildVersions builder env "current lower bounds" versions (Just overrides) <&> \case + Success -> StageNoAction (Just "Env builds successfully with the current bounds.") + Failure -> StageFailure (FailedPrecondition ["Env does not build successfully with the current bounds."]) lowerStabilizeStages :: BuildHandlers -> @@ -123,7 +124,7 @@ lowerStabilizeStages :: lowerStabilizeStages handlers conf = validateCurrent >>= \case Success -> unit - _ -> stabilizeIfPossible handlers conf + Failure -> stabilizeIfPossible handlers conf lowerStabilizeMain :: BuildHandlers -> ProjectContext -> M ProjectResult lowerStabilizeMain = processProjectSimple lowerStabilizeStages diff --git a/packages/hix/lib/Hix/Managed/Overrides.hs b/packages/hix/lib/Hix/Managed/Overrides.hs index 5b450faa..b39d040d 100644 --- a/packages/hix/lib/Hix/Managed/Overrides.hs +++ b/packages/hix/lib/Hix/Managed/Overrides.hs @@ -2,7 +2,7 @@ module Hix.Managed.Overrides where import Hix.Class.Map (nForAssoc) import Hix.Data.Monad (M) -import Hix.Data.Overrides (Override (..), Overrides) +import Hix.Data.Overrides (IsRevision (..), Override (..), Overrides) import qualified Hix.Data.PackageId import Hix.Data.PackageId (PackageId (PackageId)) import Hix.Data.PackageName (LocalPackage, isLocalPackage) @@ -14,22 +14,39 @@ import Hix.Monad (fatalError) -- If the package wasn't found anywhere, and it is part of the local build, assume that it hasn't been published yet and -- force it to be built from local sources by returning 'Local'. packageOverride :: + Maybe IsRevision -> SourceHashHandlers -> Set LocalPackage -> PackageId -> M Override -packageOverride handlers localUnavailable package@PackageId {version} = do +packageOverride revision handlers localUnavailable package@PackageId {version} = do handlers.fetchHash package >>= \case - Right (hash, repo) -> pure Override {..} + Right (hash, repo) -> pure Override {revision, ..} Left err | isLocalPackage localUnavailable package.name -> pure Local | otherwise -> fatalError err +packageOverrideRegular :: + SourceHashHandlers -> + Set LocalPackage -> + PackageId -> + M Override +packageOverrideRegular = + packageOverride Nothing + +packageRevision :: + SourceHashHandlers -> + Set LocalPackage -> + PackageId -> + M Override +packageRevision = + packageOverride (Just IsRevision) + packageOverrides :: SourceHashHandlers -> Set LocalPackage -> [PackageId] -> M Overrides packageOverrides handlers localUnavailable versions = - nForAssoc versions \ pid -> do - o <- packageOverride handlers localUnavailable pid - pure (pid.name, o) + nForAssoc versions \ package -> do + o <- packageOverrideRegular handlers localUnavailable package + pure (package.name, o) diff --git a/packages/hix/lib/Hix/Managed/StageState.hs b/packages/hix/lib/Hix/Managed/StageState.hs index a5a3b60b..a043440a 100644 --- a/packages/hix/lib/Hix/Managed/StageState.hs +++ b/packages/hix/lib/Hix/Managed/StageState.hs @@ -1,7 +1,6 @@ module Hix.Managed.StageState where import qualified Data.Map.Strict as Map -import qualified Data.Set as Set import qualified Hix.Managed.Data.MutableId import qualified Hix.Managed.Data.Mutation @@ -18,7 +17,6 @@ updateStageState old mutation = \case old { success = Map.insert candidate.name buildSuccess old.success, state, - revisions = Set.union revisions old.revisions, ext } where diff --git a/packages/hix/test/Hix/Test/Managed/LowerOptimize/CandidatesTest.hs b/packages/hix/test/Hix/Test/Managed/LowerOptimize/CandidatesTest.hs index d417fa33..3544b041 100644 --- a/packages/hix/test/Hix/Test/Managed/LowerOptimize/CandidatesTest.hs +++ b/packages/hix/test/Hix/Test/Managed/LowerOptimize/CandidatesTest.hs @@ -4,7 +4,6 @@ import Data.IORef (IORef, modifyIORef', newIORef, readIORef) import Distribution.Version (Version) import Hedgehog (evalEither, (===)) -import Hix.Data.PackageId (PackageId) import Hix.Data.PackageName (PackageName) import qualified Hix.Data.VersionBounds import Hix.Data.VersionBounds (fromLower, fromUpper) @@ -53,12 +52,11 @@ targets = candidateVersion :: Version candidateVersion = [1, 9, 2] -build :: IORef [Maybe Version] -> BuildMutation -> M (Maybe (MutationState, Set PackageId)) +build :: IORef [Maybe Version] -> BuildMutation -> M (Maybe MutationState) build buildRef BuildMutation {solverState = SolverState {constraints = [("dep", MutationConstraints {mutation})]}} = do liftIO (modifyIORef' buildRef (mutation.lower :)) pure do - s <- result =<< mutation.lower - pure (s, []) + result =<< mutation.lower where result version | candidateVersion == version @@ -81,7 +79,7 @@ test_candidatesOptimize = do for majors \ mut -> processMutationLower def lowerOptimizeMode lowerOptimizeUpdate initialState mut (build buildRef) mutationResults <- evalEither result - Just (MutationSuccess candidate True mstate [] (updateSolverState (const newConstraints) initialState)) === mutationResults + Just (MutationSuccess candidate True mstate (updateSolverState (const newConstraints) initialState)) === mutationResults triedVersions <- liftIO (readIORef buildRef) (Just <$> targets) === triedVersions where diff --git a/packages/integration/test/Hix/Integration/Managed/SolverPackagesTest.hs b/packages/integration/test/Hix/Integration/Managed/SolverPackagesTest.hs index 7a36bf57..7f74de3d 100644 --- a/packages/integration/test/Hix/Integration/Managed/SolverPackagesTest.hs +++ b/packages/integration/test/Hix/Integration/Managed/SolverPackagesTest.hs @@ -68,7 +68,8 @@ targetOverrides = ("exon", Override { version = [1, 7, 2, 0], hash = SourceHash "0hg271cvjqm4ps75qpnirq9nvjwpwb03mcbn1a364jrysrj6bg3b", - repo = Just "hackage.haskell.org" + repo = Just "hackage.haskell.org", + revision = Nothing }), ("incipit-base", Jailbreak), ("incipit-core", Jailbreak),