diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 003696043..80e87d0cc 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -56,7 +56,7 @@ jobs: shell: bash - name: Build - run: stack build + run: stack build --pedantic shell: bash - name: Install diff --git a/package.yaml b/package.yaml index fe5b7185c..080ac9cf3 100644 --- a/package.yaml +++ b/package.yaml @@ -16,6 +16,7 @@ ghc-options: - -Wincomplete-record-updates - -Wredundant-constraints - -fprint-potential-instances + - -optP-Wno-nonportable-include-path flags: static: diff --git a/spago.cabal b/spago.cabal index ab687c007..7854f6976 100644 --- a/spago.cabal +++ b/spago.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: c5171d8aacb92261a66e4da21145765f3560a8cc8d8e794ef140a95e58c1b3de +-- hash: 8a93a8d0d935703bc0cef9a60dfcacc9776c88e3e5ae6c5f7bc004e775ef1a92 name: spago -version: 0.18.0 +version: 0.18.1 description: Please see the README on GitHub at homepage: https://github.com/purescript/spago#readme bug-reports: https://github.com/purescript/spago/issues diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index ec6a229a9..55c1595df 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -30,11 +30,11 @@ import qualified Dhall.TypeCheck import qualified Web.Bower.PackageMeta as Bower import qualified Spago.Dhall as Dhall -import qualified Spago.GitHub as GitHub import qualified Spago.Messages as Messages import qualified Spago.PackageSet as PackageSet import qualified Spago.PscPackage as PscPackage import qualified Spago.Templates as Templates +import qualified Spago.Purs as Purs type Expr = Dhall.DhallExpr Dhall.Import @@ -164,7 +164,7 @@ ensureConfig = do -- | Create a Config in memory -- | For use by `spago script` and `spago repl` makeTempConfig - :: (HasLogFunc env, HasGlobalCache env) + :: HasLogFunc env => [PackageName] -> Maybe Text -> [SourcePath] @@ -172,9 +172,12 @@ makeTempConfig -> RIO env Config makeTempConfig dependencies alternateBackend configSourcePaths maybeTag = do tag <- case maybeTag of - Nothing -> GitHub.getLatestPackageSetsTag "purescript" "package-sets" >>= (\case - Left _ -> die [ "Failed to fetch latest package set tag" ] - Right tag -> pure tag) + Nothing -> do + Purs.pursVersion >>= \case + Left err -> die [ display err ] + Right compilerVersion -> (PackageSet.getLatestSetForCompilerVersion compilerVersion "purescript" "package-sets") >>= \case + Left _ -> die [ "spago script: failed to fetch latest package set tag" ] + Right tag -> pure tag Just tag -> pure tag expr <- liftIO $ Dhall.inputExpr $ "https://github.com/purescript/package-sets/releases/download/" <> tag <> "/packages.dhall" diff --git a/src/Spago/GitHub.hs b/src/Spago/GitHub.hs index 42a0595e1..55381952f 100644 --- a/src/Spago/GitHub.hs +++ b/src/Spago/GitHub.hs @@ -1,5 +1,8 @@ {-# LANGUAGE ViewPatterns #-} -module Spago.GitHub where +module Spago.GitHub + ( getLatestPackageSetsTag + , getLatestReleasesFile + ) where import Spago.Prelude import Spago.Env @@ -10,13 +13,12 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding import qualified Network.HTTP.Client as Http import qualified Network.HTTP.Simple as Http +import qualified Data.Versions as Version +import qualified Data.Map.Strict as Map import qualified Spago.Messages as Messages -tokenCacheFile :: IsString t => t -tokenCacheFile = "github-token.txt" - tagCacheFile :: Text -> Text -> Text tagCacheFile org repo = org <> "-" <> repo <> "-tag.txt" @@ -63,3 +65,15 @@ getLatestPackageSetsTag org repo = do logWarn "Error following GitHub redirect, response:" logWarn $ displayShow response empty + +getLatestReleasesFile + :: (HasLogFunc env, MonadReader env m, MonadThrow m, MonadIO m) + => Text -> Text -> m (Map Version.SemVer Text) +getLatestReleasesFile org repo = do + logDebug $ "Getting `latest-compatible-sets.json` from " <> display org <> "/" <> display repo + request <- Http.parseRequest $ "https://raw.githubusercontent.com/" <> (Text.unpack org) <> "/" <> (Text.unpack repo) <> "/master/latest-compatible-sets.json" + response <- Http.responseBody <$> Http.httpJSON request + let parseVersion (k, v) = case Version.semver k of + Left _ -> Nothing + Right version -> Just (version, v) + pure $ Map.fromList $ mapMaybe parseVersion $ Map.toList response \ No newline at end of file diff --git a/src/Spago/Messages.hs b/src/Spago/Messages.hs index ff2e6a0f0..a271b80b5 100644 --- a/src/Spago/Messages.hs +++ b/src/Spago/Messages.hs @@ -170,6 +170,14 @@ failedToCopyToGlobalCache err = makeMessage , tshow err ] +incompatiblePurs :: [Text] -> Text +incompatiblePurs versions = makeMessage $ + [ "It seems that you're using a compiler version that is not supported by package-sets at the moment." + , "Please install one of the following versions of the compiler and try again: " + ] + <> map ("- " <>) versions + <> [""] + pursVersionMismatch :: Text -> Text -> Text pursVersionMismatch currentVersion minVersion = makeMessage [ "Oh noes! It looks like the PureScript version installed on your system is not compatible with the package-set you're using." @@ -180,7 +188,7 @@ pursVersionMismatch currentVersion minVersion = makeMessage , "There are a few ways to solve this:" , "- install a compatible `purs` version (i.e. in the same 'semver range' as the one in the package set)" , "- if the `purs` version is 'too new', you can try using `spago upgrade-set` to upgrade to the latest package set" - , "- if you know what you're doing and you want to avoid this check, you can override the `version` of the `metadata` package in the packages.dhall:" + , "- if you know what you're doing and you want to disable this check, you can override the `version` of the `metadata` package in the packages.dhall:" , "" , " let overrides = { metadata = upstream.metadata // { version = \"v" <> currentVersion <> "\" } }" , "" diff --git a/src/Spago/PackageSet.hs b/src/Spago/PackageSet.hs index 9378c03b7..68b0f54b7 100644 --- a/src/Spago/PackageSet.hs +++ b/src/Spago/PackageSet.hs @@ -1,5 +1,6 @@ module Spago.PackageSet ( updatePackageSetVersion + , getLatestSetForCompilerVersion , checkPursIsUpToDate , makePackageSetFile , freeze @@ -13,6 +14,8 @@ import Spago.Env import qualified Control.Exception as Exception import Data.Dynamic (fromDynamic) +import qualified Data.List as List +import qualified Data.Map.Strict as Map import qualified Data.Text as Text import qualified Data.Versions as Version import qualified Dhall.Freeze @@ -45,6 +48,26 @@ makePackageSetFile force comments = do else logWarn $ display $ Messages.foundExistingProject packagesPath Dhall.format packagesPath +getLatestSetForCompilerVersion + :: HasLogFunc env + => Version.SemVer + -> Text + -> Text + -> RIO env (Either SomeException Text) +getLatestSetForCompilerVersion compilerVersion org repo = do + logDebug $ "Got a compiler version: " <> displayShow compilerVersion + -- we first try getting the file with the index of the latest sets + eitherLatestReleases <- try $ GitHub.getLatestReleasesFile org repo + logDebug $ "Latest releases: " <> displayShow eitherLatestReleases + for eitherLatestReleases $ \latestReleases -> do + -- if we get that, we just try to pick a set for the current compiler + case Map.lookup compilerVersion latestReleases of + -- but if the current compiler is not there we complain about compatibility + Nothing -> die [ display $ Messages.incompatiblePurs (Version.prettySemVer <$> List.reverse (Map.keys latestReleases))] + Just newTag -> do + logDebug $ "Found a new tag in the releases file: " <> display newTag + pure $ newTag + -- | Use the specified version of the package set (if specified). -- Otherwise, get the latest version of the package set if possible updatePackageSetVersion @@ -65,30 +88,37 @@ updatePackageSetVersion maybeTag = do maybe (useLatestRelease org repo currentTag) - (useSpecificRelease org repo currentTag) + (updateTag org repo currentTag) maybeTag where - -- | Tries to upgrade the Package-Sets release of the local package set. - -- It will: - -- - try to read the latest tag from GitHub - -- - try to read the current package-set file - -- - try to replace the git tag to which the package-set imports point to - -- (if they point to the Package-Sets repo. This can be eventually made GitHub generic) - -- - if all of this succeeds, it will regenerate the hashes and write to file + -- | Try to fetch the latest compatible tag in various ways, and updates + -- the packages.dhall with it useLatestRelease :: Text -> Text -> Text -> RIO env () useLatestRelease org repo currentTag = do - GitHub.getLatestPackageSetsTag org repo >>= \case - Right tag -> updateTag org repo currentTag tag - Left (err :: SomeException) -> do - logWarn "Was not possible to upgrade the package-sets release" - logDebug $ "Error: " <> display err - - useSpecificRelease - :: Text -> Text -> Text -> Text -> RIO env () - useSpecificRelease org repo currentTag tag = - updateTag org repo currentTag tag + let getLatestFromGitHub = GitHub.getLatestPackageSetsTag org repo >>= \case + Right tag -> updateTag org repo currentTag tag + Left (err :: SomeException) -> do + logWarn "Was not possible to upgrade the package-sets release" + logDebug $ "Error: " <> display err + -- first let's get the current compiler version + Purs.pursVersion >>= \case + Left err -> do + -- if we cannot we just get the latest release from GitHub + logDebug $ display err + getLatestFromGitHub + Right compilerVersion -> + getLatestSetForCompilerVersion compilerVersion org repo >>= \case + Right newTag -> updateTag org repo currentTag newTag + -- if that fails then we fetch the latest set from GitHub + -- TODO: check that it's compatible with the current compiler + Left _err -> getLatestFromGitHub + -- | Tries to upgrade the package-sets release of the local package set. + -- It will: + -- - try to read the current package-set file + -- - try to replace the git tag to which the package-set imports point to + -- - if all of this succeeds, it will regenerate the hashes and write to file updateTag :: Text -> Text -> Text -> Text -> RIO env () updateTag org repo currentTag specificTag = do let quotedTag = surroundQuote specificTag @@ -136,7 +166,7 @@ updatePackageSetVersion maybeTag = do } = [(org, repo, currentTag)] getCurrentTag _ = [] - -- | Given an import and a new purescript/package-sets tag, + -- | Given an import and a new package-sets tag, -- upgrades the import to the tag and resets the hash upgradeImports :: Text -> Text -> Text -> Dhall.Import -> Dhall.Import upgradeImports org repo newTag (Dhall.Import