diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,39 @@ # Changelog +## v2.7.3 + +**Changes since v2.7.1:** + +Other enhancements: + +* `stack upgrade` will download from `haskellstack.org` before trying + `github.com`. See + [#5288](https://github.com/commercialhaskell/stack/issues/5288) +* `stack upgrade` makes less assumptions about archive format. See + [#5288](https://github.com/commercialhaskell/stack/issues/5288) +* Add a `--no-run` flag to the `script` command when compiling. + +Bug fixes: + +* GHC source builds work properly for recent GHC versions again. See + [#5528](https://github.com/commercialhaskell/stack/issues/5528) +* `stack setup` always looks for the unpacked directory name to support + different tar file naming conventions. See + [#5545](https://github.com/commercialhaskell/stack/issues/5545) +* Bump `pantry` version for better OS support. See + [pantry#33](https://github.com/commercialhaskell/pantry/issues/33) +* When building the sanity check for a new GHC install, make sure to clear + `GHC_PACKAGE_PATH`. +* Specifying GHC RTS flags in the `stack.yaml` no longer fails with an error. + [#5568](https://github.com/commercialhaskell/stack/pull/5568) +* `stack setup` will look in sandboxed directories for executables, not + relying on `findExecutables. See + [GHC issue 20074](https://gitlab.haskell.org/ghc/ghc/-/issues/20074) +* Track changes to `setup-config` properly to avoid reconfiguring on every + change. See [#5578](https://github.com/commercialhaskell/stack/issues/5578) + + ## v2.7.1 **Changes since v2.5.1.1:** diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,9 +3,18 @@ ![Unit tests](https://github.com/commercialhaskell/stack/workflows/Unit%20tests/badge.svg) ![Integration tests](https://github.com/commercialhaskell/stack/workflows/Integration%20tests/badge.svg) [![Release](https://img.shields.io/github/release/commercialhaskell/stack.svg)](https://github.com/commercialhaskell/stack/releases) -[![Join the chat at https://gitter.im/commercialhaskell/stack](https://badges.gitter.im/commercialhaskell/stack.svg)](https://gitter.im/commercialhaskell/stack?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) Stack is a cross-platform program for developing Haskell projects. It is intended for Haskellers both new and experienced. See [haskellstack.org](http://haskellstack.org) or the [doc](./doc) directory for more information. + +### Community + +You can participate with the Stack community in the following areas: + +* [Haskell Foundation Slack](https://join.slack.com/t/haskell-foundation/shared_invite/zt-mjh76fw0-CEjg2NbyVE8rVQDvR~0F4A) + * `#stack-users` for general Stack discussion + * `#stack-collaborators` for working on the Stack code base +* [Stack Google Group mailing list](https://groups.google.com/g/haskell-stack) +* [Haskell Community Discourse](https://discourse.haskell.org/) diff --git a/doc/ChangeLog.md b/doc/ChangeLog.md --- a/doc/ChangeLog.md +++ b/doc/ChangeLog.md @@ -1,6 +1,39 @@ # Changelog +## v2.7.3 + +**Changes since v2.7.1:** + +Other enhancements: + +* `stack upgrade` will download from `haskellstack.org` before trying + `github.com`. See + [#5288](https://github.com/commercialhaskell/stack/issues/5288) +* `stack upgrade` makes less assumptions about archive format. See + [#5288](https://github.com/commercialhaskell/stack/issues/5288) +* Add a `--no-run` flag to the `script` command when compiling. + +Bug fixes: + +* GHC source builds work properly for recent GHC versions again. See + [#5528](https://github.com/commercialhaskell/stack/issues/5528) +* `stack setup` always looks for the unpacked directory name to support + different tar file naming conventions. See + [#5545](https://github.com/commercialhaskell/stack/issues/5545) +* Bump `pantry` version for better OS support. See + [pantry#33](https://github.com/commercialhaskell/pantry/issues/33) +* When building the sanity check for a new GHC install, make sure to clear + `GHC_PACKAGE_PATH`. +* Specifying GHC RTS flags in the `stack.yaml` no longer fails with an error. + [#5568](https://github.com/commercialhaskell/stack/pull/5568) +* `stack setup` will look in sandboxed directories for executables, not + relying on `findExecutables. See + [GHC issue 20074](https://gitlab.haskell.org/ghc/ghc/-/issues/20074) +* Track changes to `setup-config` properly to avoid reconfiguring on every + change. See [#5578](https://github.com/commercialhaskell/stack/issues/5578) + + ## v2.7.1 **Changes since v2.5.1.1:** diff --git a/doc/GUIDE.md b/doc/GUIDE.md --- a/doc/GUIDE.md +++ b/doc/GUIDE.md @@ -450,7 +450,7 @@ also known as *snapshots*. We mentioned the LTS resolvers, and you can get quite a bit of information about it at [https://www.stackage.org/lts](https://www.stackage.org/lts), including: -* The appropriate resolver value (`resolver: lts-17.9`, as is currently the latest LTS) +* The appropriate resolver value (`resolver: lts-18.3`, as is currently the latest LTS) * The GHC version used * A full list of all packages available in this snapshot * The ability to perform a Hoogle search on the packages in this snapshot @@ -467,7 +467,7 @@ ## Resolvers and changing your compiler version -Let's explore package sets a bit further. Instead of lts-17.9, let's change our +Let's explore package sets a bit further. Instead of lts-18.3, let's change our `stack.yaml` file to use [the latest nightly](https://www.stackage.org/nightly). Right now, this is currently 2020-03-24 - please see the resolve from the link above to get the latest. @@ -483,8 +483,8 @@ Continuous Integration (CI) setting, like on Travis. For example: ``` -michael@d30748af6d3d:~/helloworld$ stack --resolver lts-17.9 build -Downloaded lts-17.9 build plan. +michael@d30748af6d3d:~/helloworld$ stack --resolver lts-18.3 build +Downloaded lts-18.3 build plan. # build output ... ``` @@ -1143,7 +1143,7 @@ ``` michael@d30748af6d3d:~$ stack exec --package stm -- echo I installed the stm package via --package stm Run from outside a project, using implicit global project config -Using latest snapshot resolver: lts-17.9 +Using latest snapshot resolver: lts-18.3 Writing global (non-project-specific) config file to: /home/michael/.stack/global/stack.yaml Note: You can change the snapshot via the resolver field there. I installed the stm package via --package stm @@ -1156,6 +1156,10 @@ * `--no-ghc-package-path` can be used to stop the `GHC_PACKAGE_PATH` environment variable from being set. Some tools — notably cabal-install — do not behave well with that variable set. + +You may also find it convenient to use `stack exec` to launch a subshell (substitute `bash` with your preferred shell) where your compiled executable is available at the front of your `PATH`: + + stack exec bash ## ghci (the repl) diff --git a/doc/README.md b/doc/README.md --- a/doc/README.md +++ b/doc/README.md @@ -30,6 +30,7 @@ On Windows, you can download and install the [Windows 64-bit Installer](https://get.haskellstack.org/stable/windows-x86_64-installer.exe). +Note that systems with antivirus software may need `stack` added to the list of "trusted" applications. For other operating systems and direct downloads, check out the [install and upgrade guide](install_and_upgrade.md). diff --git a/doc/build_command.md b/doc/build_command.md --- a/doc/build_command.md +++ b/doc/build_command.md @@ -96,8 +96,6 @@ the local packages." This will result in an error if multiple packages have a component with the same name. To continue the above example, `stack build :mytestsuite`. - * Side note: the commonly requested `run` command is not available - because it's a simple combination of `stack build :exename && stack exec exename` * *directory*, e.g. `stack build foo/bar`, will find all local packages that exist in the given directory hierarchy and then follow the same procedure as diff --git a/doc/yaml_configuration.md b/doc/yaml_configuration.md --- a/doc/yaml_configuration.md +++ b/doc/yaml_configuration.md @@ -41,7 +41,7 @@ built when needed. Shadowing semantics, described -[here](http://docs.haskellstack.org/en/stable/architecture/#shadowing), are +[here](https://docs.haskellstack.org/en/v1.5.1/architecture/#shadowing), are applied to your configuration. So, if you add a package to your `packages` list, it will be used even if you're using a snapshot that specifies a particular version. Similarly, `extra-deps` will shadow the version specified in the @@ -531,7 +531,7 @@ #### Bootstrapping compiler Building GHC from source requires a working GHC (known as the bootstrap -compiler). As we use a Stack based version of Hadrian (`hadrian/build.stack.sh` in +compiler). As we use a Stack based version of Hadrian (`hadrian/build-stack` in GHC sources), the bootstrap compiler is configured into `hadrian/stack.yaml` and fully managed by Stack. diff --git a/src/Stack/Build/Cache.hs b/src/Stack/Build/Cache.hs --- a/src/Stack/Build/Cache.hs +++ b/src/Stack/Build/Cache.hs @@ -21,6 +21,7 @@ , writeBuildCache , writeConfigCache , writeCabalMod + , writeSetupConfigMod , TestStatus (..) , setTestStatus , getTestStatus @@ -179,6 +180,20 @@ -> RIO env () writeCabalMod dir x = do fp <- configCabalMod dir + writeBinaryFileAtomic fp "Just used for its modification time" + liftIO $ setFileTimes (toFilePath fp) x x + +-- | See 'tryGetSetupConfigMod' +writeSetupConfigMod + :: HasEnvConfig env + => Path Abs Dir + -> Maybe CTime + -> RIO env () +writeSetupConfigMod dir Nothing = do + fp <- configSetupConfigMod dir + ignoringAbsence $ removeFile fp +writeSetupConfigMod dir (Just x) = do + fp <- configSetupConfigMod dir writeBinaryFileAtomic fp "Just used for its modification time" liftIO $ setFileTimes (toFilePath fp) x x diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -845,8 +845,10 @@ ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp task = do newCabalMod <- liftIO $ modificationTime <$> getFileStatus (toFilePath cabalfp) setupConfigfp <- setupConfigFromDir pkgDir - newSetupConfigMod <- liftIO $ either (const Nothing) (Just . modificationTime) <$> - tryJust (guard . isDoesNotExistError) (getFileStatus (toFilePath setupConfigfp)) + let getNewSetupConfigMod = + liftIO $ either (const Nothing) (Just . modificationTime) <$> + tryJust (guard . isDoesNotExistError) (getFileStatus (toFilePath setupConfigfp)) + newSetupConfigMod <- getNewSetupConfigMod -- See https://github.com/commercialhaskell/stack/issues/3554 taskAnyMissingHack <- view $ actualCompilerVersionL.to getGhcVersion.to (< mkVersion [8, 4]) needConfig <- @@ -905,6 +907,11 @@ TTLocalMutable{} -> writeConfigCache pkgDir newConfigCache TTRemotePackage{} -> return () writeCabalMod pkgDir newCabalMod + -- This file gets updated one more time by the configure step, so get + -- the most recent value. We could instead change our logic above to + -- check if our config mod file is newer than the file above, but this + -- seems reasonable too. + getNewSetupConfigMod >>= writeSetupConfigMod pkgDir return needConfig where @@ -997,7 +1004,7 @@ announce $ "still blocking for directory lock on " <> fromString (toFilePath lockFP) <> "; maybe another Stack process is running?" - withCompanion complainer $ + withCompanion (\x -> complainer x) $ \stopComplaining -> withRunInIO $ \run -> withFileLock (toFilePath lockFP) Exclusive $ \_ -> diff --git a/src/Stack/Constants.hs b/src/Stack/Constants.hs --- a/src/Stack/Constants.hs +++ b/src/Stack/Constants.hs @@ -115,8 +115,8 @@ ,relFileStackDotTmpDotExe ,relFileStackDotTmp ,ghcShowOptionsOutput - ,hadrianCmdWindows - ,hadrianCmdPosix + ,hadrianScriptsWindows + ,hadrianScriptsPosix ,usrLibDirs ,testGhcEnvRelFile ,relFileBuildLock @@ -533,13 +533,15 @@ ghcShowOptionsOutput = $(TH.runIO (readProcess "ghc" ["--show-options"] "") >>= TH.lift . lines) --- | Relative path inside a GHC repo to the Hadrian build batch script -hadrianCmdWindows :: Path Rel File -hadrianCmdWindows = $(mkRelFile "hadrian/build.stack.bat") +-- | Relative paths inside a GHC repo to the Hadrian build batch script. +-- The second path is maintained for compatibility with older GHC versions. +hadrianScriptsWindows :: [Path Rel File] +hadrianScriptsWindows = [$(mkRelFile "hadrian/build-stack.bat"), $(mkRelFile "hadrian/build.stack.bat")] --- | Relative path inside a GHC repo to the Hadrian build shell script -hadrianCmdPosix :: Path Rel File -hadrianCmdPosix = $(mkRelFile "hadrian/build.stack.sh") +-- | Relative paths inside a GHC repo to the Hadrian build shell script +-- The second path is maintained for compatibility with older GHC versions. +hadrianScriptsPosix :: [Path Rel File] +hadrianScriptsPosix = [$(mkRelFile "hadrian/build-stack"), $(mkRelFile "hadrian/build.stack.sh")] -- | Used in Stack.Setup for detecting libtinfo, see comments at use site usrLibDirs :: [Path Abs Dir] diff --git a/src/Stack/New.hs b/src/Stack/New.hs --- a/src/Stack/New.hs +++ b/src/Stack/New.hs @@ -421,7 +421,7 @@ show (AttemptedOverwrites fps) = "The template would create the following files, but they already exist:\n" <> unlines (map ((" " ++) . toFilePath) fps) <> - "Use --force to ignore this, and overwite these files." + "Use --force to ignore this, and overwrite these files." show (FailedToDownloadTemplatesHelp ex) = "Failed to download `stack templates` help. The HTTP error was: " <> show ex show (BadTemplatesHelpEncoding url err) = diff --git a/src/Stack/Options/ScriptParser.hs b/src/Stack/Options/ScriptParser.hs --- a/src/Stack/Options/ScriptParser.hs +++ b/src/Stack/Options/ScriptParser.hs @@ -13,6 +13,7 @@ , soCompile :: !ScriptExecute , soGhcOptions :: ![String] , soScriptExtraDeps :: ![PackageIdentifierRevision] + , soShouldRun :: !ShouldRun } deriving Show @@ -22,6 +23,9 @@ | SEOptimize deriving Show +data ShouldRun = YesRun | NoRun + deriving Show + scriptOptsParser :: Parser ScriptOpts scriptOptsParser = ScriptOpts <$> many (strOption @@ -48,5 +52,6 @@ (long "extra-dep" <> metavar "PACKAGE-VERSION" <> help "Extra dependencies to be added to the snapshot")) + <*> (flag' NoRun (long "no-run" <> help "Don't run, just compile.") <|> pure YesRun) where extraDepRead = eitherReader $ mapLeft show . parsePackageIdentifierRevision . fromString diff --git a/src/Stack/Script.hs b/src/Stack/Script.hs --- a/src/Stack/Script.hs +++ b/src/Stack/Script.hs @@ -84,6 +84,15 @@ , globalStackYaml = SYLNoProject $ soScriptExtraDeps opts } + case soShouldRun opts of + YesRun -> pure () + NoRun -> do + unless (null $ soArgs opts) $ throwString "--no-run incompatible with arguments" + case soCompile opts of + SEInterpret -> throwString "--no-run requires either --compile or --optimize" + SECompile -> pure () + SEOptimize -> pure () + -- Optimization: if we're compiling, and the executable is newer -- than the source file, run it immediately. local (over globalOptsL modifyGO) $ @@ -93,11 +102,16 @@ SEOptimize -> shortCut file scriptDir where + runCompiled file = do + let exeName = toExeName $ toFilePath file + case soShouldRun opts of + YesRun -> exec exeName (soArgs opts) + NoRun -> logInfo $ "Compilation finished, executable available at " <> fromString exeName shortCut file scriptDir = handleIO (const $ longWay file scriptDir) $ do srcMod <- getModificationTime file exeMod <- Dir.getModificationTime $ toExeName $ toFilePath file if srcMod < exeMod - then exec (toExeName $ toFilePath file) (soArgs opts) + then runCompiled file else longWay file scriptDir longWay file scriptDir = @@ -168,7 +182,7 @@ compilerExeName (ghcArgs ++ [toFilePath file]) (void . readProcessStdout_) - exec (toExeName $ toFilePath file) (soArgs opts) + runCompiled file toPackageName = reverse . drop 1 . dropWhile (/= '-') . reverse diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs --- a/src/Stack/Setup.hs +++ b/src/Stack/Setup.hs @@ -54,10 +54,13 @@ import Distribution.Text (simpleParse) import Distribution.Types.PackageName (mkPackageName) import Distribution.Version (mkVersion) +import Network.HTTP.Client (redirectCount) import Network.HTTP.StackClient (CheckHexDigest (..), HashCheck (..), getResponseBody, getResponseStatusCode, httpLbs, httpJSON, mkDownloadRequest, parseRequest, parseUrlThrow, setGithubHeaders, - setHashChecks, setLengthCheck, verifiedDownloadWithProgress, withResponse) + setHashChecks, setLengthCheck, verifiedDownloadWithProgress, withResponse, + setRequestMethod) +import Network.HTTP.Simple (getResponseHeader) import Path hiding (fileExtension) import Path.CheckInstall (warnInstallSearchPathIssues) import Path.Extended (fileExtension) @@ -525,7 +528,7 @@ Just x -> return x Nothing -> throwString $ "MSYS2 not found for " ++ T.unpack osKey let tool = Tool (PackageIdentifier (mkPackageName "msys2") version) - Just <$> downloadAndInstallTool (configLocalPrograms config) info tool (installMsys2Windows osKey si) + Just <$> downloadAndInstallTool (configLocalPrograms config) info tool (installMsys2Windows si) | otherwise -> do logWarn "Continuing despite missing tool: msys2" return Nothing @@ -664,18 +667,36 @@ WCGhc version -> pure ["ghc-" ++ versionString version, "ghc"] WCGhcGit{} -> pure ["ghc"] WCGhcjs{} -> throwIO GhcjsNotSupported + + -- Previously, we used findExecutable to locate these executables. This was + -- actually somewhat sloppy, as it could discover executables outside of the + -- sandbox. This led to a specific issue on Windows with GHC 9.0.1. See + -- https://gitlab.haskell.org/ghc/ghc/-/issues/20074. Instead, now, we look + -- on the paths specified only. let loop [] = do logError $ "Looked for sandboxed compiler named one of: " <> displayShow names logError $ "Could not find it on the paths " <> displayShow (edBins paths) throwString "Could not find sandboxed compiler" loop (x:xs) = do - res <- findExecutable x + res <- liftIO $ D.findExecutablesInDirectories (map toFilePath (edBins paths)) x case res of - Left _ -> loop xs - Right y -> parseAbsFile y - compiler <- withProcessContext menv $ loop names + [] -> loop xs + compiler:rest -> do + unless (null rest) $ do + logWarn "Found multiple candidate compilers:" + for_ res $ \y -> logWarn $ "- " <> fromString y + logWarn $ "This usually indicates a failed installation. Trying anyway with " <> fromString compiler + parseAbsFile compiler + compiler <- withProcessContext menv $ do + compiler <- loop names - when (soptsSanityCheck sopts) $ sanityCheck compiler + -- Run this here to ensure that the sanity check uses the modified + -- environment, otherwise we may infect GHC_PACKAGE_PATH and break sanity + -- checks. + when (soptsSanityCheck sopts) $ sanityCheck compiler + + pure compiler + cp <- pathsFromCompiler wc compilerBuild True compiler pure (cp, paths) @@ -836,10 +857,13 @@ , "--flavour=" <> flavour -- selected flavour , "binary-dist" ] - hadrianCmd - | osIsWindows = hadrianCmdWindows - | otherwise = hadrianCmdPosix + hadrianScripts + | osIsWindows = hadrianScriptsWindows + | otherwise = hadrianScriptsPosix + foundHadrianPaths <- filterM doesFileExist $ (cwd ) <$> hadrianScripts + hadrianPath <- maybe (throwString "No Hadrian build script found") pure $ listToMaybe foundHadrianPaths + logSticky $ "Building GHC from source with `" <> RIO.display flavour <> "` flavour. It can take a long time (more than one hour)..." @@ -847,7 +871,7 @@ -- We need to provide an absolute path to the script since -- the process package only sets working directory _after_ -- discovering the executable - proc (toFilePath (cwd hadrianCmd)) hadrianArgs runProcess_ + proc (toFilePath hadrianPath) hadrianArgs runProcess_ -- find the bindist and install it bindistPath <- parseRelDir "_build/bindist" @@ -872,8 +896,8 @@ } ghcdlinfo = GHCDownloadInfo mempty mempty dlinfo installer - | osIsWindows = installGHCWindows Nothing - | otherwise = installGHCPosix Nothing ghcdlinfo + | osIsWindows = installGHCWindows + | otherwise = installGHCPosix ghcdlinfo si <- runMemoized getSetupInfo' _ <- downloadAndInstallTool (configLocalPrograms config) @@ -1136,8 +1160,8 @@ config <- view configL let installer = case configPlatform config of - Platform _ Cabal.Windows -> installGHCWindows (Just selectedVersion) - _ -> installGHCPosix (Just selectedVersion) downloadInfo + Platform _ Cabal.Windows -> installGHCWindows + _ -> installGHCPosix downloadInfo logInfo $ "Preparing to install GHC" <> (case ghcVariant of @@ -1309,15 +1333,14 @@ | SevenZ installGHCPosix :: HasConfig env - => Maybe Version - -> GHCDownloadInfo + => GHCDownloadInfo -> SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> Path Abs Dir -> RIO env () -installGHCPosix mversion downloadInfo _ archiveFile archiveType tempDir destDir = do +installGHCPosix downloadInfo _ archiveFile archiveType tempDir destDir = do platform <- view platformL menv0 <- view processContextL menv <- mkProcessContext (removeHaskellEnvVars (view envVarsL menv0)) @@ -1380,11 +1403,7 @@ logDebug $ "Unpacking " <> fromString (toFilePath archiveFile) runStep "unpacking" tempDir mempty tarTool [compOpt : "xf", toFilePath archiveFile] - dir <- case mversion of - Just version -> do - relDir <- parseRelDir $ "ghc-" ++ versionString version - return (tempDir relDir) - Nothing -> expectSingleUnpackedDir archiveFile tempDir + dir <- expectSingleUnpackedDir archiveFile tempDir logSticky "Configuring GHC ..." runStep "configuring" dir @@ -1430,27 +1449,24 @@ Right x' -> return $ Right x' installGHCWindows :: HasBuildConfig env - => Maybe Version - -> SetupInfo + => SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> Path Abs Dir -> RIO env () -installGHCWindows mversion si archiveFile archiveType _tempDir destDir = do - tarComponent <- mapM (\v -> parseRelDir $ "ghc-" ++ versionString v) mversion - withUnpackedTarball7z "GHC" si archiveFile archiveType tarComponent destDir +installGHCWindows si archiveFile archiveType _tempDir destDir = do + withUnpackedTarball7z "GHC" si archiveFile archiveType destDir logInfo $ "GHC installed to " <> fromString (toFilePath destDir) installMsys2Windows :: HasBuildConfig env - => Text -- ^ OS Key - -> SetupInfo + => SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> Path Abs Dir -> RIO env () -installMsys2Windows osKey si archiveFile archiveType _tempDir destDir = do +installMsys2Windows si archiveFile archiveType _tempDir destDir = do exists <- liftIO $ D.doesDirectoryExist $ toFilePath destDir when exists $ liftIO (D.removeDirectoryRecursive $ toFilePath destDir) `catchIO` \e -> do logError $ @@ -1458,8 +1474,7 @@ fromString (toFilePath destDir) throwM e - msys <- parseRelDir $ "msys" ++ T.unpack (fromMaybe "32" $ T.stripPrefix "windows" osKey) - withUnpackedTarball7z "MSYS2" si archiveFile archiveType (Just msys) destDir + withUnpackedTarball7z "MSYS2" si archiveFile archiveType destDir -- I couldn't find this officially documented anywhere, but you need to run @@ -1488,10 +1503,9 @@ -> SetupInfo -> Path Abs File -- ^ Path to archive file -> ArchiveType - -> Maybe (Path Rel Dir) -- ^ Name of directory expected in archive. If Nothing, expects a single folder. -> Path Abs Dir -- ^ Destination directory. -> RIO env () -withUnpackedTarball7z name si archiveFile archiveType msrcDir destDir = do +withUnpackedTarball7z name si archiveFile archiveType destDir = do suffix <- case archiveType of TarXz -> return ".xz" @@ -1509,9 +1523,7 @@ liftIO $ ignoringAbsence (removeDirRecur destDir) run7z tmpDir archiveFile run7z tmpDir (tmpDir tarFile) - absSrcDir <- case msrcDir of - Just srcDir -> return $ tmpDir srcDir - Nothing -> expectSingleUnpackedDir archiveFile tmpDir + absSrcDir <- expectSingleUnpackedDir archiveFile tmpDir renameDir absSrcDir destDir expectSingleUnpackedDir :: (MonadIO m, MonadThrow m) => Path Abs File -> Path Abs Dir -> m (Path Abs Dir) @@ -1782,14 +1794,92 @@ -- Binary Stack upgrades -newtype StackReleaseInfo = StackReleaseInfo Value +-- | Information on a binary release of Stack +data StackReleaseInfo + = SRIGithub !Value + -- ^ Metadata downloaded from GitHub releases about available binaries. + | SRIHaskellStackOrg !HaskellStackOrg + -- ^ Information on the latest available binary for the current platforms. -downloadStackReleaseInfo :: (MonadIO m, MonadThrow m) - => Maybe String -- Github org - -> Maybe String -- Github repo - -> Maybe String -- ^ optional version - -> m StackReleaseInfo -downloadStackReleaseInfo morg mrepo mver = liftIO $ do +data HaskellStackOrg = HaskellStackOrg + { hsoUrl :: !Text + , hsoVersion :: !Version + } + deriving Show + +downloadStackReleaseInfo + :: (HasPlatform env, HasLogFunc env) + => Maybe String -- Github org + -> Maybe String -- Github repo + -> Maybe String -- ^ optional version + -> RIO env StackReleaseInfo +downloadStackReleaseInfo Nothing Nothing Nothing = do + platform <- view platformL + -- Fallback list of URLs to try for upgrading. + let urls0 = + case platform of + Platform X86_64 Cabal.Linux -> + [ "https://get.haskellstack.org/upgrade/linux-x86_64-static.tar.gz" + , "https://get.haskellstack.org/upgrade/linux-x86_64.tar.gz" + ] + Platform X86_64 Cabal.OSX -> + [ "https://get.haskellstack.org/upgrade/osx-x86_64.tar.gz" + ] + Platform X86_64 Cabal.Windows -> + [ "https://get.haskellstack.org/upgrade/windows-x86_64.tar.gz" + ] + _ -> [] + -- Helper function: extract the version from a GitHub releases URL. + let extractVersion loc = do + version0 <- + case reverse $ splitOn "/" $ T.unpack loc of + _final:version0:_ -> Right version0 + _ -> Left $ "Insufficient pieces in location: " ++ show loc + version1 <- maybe (Left "no leading v on version") Right $ stripPrefix "v" version0 + maybe (Left $ "Invalid version: " ++ show version1) Right $ parseVersion version1 + + -- Try out different URLs. If we've exhausted all of them, fall back to GitHub. + loop [] = do + logDebug "Could not get binary from haskellstack.org, trying GitHub" + downloadStackReleaseInfoGithub Nothing Nothing Nothing + + -- Try the next URL + loop (url:urls) = do + -- Make a HEAD request without any redirects + req <- setRequestMethod "HEAD" <$> parseRequest (T.unpack url) + res <- httpLbs req { redirectCount = 0 } + + -- Look for a redirect. We're looking for a standard GitHub releases + -- URL where we can extract version information from. + case getResponseHeader "location" res of + [] -> logDebug "No location header found, continuing" *> loop urls + -- Exactly one location header. + [locBS] -> + case decodeUtf8' locBS of + Left e -> logDebug ("Invalid UTF8: " <> displayShow (locBS, e)) *> loop urls + Right loc -> + case extractVersion loc of + Left s -> logDebug ("No version found: " <> displayShow (url, loc, s)) *> loop (loc:urls) + -- We found a valid URL, let's use it! + Right version -> do + let hso = HaskellStackOrg + { hsoUrl = loc + , hsoVersion = version + } + logDebug $ "Downloading from haskellstack.org: " <> displayShow hso + pure $ SRIHaskellStackOrg hso + locs -> logDebug ("Multiple location headers found: " <> displayShow locs) *> loop urls + loop urls0 +downloadStackReleaseInfo morg mrepo mver = downloadStackReleaseInfoGithub morg mrepo mver + +-- | Same as above, but always uses Github +downloadStackReleaseInfoGithub + :: (MonadIO m, MonadThrow m) + => Maybe String -- Github org + -> Maybe String -- Github repo + -> Maybe String -- ^ optional version + -> m StackReleaseInfo +downloadStackReleaseInfoGithub morg mrepo mver = liftIO $ do let org = fromMaybe "commercialhaskell" morg repo = fromMaybe "stack" mrepo let url = concat @@ -1806,7 +1896,7 @@ res <- httpJSON $ setGithubHeaders req let code = getResponseStatusCode res if code >= 200 && code < 300 - then return $ StackReleaseInfo $ getResponseBody res + then return $ SRIGithub $ getResponseBody res else throwString $ "Could not get release information for Stack from: " ++ url preferredPlatforms :: (MonadReader env m, HasPlatform env, MonadThrow m) @@ -1901,7 +1991,7 @@ `catchAny` (logError . displayShow) where - findArchive (StackReleaseInfo val) pattern = do + findArchive (SRIGithub val) pattern = do Object top <- return val Array assets <- HashMap.lookup "assets" top getFirst $ fold $ fmap (First . findMatch pattern') assets @@ -1915,6 +2005,7 @@ String url <- HashMap.lookup "browser_download_url" o Just url findMatch _ _ = Nothing + findArchive (SRIHaskellStackOrg hso) _ = pure $ hsoUrl hso handleTarball :: Path Abs File -> Bool -> T.Text -> IO () handleTarball tmpFile isWindows url = do @@ -1930,25 +2021,26 @@ , T.unpack url ] loop (Tar.Fail e) = throwM e - loop (Tar.Next e es) - | Tar.entryPath e == exeName = - case Tar.entryContent e of - Tar.NormalFile lbs _ -> do - ensureDir destDir - LBS.writeFile (toFilePath tmpFile) lbs - _ -> error $ concat - [ "Invalid file type for tar entry named " - , exeName - , " downloaded from " - , T.unpack url - ] - | otherwise = loop es + loop (Tar.Next e es) = + case FP.splitPath (Tar.entryPath e) of + -- Ignore the first component, see: https://github.com/commercialhaskell/stack/issues/5288 + [_ignored, name] | name == exeName -> do + case Tar.entryContent e of + Tar.NormalFile lbs _ -> do + ensureDir destDir + LBS.writeFile (toFilePath tmpFile) lbs + _ -> error $ concat + [ "Invalid file type for tar entry named " + , Tar.entryPath e + , " downloaded from " + , T.unpack url + ] + _ -> loop es loop entries where - -- The takeBaseName drops the .gz, dropExtension drops the .tar - exeName = - let base = FP.dropExtension (FP.takeBaseName (T.unpack url)) FP. "stack" - in if isWindows then base FP.<.> "exe" else base + exeName + | isWindows = "stack.exe" + | otherwise = "stack" -- | Ensure that the Stack executable download is in the same location -- as the currently running executable. See: @@ -2006,8 +2098,9 @@ | otherwise -> throwM e getDownloadVersion :: StackReleaseInfo -> Maybe Version -getDownloadVersion (StackReleaseInfo val) = do +getDownloadVersion (SRIGithub val) = do Object o <- Just val String rawName <- HashMap.lookup "name" o -- drop the "v" at the beginning of the name parseVersion $ T.unpack (T.drop 1 rawName) +getDownloadVersion (SRIHaskellStackOrg hso) = Just $ hsoVersion hso diff --git a/src/Stack/Storage/Project.hs b/src/Stack/Storage/Project.hs --- a/src/Stack/Storage/Project.hs +++ b/src/Stack/Storage/Project.hs @@ -93,8 +93,9 @@ (HasBuildConfig env, HasLogFunc env) => ReaderT SqlBackend (RIO env) a -> RIO env a -withProjectStorage inner = - flip SQLite.withStorage_ inner =<< view (buildConfigL . to bcProjectStorage . to unProjectStorage) +withProjectStorage inner = do + storage <- view (buildConfigL . to bcProjectStorage . to unProjectStorage) + SQLite.withStorage_ storage inner -- | Key used to retrieve configuration or flag cache type ConfigCacheKey = Unique ConfigCacheParent diff --git a/src/Stack/Storage/User.hs b/src/Stack/Storage/User.hs --- a/src/Stack/Storage/User.hs +++ b/src/Stack/Storage/User.hs @@ -134,8 +134,9 @@ (HasConfig env, HasLogFunc env) => ReaderT SqlBackend (RIO env) a -> RIO env a -withUserStorage inner = - flip SQLite.withStorage_ inner =<< view (configL . to configUserStorage . to unUserStorage) +withUserStorage inner = do + storage <- view (configL . to configUserStorage . to unUserStorage) + SQLite.withStorage_ storage inner -- | Key used to retrieve the precompiled cache type PrecompiledCacheKey = Unique PrecompiledCacheParent diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs --- a/src/Stack/Types/Build.hs +++ b/src/Stack/Types/Build.hs @@ -629,7 +629,7 @@ flagNameString name) (Map.toList flags) , map T.unpack $ packageCabalConfigOpts package - , concatMap (\x -> [compilerOptionsCabalFlag wc, T.unpack x]) (packageGhcOptions package) + , processGhcOptions (packageGhcOptions package) , map ("--extra-include-dirs=" ++) (configExtraIncludeDirs config) , map ("--extra-lib-dirs=" ++) (configExtraLibDirs config) , maybe [] (\customGcc -> ["--with-gcc=" ++ toFilePath customGcc]) (configOverrideGccPath config) @@ -637,6 +637,45 @@ , ["--ghc-option=-fhide-source-paths" | hideSourcePaths cv] ] where + -- This function parses the GHC options that are providing in the + -- stack.yaml file. In order to handle RTS arguments correctly, we need + -- to provide the RTS arguments as a single argument. + processGhcOptions :: [Text] -> [String] + processGhcOptions args = + let + (preRtsArgs, mid) = + break ("+RTS" ==) args + (rtsArgs, end) = + break ("-RTS" ==) mid + fullRtsArgs = + case rtsArgs of + [] -> + -- This means that we didn't have any RTS args - no + -- `+RTS` - and therefore no need for a `-RTS`. + [] + _ -> + -- In this case, we have some RTS args. `break` + -- puts the `"-RTS"` string in the `snd` list, so + -- we want to append it on the end of `rtsArgs` + -- here. + -- + -- We're not checking that `-RTS` is the first + -- element of `end`. This is because the GHC RTS + -- allows you to omit a trailing -RTS if that's the + -- last of the arguments. This permits a GHC + -- options in stack.yaml that matches what you + -- might pass directly to GHC. + [T.unwords $ rtsArgs ++ ["-RTS"]] + -- We drop the first element from `end`, because it is always + -- either `"-RTS"` (and we don't want that as a separate + -- argument) or the list is empty (and `drop _ [] = []`). + postRtsArgs = + drop 1 end + newArgs = + concat [preRtsArgs, fullRtsArgs, postRtsArgs] + in + concatMap (\x -> [compilerOptionsCabalFlag wc, T.unpack x]) newArgs + wc = view (actualCompilerVersionL.to whichCompiler) econfig cv = view (actualCompilerVersionL.to getGhcVersion) econfig diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -1212,7 +1212,10 @@ , ") is outside the required\n" ,"version range specified in stack.yaml (" , T.unpack (versionRangeText requiredRange) - , ")." ] + , ").\n" + , "You can upgrade stack by running:\n\n" + , "stack upgrade" + ] show (NoMatchingSnapshot names) = concat [ "None of the following snapshots provides a compiler matching " , "your package(s):\n" diff --git a/stack.cabal b/stack.cabal --- a/stack.cabal +++ b/stack.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: stack -version: 2.7.1 +version: 2.7.3 license: BSD3 license-file: LICENSE maintainer: manny@fpcomplete.com @@ -253,7 +253,7 @@ echo >=0.1.4, exceptions >=0.10.4, extra >=1.7.9, - file-embed >=0.0.13.0, + file-embed >=0.0.14.0, filelock >=0.1.1.5, filepath >=1.4.2.1, fsnotify >=0.3.0.1, @@ -278,9 +278,9 @@ network-uri >=2.6.4.1, open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0, - pantry >=0.5.1.3, + pantry >=0.5.2, path >=0.7.0, - path-io >=1.6.2, + path-io >=1.6.3, persistent >=2.11.0.4, persistent-sqlite >=2.11.1.0, persistent-template >=2.9.1.0, @@ -308,8 +308,8 @@ typed-process >=0.2.6.0, unicode-transforms >=0.3.7.1, unix-compat >=0.5.3, - unliftio >=0.2.14, - unordered-containers >=0.2.13.0, + unliftio >=0.2.18, + unordered-containers >=0.2.14.0, vector >=0.12.1.2, yaml >=0.11.5.0, zip-archive >=0.4.1, @@ -380,7 +380,7 @@ echo >=0.1.4, exceptions >=0.10.4, extra >=1.7.9, - file-embed >=0.0.13.0, + file-embed >=0.0.14.0, filelock >=0.1.1.5, filepath >=1.4.2.1, fsnotify >=0.3.0.1, @@ -405,9 +405,9 @@ network-uri >=2.6.4.1, open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0, - pantry >=0.5.1.3, + pantry >=0.5.2, path >=0.7.0, - path-io >=1.6.2, + path-io >=1.6.3, persistent >=2.11.0.4, persistent-sqlite >=2.11.1.0, persistent-template >=2.9.1.0, @@ -436,8 +436,8 @@ typed-process >=0.2.6.0, unicode-transforms >=0.3.7.1, unix-compat >=0.5.3, - unliftio >=0.2.14, - unordered-containers >=0.2.13.0, + unliftio >=0.2.18, + unordered-containers >=0.2.14.0, vector >=0.12.1.2, yaml >=0.11.5.0, zip-archive >=0.4.1, @@ -509,7 +509,7 @@ echo >=0.1.4, exceptions >=0.10.4, extra >=1.7.9, - file-embed >=0.0.13.0, + file-embed >=0.0.14.0, filelock >=0.1.1.5, filepath >=1.4.2.1, fsnotify >=0.3.0.1, @@ -536,9 +536,9 @@ open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0, optparse-generic >=1.3.1, - pantry >=0.5.1.3, + pantry >=0.5.2, path >=0.7.0, - path-io >=1.6.2, + path-io >=1.6.3, persistent >=2.11.0.4, persistent-sqlite >=2.11.1.0, persistent-template >=2.9.1.0, @@ -566,8 +566,8 @@ typed-process >=0.2.6.0, unicode-transforms >=0.3.7.1, unix-compat >=0.5.3, - unliftio >=0.2.14, - unordered-containers >=0.2.13.0, + unliftio >=0.2.18, + unordered-containers >=0.2.14.0, vector >=0.12.1.2, yaml >=0.11.5.0, zip-archive >=0.4.1, @@ -645,7 +645,7 @@ echo >=0.1.4, exceptions >=0.10.4, extra >=1.7.9, - file-embed >=0.0.13.0, + file-embed >=0.0.14.0, filelock >=0.1.1.5, filepath >=1.4.2.1, fsnotify >=0.3.0.1, @@ -671,9 +671,9 @@ network-uri >=2.6.4.1, open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0, - pantry >=0.5.1.3, + pantry >=0.5.2, path >=0.7.0, - path-io >=1.6.2, + path-io >=1.6.3, persistent >=2.11.0.4, persistent-sqlite >=2.11.1.0, persistent-template >=2.9.1.0, @@ -704,8 +704,8 @@ typed-process >=0.2.6.0, unicode-transforms >=0.3.7.1, unix-compat >=0.5.3, - unliftio >=0.2.14, - unordered-containers >=0.2.13.0, + unliftio >=0.2.18, + unordered-containers >=0.2.14.0, vector >=0.12.1.2, yaml >=0.11.5.0, zip-archive >=0.4.1, diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-17.10 +resolver: lts-17.15 packages: - . @@ -19,8 +19,6 @@ ghc-options: "$locals": -fhide-source-paths - -extra-deps: [] drop-packages: # See https://github.com/commercialhaskell/stack/pull/4712 diff --git a/test/integration/lib/StackTest.hs b/test/integration/lib/StackTest.hs --- a/test/integration/lib/StackTest.hs +++ b/test/integration/lib/StackTest.hs @@ -252,6 +252,9 @@ isWindows :: Bool isWindows = os == "mingw32" +isLinux :: Bool +isLinux = os == "linux" + -- | Is the OS Alpine Linux? getIsAlpine :: IO Bool getIsAlpine = doesFileExist "/etc/alpine-release"