diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 1214a486..00235a4b 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -181,6 +181,14 @@ There are also a number of checks run by the Nix flake for non-PureScript code, nix flake check -L ``` +### Solver Benchmarks + +Run the local Minibench workloads with `spago run -p registry-scripts -m Registry.Scripts.BenchSolver -- --samples 40 > before.json`. +Use `--baseline before.json` to check identical resolutions and diagnostics, and `--case NAME` to filter workloads. +Optional `--snapshot PATH` adds registry cases; its JSON contains `manifests` (manifest array), `metadata` (package-name map), and `compilers` (nonempty version array). +Reports contain mean, standard deviation, minimum, and maximum in nanoseconds; input preparation and validation are untimed. +Compare repeated before/after runs on the same machine and snapshot, without concurrent builds; these measure dependency solving, not compilation or scheduling. + ### Testing Guidelines The PureScript code in the registry is well-tested, ranging from tests for individual functions to full end-to-end tests for the registry server running in a NixOS machine configured the same way as the deployed machine. The smaller and more pure the test, the easier it is to write and maintain; most code is tested via unit tests written with `spec`, and only the core pipelines are run in the integration test. diff --git a/lib/src/Solver.purs b/lib/src/Solver.purs index 89703b1a..e8bbf08d 100644 --- a/lib/src/Solver.purs +++ b/lib/src/Solver.purs @@ -37,6 +37,7 @@ import Data.Foldable (fold, foldMap, intercalate) import Data.FoldableWithIndex (anyWithIndex, foldMapWithIndex, foldlWithIndex, forWithIndex_) import Data.Functor.App (App(..)) import Data.FunctorWithIndex (mapWithIndex) +import Data.List (List(..)) import Data.List.NonEmpty as NEL import Data.Map (Map, SemigroupMap(..)) import Data.Map as Map @@ -134,7 +135,7 @@ updateCompilerIndex (CompilerIndex index) (Manifest m) (Metadata { published }) -- | a compiler range accepted by all dependencies. solveWithCompiler :: Range -> CompilerIndex -> Map PackageName Range -> Either SolverErrors (Tuple Version (Map PackageName Version)) solveWithCompiler pursRange (CompilerIndex index) required = do - results <- solveFull { registry: initializeRegistry index, required: initializeRequired (Map.insert purs pursRange required) } + results <- solve index (Map.insert purs pursRange required) let pursVersion = Maybe.fromMaybe' (\_ -> Partial.unsafeCrashWith "Produced a compiler-derived build plan with no compiler!") $ Map.lookup purs results pure $ Tuple pursVersion $ Map.delete purs results @@ -149,10 +150,15 @@ type DependencyIndex = Map PackageName (Map Version (Map PackageName Range)) -- | Solve a map of requirements given a registry index. solve :: DependencyIndex -> Map PackageName Range -> Either SolverErrors (Map PackageName Version) -solve index required = +solve index required = do + let + initializedRequired = initializeRequired required + -- Record where the dependency requirements come from for every package + -- version reachable in this solve, for use in error reporting. + registry = initializeRegistry (gatherReachable index required) solveFull - { registry: initializeRegistry index - , required: initializeRequired required + { registry: map (addFrom initializedRequired) <$> registry + , required: initializedRequired } -------------------------------------------------------------------------------- @@ -300,7 +306,7 @@ type RRI = RR (inRange :: TransitivizedRegistry) -- | latest version of the alphabetically-smallest package that isn't pinned to -- | a single version yet. solveFull :: RR () -> Either SolverErrors (Map PackageName Version) -solveFull = solveAux <<< solveSeed <<< withReachable +solveFull = solveAux <<< solveSeed where solveAux :: RRU -> Either SolverErrors (Map PackageName Version) @@ -575,17 +581,24 @@ requirementUpdates { registry: SemigroupMap registry, required: SemigroupMap req Just versions -> SemigroupMap $ Map.singleton package versions Nothing -> mempty --- | Trim the registry down to only package versions that are reachable from --- | the initial set of requirements. Only done once. -gatherReachable :: forall r. RR r -> TransitivizedRegistry -gatherReachable { registry, required } = - let - reachable0 :: SemigroupMap PackageName (SemigroupMap Version (SemigroupMap PackageName Intersection)) - reachable0 = mapWithIndex (getPackageRange registry) required - moreReachable = (foldMap <<< foldMap) (mapWithIndex (getPackageRange registry)) - reachable = fixEqM moreReachable reachable0 - in - reachable +-- | Visit each reachable package version once. Dependencies are immutable at +-- | this point, so revisiting a version cannot discover any new edges. Track +-- | versions, not just package names: a later edge may reach a disjoint range. +gatherReachable :: DependencyIndex -> Map PackageName Range -> DependencyIndex +gatherReachable registry required = go Map.empty (Map.toUnfoldable required) + where + go seen Nil = seen + go seen (Cons (Tuple package range) pending) = do + let + visited = fromMaybe Map.empty (Map.lookup package seen) + versions = fromMaybe Map.empty (Map.lookup package registry) + fresh = Map.filterKeys (\version -> Range.includes range version && not (Map.member version visited)) versions + if Map.isEmpty fresh then go seen pending + else do + let + next = foldMap Map.toUnfoldable fresh <> pending + seen' = Map.insert package (Map.union fresh visited) seen + go seen' next -- | Also helps with efficiency: remove package versions from the registry -- | that are outside of the global requirements. Done regularly. @@ -632,22 +645,20 @@ instance Semigroup SolverPosition where append (Pos l1 g1) (Pos l2 g2) = Pos (l1 <> l2) (g1 <> g2) -dependency :: SolverPosition -> SolverPosition -> SolverPosition -dependency (Pos _ g1) (Pos l2 g2) = Pos l2 (g1 <> g2) - -dependencyOf :: forall z. Newtype z Sourced => SolverPosition -> z -> z -dependencyOf p1 = coerce \(Sourced v p2) -> - Sourced v (dependency p1 p2) +dependencyOf :: forall z. Newtype z Sourced => Set PackageName -> z -> z +dependencyOf roots = coerce \(Sourced v (Pos local global)) -> + Sourced v (Pos local (roots <> global)) asDependencyOf :: Intersection -> Intersection -> Intersection -asDependencyOf (Intersection i1) (Intersection i2) = +asDependencyOf (Intersection i1) (Intersection i2) = do let - pos = getPos i1.lower <> getPos i1.upper - in - Intersection - { lower: dependencyOf pos i2.lower - , upper: dependencyOf pos i2.upper - } + Pos _ lowerRoots = getPos i1.lower + Pos _ upperRoots = getPos i1.upper + roots = lowerRoots <> upperRoots + Intersection + { lower: dependencyOf roots i2.lower + , upper: dependencyOf roots i2.upper + } data Sourced = Sourced Version SolverPosition @@ -742,9 +753,6 @@ fromLoose = coerce -- Data management -------------------------------------------------------------------------------- -withReachable :: forall r. RR r -> RR r -withReachable r = r { registry = map (addFrom r.required) <$> gatherReachable r } - withInRange :: RR () -> RRI withInRange r = { registry: r.registry @@ -790,24 +798,5 @@ doubleton package version dat = coerce $ Map.alter (Just <<< helper) package accumulated :: forall a. Monoid a => Endo (->) a -> a accumulated (Endo f) = f mempty -fixEq :: forall a. Eq a => (a -> a) -> (a -> a) -fixEq f a = let b = f a in if b == a then a else fixEq f b - --- | An optimized fixpoint for semilattice closure operations, accumulating a --- | full result while only running the function on the newly added bit. --- | --- | Invariant: f (acc <> lastAdded) = acc <> f lastAdded -fixEqM :: forall a. Semigroup a => Eq a => (a -> a) -> (a -> a) -fixEqM f = join go - where - go acc lastAdded = - let - moreAdded = f lastAdded - moreAcc = acc <> moreAdded - in - if moreAcc == acc then acc - else - go moreAcc moreAdded - noUpdates :: forall r k v. { updated :: SemigroupMap k v | r } -> Boolean noUpdates { updated: SemigroupMap updated } = Map.isEmpty updated diff --git a/lib/test/Registry/Solver.purs b/lib/test/Registry/Solver.purs index ac593264..5a03d424 100644 --- a/lib/test/Registry/Solver.purs +++ b/lib/test/Registry/Solver.purs @@ -4,26 +4,26 @@ import Prelude import Data.Array as Array import Data.Either (Either(..)) -import Data.Foldable (for_) +import Data.Foldable (all, for_) import Data.FoldableWithIndex (foldMapWithIndex) +import Data.Int as Int import Data.List.NonEmpty as NonEmptyList import Data.Map (Map, SemigroupMap(..)) import Data.Map as Map -import Data.Maybe (Maybe(..), fromMaybe') +import Data.Maybe (Maybe(..)) import Data.Newtype (un, wrap) import Data.Semigroup.Foldable (intercalateMap) import Data.Set as Set import Data.Set.NonEmpty as NES import Data.Tuple (Tuple(..)) import Data.Tuple.Nested ((/\)) -import Partial.Unsafe (unsafeCrashWith) import Registry.Manifest (Manifest(..)) import Registry.ManifestIndex as ManifestIndex import Registry.PackageName as PackageName import Registry.Range as Range import Registry.Solver (Intersection(..), LocalSolverPosition(..), SolverError(..), SolverPosition(..), Sourced(..), buildCompilerIndex, initializeRegistry, initializeRequired, lowerBound, printSolverError, solve, solveSeed, solveSteps, solveWithCompiler, updateCompilerIndex, upperBound) import Registry.Test.Assert as Assert -import Registry.Test.Utils (fromRight, unsafeManifest, unsafeMetadata, unsafeNonEmptyArray, unsafeVersion) +import Registry.Test.Utils (fromJust, fromRight, unsafeManifest, unsafeMetadata, unsafeNonEmptyArray, unsafePackageName, unsafeRange, unsafeVersion) import Registry.Types (PackageName, Range, Version) import Registry.Version as Version import Test.Spec as Spec @@ -36,7 +36,7 @@ spec = do shouldSucceedSteps goals result = pure unit >>= \_ -> do let solved = solveSteps (solveSeed { registry: initializeRegistry solverIndex, required: initializeRequired (Map.fromFoldable goals) }) - let toRange intersect = fromMaybe' (\_ -> unsafeCrashWith "Bad intersection") (Range.mk (lowerBound intersect) (upperBound intersect)) + let toRange intersect = fromJust "Bad intersection" (Range.mk (lowerBound intersect) (upperBound intersect)) map toRange (un SemigroupMap solved.required) `Assert.shouldEqual` Map.fromFoldable result shouldFail goals errors = pure unit >>= \_ -> case solve solverIndex (Map.fromFoldable goals) of @@ -61,110 +61,110 @@ spec = do Spec.describe "Valid dependency ranges" do Spec.it "Solves simple range" do shouldSucceed - [ simple.package /\ range 0 1 ] - [ simple.package /\ version 0, prelude.package /\ version 0 ] + [ simple.package /\ unsafeRange ">=0.0.0 <1.0.0" ] + [ simple.package /\ unsafeVersion "0.0.0", prelude.package /\ unsafeVersion "0.0.0" ] Spec.it "Chooses range with highest SemVer versions from several solution" do shouldSucceed - [ simple.package /\ range 0 2 ] - [ simple.package /\ version 1, prelude.package /\ version 1 ] + [ simple.package /\ unsafeRange ">=0.0.0 <2.0.0" ] + [ simple.package /\ unsafeVersion "1.0.0", prelude.package /\ unsafeVersion "1.0.0" ] Spec.it "Solves for multiple packages" do shouldSucceed - [ prelude.package /\ range 0 2, simple.package /\ range 0 2 ] - [ simple.package /\ version 1, prelude.package /\ version 1 ] + [ prelude.package /\ unsafeRange ">=0.0.0 <2.0.0", simple.package /\ unsafeRange ">=0.0.0 <2.0.0" ] + [ simple.package /\ unsafeVersion "1.0.0", prelude.package /\ unsafeVersion "1.0.0" ] Spec.describe "Valid ranges with small intersection" do Spec.it "Tight bound on 'prelude@0'" do shouldSucceed - [ simple.package /\ range 0 2 -- loose - , prelude.package /\ range 0 1 -- tight + [ simple.package /\ unsafeRange ">=0.0.0 <2.0.0" -- loose + , prelude.package /\ unsafeRange ">=0.0.0 <1.0.0" -- tight ] - [ simple.package /\ version 0 - , prelude.package /\ version 0 + [ simple.package /\ unsafeVersion "0.0.0" + , prelude.package /\ unsafeVersion "0.0.0" ] Spec.it "Tight bound on 'prelude@1'" do shouldSucceed - [ simple.package /\ range 0 2 -- loose - , prelude.package /\ range 1 2 -- tight + [ simple.package /\ unsafeRange ">=0.0.0 <2.0.0" -- loose + , prelude.package /\ unsafeRange ">=1.0.0 <2.0.0" -- tight ] - [ simple.package /\ version 1 - , prelude.package /\ version 1 + [ simple.package /\ unsafeVersion "1.0.0" + , prelude.package /\ unsafeVersion "1.0.0" ] Spec.it "Tight bound on 'simple@0'" do shouldSucceed - [ prelude.package /\ range 0 2 -- loose - , simple.package /\ range 0 1 -- tight + [ prelude.package /\ unsafeRange ">=0.0.0 <2.0.0" -- loose + , simple.package /\ unsafeRange ">=0.0.0 <1.0.0" -- tight ] - [ simple.package /\ version 0 - , prelude.package /\ version 0 + [ simple.package /\ unsafeVersion "0.0.0" + , prelude.package /\ unsafeVersion "0.0.0" ] Spec.it "Tight bound on 'simple@1'" do shouldSucceed - [ prelude.package /\ range 0 2 -- loose - , simple.package /\ range 1 2 -- tight + [ prelude.package /\ unsafeRange ">=0.0.0 <2.0.0" -- loose + , simple.package /\ unsafeRange ">=1.0.0 <2.0.0" -- tight ] - [ simple.package /\ version 1 - , prelude.package /\ version 1 + [ simple.package /\ unsafeVersion "1.0.0" + , prelude.package /\ unsafeVersion "1.0.0" ] Spec.describe "Single-step expands bounds" do Spec.it "Simple range" do shouldSucceedSteps - [ simple.package /\ range 0 1 ] - [ simple.package /\ range 0 1, prelude.package /\ range 0 1 ] + [ simple.package /\ unsafeRange ">=0.0.0 <1.0.0" ] + [ simple.package /\ unsafeRange ">=0.0.0 <1.0.0", prelude.package /\ unsafeRange ">=0.0.0 <1.0.0" ] Spec.it "Multi-version range" do shouldSucceedSteps - [ simple.package /\ range 0 2 ] - [ simple.package /\ range 0 2, prelude.package /\ range 0 2 ] + [ simple.package /\ unsafeRange ">=0.0.0 <2.0.0" ] + [ simple.package /\ unsafeRange ">=0.0.0 <2.0.0", prelude.package /\ unsafeRange ">=0.0.0 <2.0.0" ] Spec.it "Transitive" do shouldSucceedSteps - [ onlySimple.package /\ range 0 1 ] - [ onlySimple.package /\ range 0 1, simple.package /\ range 0 1, prelude.package /\ range 0 1 ] + [ onlySimple.package /\ unsafeRange ">=0.0.0 <1.0.0" ] + [ onlySimple.package /\ unsafeRange ">=0.0.0 <1.0.0", simple.package /\ unsafeRange ">=0.0.0 <1.0.0", prelude.package /\ unsafeRange ">=0.0.0 <1.0.0" ] Spec.describe "Valid dependency ranges containing some invalid versions solve" do Spec.it "Proceeds past broken ranges to find a later valid range" do -- 'broken-fixed' cannot be solved at the broken version 0, but it can be -- solved at the fixed version 1. shouldSucceed - [ brokenFixed.package /\ range 0 2 ] - [ brokenFixed.package /\ version 1, prelude.package /\ version 0 ] + [ brokenFixed.package /\ unsafeRange ">=0.0.0 <2.0.0" ] + [ brokenFixed.package /\ unsafeVersion "1.0.0", prelude.package /\ unsafeVersion "0.0.0" ] Spec.it "Backtracks from broken ranges to find the highest valid range." do -- 'fixed-broken' works at version 0 and 1, but is broken at version 2. shouldSucceed - [ fixedBroken.package /\ range 0 2 ] - [ fixedBroken.package /\ version 1, prelude.package /\ version 1 ] + [ fixedBroken.package /\ unsafeRange ">=0.0.0 <3.0.0" ] + [ fixedBroken.package /\ unsafeVersion "1.0.0", prelude.package /\ unsafeVersion "1.0.0" ] Spec.describe "Does not solve when no versions exist for the specified range" do Spec.it "No versions available for target package" do shouldFail - [ package "does-not-exist" /\ range 0 4 ] + [ unsafePackageName "does-not-exist" /\ unsafeRange ">=0.0.0 <4.0.0" ] [ { error: Conflicts $ Map.fromFoldable - [ package "does-not-exist" `Tuple` intersection 0 (solveRoot "does-not-exist") 4 (solveRoot "does-not-exist") ] + [ unsafePackageName "does-not-exist" `Tuple` intersection 0 (solveRoot "does-not-exist") 4 (solveRoot "does-not-exist") ] , message: "No versions found in the registry for does-not-exist in range\n >=0.0.0 (declared dependency)\n <4.0.0 (declared dependency)" } ] Spec.it "Target package has versions, but none in range" do shouldFail - [ prelude.package /\ range 20 50 ] + [ prelude.package /\ unsafeRange ">=20.0.0 <50.0.0" ] [ { error: Conflicts $ Map.fromFoldable - [ package "prelude" `Tuple` intersection 20 (solveRoot "prelude") 50 (solveRoot "prelude") ] + [ unsafePackageName "prelude" `Tuple` intersection 20 (solveRoot "prelude") 50 (solveRoot "prelude") ] , message: "No versions found in the registry for prelude in range\n >=20.0.0 (declared dependency)\n <50.0.0 (declared dependency)" } ] Spec.it "Direct dependency of target package has no versions in range." do shouldFail - [ brokenFixed.package /\ range 0 1 ] + [ brokenFixed.package /\ unsafeRange ">=0.0.0 <1.0.0" ] [ { error: Conflicts $ Map.fromFoldable - [ package "does-not-exist" `Tuple` intersection 0 (via' "broken-fixed" 0) 4 (via' "broken-fixed" 0) + [ unsafePackageName "does-not-exist" `Tuple` intersection 0 (via' "broken-fixed" 0) 4 (via' "broken-fixed" 0) ] , message: "No versions found in the registry for does-not-exist in range\n >=0.0.0 seen in broken-fixed@0.0.0\n <4.0.0 seen in broken-fixed@0.0.0" } @@ -172,9 +172,9 @@ spec = do Spec.it "Nested dependency of target package has no versions in range." do shouldFail - [ transitiveBroken.package /\ range 0 1 ] + [ transitiveBroken.package /\ unsafeRange ">=0.0.0 <1.0.0" ] [ { error: Conflicts $ Map.fromFoldable - [ package "does-not-exist" `Tuple` intersection 0 (via "fixed-broken" 2 [ "transitive-broken" ]) 5 (via "fixed-broken" 2 [ "transitive-broken" ]) + [ unsafePackageName "does-not-exist" `Tuple` intersection 0 (via "fixed-broken" 2 [ "transitive-broken" ]) 5 (via "fixed-broken" 2 [ "transitive-broken" ]) ] , message: "No versions found in the registry for does-not-exist in range\n >=0.0.0 seen in fixed-broken@2.0.0 from declared dependencies transitive-broken\n <5.0.0 seen in fixed-broken@2.0.0 from declared dependencies transitive-broken" } @@ -182,9 +182,9 @@ spec = do Spec.it "Fails when target package cannot be satisfied" do shouldFail - [ brokenBroken.package /\ range 0 2 ] + [ brokenBroken.package /\ unsafeRange ">=0.0.0 <2.0.0" ] [ { error: Conflicts $ Map.fromFoldable - [ package "does-not-exist" `Tuple` intersection 0 (via' "broken-broken" 0 <> via' "broken-broken" 1) 5 (via' "broken-broken" 0 <> via' "broken-broken" 1) + [ unsafePackageName "does-not-exist" `Tuple` intersection 0 (via' "broken-broken" 0 <> via' "broken-broken" 1) 5 (via' "broken-broken" 0 <> via' "broken-broken" 1) ] , message: "No versions found in the registry for does-not-exist in range\n >=0.0.0 seen in broken-broken@0.0.0, broken-broken@1.0.0\n <5.0.0 seen in broken-broken@0.0.0, broken-broken@1.0.0" } @@ -193,9 +193,9 @@ spec = do Spec.describe "Does not solve when ranges do not intersect" do Spec.it "Simple disjoint ranges" do shouldFail - [ simple.package /\ range 0 1, prelude.package /\ range 1 2 ] - [ { error: WhileSolving (package "simple") $ Map.singleton (version 0) $ Conflicts $ Map.fromFoldable - [ package "prelude" `Tuple` intersection 1 (solveRoot "prelude") 1 (via "simple" 0 []) + [ simple.package /\ unsafeRange ">=0.0.0 <1.0.0", prelude.package /\ unsafeRange ">=1.0.0 <2.0.0" ] + [ { error: WhileSolving (unsafePackageName "simple") $ Map.singleton (unsafeVersion "0.0.0") $ Conflicts $ Map.fromFoldable + [ unsafePackageName "prelude" `Tuple` intersection 1 (solveRoot "prelude") 1 (via "simple" 0 []) ] , message: "While solving simple each version could not be solved:\n- 0.0.0: \n Conflict in version ranges for prelude:\n >=1.0.0 (declared dependency)\n <1.0.0 seen in simple@0.0.0" } @@ -205,11 +205,11 @@ spec = do -- range provided Spec.it "Transitive disjoint ranges" do shouldFail - [ onlySimple.package /\ range 0 4 - , prelude.package /\ range 1 2 + [ onlySimple.package /\ unsafeRange ">=0.0.0 <4.0.0" + , prelude.package /\ unsafeRange ">=1.0.0 <2.0.0" ] - [ { error: WhileSolving (package "simple") $ Map.singleton (version 0) $ Conflicts $ Map.fromFoldable - [ package "prelude" `Tuple` intersection 1 (solveRoot "prelude") 1 (via "simple" 0 []) + [ { error: WhileSolving (unsafePackageName "simple") $ Map.singleton (unsafeVersion "0.0.0") $ Conflicts $ Map.fromFoldable + [ unsafePackageName "prelude" `Tuple` intersection 1 (solveRoot "prelude") 1 (via "simple" 0 []) ] , message: "While solving simple each version could not be solved:\n- 0.0.0: \n Conflict in version ranges for prelude:\n >=1.0.0 (declared dependency)\n <1.0.0 seen in simple@0.0.0" } @@ -217,11 +217,11 @@ spec = do Spec.it "Fails on disjoint ranges" do shouldFail - [ brokenFixed.package /\ range 0 1 - , fixedBroken.package /\ range 2 3 + [ brokenFixed.package /\ unsafeRange ">=0.0.0 <1.0.0" + , fixedBroken.package /\ unsafeRange ">=2.0.0 <3.0.0" ] [ { error: Conflicts $ Map.fromFoldable - [ package "does-not-exist" `Tuple` intersection 0 (via' "broken-fixed" 0 <> via' "fixed-broken" 2) 4 (via' "broken-fixed" 0) + [ unsafePackageName "does-not-exist" `Tuple` intersection 0 (via' "broken-fixed" 0 <> via' "fixed-broken" 2) 4 (via' "broken-fixed" 0) ] , message: "No versions found in the registry for does-not-exist in range\n >=0.0.0 seen in broken-fixed@0.0.0, fixed-broken@2.0.0\n <4.0.0 seen in broken-fixed@0.0.0" } @@ -230,16 +230,16 @@ spec = do Spec.describe "Reports multiple errors" do Spec.it "Reports different errors for different versions" do shouldFail - [ chaotic.package /\ range 1 3 - , prelude.package /\ range 2 4 + [ chaotic.package /\ unsafeRange ">=1.0.0 <3.0.0" + , prelude.package /\ unsafeRange ">=2.0.0 <4.0.0" ] - [ { error: WhileSolving (package "chaotic") $ Map.fromFoldable - [ Tuple (version 1) $ Conflicts $ Map.fromFoldable - [ package "prelude" `Tuple` intersection 2 (solveRoot "prelude") 1 (via "chaotic" 1 []) + [ { error: WhileSolving (unsafePackageName "chaotic") $ Map.fromFoldable + [ Tuple (unsafeVersion "1.0.0") $ Conflicts $ Map.fromFoldable + [ unsafePackageName "prelude" `Tuple` intersection 2 (solveRoot "prelude") 1 (via "chaotic" 1 []) ] - , Tuple (version 2) $ Conflicts $ Map.fromFoldable + , Tuple (unsafeVersion "2.0.0") $ Conflicts $ Map.fromFoldable -- TODO: why no global "chaotic" here? - [ package "prelude" `Tuple` intersection 5 (via "chaotic" 2 []) 4 (solveRoot "prelude") + [ unsafePackageName "prelude" `Tuple` intersection 5 (via "chaotic" 2 []) 4 (solveRoot "prelude") ] ] , message: "While solving chaotic each version could not be solved:\n- 1.0.0: \n Conflict in version ranges for prelude:\n >=2.0.0 (declared dependency)\n <1.0.0 seen in chaotic@1.0.0\n- 2.0.0: \n Conflict in version ranges for prelude:\n >=5.0.0 seen in chaotic@2.0.0\n <4.0.0 (declared dependency)" @@ -248,20 +248,20 @@ spec = do Spec.it "Groups same errors" do shouldFail - [ chaotic.package /\ range 1 4 - , prelude.package /\ range 2 4 + [ chaotic.package /\ unsafeRange ">=1.0.0 <4.0.0" + , prelude.package /\ unsafeRange ">=2.0.0 <4.0.0" ] - [ { error: WhileSolving (package "chaotic") $ Map.fromFoldable - [ Tuple (version 1) $ Conflicts $ Map.fromFoldable - [ package "prelude" `Tuple` intersection 2 (solveRoot "prelude") 1 (via "chaotic" 1 []) + [ { error: WhileSolving (unsafePackageName "chaotic") $ Map.fromFoldable + [ Tuple (unsafeVersion "1.0.0") $ Conflicts $ Map.fromFoldable + [ unsafePackageName "prelude" `Tuple` intersection 2 (solveRoot "prelude") 1 (via "chaotic" 1 []) ] - , Tuple (version 2) $ Conflicts $ Map.fromFoldable + , Tuple (unsafeVersion "2.0.0") $ Conflicts $ Map.fromFoldable -- TODO: why no global "chaotic" here? - [ package "prelude" `Tuple` intersection 5 (via "chaotic" 2 []) 4 (solveRoot "prelude") + [ unsafePackageName "prelude" `Tuple` intersection 5 (via "chaotic" 2 []) 4 (solveRoot "prelude") ] - , Tuple (version 3) $ Conflicts $ Map.fromFoldable + , Tuple (unsafeVersion "3.0.0") $ Conflicts $ Map.fromFoldable -- TODO: why no global "chaotic" here? - [ package "prelude" `Tuple` intersection 5 (via "chaotic" 3 []) 4 (solveRoot "prelude") + [ unsafePackageName "prelude" `Tuple` intersection 5 (via "chaotic" 3 []) 4 (solveRoot "prelude") ] ] , message: "While solving chaotic each version could not be solved:\n- 1.0.0: \n Conflict in version ranges for prelude:\n >=2.0.0 (declared dependency)\n <1.0.0 seen in chaotic@1.0.0\n- 2.0.0: \n Conflict in version ranges for prelude:\n >=5.0.0 seen in chaotic@2.0.0\n <4.0.0 (declared dependency)\n- 3.0.0: \n Conflict in version ranges for prelude:\n >=5.0.0 seen in chaotic@3.0.0\n <4.0.0 (declared dependency)" @@ -271,22 +271,115 @@ spec = do -- since we try packages in alphabetical order Spec.it "Reports different errors for different versions (converse)" do shouldFail - [ qaotic.package /\ range 1 3 - , prelude.package /\ range 2 4 + [ qaotic.package /\ unsafeRange ">=1.0.0 <3.0.0" + , prelude.package /\ unsafeRange ">=2.0.0 <4.0.0" ] - [ { error: WhileSolving (package "qaotic") $ Map.fromFoldable - [ Tuple (version 1) $ Conflicts $ Map.fromFoldable - [ package "prelude" `Tuple` intersection 2 (solveRoot "prelude") 1 (via "qaotic" 1 []) + [ { error: WhileSolving (unsafePackageName "qaotic") $ Map.fromFoldable + [ Tuple (unsafeVersion "1.0.0") $ Conflicts $ Map.fromFoldable + [ unsafePackageName "prelude" `Tuple` intersection 2 (solveRoot "prelude") 1 (via "qaotic" 1 []) ] - , Tuple (version 2) $ Conflicts $ Map.fromFoldable + , Tuple (unsafeVersion "2.0.0") $ Conflicts $ Map.fromFoldable -- TODO: why no global "prelude" here? - [ package "prelude" `Tuple` intersection 5 (via "qaotic" 2 []) 4 (solveRoot "prelude") + [ unsafePackageName "prelude" `Tuple` intersection 5 (via "qaotic" 2 []) 4 (solveRoot "prelude") ] ] , message: "While solving qaotic each version could not be solved:\n- 1.0.0: \n Conflict in version ranges for prelude:\n >=2.0.0 (declared dependency)\n <1.0.0 seen in qaotic@1.0.0\n- 2.0.0: \n Conflict in version ranges for prelude:\n >=5.0.0 seen in qaotic@2.0.0\n <4.0.0 (declared dependency)" } ] + Spec.describe "Resolution contracts" do + Spec.it "Excludes broken dependencies belonging only to rejected versions" do + let + index = Map.fromFoldable + [ unsafePackageName "a" /\ Map.fromFoldable + [ unsafeVersion "1.0.0" /\ Map.singleton (unsafePackageName "orphan") (unsafeRange ">=1.0.0 <2.0.0") + , unsafeVersion "2.0.0" /\ Map.empty + ] + , unsafePackageName "orphan" /\ Map.singleton (unsafeVersion "1.0.0") (Map.singleton (unsafePackageName "missing") (unsafeRange ">=1.0.0 <2.0.0")) + ] + solve index (Map.singleton (unsafePackageName "a") (unsafeRange ">=1.0.0 <3.0.0")) + `Assert.shouldContain` Map.singleton (unsafePackageName "a") (unsafeVersion "2.0.0") + + Spec.it "Reports both originally requested packages and the package version directly requiring the missing dependency" do + let + index = Map.fromFoldable + [ unsafePackageName "a" /\ Map.singleton (unsafeVersion "1.0.0") (Map.singleton (unsafePackageName "middle") (unsafeRange ">=2.0.0 <5.0.0")) + , unsafePackageName "b" /\ Map.singleton (unsafeVersion "1.0.0") (Map.singleton (unsafePackageName "middle") (unsafeRange ">=1.0.0 <4.0.0")) + , unsafePackageName "middle" /\ Map.singleton (unsafeVersion "2.0.0") (Map.singleton (unsafePackageName "missing") (unsafeRange ">=1.0.0 <2.0.0")) + ] + goals = Map.fromFoldable [ unsafePackageName "a" /\ unsafeRange ">=1.0.0 <2.0.0", unsafePackageName "b" /\ unsafeRange ">=1.0.0 <2.0.0" ] + source = via "middle" 2 [ "a", "b" ] + solve index goals `Assert.shouldEqual` + Left (pure (Conflicts (Map.singleton (unsafePackageName "missing") (intersection 1 source 2 source)))) + + Spec.it "Prefers the alphabetically first package, not the largest total versions" do + let + index = Map.fromFoldable + [ unsafePackageName "a" /\ Map.fromFoldable + [ unsafeVersion "1.0.0" /\ Map.singleton (unsafePackageName "z") (unsafeRange ">=1.0.0 <2.0.0") + , unsafeVersion "2.0.0" /\ Map.singleton (unsafePackageName "z") (unsafeRange ">=2.0.0 <3.0.0") + ] + , unsafePackageName "b" /\ Map.fromFoldable + [ unsafeVersion "1.0.0" /\ Map.singleton (unsafePackageName "z") (unsafeRange ">=2.0.0 <3.0.0") + , unsafeVersion "9.0.0" /\ Map.singleton (unsafePackageName "z") (unsafeRange ">=1.0.0 <2.0.0") + ] + , unsafePackageName "z" /\ Map.fromFoldable [ unsafeVersion "1.0.0" /\ Map.empty, unsafeVersion "2.0.0" /\ Map.empty ] + ] + solve index (Map.fromFoldable [ unsafePackageName "a" /\ unsafeRange ">=1.0.0 <3.0.0", unsafePackageName "b" /\ unsafeRange ">=1.0.0 <10.0.0" ]) + `Assert.shouldContain` Map.fromFoldable [ unsafePackageName "a" /\ unsafeVersion "2.0.0", unsafePackageName "b" /\ unsafeVersion "1.0.0", unsafePackageName "z" /\ unsafeVersion "2.0.0" ] + + Spec.it "Matches exhaustive assignments on 4096 small cyclic version graphs" do + -- Each of six package versions independently has no dependency, an exact + -- low/high dependency, or a broad dependency on the next package in a + -- three-package ring. Enumerating assignments (including absent packages) + -- is independent of the solver's propagation and backtracking algorithm. + let + names = map unsafePackageName [ "a", "b", "c" ] + + assignments = do + a <- [ Nothing, Just (unsafeVersion "1.0.0"), Just (unsafeVersion "2.0.0") ] + b <- [ Nothing, Just (unsafeVersion "1.0.0"), Just (unsafeVersion "2.0.0") ] + c <- [ Nothing, Just (unsafeVersion "1.0.0"), Just (unsafeVersion "2.0.0") ] + pure $ Map.fromFoldable $ Array.catMaybes $ Array.zipWith (\p -> map (Tuple p)) names [ a, b, c ] + + goals = Map.singleton (unsafePackageName "a") (unsafeRange ">=1.0.0 <3.0.0") + + satisfies plan deps = all + ( \(Tuple p bounds) -> case Map.lookup p plan of + Nothing -> false + Just v -> Range.includes bounds v + ) + (Map.toUnfoldable deps :: Array (Tuple PackageName Range)) + + valid index plan = satisfies plan goals && all + ( \(Tuple p v) -> case Map.lookup p index >>= Map.lookup v of + Nothing -> false + Just deps -> satisfies plan deps + ) + (Map.toUnfoldable plan :: Array (Tuple PackageName Version)) + + for_ (Array.range 0 4095) \seed -> do + let + versionEntry i j = do + let + digit = (seed / Int.pow 4 (i * 2 + j - 1)) `mod` 4 + next = unsafePackageName (if i == 0 then "b" else if i == 1 then "c" else "a") + deps = case digit of + 0 -> Map.empty + 1 -> Map.singleton next (unsafeRange ">=1.0.0 <2.0.0") + 2 -> Map.singleton next (unsafeRange ">=2.0.0 <3.0.0") + _ -> Map.singleton next (unsafeRange ">=1.0.0 <3.0.0") + + majorVersion j /\ deps + + versions i = Map.fromFoldable $ map (versionEntry i) [ 1, 2 ] + + index = Map.fromFoldable $ Array.mapWithIndex (\i p -> p /\ versions i) names + + case solve index goals of + Left _ -> when (Array.any (valid index) assignments) $ Assert.fail $ "False unsatisfiability for graph " <> show seed + Right plan -> unless (valid index plan) $ Assert.fail $ "Invalid resolution for graph " <> show seed + Spec.describe "CompilerIndex" do let -- Package graph: @@ -344,8 +437,29 @@ spec = do (\i error -> "[Error " <> show (i + 1) <> "] " <> printSolverError error <> "\n") errs Right (Tuple _solvedCompiler resolutions) -> do - Map.lookup (package "prelude") resolutions `Assert.shouldEqual` Just (unsafeVersion "6.0.1") - Map.lookup (package "effect") resolutions `Assert.shouldEqual` Just (unsafeVersion "4.0.0") + Map.lookup (unsafePackageName "prelude") resolutions `Assert.shouldEqual` Just (unsafeVersion "6.0.1") + Map.lookup (unsafePackageName "effect") resolutions `Assert.shouldEqual` Just (unsafeVersion "4.0.0") + + Spec.it "Prefers the newer package version unless the compiler requirement forces an older one" do + let + metadata = Map.fromFoldable + [ unsafeMetadata "prelude" [ Tuple "6.0.1" [ "0.15.15", "0.15.16" ] ] + , unsafeMetadata "effect" + [ Tuple "4.0.0" [ "0.15.16" ] + , Tuple "5.0.0" [ "0.15.15" ] + ] + , unsafeMetadata "my-pkg" [ Tuple "1.0.0" [ "0.15.15" ] ] + ] + index = buildCompilerIndex compilers manifestIndex metadata + goals = Map.singleton (unsafePackageName "effect") (unsafeRange ">=4.0.0 <6.0.0") + expected compiler effect = Tuple (unsafeVersion compiler) $ Map.fromFoldable + [ unsafePackageName "effect" /\ unsafeVersion effect + , unsafePackageName "prelude" /\ unsafeVersion "6.0.1" + ] + solveWithCompiler (Range.exact (unsafeVersion "0.15.16")) index goals + `Assert.shouldContain` expected "0.15.16" "4.0.0" + solveWithCompiler (unsafeRange ">=0.15.15 <0.15.17") index goals + `Assert.shouldContain` expected "0.15.15" "5.0.0" Spec.it "updateCompilerIndex produces same result as full rebuild" do -- Setup: effect has two versions (4.0.0 and 5.0.0) both supporting @@ -365,7 +479,7 @@ spec = do updatedMetadata = Map.fromFoldable [ unsafeMetadata "prelude" [ Tuple "6.0.1" [ "0.15.15" ] ] - , Tuple (package "effect") updatedEffectMeta + , Tuple (unsafePackageName "effect") updatedEffectMeta , unsafeMetadata "my-pkg" [ Tuple "1.0.0" [ "0.15.15" ] ] ] fullNew = buildCompilerIndex compilers manifestIndex updatedMetadata @@ -405,120 +519,105 @@ type TestPackage = -- | Transitively depends on a broken range transitiveBroken :: TestPackage transitiveBroken = - { package: package "transitive-broken" + { package: unsafePackageName "transitive-broken" , versions: Map.fromFoldable - [ version 0 /\ Just (fixedBroken.package /\ range 2 3) - , version 1 /\ Just (brokenFixed.package /\ range 0 1) + [ unsafeVersion "0.0.0" /\ Just (fixedBroken.package /\ unsafeRange ">=2.0.0 <3.0.0") + , unsafeVersion "1.0.0" /\ Just (brokenFixed.package /\ unsafeRange ">=0.0.0 <1.0.0") ] } -- | Broken at v1 and v2 brokenBroken :: TestPackage brokenBroken = - { package: package "broken-broken" + { package: unsafePackageName "broken-broken" , versions: Map.fromFoldable - [ version 0 /\ Just (package "does-not-exist" /\ range 0 5) - , version 1 /\ Just (package "does-not-exist" /\ range 0 5) + [ unsafeVersion "0.0.0" /\ Just (unsafePackageName "does-not-exist" /\ unsafeRange ">=0.0.0 <5.0.0") + , unsafeVersion "1.0.0" /\ Just (unsafePackageName "does-not-exist" /\ unsafeRange ">=0.0.0 <5.0.0") ] } -- | Fixed at v0, v1, broken at v2 fixedBroken :: TestPackage fixedBroken = - { package: package "fixed-broken" + { package: unsafePackageName "fixed-broken" , versions: Map.fromFoldable - [ version 0 /\ Just (prelude.package /\ range 0 1) - , version 1 /\ Just (prelude.package /\ range 1 2) - , version 2 /\ Just (package "does-not-exist" /\ range 0 5) + [ unsafeVersion "0.0.0" /\ Just (prelude.package /\ unsafeRange ">=0.0.0 <1.0.0") + , unsafeVersion "1.0.0" /\ Just (prelude.package /\ unsafeRange ">=1.0.0 <2.0.0") + , unsafeVersion "2.0.0" /\ Just (unsafePackageName "does-not-exist" /\ unsafeRange ">=0.0.0 <5.0.0") ] } -- | Broken at v0, fixed at v1 brokenFixed :: TestPackage brokenFixed = - { package: package "broken-fixed" + { package: unsafePackageName "broken-fixed" , versions: Map.fromFoldable - [ version 0 /\ Just (package "does-not-exist" /\ range 0 4) - , version 1 /\ Just (prelude.package /\ range 0 1) + [ unsafeVersion "0.0.0" /\ Just (unsafePackageName "does-not-exist" /\ unsafeRange ">=0.0.0 <4.0.0") + , unsafeVersion "1.0.0" /\ Just (prelude.package /\ unsafeRange ">=0.0.0 <1.0.0") ] } onlySimple :: TestPackage onlySimple = - { package: package "only-simple" - , versions: Map.singleton (version 0) (Just (simple.package /\ range 0 1)) + { package: unsafePackageName "only-simple" + , versions: Map.singleton (unsafeVersion "0.0.0") (Just (simple.package /\ unsafeRange ">=0.0.0 <1.0.0")) } simple :: TestPackage simple = - { package: package "simple" + { package: unsafePackageName "simple" , versions: Map.fromFoldable - [ version 0 /\ Just (prelude.package /\ range 0 1) - , version 1 /\ Just (prelude.package /\ range 1 2) + [ unsafeVersion "0.0.0" /\ Just (prelude.package /\ unsafeRange ">=0.0.0 <1.0.0") + , unsafeVersion "1.0.0" /\ Just (prelude.package /\ unsafeRange ">=1.0.0 <2.0.0") ] } prelude :: TestPackage prelude = - { package: package "prelude" + { package: unsafePackageName "prelude" , versions: Map.fromFoldable - [ version 0 /\ Nothing - , version 1 /\ Nothing - , version 2 /\ Nothing - , version 3 /\ Nothing - , version 4 /\ Nothing - , version 5 /\ Nothing + [ unsafeVersion "0.0.0" /\ Nothing + , unsafeVersion "1.0.0" /\ Nothing + , unsafeVersion "2.0.0" /\ Nothing + , unsafeVersion "3.0.0" /\ Nothing + , unsafeVersion "4.0.0" /\ Nothing + , unsafeVersion "5.0.0" /\ Nothing ] } chaotic :: TestPackage chaotic = - { package: package "chaotic" + { package: unsafePackageName "chaotic" , versions: Map.fromFoldable - [ version 1 /\ Just (prelude.package /\ range 0 1) - , version 2 /\ Just (prelude.package /\ range 5 6) - , version 3 /\ Just (prelude.package /\ range 5 6) + [ unsafeVersion "1.0.0" /\ Just (prelude.package /\ unsafeRange ">=0.0.0 <1.0.0") + , unsafeVersion "2.0.0" /\ Just (prelude.package /\ unsafeRange ">=5.0.0 <6.0.0") + , unsafeVersion "3.0.0" /\ Just (prelude.package /\ unsafeRange ">=5.0.0 <6.0.0") ] } qaotic :: TestPackage qaotic = - { package: package "qaotic" + { package: unsafePackageName "qaotic" , versions: Map.fromFoldable - [ version 1 /\ Just (prelude.package /\ range 0 1) - , version 2 /\ Just (prelude.package /\ range 5 6) + [ unsafeVersion "1.0.0" /\ Just (prelude.package /\ unsafeRange ">=0.0.0 <1.0.0") + , unsafeVersion "2.0.0" /\ Just (prelude.package /\ unsafeRange ">=5.0.0 <6.0.0") ] } -package :: String -> PackageName -package = fromRight "bad package name" <<< PackageName.parse - -version :: Int -> Version -version = fromRight "bad version" <<< Version.parse <<< (_ <> ".0.0") <<< show - --- For all these tests, we work with major versions only because we do not --- need to exercise the intricacies of the range relations, just the solver, --- which does not care about what versions are, just how they relate -range :: Int -> Int -> Range -range lower upper = fromRight "bad range" $ Range.parse $ Array.fold - [ ">=" - , show lower - , ".0.0 <" - , show upper - , ".0.0" - ] +majorVersion :: Int -> Version +majorVersion = unsafeVersion <<< (_ <> ".0.0") <<< show intersection :: Int -> SolverPosition -> Int -> SolverPosition -> Intersection intersection lower lowerPos upper upperPos = Intersection - { lower: wrap $ Sourced (version lower) lowerPos - , upper: wrap $ Sourced (version upper) upperPos + { lower: wrap $ Sourced (majorVersion lower) lowerPos + , upper: wrap $ Sourced (majorVersion upper) upperPos } solveRoot :: String -> SolverPosition -solveRoot = Pos Root <<< Set.singleton <<< package +solveRoot = Pos Root <<< Set.singleton <<< unsafePackageName via :: String -> Int -> Array String -> SolverPosition -via p v = Pos (Solving (NES.singleton { package: package p, version: version v })) <<< Set.fromFoldable <<< map package +via p v = Pos (Solving (NES.singleton { package: unsafePackageName p, version: majorVersion v })) <<< Set.fromFoldable <<< map unsafePackageName via' :: String -> Int -> SolverPosition -via' p v = Pos (Solving (NES.singleton { package: package p, version: version v })) (Set.singleton (package p)) +via' p v = Pos (Solving (NES.singleton { package: unsafePackageName p, version: majorVersion v })) (Set.singleton (unsafePackageName p)) diff --git a/scripts/spago.yaml b/scripts/spago.yaml index a3bdb19f..372a4a8d 100644 --- a/scripts/spago.yaml +++ b/scripts/spago.yaml @@ -15,6 +15,7 @@ package: - foldable-traversable - formatters - json + - minibench - node-fs - node-path - node-process @@ -23,5 +24,6 @@ package: - registry-app - registry-foreign - registry-lib + - registry-test-utils - run - strings diff --git a/scripts/src/BenchSolver.purs b/scripts/src/BenchSolver.purs new file mode 100644 index 00000000..79b22edc --- /dev/null +++ b/scripts/src/BenchSolver.purs @@ -0,0 +1,234 @@ +-- | Local dependency-solver benchmarks; run with --help for options. +module Registry.Scripts.BenchSolver where + +import Registry.App.Prelude + +import ArgParse.Basic as Arg +import Data.Array as Array +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common +import Data.Codec.JSON.Record as CJ.Record +import Data.Foldable as Foldable +import Data.Map as Map +import Data.Set as Set +import Data.String as String +import Effect.Aff as Aff +import Effect.Class.Console as Console +import Node.Process as Process +import Performance.Minibench as Bench +import Registry.Internal.Codec as Codec +import Registry.Manifest as Manifest +import Registry.ManifestIndex as ManifestIndex +import Registry.Metadata as Metadata +import Registry.PackageName as PackageName +import Registry.Range as Range +import Registry.Sha256 as Sha256 +import Registry.Solver as Solver +import Registry.Test.Utils as Utils +import Registry.Version as Version + +type Plan = Map PackageName Version +type Solution = { compiler :: Maybe Version, resolutions :: Plan } +type Outcome = Either Solver.SolverErrors Solution + +data Expected = Unsolvable | Solvable (Maybe Plan) + +type Workload = + { label :: String + , index :: Solver.DependencyIndex + , goals :: Map PackageName Range + , expected :: Expected + , metadata :: Maybe (Map PackageName Metadata) + , run :: Unit -> Outcome + } + +type Snapshot = + { manifests :: Array Manifest + , metadata :: Map PackageName Metadata + , compilers :: NonEmptyArray Version + } + +snapshotCodec :: CJ.Codec Snapshot +snapshotCodec = CJ.Record.object + { manifests: CJ.array Manifest.codec + , metadata: Codec.packageMap Metadata.codec + , compilers: CJ.Common.nonEmptyArray Version.codec + } + +type Report = + { node :: String + , snapshot :: Maybe Sha256 + , samples :: Int + , results :: Array { label :: String, timing :: Bench.BenchResult, result :: Either (Array String) Solution } + } + +reportCodec :: CJ.Codec Report +reportCodec = CJ.Record.object + { node: CJ.string + , snapshot: CJ.Record.optional Sha256.codec + , samples: CJ.int + , results: CJ.array $ CJ.Record.object + { label: CJ.string + , timing: CJ.Record.object { mean: CJ.number, stdDev: CJ.number, min: CJ.number, max: CJ.number } + , result: CJ.Common.either (CJ.array CJ.string) $ CJ.Record.object + { compiler: CJ.Record.optional Version.codec + , resolutions: Codec.packageMap Version.codec + } + } + } + +main :: Effect Unit +main = launchAff_ do + args <- Array.drop 2 <$> liftEffect Process.argv + options <- require $ lmap Arg.printArgError $ Arg.parseArgs "bench-solver" "Benchmark local solver workloads (Minibench timings in nanoseconds)." + ( Arg.fromRecord + { snapshot: Arg.optional $ Arg.argument [ "--snapshot" ] "Local registry snapshot JSON" + , baseline: Arg.optional $ Arg.argument [ "--baseline" ] "Compare complete results with this report" + , samples: Arg.default 40 $ Arg.int $ Arg.argument [ "--samples" ] "Timed solves per case (at least two)" + , filter: Arg.default "" $ Arg.argument [ "--case" ] "Workload label substring" + } + ) + args + require $ ensure (options.samples >= 2) "--samples must be at least two" + snapshot <- traverse (require <=< readJsonFile snapshotCodec) options.snapshot + hash <- traverse Sha256.hashFile options.snapshot + real <- require $ maybe (Right []) snapshotWorkloads snapshot + + let cases = Array.filter (String.contains (String.Pattern options.filter) <<< _.label) (syntheticWorkloads <> real) + + require $ ensure (not (Array.null cases)) "--case matched no workloads" + results <- for cases \work -> do + -- Validate and warm up outside Minibench's timed region. + for_ (Array.range 1 3) \_ -> require $ validate work (work.run unit) + + let result = work.run unit + + timing <- liftEffect $ Bench.benchWith' options.samples work.run + require $ ensure (work.run unit == result) (work.label <> ": result changed after timing") + Console.error $ work.label <> ": mean " <> Bench.withUnits timing.mean + pure { label: work.label, timing, result: lmap (map Solver.printSolverError <<< Array.fromFoldable) result } + for_ options.baseline \path -> do + before <- require =<< readJsonFile reportCodec path + require $ ensure (before.snapshot == hash && before.samples == options.samples && before.node == Process.version) "Different snapshot, sample count, or Node version" + require $ ensure (map (\r -> { label: r.label, result: r.result }) before.results == map (\r -> { label: r.label, result: r.result }) results) "Changed workloads, resolutions, or diagnostics" + Console.log $ printJson reportCodec { node: Process.version, snapshot: hash, samples: options.samples, results } + +require :: forall a. Either String a -> Aff a +require = either (Aff.throwError <<< Aff.error) pure + +ensure :: Boolean -> String -> Either String Unit +ensure condition message = if condition then Right unit else Left message + +-- | Inspect only selected versions, independently of solver propagation/search. +validate :: Workload -> Outcome -> Either String Unit +validate work result = case result, work.expected of + Left _, Unsolvable -> Right unit + Left _, _ -> Left $ work.label <> ": unexpectedly unsatisfiable" + Right _, Unsolvable -> Left $ work.label <> ": expected unsatisfiable" + Right solved, Solvable expected -> do + for_ expected \plan -> ensure (plan == solved.resolutions) (work.label <> ": incorrect selection") + reached <- visit Set.empty (Map.toUnfoldable work.goals) + ensure (reached == Map.keys solved.resolutions) "Extraneous packages in resolution" + for_ work.metadata \metadata -> do + ensure (solved.compiler == Just compiler) "Wrong compiler selection" + forWithIndex_ solved.resolutions \name selected -> do + Metadata meta <- note "Missing compiler metadata" $ Map.lookup name metadata + for_ (Map.lookup selected meta.published) \entry -> + ensure (Foldable.minimum entry.compilers <= Just compiler && Just compiler <= Foldable.maximum entry.compilers) "Compiler outside metadata bounds" + where + visit seen pending = case Array.uncons pending of + Nothing -> Right seen + Just { head: Tuple name bounds, tail } -> do + selected <- note "Missing dependency" $ Map.lookup name solved.resolutions + ensure (Range.includes bounds selected) "Dependency outside required range" + selectedDeps <- note "Unknown package version" $ Map.lookup name work.index >>= Map.lookup selected + if Set.member name seen then visit seen tail + else visit (Set.insert name seen) ((Map.toUnfoldable selectedDeps :: Array _) <> tail) + +workload :: String -> Solver.DependencyIndex -> Map PackageName Range -> Expected -> Workload +workload label index goals expected = + { label + , index + , goals + , expected + , metadata: Nothing + , run: \_ -> map (\resolutions -> { compiler: Nothing, resolutions }) $ Solver.solve index goals + } + +compiler :: Version +compiler = Utils.unsafeVersion "0.15.16" + +snapshotWorkloads :: Snapshot -> Either String (Array Workload) +snapshotWorkloads snapshot = do + let + index = Array.foldl (\acc (Manifest m) -> Map.insertWith Map.union m.name (Map.singleton m.version m.dependencies) acc) Map.empty snapshot.manifests + seed = Solver.buildCompilerIndex snapshot.compilers ManifestIndex.empty Map.empty + + withMetadata <- for snapshot.manifests \manifest@(Manifest m) -> + Tuple manifest <$> note ("Missing metadata for " <> PackageName.print m.name) (Map.lookup m.name snapshot.metadata) + + let compilerIndex = Array.foldl (\acc (Tuple manifest meta) -> Solver.updateCompilerIndex acc manifest meta) seed withMetadata + + Array.concat <$> for [ "prelude", "effect", "aff", "web-storage", "halogen", "spec", "tidy", "language-cst-parser" ] \name -> do + latest <- note ("Snapshot missing " <> name) $ Map.lookup (Utils.unsafePackageName name) index >>= Map.findMax + + let + label = name <> "@" <> Version.print latest.key + plain = workload (label <> "/solve") index latest.value (Solvable Nothing) + + pure + [ plain + , plain + { label = label <> "/compiler" + , metadata = Just snapshot.metadata + , run = \_ -> Solver.solveWithCompiler (Range.exact compiler) compilerIndex latest.value + # map (\(Tuple selected resolutions) -> { compiler: Just selected, resolutions }) + } + ] + +syntheticWorkloads :: Array Workload +syntheticWorkloads = do + let + chain = Map.fromFoldable $ map + (\i -> Utils.unsafePackageName ("chain-" <> show i) /\ releases 1 3 (\_ -> if i == 59 then Map.empty else deps [ ("chain-" <> show (i + 1)) /\ range 1 4 ])) + (Array.range 0 59) + + diamondPlan = map (\i -> Utils.unsafePackageName ("branch-" <> show i) /\ version 10) (Array.range 0 39) + # Array.cons (Utils.unsafePackageName "root" /\ version 1) + # Array.cons (Utils.unsafePackageName "shared" /\ version 2) + # Map.fromFoldable + + diamond = map (\i -> Utils.unsafePackageName ("branch-" <> show i) /\ releases 1 10 (\_ -> deps [ "shared" /\ range 1 3 ])) (Array.range 0 39) + # Array.cons (Utils.unsafePackageName "shared" /\ releases 1 2 (const Map.empty)) + # Array.cons (Utils.unsafePackageName "root" /\ releases 1 1 (\_ -> deps $ map (\i -> ("branch-" <> show i) /\ range 1 11) (Array.range 0 39))) + # Map.fromFoldable + + unrelated = map (\i -> Utils.unsafePackageName ("unused-" <> show i) /\ releases 1 1 (\_ -> deps [ "target" /\ range 1 2 ])) (Array.range 0 1999) + # Array.cons (Utils.unsafePackageName "target" /\ releases 1 1 (const Map.empty)) + # Map.fromFoldable + + conflict = Map.fromFoldable + [ Utils.unsafePackageName "a" /\ releases 1 2 (\i -> deps [ "z" /\ range i (i + 1) ]) + , Utils.unsafePackageName "b" /\ releases 1 2 (\i -> deps [ "z" /\ range (3 - i) (4 - i) ]) + , Utils.unsafePackageName "z" /\ releases 1 2 (const Map.empty) + ] + + [ workload "chain-60" chain (deps [ "chain-0" /\ range 1 4 ]) $ Solvable $ Just $ Map.fromFoldable $ map (\i -> Utils.unsafePackageName ("chain-" <> show i) /\ version 3) (Array.range 0 59) + , workload "diamond-40x10" diamond (deps [ "root" /\ range 1 2 ]) $ Solvable $ Just diamondPlan + , workload "unreachable-2000" unrelated (deps [ "target" /\ range 1 2 ]) $ Solvable $ Just $ Map.singleton (Utils.unsafePackageName "target") (version 1) + , workload "narrow-1000" (Map.singleton (Utils.unsafePackageName "releases") (releases 0 999 (const Map.empty))) (deps [ "releases" /\ range 498 500 ]) $ Solvable $ Just $ Map.singleton (Utils.unsafePackageName "releases") (version 499) + , workload "selection-backtrack" conflict (deps [ "a" /\ range 1 3, "b" /\ range 1 3 ]) $ Solvable $ Just $ Map.fromFoldable [ Utils.unsafePackageName "a" /\ version 2, Utils.unsafePackageName "b" /\ version 1, Utils.unsafePackageName "z" /\ version 2 ] + , workload "incompatible-roots" conflict (deps [ "a" /\ range 2 3, "b" /\ range 2 3 ]) Unsolvable + ] + +version :: Int -> Version +version = Utils.unsafeVersion <<< (_ <> ".0.0") <<< show + +range :: Int -> Int -> Range +range lo hi = unsafeFromJust $ Range.mk (version lo) (version hi) + +deps :: Array (Tuple String Range) -> Map PackageName Range +deps = Map.fromFoldable <<< map (lmap Utils.unsafePackageName) + +releases :: Int -> Int -> (Int -> Map PackageName Range) -> Map Version (Map PackageName Range) +releases lo hi dependencies = Map.fromFoldable $ map (\i -> version i /\ dependencies i) (Array.range lo hi) diff --git a/spago.lock b/spago.lock index 5a5aa6a1..eb344752 100644 --- a/spago.lock +++ b/spago.lock @@ -279,6 +279,7 @@ "foldable-traversable", "formatters", "json", + "minibench", "node-fs", "node-path", "node-process", @@ -287,6 +288,7 @@ "registry-app", "registry-foreign", "registry-lib", + "registry-test-utils", "run", "strings" ] @@ -2087,6 +2089,19 @@ "prelude" ] }, + "minibench": { + "type": "registry", + "version": "4.0.1", + "integrity": "sha256-zd/YnOqnzz/ers1umv5rgJOyPntF2zFpcLVbPWQIbYU=", + "dependencies": [ + "console", + "effect", + "integers", + "numbers", + "prelude", + "refs" + ] + }, "mmorph": { "type": "registry", "version": "7.0.0",