stack 2.3.3 → 2.5.1
raw patch · 39 files changed
+376/−253 lines, 39 filesdep ~optparse-applicativedep ~pantrydep ~persistent
Dependency ranges changed: optparse-applicative, pantry, persistent, persistent-template, rio, rio-prettyprint, unix-compat
Files
- ChangeLog.md +41/−1
- doc/ChangeLog.md +41/−1
- doc/GUIDE.md +5/−5
- doc/README.md +3/−0
- doc/build_command.md +4/−1
- doc/docker_integration.md +4/−0
- doc/install_and_upgrade.md +3/−7
- doc/pantry.md +4/−2
- doc/yaml_configuration.md +20/−3
- src/Stack/Build.hs +13/−3
- src/Stack/Build/Execute.hs +4/−8
- src/Stack/Build/Source.hs +21/−52
- src/Stack/BuildPlan.hs +2/−5
- src/Stack/Config.hs +88/−23
- src/Stack/Config/Docker.hs +5/−24
- src/Stack/Coverage.hs +2/−2
- src/Stack/Docker.hs +3/−1
- src/Stack/Dot.hs +3/−1
- src/Stack/Ghci.hs +4/−2
- src/Stack/Ls.hs +1/−1
- src/Stack/New.hs +1/−1
- src/Stack/Options/BuildParser.hs +5/−2
- src/Stack/Options/ConfigParser.hs +7/−1
- src/Stack/Options/DockerParser.hs +4/−0
- src/Stack/Options/ExecParser.hs +9/−6
- src/Stack/Options/ScriptParser.hs +5/−2
- src/Stack/Package.hs +12/−2
- src/Stack/Runners.hs +2/−9
- src/Stack/Types/Build.hs +1/−1
- src/Stack/Types/Config.hs +7/−1
- src/Stack/Types/Config/Build.hs +2/−0
- src/Stack/Types/Docker.hs +9/−0
- src/Stack/Types/Package.hs +13/−12
- src/Stack/Types/Resolver.hs +1/−39
- src/main/Main.hs +6/−5
- src/test/Stack/Config/DockerSpec.hs +3/−14
- src/test/Stack/ConfigSpec.hs +2/−2
- stack.cabal +13/−13
- stack.yaml +3/−1
ChangeLog.md view
@@ -1,6 +1,46 @@ # Changelog +## v2.5.1++**Changes since v2.3.3**++Major changes:+* Add the `snapshot-location-base` yaml configuration option, which allows to+ override the default location of snapshot configuration files. This option+ affects how snapshot synonyms (LTS/Nightly) are expanded to URLs by the+ `pantry` library.+* `docker-network` configuration key added to override docker `--net` arg++Behavior changes:++* File watching now takes into account specified targets, old behavior could+ be restored using the new flag `--watch-all`+ [#5310](https://github.com/commercialhaskell/stack/issues/5310)++Other enhancements:++* `stack ls dependencies json` now includes fields `sha256` and `size` for+ dependencies of `type` `archive` in `location`.+ [#5280](https://github.com/commercialhaskell/stack/issues/5280)+* Build failures now show a hint to scroll up to the corresponding section+ [#5279](https://github.com/commercialhaskell/stack/issues/5279)+* Customisable output styles (see `stack --help` and the `--stack-colors`+ option, and `stack ls stack-colors --help`) now include `info`, `debug`,+ `other-level`, `secondary` and `highlight`, used with verbose output.++Bug fixes:++* Fix `stack test --coverage` when using Cabal 3+* `stack new` now generates PascalCase'd module name correctly.+ [#5376](https://github.com/commercialhaskell/stack/issues/5376)+* Connection issues to Casa server no longer cause builds to failure. Casa acts+ only as an optimizing cache layer, not a critical piece of infrastructure.+* Fix modified time busting caches by always calculating sha256 digest during+ the build process.+ [#5125](https://github.com/commercialhaskell/stack/issues/5125)++ ## v2.3.3 **Changes since v2.3.1**@@ -95,7 +135,7 @@ prefixes each build log output line with a timestamp. * Show warning about `local-programs-path` with spaces on windows- when running scripts. See + when running scripts. See [#5013](https://github.com/commercialhaskell/stack/pull/5013) * Add `ls dependencies json` which will print dependencies as JSON.
doc/ChangeLog.md view
@@ -1,6 +1,46 @@ # Changelog +## v2.5.1++**Changes since v2.3.3**++Major changes:+* Add the `snapshot-location-base` yaml configuration option, which allows to+ override the default location of snapshot configuration files. This option+ affects how snapshot synonyms (LTS/Nightly) are expanded to URLs by the+ `pantry` library.+* `docker-network` configuration key added to override docker `--net` arg++Behavior changes:++* File watching now takes into account specified targets, old behavior could+ be restored using the new flag `--watch-all`+ [#5310](https://github.com/commercialhaskell/stack/issues/5310)++Other enhancements:++* `stack ls dependencies json` now includes fields `sha256` and `size` for+ dependencies of `type` `archive` in `location`.+ [#5280](https://github.com/commercialhaskell/stack/issues/5280)+* Build failures now show a hint to scroll up to the corresponding section+ [#5279](https://github.com/commercialhaskell/stack/issues/5279)+* Customisable output styles (see `stack --help` and the `--stack-colors`+ option, and `stack ls stack-colors --help`) now include `info`, `debug`,+ `other-level`, `secondary` and `highlight`, used with verbose output.++Bug fixes:++* Fix `stack test --coverage` when using Cabal 3+* `stack new` now generates PascalCase'd module name correctly.+ [#5376](https://github.com/commercialhaskell/stack/issues/5376)+* Connection issues to Casa server no longer cause builds to failure. Casa acts+ only as an optimizing cache layer, not a critical piece of infrastructure.+* Fix modified time busting caches by always calculating sha256 digest during+ the build process.+ [#5125](https://github.com/commercialhaskell/stack/issues/5125)++ ## v2.3.3 **Changes since v2.3.1**@@ -95,7 +135,7 @@ prefixes each build log output line with a timestamp. * Show warning about `local-programs-path` with spaces on windows- when running scripts. See + when running scripts. See [#5013](https://github.com/commercialhaskell/stack/pull/5013) * Add `ls dependencies json` which will print dependencies as JSON.
doc/GUIDE.md view
@@ -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-14.27`, as is currently the latest LTS)+* The appropriate resolver value (`resolver: lts-16.15`, 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-14.27, let's change our+Let's explore package sets a bit further. Instead of lts-16.15, 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-14.27 build-Downloaded lts-14.27 build plan.+michael@d30748af6d3d:~/helloworld$ stack --resolver lts-16.15 build+Downloaded lts-16.15 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-14.27+Using latest snapshot resolver: lts-16.15 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
doc/README.md view
@@ -17,6 +17,9 @@ #### How to install +Stack can be installed on most Unix-like (Un*x) operating systems, including+macOS, and on Windows.+ For most Un*x operating systems, the easiest way to install is to run: curl -sSL https://get.haskellstack.org/ | sh
doc/build_command.md view
@@ -157,7 +157,10 @@ worth mentioning here since they compose well with the rest of the build system as described: -* `--file-watch` will rebuild your project every time a file changes+* `--file-watch` will rebuild your project every time a file changes, by default+ it will take into account all files belonging to the targets you specify,+ alternatively one could specify `--watch-all` which will make Stack watch+ any local files (from project packages or from local dependencies) * `--exec "cmd [args]"` will run a command after a successful build To come back to the composable approach described above, consider this final
doc/docker_integration.md view
@@ -199,6 +199,10 @@ # What to name the Docker container. Only useful with `detach` or # `persist` true. (default none) container-name: "example-name"+ + # Sets the network used by docker. Gets directly passed to dockers `net`+ # argument (default: host)+ network: host # Additional arguments to pass to `docker run`. (default none) run-args: ["--net=bridge"]
doc/install_and_upgrade.md view
@@ -139,12 +139,8 @@ Use the [generic Linux option](#linux). -There is also an-unofficial-[Fedora Copr repo](https://copr.fedoraproject.org/coprs/petersen/stack2/) which-can be enabled with: `sudo dnf copr enable petersen/stack2`. Note that this Stack-version may lag behind, so we recommend running `stack upgrade` after installing-it.+Fedora includes builds of stack, but the version may lag behind,+so we recommend running `stack upgrade` after installing it. ## <a name="suse"></a>openSUSE / SUSE Linux Enterprise @@ -254,7 +250,7 @@ * Ensure you have required system dependencies installed. These include GCC, GNU make, xz, perl, libgmp, libffi, and zlib. We also recommend Git and GPG. To install these using your package manager: * Debian / Ubuntu: `sudo apt-get install g++ gcc libc6-dev libffi-dev libgmp-dev make xz-utils zlib1g-dev git gnupg netbase`- * Fedora / CentOS: `sudo dnf install perl make automake gcc gmp-devel libffi zlib xz tar git gnupg` (use `yum` instead of `dnf` on CentOS and Fedora <= 21)+ * Fedora / CentOS: `sudo dnf install perl make automake gcc gmp-devel libffi zlib zlib-devel xz tar git gnupg` (use `yum` instead of `dnf` on CentOS and Fedora <= 21) * Fedora 24: In order to use `stack setup` on a 32-bit system, you may need to run `sudo dnf install ncurses-compat-libs`. If this package is not installed, Stack may not be able to install 32-bit GHC versions.
doc/pantry.md view
@@ -25,8 +25,10 @@ * Via a _convenience synonym_, which provides a short form for some common URLs. These are: * Github: `github:user/repo:path` is treated as `https://raw.githubusercontent.com/user/repo/master/path`- * LTS Haskell: `lts-X.Y` is treated as `github:commercialhaskell/stackage-snapshots:lts/X/Y.yaml`- * Stackage Nightly: `nightly-YYYY-MM-DD` is treated as `github:commercialhaskell/stackage-snapshots:nightly/YYYY/M/D.yaml`+ * LTS Haskell: `lts-X.Y` is treated by default as `github:commercialhaskell/stackage-snapshots:lts/X/Y.yaml`+ * Stackage Nightly: `nightly-YYYY-MM-DD` is treated by default as `github:commercialhaskell/stackage-snapshots:nightly/YYYY/M/D.yaml`++By default, LTS Haskell/Stackage Nightly snapshot configurations are retrieved from `commercialhaskell`'s GitHub repository. You can set a custom location in the [snapshot-location-base](yaml_configuration.md#snapshot-location-base) yaml configuration field. For safer, more reproducible builds, you can optionally specify a URL together with a cryptographic hash of its content, e.g.:
doc/yaml_configuration.md view
@@ -614,7 +614,7 @@ * `integersimple`: Use a GHC bindist that uses [integer-simple instead of GMP](https://ghc.haskell.org/trac/ghc/wiki/ReplacingGMPNotes) * any other value: Use a custom GHC bindist. You should specify- [setup-info](#setup-info) or [setup-info-locations](#setup-info-locations) + [setup-info](#setup-info) or [setup-info-locations](#setup-info-locations) so `stack setup` knows where to download it, or pass the `stack setup --ghc-bindist` argument on the command-line @@ -1143,11 +1143,12 @@ terminal theme might wish to set the styles as follows: ```yaml-stack-colors: error=31:good=32:shell=35:dir=34:recommendation=32:target=95:module=35:package-component=95+stack-colors: error=31:good=32:shell=35:dir=34:recommendation=32:target=95:module=35:package-component=95:secondary=92:highlight=32 ``` The styles can also be set at the command line using the equivalent `--stack-colors=<STYLES>` global option. Styles set at the command line take precedence over those set in-a yaml configuration file.+a yaml configuration file. (In respect of styles used in verbose output, some of+that output occurs before the configuration file is processed.) (The British English spelling (colour) is also accepted. In yaml configuration files, the American spelling is the alternative that has priority.)@@ -1197,3 +1198,19 @@ ``` Since 2.3.3++### snapshot-location-base+Sets the base location of LTS Haskell/Stackage Nightly snapshots. Default is https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/ (as set in the `pantry` library).++For example:+```yaml+snapshot-location-base: https://example.com/snapshots/location/+```+has the following effect:+* `lts-X.Y` expands to `https://example.com/snapshots/location/lts/X/Y.yaml`+* `nightly-YYYY-MM-DD` expands to `https://example.com/snapshots/location/nightly/YYYY/M/D.yaml`++This field is convenient in setups that restrict access to GitHub, for instance closed corporate setups. In this setting, it is common for the development environment to have general access to the internet, but not for testing/building environments. To avoid the firewall, one can run a local snapshots mirror and then use a custom `snapshot-location-base` in the closed environments only.+++Since 2.5.0
src/Stack/Build.hs view
@@ -68,11 +68,22 @@ checkSubLibraryDependencies (Map.elems $ smProject sourceMap) + boptsCli <- view $ envConfigL.to envConfigBuildOptsCLI -- Set local files, necessary for file watching stackYaml <- view stackYamlL for_ msetLocalFiles $ \setLocalFiles -> do- files <- sequence- [lpFiles lp | lp <- allLocals]+ files <-+ if boptsCLIWatchAll boptsCli+ then sequence [lpFiles lp | lp <- allLocals]+ else forM allLocals $ \lp -> do+ let pn = packageName (lpPackage lp)+ case Map.lookup pn (smtTargets $ smTargets sourceMap) of+ Nothing ->+ pure Set.empty+ Just (TargetAll _) ->+ lpFiles lp+ Just (TargetComps components) ->+ lpFilesForComponents components lp liftIO $ setLocalFiles $ Set.insert stackYaml $ Set.unions files checkComponentsBuildable allLocals@@ -81,7 +92,6 @@ (installedMap, globalDumpPkgs, snapshotDumpPkgs, localDumpPkgs) <- getInstalled installMap - boptsCli <- view $ envConfigL.to envConfigBuildOptsCLI baseConfigOpts <- mkBaseConfigOpts boptsCli plan <- constructPlan baseConfigOpts localDumpPkgs loadPackage sourceMap installedMap (boptsCLIInitialBuildSteps boptsCli)
src/Stack/Build/Execute.hs view
@@ -59,7 +59,6 @@ import Distribution.Types.PackageName (mkPackageName) import Distribution.Types.UnqualComponentName (mkUnqualComponentName) import Distribution.Version (mkVersion)-import Foreign.C.Types (CTime) import Path import Path.CheckInstall import Path.Extra (toFilePathNoTrailingSep, rejectMissingFile)@@ -91,7 +90,6 @@ import qualified System.FilePath as FP import System.IO.Error (isDoesNotExistError) import System.PosixCompat.Files (createLink, modificationTime, getFileStatus)-import System.PosixCompat.Time (epochTime) import RIO.PrettyPrint import RIO.Process import Pantry.Internal.Companion@@ -1601,11 +1599,10 @@ -- FIXME: only output these if they're in the build plan. - preBuildTime <- liftIO epochTime let postBuildCheck _succeeded = do mlocalWarnings <- case taskType of TTLocalMutable lp -> do- warnings <- checkForUnlistedFiles taskType preBuildTime pkgDir+ warnings <- checkForUnlistedFiles taskType pkgDir -- TODO: Perhaps only emit these warnings for non extra-dep? return (Just (lpCabalFile lp, warnings)) _ -> return Nothing@@ -1829,12 +1826,11 @@ file = T.unpack name -- | Check if any unlisted files have been found, and add them to the build cache.-checkForUnlistedFiles :: HasEnvConfig env => TaskType -> CTime -> Path Abs Dir -> RIO env [PackageWarning]-checkForUnlistedFiles (TTLocalMutable lp) preBuildTime pkgDir = do+checkForUnlistedFiles :: HasEnvConfig env => TaskType -> Path Abs Dir -> RIO env [PackageWarning]+checkForUnlistedFiles (TTLocalMutable lp) pkgDir = do caches <- runMemoizedWith $ lpNewBuildCaches lp (addBuildCache,warnings) <- addUnlistedToBuildCache- preBuildTime (lpPackage lp) (lpCabalFile lp) (lpComponents lp)@@ -1844,7 +1840,7 @@ writeBuildCache pkgDir component $ Map.unions (cache : newToCache) return warnings-checkForUnlistedFiles TTRemotePackage{} _ _ = return []+checkForUnlistedFiles TTRemotePackage{} _ = return [] -- | Implements running a package's tests. Also handles producing -- coverage reports if coverage is enabled.
src/Stack/Build/Source.hs view
@@ -19,16 +19,13 @@ import Stack.Prelude import qualified Pantry.SHA256 as SHA256-import qualified Data.ByteString as S import Data.ByteString.Builder (toLazyByteString) import Conduit (ZipSink (..), withSourceFile)-import qualified Data.Conduit.List as CL import qualified Distribution.PackageDescription as C import Data.List import qualified Data.Map as Map import qualified Data.Map.Strict as M import qualified Data.Set as Set-import Foreign.C.Types (CTime) import Stack.Build.Cache import Stack.Build.Haddock (shouldHaddockDeps) import Stack.Build.Target@@ -41,7 +38,6 @@ import Stack.Types.SourceMap import System.FilePath (takeFileName) import System.IO.Error (isDoesNotExistError)-import System.PosixCompat.Files (modificationTime, getFileStatus) -- | loads and returns project packages projectLocalPackages :: HasEnvConfig env@@ -406,46 +402,38 @@ -> m (Set FilePath, Map FilePath FileCacheInfo) checkBuildCache oldCache files = do fileTimes <- liftM Map.fromList $ forM files $ \fp -> do- mmodTime <- liftIO (getModTimeMaybe (toFilePath fp))- return (toFilePath fp, mmodTime)+ mdigest <- liftIO (getFileDigestMaybe (toFilePath fp))+ return (toFilePath fp, mdigest) liftM (mconcat . Map.elems) $ sequence $ Map.mergeWithKey- (\fp mmodTime fci -> Just (go fp mmodTime (Just fci)))- (Map.mapWithKey (\fp mmodTime -> go fp mmodTime Nothing))+ (\fp mdigest fci -> Just (go fp mdigest (Just fci)))+ (Map.mapWithKey (\fp mdigest -> go fp mdigest Nothing)) (Map.mapWithKey (\fp fci -> go fp Nothing (Just fci))) fileTimes oldCache where- go :: FilePath -> Maybe CTime -> Maybe FileCacheInfo -> m (Set FilePath, Map FilePath FileCacheInfo)+ go :: FilePath -> Maybe SHA256 -> Maybe FileCacheInfo -> m (Set FilePath, Map FilePath FileCacheInfo) -- Filter out the cabal_macros file to avoid spurious recompilations go fp _ _ | takeFileName fp == "cabal_macros.h" = return (Set.empty, Map.empty) -- Common case where it's in the cache and on the filesystem.- go fp (Just modTime') (Just fci)- | fciModTime fci == modTime' = return (Set.empty, Map.singleton fp fci)- | otherwise = do- newFci <- calcFci modTime' fp- let isDirty =- fciSize fci /= fciSize newFci ||- fciHash fci /= fciHash newFci- newDirty = if isDirty then Set.singleton fp else Set.empty- return (newDirty, Map.singleton fp newFci)+ go fp (Just digest') (Just fci)+ | fciHash fci == digest' = return (Set.empty, Map.singleton fp fci)+ | otherwise = return (Set.singleton fp, Map.singleton fp $ FileCacheInfo digest') -- Missing file. Add it to dirty files, but no FileCacheInfo. go fp Nothing _ = return (Set.singleton fp, Map.empty) -- Missing cache. Add it to dirty files and compute FileCacheInfo.- go fp (Just modTime') Nothing = do- newFci <- calcFci modTime' fp- return (Set.singleton fp, Map.singleton fp newFci)+ go fp (Just digest') Nothing =+ return (Set.singleton fp, Map.singleton fp $ FileCacheInfo digest') -- | Returns entries to add to the build cache for any newly found unlisted modules addUnlistedToBuildCache :: HasEnvConfig env- => CTime- -> Package+ => Package -> Path Abs File -> Set NamedComponent -> Map NamedComponent (Map FilePath a) -> RIO env (Map NamedComponent [Map FilePath FileCacheInfo], [PackageWarning])-addUnlistedToBuildCache preBuildTime pkg cabalFP nonLibComponents buildCaches = do+addUnlistedToBuildCache pkg cabalFP nonLibComponents buildCaches = do (componentFiles, warnings) <- getPackageFilesForTargets pkg cabalFP nonLibComponents results <- forM (M.toList componentFiles) $ \(component, files) -> do let buildCache = M.findWithDefault M.empty component buildCaches@@ -457,13 +445,10 @@ return (M.fromList (map fst results), concatMap snd results) where addFileToCache fp = do- mmodTime <- getModTimeMaybe fp- case mmodTime of+ mdigest <- getFileDigestMaybe fp+ case mdigest of Nothing -> return Map.empty- Just modTime' ->- if modTime' < preBuildTime- then Map.singleton fp <$> calcFci modTime' fp- else return Map.empty+ Just digest' -> return . Map.singleton fp $ FileCacheInfo digest' -- | Gets list of Paths for files relevant to a set of components in a package. -- Note that the library component, if any, is always automatically added to the@@ -484,34 +469,18 @@ M.filterWithKey (\component _ -> component `elem` components) compFiles return (componentsFiles, warnings) --- | Get file modification time, if it exists.-getModTimeMaybe :: MonadIO m => FilePath -> m (Maybe CTime)-getModTimeMaybe fp =+-- | Get file digest, if it exists+getFileDigestMaybe :: MonadIO m => FilePath -> m (Maybe SHA256)+getFileDigestMaybe fp = do liftIO (catch- (liftM- (Just . modificationTime)- (getFileStatus fp))+ (liftM Just . withSourceFile fp $ getDigest) (\e -> if isDoesNotExistError e then return Nothing else throwM e))---- | Create FileCacheInfo for a file.-calcFci :: MonadIO m => CTime -> FilePath -> m FileCacheInfo-calcFci modTime' fp = liftIO $- withSourceFile fp $ \src -> do- (size, digest) <- runConduit $ src .| getZipSink- ((,)- <$> ZipSink (CL.fold- (\x y -> x + fromIntegral (S.length y))- 0)- <*> ZipSink SHA256.sinkHash)- return FileCacheInfo- { fciModTime = modTime'- , fciSize = FileSize size- , fciHash = digest- }+ where+ getDigest src = runConduit $ src .| getZipSink (ZipSink SHA256.sinkHash) -- | Get 'PackageConfig' for package given its name. getPackageConfig
src/Stack/BuildPlan.hs view
@@ -45,7 +45,6 @@ import Stack.Types.Version import Stack.Types.Config import Stack.Types.Compiler-import Stack.Types.Resolver data BuildPlanException = UnknownPackages@@ -62,7 +61,7 @@ , "Non existing resolver: " ++ snapName' ++ "." , "For a complete list of available snapshots see https://www.stackage.org/snapshots" ]- where snapName' = show $ renderSnapName snapName+ where snapName' = show snapName show (UnknownPackages stackYaml unknown shadowed) = unlines $ unknown' ++ shadowed' where@@ -387,9 +386,7 @@ logInfo $ "Selecting the best among " <> displayShow (NonEmpty.length snaps) <> " snapshots...\n"- let resolverStackage (LTS x y) = ltsSnapshotLocation x y- resolverStackage (Nightly d) = nightlySnapshotLocation d- F.foldr1 go (NonEmpty.map (getResult . resolverStackage) snaps)+ F.foldr1 go (NonEmpty.map (getResult <=< snapshotLocation) snaps) where go mold mnew = do old@(_snap, _loc, bpc) <- mold
src/Stack/Config.hs view
@@ -30,11 +30,13 @@ ,defaultConfigYaml ,getProjectConfig ,withBuildConfig+ ,withNewLogFunc ) where import Control.Monad.Extra (firstJustM) import Stack.Prelude import Pantry.Internal.AesonExtended+import Data.Array.IArray ((!), (//)) import qualified Data.ByteString as S import Data.ByteString.Builder (byteString) import Data.Coerce (coerce)@@ -51,7 +53,7 @@ import GHC.Conc (getNumProcessors) import Lens.Micro ((.~)) import Network.HTTP.StackClient (httpJSON, parseUrlThrow, getResponseBody)-import Options.Applicative (Parser, strOption, long, help)+import Options.Applicative (Parser, help, long, metavar, strOption) import Path import Path.Extra (toFilePathNoTrailingSep) import Path.Find (findInParents)@@ -74,14 +76,18 @@ import Stack.Types.Resolver import Stack.Types.SourceMap import Stack.Types.Version-import System.Console.ANSI (hSupportsANSIWithoutEmulation)+import System.Console.ANSI (hSupportsANSIWithoutEmulation, setSGRCode) import System.Environment import System.Info.ShortPathName (getShortPathName) import System.PosixCompat.Files (fileOwner, getFileStatus) import System.PosixCompat.User (getEffectiveUserID) import RIO.List (unzip)-import RIO.PrettyPrint (stylesUpdateL, useColorL)+import RIO.PrettyPrint (Style (Highlight, Secondary),+ logLevelToStyle, stylesUpdateL, useColorL)+import RIO.PrettyPrint.StylesUpdate (StylesUpdate (..))+import RIO.PrettyPrint.DefaultStyles (defaultStyles) import RIO.Process+import RIO.Time (toGregorian) -- | If deprecated path exists, use it and print a warning. -- Otherwise, return the new path.@@ -155,18 +161,18 @@ iopc <- loadConfigYaml (parseProjectAndConfigMonoid (parent fp)) fp ProjectAndConfigMonoid project _ <- liftIO iopc return $ projectResolver project- ARLatestNightly -> nightlySnapshotLocation . snapshotsNightly <$> getSnapshots+ ARLatestNightly -> RSLSynonym . Nightly . snapshotsNightly <$> getSnapshots ARLatestLTSMajor x -> do snapshots <- getSnapshots case IntMap.lookup x $ snapshotsLts snapshots of Nothing -> throwString $ "No LTS release found with major version " ++ show x- Just y -> return $ ltsSnapshotLocation x y+ Just y -> return $ RSLSynonym $ LTS x y ARLatestLTS -> do snapshots <- getSnapshots if IntMap.null $ snapshotsLts snapshots then throwString "No LTS releases found" else let (x, y) = IntMap.findMax $ snapshotsLts snapshots- in return $ ltsSnapshotLocation x y+ in return $ RSLSynonym $ LTS x y logInfo $ "Selected resolver: " <> display r return r @@ -174,9 +180,9 @@ getLatestResolver :: HasConfig env => RIO env RawSnapshotLocation getLatestResolver = do snapshots <- getSnapshots- let mlts = uncurry ltsSnapshotLocation <$>+ let mlts = uncurry LTS <$> listToMaybe (reverse (IntMap.toList (snapshotsLts snapshots)))- pure $ fromMaybe (nightlySnapshotLocation (snapshotsNightly snapshots)) mlts+ pure $ RSLSynonym $ fromMaybe (Nightly (snapshotsNightly snapshots)) mlts -- Interprets ConfigMonoid options. configFromConfigMonoid@@ -353,10 +359,12 @@ ColorNever -> False ColorAlways -> True ColorAuto -> useAnsi- configRunner = configRunner'- & processContextL .~ origEnv- & stylesUpdateL .~ stylesUpdate'- & useColorL .~ fromMaybe useColor' mUseColor+ useColor'' = fromMaybe useColor' mUseColor+ configRunner'' = configRunner'+ & processContextL .~ origEnv+ & stylesUpdateL .~ stylesUpdate'+ & useColorL .~ useColor''+ go = runnerGlobalOpts configRunner' hsc <- case getFirst configMonoidPackageIndices of@@ -372,19 +380,73 @@ Just x -> pure x Nothing -> pure $ configStackRoot </> relDirPantry + let snapLoc =+ case getFirst configMonoidSnapshotLocation of+ Nothing -> defaultSnapshotLocation+ Just addr -> customSnapshotLocation+ where+ customSnapshotLocation (LTS x y) =+ mkRSLUrl $ addr'+ <> "/lts/" <> display x+ <> "/" <> display y <> ".yaml"+ customSnapshotLocation (Nightly date) =+ let (year, month, day) = toGregorian date+ in mkRSLUrl $ addr'+ <> "/nightly/"+ <> display year+ <> "/" <> display month+ <> "/" <> display day <> ".yaml"+ mkRSLUrl builder = RSLUrl (utf8BuilderToText builder) Nothing+ addr' = display $ T.dropWhileEnd (=='/') addr+ let configStackDeveloperMode = fromFirst stackDeveloperModeDefault configMonoidStackDeveloperMode - withPantryConfig- pantryRoot- hsc- (maybe HpackBundled HpackCommand $ getFirst configMonoidOverrideHpack)- clConnectionCount- (fromFirst defaultCasaRepoPrefix configMonoidCasaRepoPrefix)- defaultCasaMaxPerRequest- (\configPantryConfig -> initUserStorage- (configStackRoot </> relFileStorage)- (\configUserStorage -> inner Config {..}))+ withNewLogFunc go useColor'' stylesUpdate' $ \logFunc -> do+ let configRunner = configRunner'' & logFuncL .~ logFunc+ withLocalLogFunc logFunc $ withPantryConfig+ pantryRoot+ hsc+ (maybe HpackBundled HpackCommand $ getFirst configMonoidOverrideHpack)+ clConnectionCount+ (fromFirst defaultCasaRepoPrefix configMonoidCasaRepoPrefix)+ defaultCasaMaxPerRequest+ snapLoc+ (\configPantryConfig -> initUserStorage+ (configStackRoot </> relFileStorage)+ (\configUserStorage -> inner Config {..})) +-- | Runs the provided action with the given 'LogFunc' in the environment+withLocalLogFunc :: HasLogFunc env => LogFunc -> RIO env a -> RIO env a+withLocalLogFunc logFunc = local (set logFuncL logFunc)++-- | Runs the provided action with a new 'LogFunc', given a 'StylesUpdate'.+withNewLogFunc :: MonadUnliftIO m+ => GlobalOpts+ -> Bool -- ^ Use color+ -> StylesUpdate+ -> (LogFunc -> m a)+ -> m a+withNewLogFunc go useColor (StylesUpdate update) inner = do+ logOptions0 <- logOptionsHandle stderr False+ let logOptions+ = setLogUseColor useColor+ $ setLogLevelColors logLevelColors+ $ setLogSecondaryColor secondaryColor+ $ setLogAccentColors (const highlightColor)+ $ setLogUseTime (globalTimeInLog go)+ $ setLogMinLevel (globalLogLevel go)+ $ setLogVerboseFormat (globalLogLevel go <= LevelDebug)+ $ setLogTerminal (globalTerminal go)+ logOptions0+ withLogFunc logOptions inner+ where+ styles = defaultStyles // update+ logLevelColors :: LogLevel -> Utf8Builder+ logLevelColors level =+ fromString $ setSGRCode $ snd $ styles ! logLevelToStyle level+ secondaryColor = fromString $ setSGRCode $ snd $ styles ! Secondary+ highlightColor = fromString $ setSGRCode $ snd $ styles ! Highlight+ -- | Get the default location of the local programs directory. getDefaultLocalProgramsBase :: MonadThrow m => Path Abs Dir@@ -886,7 +948,10 @@ return path packagesParser :: Parser [String]-packagesParser = many (strOption (long "package" <> help "Additional packages that must be installed"))+packagesParser = many (strOption+ (long "package" <>+ metavar "PACKAGE(S)" <>+ help "Additional package(s) that must be installed")) defaultConfigYaml :: IsString s => s defaultConfigYaml =
src/Stack/Config/Docker.hs view
@@ -8,7 +8,6 @@ import Stack.Prelude import Data.List (find) import qualified Data.Text as T-import Data.Text.Read (decimal) import Distribution.Version (simplifyVersionRange) import Stack.Types.Version import Stack.Types.Config@@ -24,22 +23,14 @@ -> m String addDefaultTag base mproject maresolver = do let exc = throwM $ ResolverNotSupportedException mproject maresolver- onUrl url = maybe exc pure $ do- (x, y) <- parseLtsName url- Just $ concat- [ base- , ":lts-"- , show x- , "."- , show y- ]- case maresolver of- Just (ARResolver (RSLUrl url _)) -> onUrl url+ lts <- case maresolver of+ Just (ARResolver (RSLSynonym lts@(LTS _ _))) -> return lts Just _aresolver -> exc Nothing -> case projectResolver <$> mproject of- Just (RSLUrl url _) -> onUrl url+ Just (RSLSynonym lts@(LTS _ _)) -> return lts _ -> exc+ return $ base ++ ":" ++ show lts -- | Interprets DockerOptsMonoid options. dockerOptsFromMonoid@@ -70,6 +61,7 @@ dockerDetach = fromFirstFalse dockerMonoidDetach dockerPersist = fromFirstFalse dockerMonoidPersist dockerContainerName = emptyToNothing (getFirst dockerMonoidContainerName)+ dockerNetwork = emptyToNothing (getFirst dockerMonoidNetwork) dockerRunArgs = dockerMonoidRunArgs dockerMount = dockerMonoidMount dockerMountMode = emptyToNothing (getFirst dockerMonoidMountMode)@@ -105,14 +97,3 @@ , "\nUse an LTS resolver, or set the '" , T.unpack dockerImageArgName , "' explicitly, in your configuration file."]---- | Parse an LTS major and minor number from a snapshot URL.------ This might make more sense in pantry instead.-parseLtsName :: Text -> Maybe (Int, Int)-parseLtsName t0 = do- t1 <- T.stripPrefix "https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/" t0- Right (x, t2) <- Just $ decimal t1- t3 <- T.stripPrefix "/" t2- Right (y, ".yaml") <- Just $ decimal t3- Just (x, y)
src/Stack/Coverage.hs view
@@ -379,7 +379,7 @@ encodeUtf8Builder (pathToHtml outputDir) <> "\".</b>" else- "<table class=\"dashboard\" width=\"100%\" boder=\"1\"><tbody>" <>+ "<table class=\"dashboard\" width=\"100%\" border=\"1\"><tbody>" <> "<p><b>NOTE: This is merely a listing of the html files found in the coverage reports directory. Some of these reports may be old.</b></p>" <> "<tr><th>Package</th><th>TestSuite</th><th>Modification Time</th></tr>" <> foldMap encodeUtf8Builder rows <>@@ -434,7 +434,7 @@ extractField path = do contents <- readFileUtf8 (toFilePath path) case asum (map (T.stripPrefix (field <> ": ")) (T.lines contents)) of- Just result -> return $ Right result+ Just result -> return $ Right $ T.strip result Nothing -> notFoundErr cabalVer <- view cabalVersionL if cabalVer < mkVersion [1, 24]
src/Stack/Docker.hs view
@@ -253,7 +253,6 @@ containerID <- withWorkingDir (toFilePath projectRoot) $ trim . decodeUtf8 <$> readDockerProcess (concat [["create"- ,"--net=host" ,"-e",inContainerEnvVar ++ "=1" ,"-e",stackRootEnvVar ++ "=" ++ toFilePathNoTrailingSep stackRoot ,"-e",platformVariantEnvVar ++ "=dk" ++ platformVariant@@ -265,6 +264,9 @@ ,"-v",toFilePathNoTrailingSep projectRoot ++ ":" ++ toFilePathNoTrailingSep projectRoot ++ mountSuffix ,"-v",toFilePathNoTrailingSep sandboxHomeDir ++ ":" ++ toFilePathNoTrailingSep sandboxHomeDir ++ mountSuffix ,"-w",toFilePathNoTrailingSep pwd]+ ,case dockerNetwork docker of+ Nothing -> ["--net=host"]+ Just name -> ["--net=" ++ name] ,case muserEnv of Nothing -> [] Just userEnv -> ["-e","USER=" ++ userEnv]
src/Stack/Dot.hs view
@@ -188,7 +188,9 @@ ALUrl u -> u ALFilePath (ResolvedPath _ path) -> Text.pack $ "file://" ++ Path.toFilePath path in object [ "type" .= ("archive" :: Text)- , "url" .= url ]+ , "url" .= url+ , "sha256" .= archiveHash archive+ , "size" .= archiveSize archive ] pkgLocToJSON (PLImmutable (PLIRepo repo _)) = object [ "type" .= case repoType repo of RepoGit -> "git" :: Text RepoHg -> "hg" :: Text
src/Stack/Ghci.hs view
@@ -823,9 +823,11 @@ checkForDuplicateModules pkgs = do unless (null duplicates) $ do borderedWarning $ do- prettyError $ "Multiple files use the same module name:" <>+ prettyWarn $ "Multiple files use the same module name:" <> line <> bulletedList (map prettyDuplicate duplicates)- throwM LoadingDuplicateModules+ -- MSS 2020-10-13 Disabling, may remove entirely in the future+ -- See: https://github.com/commercialhaskell/stack/issues/5407#issuecomment-707339928+ -- throwM LoadingDuplicateModules where duplicates :: [(ModuleName, Map (Path Abs File) (Set (PackageName, NamedComponent)))] duplicates =
src/Stack/Ls.hs view
@@ -12,7 +12,7 @@ import Control.Exception (throw) import Data.Aeson import Data.Array.IArray ((//), elems)-import Stack.Prelude hiding (Snapshot (..))+import Stack.Prelude hiding (Snapshot (..), SnapName (..)) import qualified Data.Aeson.Types as A import qualified Data.List as L import Data.Text hiding (pack, intercalate)
src/Stack/New.hs view
@@ -199,7 +199,7 @@ let context = M.unions [nonceParams, nameParams, configParams, yearParam] where nameAsVarId = T.replace "-" "_" $ T.pack $ packageNameString project- nameAsModule = T.filter (/= '-') $ T.toTitle $ T.pack $ packageNameString project+ nameAsModule = T.filter (/= ' ') $ T.toTitle $ T.replace "-" " " $ T.pack $ packageNameString project nameParams = M.fromList [ ("name", T.pack $ packageNameString project) , ("name-as-varid", nameAsVarId) , ("name-as-module", nameAsModule) ]
src/Stack/Options/BuildParser.hs view
@@ -71,10 +71,13 @@ help "Like --file-watch, but polling the filesystem instead of using events") <|> pure NoFileWatch) <*>+ switch+ (long "watch-all" <>+ help "Watch all local files not taking targets into account") <*> many (cmdOption (long "exec" <>- metavar "CMD [ARGS]" <>- help "Command and arguments to run after a successful build")) <*>+ metavar "COMMAND [ARGUMENT(S)]" <>+ help "Command and argument(s) to run after a successful build")) <*> switch (long "only-configure" <> help
src/Stack/Options/ConfigParser.hs view
@@ -22,7 +22,7 @@ (\stackRoot workDir buildOpts dockerOpts nixOpts systemGHC installGHC arch ghcVariant ghcBuild jobs includes libs overrideGccPath overrideHpack skipGHCCheck skipMsys localBin setupInfoLocations modifyCodePage- allowDifferentUser dumpLogs colorWhen -> mempty+ allowDifferentUser dumpLogs colorWhen snapLoc -> mempty { configMonoidStackRoot = stackRoot , configMonoidWorkDir = workDir , configMonoidBuildOpts = buildOpts@@ -46,6 +46,7 @@ , configMonoidAllowDifferentUser = allowDifferentUser , configMonoidDumpLogs = dumpLogs , configMonoidColorWhen = colorWhen+ , configMonoidSnapshotLocation = snapLoc }) <$> optionalFirst (absDirOption ( long stackRootOptionName@@ -161,6 +162,11 @@ \support color codes" <> hide ))+ <*> optionalFirst (strOption+ ( long "snapshot-location-base"+ <> help "The base location of LTS/Nightly snapshots"+ <> metavar "URL"+ )) where hide = hideMods (hide0 /= OuterGlobalOpts) toDumpLogs (First (Just True)) = First (Just DumpAllLogs)
src/Stack/Options/DockerParser.hs view
@@ -59,6 +59,10 @@ hide <> metavar "NAME" <> help "Docker container name")+ <*> firstStrOption (long (dockerOptName dockerNetworkArgName) <>+ hide <>+ metavar "NETWORK" <>+ help "Docker network") <*> argsOption (long (dockerOptName dockerRunArgsArgName) <> hide <> value [] <>
src/Stack/Options/ExecParser.hs view
@@ -16,16 +16,16 @@ <*> eoArgsParser <*> execOptsExtraParser where- eoCmdParser = ExecCmd <$> strArgument (metavar "CMD" <> completer projectExeCompleter)+ eoCmdParser = ExecCmd <$> strArgument (metavar "COMMAND" <> completer projectExeCompleter) eoArgsParser = many (strArgument (metavar txt)) where txt = case mcmd of Nothing -> normalTxt Just ExecCmd{} -> normalTxt- Just ExecRun -> "-- ARGS (e.g. stack run -- file.txt)"- Just ExecGhc -> "-- ARGS (e.g. stack runghc -- X.hs -o x)"- Just ExecRunGhc -> "-- ARGS (e.g. stack runghc -- X.hs)"- normalTxt = "-- ARGS (e.g. stack exec -- ghc-pkg describe base)"+ Just ExecRun -> "-- ARGUMENT(S) (e.g. stack run -- file.txt)"+ Just ExecGhc -> "-- ARGUMENT(S) (e.g. stack runghc -- X.hs -o x)"+ Just ExecRunGhc -> "-- ARGUMENT(S) (e.g. stack runghc -- X.hs)"+ normalTxt = "-- ARGUMENT(S) (e.g. stack exec ghc-pkg -- describe base)" evalOptsParser :: String -- ^ metavar -> Parser EvalOpts@@ -59,7 +59,10 @@ <*> pure True eoPackagesParser :: Parser [String]- eoPackagesParser = many (strOption (long "package" <> help "Additional packages that must be installed"))+ eoPackagesParser = many+ (strOption (long "package"+ <> help "Additional package(s) that must be installed"+ <> metavar "PACKAGE(S)")) eoRtsOptionsParser :: Parser [String] eoRtsOptionsParser = concat <$> many (argsOption
src/Stack/Options/ScriptParser.hs view
@@ -24,9 +24,12 @@ scriptOptsParser :: Parser ScriptOpts scriptOptsParser = ScriptOpts- <$> many (strOption (long "package" <> help "Additional packages that must be installed"))+ <$> many (strOption+ (long "package" <>+ metavar "PACKAGE(S)" <>+ help "Additional package(s) that must be installed")) <*> strArgument (metavar "FILE" <> completer (fileExtCompleter [".hs", ".lhs"]))- <*> many (strArgument (metavar "-- ARGS (e.g. stack script X.hs -- args to program)"))+ <*> many (strArgument (metavar "-- ARGUMENT(S) (e.g. stack script X.hs -- argument(s) to program)")) <*> (flag' SECompile ( long "compile" <> help "Compile the script without optimization and run the executable"
src/Stack/Package.hs view
@@ -82,6 +82,7 @@ data Ctx = Ctx { ctxFile :: !(Path Abs File) , ctxDistDir :: !(Path Abs Dir) , ctxBuildConfig :: !BuildConfig+ , ctxCabalVer :: !Version } instance HasPlatform Ctx@@ -219,9 +220,10 @@ let pkgDir = parent cabalfp distDir <- distDirFromDir pkgDir bc <- view buildConfigL+ cabalVer <- view cabalVersionL (componentModules,componentFiles,dataFiles',warnings) <- runRIO- (Ctx cabalfp distDir bc)+ (Ctx cabalfp distDir bc cabalVer) (packageDescModulesAndFiles pkg) setupFiles <- if buildType pkg == Custom@@ -795,13 +797,21 @@ resolveComponentFiles component build names = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . ctxFile)+ agdirs <- autogenDirs (modules,files,warnings) <- resolveFilesAndDeps component- (if null dirs then [dir] else dirs)+ ((if null dirs then [dir] else dirs) ++ agdirs) names cfiles <- buildOtherSources build return (modules, files <> cfiles, warnings)+ where+ autogenDirs = do+ cabalVer <- asks ctxCabalVer+ distDir <- asks ctxDistDir+ let compDir = componentAutogenDir cabalVer component distDir+ pkgDir = maybeToList $ packageAutogenDir cabalVer distDir+ filterM doesDirExist $ compDir : pkgDir -- | Get all C sources and extra source files in a build. buildOtherSources :: BuildInfo -> RIO Ctx [DotCabalPath]
src/Stack/Runners.hs view
@@ -148,15 +148,8 @@ <$> getTerminalWidth) pure (globalTermWidth go) menv <- mkDefaultProcessContext- logOptions0 <- logOptionsHandle stderr False- let logOptions- = setLogUseColor useColor- $ setLogUseTime (globalTimeInLog go)- $ setLogMinLevel (globalLogLevel go)- $ setLogVerboseFormat (globalLogLevel go <= LevelDebug)- $ setLogTerminal (globalTerminal go)- logOptions0- withLogFunc logOptions $ \logFunc -> runRIO Runner+ let update = globalStylesUpdate go+ withNewLogFunc go useColor update $ \logFunc -> runRIO Runner { runnerGlobalOpts = go , runnerUseColor = useColor , runnerLogFunc = logFunc
src/Stack/Types/Build.hs view
@@ -348,7 +348,7 @@ (True, Nothing) -> "simple Setup.hs" (True, Just taskProvides') -> "custom Setup.hs for package " ++ dropQuotes (packageIdentifierString taskProvides') ) ++- " using:\n " ++ fullCmd ++ "\n" +++ " (scroll up to its section to see the error) using:\n " ++ fullCmd ++ "\n" ++ " Process exited with code: " ++ show exitCode ++ (if exitCode == ExitFailure (-9) then " (THIS MAY INDICATE OUT OF MEMORY)"
src/Stack/Types/Config.hs view
@@ -863,6 +863,8 @@ , configMonoidRecommendUpgrade :: !FirstTrue -- ^ See 'configRecommendUpgrade' , configMonoidCasaRepoPrefix :: !(First CasaRepoPrefix)+ , configMonoidSnapshotLocation :: !(First Text)+ -- ^ Custom location of LTS/Nightly snapshots , configMonoidStackDeveloperMode :: !(First Bool) -- ^ See 'configStackDeveloperMode' }@@ -988,6 +990,7 @@ configMonoidRecommendUpgrade <- FirstTrue <$> obj ..:? configMonoidRecommendUpgradeName configMonoidCasaRepoPrefix <- First <$> obj ..:? configMonoidCasaRepoPrefixName+ configMonoidSnapshotLocation <- First <$> obj ..:? configMonoidSnapshotLocationName configMonoidStackDeveloperMode <- First <$> obj ..:? configMonoidStackDeveloperModeName @@ -1156,6 +1159,9 @@ configMonoidCasaRepoPrefixName :: Text configMonoidCasaRepoPrefixName = "casa-repo-prefix" +configMonoidSnapshotLocationName :: Text+configMonoidSnapshotLocationName = "snapshot-location-base"+ configMonoidStackDeveloperModeName :: Text configMonoidStackDeveloperModeName = "stack-developer-mode" @@ -1223,7 +1229,7 @@ show (NoMatchingSnapshot names) = concat [ "None of the following snapshots provides a compiler matching " , "your package(s):\n"- , unlines $ map (\name -> " - " <> T.unpack (renderSnapName name))+ , unlines $ map (\name -> " - " <> show name) (NonEmpty.toList names) , resolveOptions ]
src/Stack/Types/Config/Build.hs view
@@ -133,6 +133,7 @@ , boptsCLIGhcOptions = [] , boptsCLIBuildSubset = BSAll , boptsCLIFileWatch = NoFileWatch+ , boptsCLIWatchAll = False , boptsCLIExec = [] , boptsCLIOnlyConfigure = False , boptsCLICommand = Build@@ -166,6 +167,7 @@ , boptsCLIFlags :: !(Map ApplyCLIFlag (Map FlagName Bool)) , boptsCLIBuildSubset :: !BuildSubset , boptsCLIFileWatch :: !FileWatchOpts+ , boptsCLIWatchAll :: !Bool , boptsCLIExec :: ![(String, [String])] , boptsCLIOnlyConfigure :: !Bool , boptsCLICommand :: !BuildCommand
src/Stack/Types/Docker.hs view
@@ -43,6 +43,8 @@ ,dockerContainerName :: !(Maybe String) -- ^ Container name to use, only makes sense from command-line with `dockerPersist` -- or `dockerDetach`.+ ,dockerNetwork :: !(Maybe String)+ -- ^ The network docker uses. ,dockerRunArgs :: ![String] -- ^ Arguments to pass directly to @docker run@. ,dockerMount :: ![Mount]@@ -85,6 +87,8 @@ ,dockerMonoidContainerName :: !(First String) -- ^ Container name to use, only makes sense from command-line with `dockerPersist` -- or `dockerDetach`.+ ,dockerMonoidNetwork :: !(First String)+ -- ^ See: 'dockerNetwork' ,dockerMonoidRunArgs :: ![String] -- ^ Arguments to pass directly to @docker run@ ,dockerMonoidMount :: ![Mount]@@ -118,6 +122,7 @@ dockerMonoidDetach <- FirstFalse <$> o ..:? dockerDetachArgName dockerMonoidPersist <- FirstFalse <$> o ..:? dockerPersistArgName dockerMonoidContainerName <- First <$> o ..:? dockerContainerNameArgName+ dockerMonoidNetwork <- First <$> o ..:? dockerNetworkArgName dockerMonoidRunArgs <- o ..:? dockerRunArgsArgName ..!= [] dockerMonoidMount <- o ..:? dockerMountArgName ..!= [] dockerMonoidMountMode <- First <$> o ..:? dockerMountModeArgName@@ -391,6 +396,10 @@ -- | Docker container name argument name. dockerContainerNameArgName :: Text dockerContainerNameArgName = "container-name"+--+-- | Docker container name argument name.+dockerNetworkArgName :: Text+dockerNetworkArgName = "network" -- | Docker persist argument name. dockerPersistArgName :: Text
src/Stack/Types/Package.hs view
@@ -11,7 +11,6 @@ module Stack.Types.Package where import Stack.Prelude-import Foreign.C.Types (CTime) import qualified RIO.Text as T import Data.Aeson (ToJSON (..), FromJSON (..), (.=), (.:), object, withObject) import qualified Data.Map as M@@ -320,6 +319,14 @@ lpFiles :: HasEnvConfig env => LocalPackage -> RIO env (Set.Set (Path Abs File)) lpFiles = runMemoizedWith . fmap (Set.unions . M.elems) . lpComponentFiles +lpFilesForComponents :: HasEnvConfig env+ => Set NamedComponent+ -> LocalPackage+ -> RIO env (Set.Set (Path Abs File))+lpFilesForComponents components lp = runMemoizedWith $ do+ componentFiles <- lpComponentFiles lp+ pure $ mconcat (M.elems (M.restrictKeys componentFiles components))+ -- | A location to install a package into, either snapshot or local data InstallLocation = Snap | Local deriving (Show, Eq)@@ -334,10 +341,8 @@ data InstalledPackageLocation = InstalledTo InstallLocation | ExtraGlobal deriving (Show, Eq) -data FileCacheInfo = FileCacheInfo- { fciModTime :: !CTime- , fciSize :: !FileSize- , fciHash :: !SHA256+newtype FileCacheInfo = FileCacheInfo+ { fciHash :: SHA256 } deriving (Generic, Show, Eq, Typeable) instance NFData FileCacheInfo@@ -345,16 +350,12 @@ -- Provided for storing the BuildCache values in a file. But maybe -- JSON/YAML isn't the right choice here, worth considering. instance ToJSON FileCacheInfo where- toJSON (FileCacheInfo time size hash') = object- [ "modtime" .= time- , "size" .= size- , "hash" .= hash'+ toJSON (FileCacheInfo hash') = object+ [ "hash" .= hash' ] instance FromJSON FileCacheInfo where parseJSON = withObject "FileCacheInfo" $ \o -> FileCacheInfo- <$> o .: "modtime"- <*> o .: "size"- <*> o .: "hash"+ <$> o .: "hash" -- | A descriptor from a .cabal file indicating one of the following: --
src/Stack/Types/Resolver.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}@@ -14,10 +13,7 @@ module Stack.Types.Resolver (AbstractResolver(..) ,readAbstractResolver- ,SnapName(..) ,Snapshots (..)- ,renderSnapName- ,parseSnapName ) where import Pantry.Internal.AesonExtended@@ -62,23 +58,12 @@ pure $ pure $ ARLatestLTSMajor x' _ -> pure $ ARResolver <$> parseRawSnapshotLocation (T.pack s) --- | The name of an LTS Haskell or Stackage Nightly snapshot.-data SnapName- = LTS !Int !Int- | Nightly !Day- deriving (Generic, Typeable, Show, Data, Eq)-instance NFData SnapName-instance Display SnapName where- display = display . renderSnapName- data BuildPlanTypesException- = ParseSnapNameException !Text- | ParseResolverException !Text+ = ParseResolverException !Text | FilepathInDownloadedSnapshot !Text deriving Typeable instance Exception BuildPlanTypesException instance Show BuildPlanTypesException where- show (ParseSnapNameException t) = "Invalid snapshot name: " ++ T.unpack t show (ParseResolverException t) = concat [ "Invalid resolver value: " , T.unpack t@@ -90,29 +75,6 @@ , "field, but filepaths are not allowed in downloaded snapshots.\n" , "Filepath specified: " ++ T.unpack url ]---- | Convert a 'SnapName' into its short representation, e.g. @lts-2.8@,--- @nightly-2015-03-05@.-renderSnapName :: SnapName -> Text-renderSnapName (LTS x y) = T.pack $ concat ["lts-", show x, ".", show y]-renderSnapName (Nightly d) = T.pack $ "nightly-" ++ show d---- | Parse the short representation of a 'SnapName'.-parseSnapName :: MonadThrow m => Text -> m SnapName-parseSnapName t0 =- case lts <|> nightly of- Nothing -> throwM $ ParseSnapNameException t0- Just sn -> return sn- where- lts = do- t1 <- T.stripPrefix "lts-" t0- Right (x, t2) <- Just $ decimal t1- t3 <- T.stripPrefix "." t2- Right (y, "") <- Just $ decimal t3- return $ LTS x y- nightly = do- t1 <- T.stripPrefix "nightly-" t0- Nightly <$> readMaybe (T.unpack t1) -- | Most recent Nightly and newest LTS version per major release. data Snapshots = Snapshots
src/main/Main.hs view
@@ -277,11 +277,12 @@ execCmd (execOptsParser $ Just ExecGhc) addCommand' "hoogle"- ("Run hoogle, the Haskell API search engine. Use 'stack exec' syntax " ++- "to pass Hoogle arguments, e.g. stack hoogle -- --count=20 or " ++- "stack hoogle -- server --local")+ ("Run hoogle, the Haskell API search engine. Use the '-- ARGUMENT(S)' syntax " +++ "to pass Hoogle arguments, e.g. stack hoogle -- --count=20, or " +++ "stack hoogle -- server --local.") hoogleCmd- ((,,,) <$> many (strArgument (metavar "ARG"))+ ((,,,) <$> many (strArgument+ (metavar "-- ARGUMENT(S) (e.g. stack hoogle -- server --local)")) <*> boolFlags True "setup"@@ -297,7 +298,7 @@ -- These are the only commands allowed in interpreter mode as well addCommand' "exec"- "Execute a command"+ "Execute a command. If the command is absent, the first of any arguments is taken as the command." execCmd (execOptsParser Nothing) addCommand' "run"
src/test/Stack/Config/DockerSpec.hs view
@@ -1,37 +1,26 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-} module Stack.Config.DockerSpec (spec) where import Test.Hspec-import Test.Hspec.QuickCheck import Stack.Prelude import Stack.Types.Resolver import RIO.Time (fromGregorian)-import Stack.Config.Docker (parseLtsName, addDefaultTag)+import Stack.Config.Docker (addDefaultTag) spec :: Spec spec = do- prop "parseLtsName" $ \(abs -> x) (abs -> y) -> do- case ltsSnapshotLocation x y of- RSLUrl url _ ->- case parseLtsName url of- Just (x', y') -> do- x `shouldBe` x'- y `shouldBe` y'- Nothing -> error "parseLtsName failed"- loc -> error $ show loc describe "addDefaultTag" $ do it "succeeds fails no resolver" $ addDefaultTag "foo/bar" Nothing Nothing `shouldBe` Nothing it "succeeds on LTS" $ addDefaultTag "foo/bar" Nothing- (Just $ ARResolver $ ltsSnapshotLocation 1 2)+ (Just $ ARResolver $ RSLSynonym $ LTS 1 2) `shouldBe` Just "foo/bar:lts-1.2" it "fails on nightly" $ addDefaultTag "foo/bar" Nothing- (Just $ ARResolver $ nightlySnapshotLocation $ fromGregorian 2018 1 1)+ (Just $ ARResolver $ RSLSynonym $ Nightly $ fromGregorian 2018 1 1) `shouldBe` Nothing
src/test/Stack/ConfigSpec.hs view
@@ -121,11 +121,11 @@ it "parses snapshot using 'resolver'" $ inTempDir $ do loadProject resolverConfig $ \Project{..} ->- projectResolver `shouldBe` ltsSnapshotLocation 2 10+ projectResolver `shouldBe` RSLSynonym (LTS 2 10) it "parses snapshot using 'snapshot'" $ inTempDir $ do loadProject snapshotConfig $ \Project{..} ->- projectResolver `shouldBe` ltsSnapshotLocation 2 10+ projectResolver `shouldBe` RSLSynonym (LTS 2 10) it "throws if both 'resolver' and 'snapshot' are present" $ inTempDir $ do loadProject resolverSnapshotConfig (const (return ()))
stack.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: stack-version: 2.3.3+version: 2.5.1 license: BSD3 license-file: LICENSE maintainer: manny@fpcomplete.com@@ -276,7 +276,7 @@ network-uri >=2.6.2.0, open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0,- pantry ==0.4.*,+ pantry >=0.5.1.3, path >=0.6.1, path-io >=1.4.2, persistent >=2.9.2,@@ -288,8 +288,8 @@ project-template >=0.2.0.1, regex-applicative-text >=0.1.0.1, retry >=0.8.1.0,- rio >=0.1.14.0,- rio-prettyprint >=0.1.0.0,+ rio >=0.1.18.0,+ rio-prettyprint >=0.1.1.0, semigroups >=0.18.5, split >=0.2.3.3, stm >=2.5.0.0,@@ -403,7 +403,7 @@ network-uri >=2.6.2.0, open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0,- pantry ==0.4.*,+ pantry >=0.5.1.3, path >=0.6.1, path-io >=1.4.2, persistent >=2.9.2,@@ -415,8 +415,8 @@ project-template >=0.2.0.1, regex-applicative-text >=0.1.0.1, retry >=0.8.1.0,- rio >=0.1.14.0,- rio-prettyprint >=0.1.0.0,+ rio >=0.1.18.0,+ rio-prettyprint >=0.1.1.0, semigroups >=0.18.5, split >=0.2.3.3, stack -any,@@ -534,7 +534,7 @@ open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0, optparse-generic >=1.3.1,- pantry ==0.4.*,+ pantry >=0.5.1.3, path >=0.6.1, path-io >=1.4.2, persistent >=2.9.2,@@ -546,8 +546,8 @@ project-template >=0.2.0.1, regex-applicative-text >=0.1.0.1, retry >=0.8.1.0,- rio >=0.1.14.0,- rio-prettyprint >=0.1.0.0,+ rio >=0.1.18.0,+ rio-prettyprint >=0.1.1.0, semigroups >=0.18.5, split >=0.2.3.3, stm >=2.5.0.0,@@ -669,7 +669,7 @@ network-uri >=2.6.2.0, open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0,- pantry ==0.4.*,+ pantry >=0.5.1.3, path >=0.6.1, path-io >=1.4.2, persistent >=2.9.2,@@ -682,8 +682,8 @@ raw-strings-qq >=1.1, regex-applicative-text >=0.1.0.1, retry >=0.8.1.0,- rio >=0.1.14.0,- rio-prettyprint >=0.1.0.0,+ rio >=0.1.18.0,+ rio-prettyprint >=0.1.1.0, semigroups >=0.18.5, smallcheck >=1.1.5, split >=0.2.3.3,
stack.yaml view
@@ -28,9 +28,11 @@ - hpack-0.33.0@rev:0 - http-download-0.2.0.0@rev:0 - filelock-0.1.1.5@rev:0-- pantry-0.4.0.1@rev:0+- rio-0.1.19.0@rev:0+- rio-prettyprint-0.1.1.0@rev:0 - casa-client-0.0.1@rev:0 - casa-types-0.0.1@rev:0+- pantry-0.5.1.3@rev:0 drop-packages: # See https://github.com/commercialhaskell/stack/pull/4712