diff --git a/src/Spago/Command/Registry.purs b/src/Spago/Command/Registry.purs index 27db1f8d5..cd58ccd50 100644 --- a/src/Spago/Command/Registry.purs +++ b/src/Spago/Command/Registry.purs @@ -97,8 +97,7 @@ type RegistryPackageSetsArgs = packageSets :: RegistryPackageSetsArgs -> Spago (RegistryEnv _) Unit packageSets { latest, json } = do - { db } <- ask - availableSets <- liftEffect $ Db.selectPackageSets db + availableSets <- Registry.listPackageSets let sets = case latest of diff --git a/src/Spago/Command/Upgrade.purs b/src/Spago/Command/Upgrade.purs index fcd3aadc2..9f4d89171 100644 --- a/src/Spago/Command/Upgrade.purs +++ b/src/Spago/Command/Upgrade.purs @@ -6,25 +6,19 @@ import Registry.Version as Version import Spago.Command.Fetch (FetchEnv) import Spago.Config as Config import Spago.Core.Config as Core -import Spago.Db as Db +import Spago.Registry as Registry run :: forall a. Spago (FetchEnv a) Unit run = do - { workspace, db, purs, getRegistry, logOptions, git, offline } <- ask + { workspace } <- ask case workspace.workspaceConfig.packageSet of - Just (Core.SetFromRegistry { registry }) -> do - -- We are going to read from the database, but we have no guarantee it's up to date, - -- so we need to pull a fresh registry first - calling the `getRegistry` is enough, - -- since that will populate the db with the missing stuff - _ <- runSpago { logOptions, db, git, purs, offline } getRegistry - maybeLatestPackageSet <- liftEffect $ Db.selectLatestPackageSetByCompiler db purs.version - case maybeLatestPackageSet of - Nothing -> die "No package set found for the current compiler version." - Just latestPackageSet - | latestPackageSet.version <= registry -> logSuccess "Nothing to upgrade, you already have the latest package set." - | otherwise -> do - logInfo $ "Upgrading the package set to the latest version: " <> Version.print latestPackageSet.version - Config.setPackageSetVersionInConfig workspace.doc latestPackageSet.version - logSuccess "Upgrade successful!" + Just (Core.SetFromRegistry { registry: currentPackageSet }) -> do + latestPackageSet <- Registry.findPackageSet Nothing + case latestPackageSet <= currentPackageSet of + true -> logSuccess "Nothing to upgrade, you already have the latest package set." + false -> do + logInfo $ "Upgrading the package set to the latest version: " <> Version.print latestPackageSet + Config.setPackageSetVersionInConfig workspace.doc latestPackageSet + logSuccess "Upgrade successful!" Just _ -> die "This command is not yet implemented for projects using a custom package set." Nothing -> die "This command is not yet implemented for projects using a solver. See https://github.com/purescript/spago/issues/1001" diff --git a/src/Spago/Registry.purs b/src/Spago/Registry.purs index 0da4c4a87..55e85ef61 100644 --- a/src/Spago/Registry.purs +++ b/src/Spago/Registry.purs @@ -9,6 +9,7 @@ module Spago.Registry , getMetadata , getRegistryFns , listMetadataFiles + , listPackageSets , readPackageSet ) where @@ -62,6 +63,7 @@ type RegistryFunctions = { getManifestFromIndex :: PackageName -> Version -> Spago (LogEnv ()) (Maybe Manifest) , getMetadata :: PackageName -> Spago (LogEnv ()) (Either String Metadata) , findPackageSet :: Maybe Version -> Spago (PreRegistryEnv ()) Version + , listPackageSets :: Spago (PreRegistryEnv ()) (Array Db.PackageSet) , listMetadataFiles :: Spago (LogEnv ()) (Array String) , readPackageSet :: Version -> Spago (LogEnv ()) PackageSet } @@ -78,6 +80,12 @@ getManifestFromIndex packageName version = do { getManifestFromIndex: fn } <- runSpago { logOptions, db, git, purs, offline } getRegistry runSpago { logOptions } (fn packageName version) +listPackageSets :: Spago (RegistryEnv _) (Array Db.PackageSet) +listPackageSets = do + { getRegistry, logOptions, db, git, purs, offline } <- ask + { listPackageSets: fn } <- runSpago { logOptions, db, git, purs, offline } getRegistry + runSpago { logOptions, db, git, purs, offline } fn + findPackageSet :: Maybe Version -> Spago (RegistryEnv _) _ findPackageSet version = do { getRegistry, logOptions, db, git, purs, offline } <- ask @@ -116,6 +124,7 @@ getRegistryFns registryBox registryLock = do { getManifestFromIndex: getManifestFromIndexImpl db , getMetadata: getMetadataImpl db fetchingFreshRegistry , listMetadataFiles: FS.ls (Path.concat [ Paths.registryPath, Registry.Constants.metadataDirectory ]) + , listPackageSets: listPackageSetsImpl , findPackageSet: findPackageSetImpl , readPackageSet: readPackageSetImpl } @@ -233,6 +242,11 @@ getManifestFromIndexImpl db name version = do liftEffect $ Db.insertManifest db name m.version manifest pure (Map.lookup version versions) +listPackageSetsImpl :: Spago (PreRegistryEnv _) (Array Db.PackageSet) +listPackageSetsImpl = do + { db } <- ask + liftEffect $ Db.selectPackageSets db + findPackageSetImpl :: forall a. Maybe Version -> Spago (PreRegistryEnv a) Version findPackageSetImpl maybeSet = do { db, purs } <- ask