Merge remote-tracking branch 'origin/pantry' into pantry

.hlint.yaml

@@ -60,7 +60,6 @@
 - error: {lhs: "Network.HTTP.Client.parseUrlThrow", rhs: "Network.HTTP.StackClient.parseUrlThrow"}
 - error: {lhs: "Network.HTTP.Client.path", rhs: "Network.HTTP.StackClient.path"}
 - error: {lhs: "Network.HTTP.Client.responseHeaders", rhs: "Network.HTTP.StackClient.responseHeaders"}
-- error: {lhs: "Network.HTTP.Client.withResponse", rhs: "Network.HTTP.StackClient.withResponseByManager"}
 - error: {lhs: "Network.HTTP.Conduit.requestHeaders", rhs: "Network.HTTP.StackClient.requestHeaders"}
 - error: {lhs: "Network.HTTP.Simple.HttpException", rhs: "Network.HTTP.StackClient.HttpException"}
 - error: {lhs: "Network.HTTP.Simple.addRequestHeader", rhs: "Network.HTTP.StackClient.addRequestHeader"}
@@ -88,4 +87,3 @@
 - error: {lhs: "Network.HTTP.Types.hContentMD5", rhs: "Network.HTTP.StackClient.hContentMD5"}
 - error: {lhs: "Network.HTTP.Types.methodPut", rhs: "Network.HTTP.StackClient.methodPut"}
 - ignore: {name: "Use alternative", within: "Network.HTTP.StackClient"}
-- ignore: {name: "Use withResponseByManager", within: "Network.HTTP.StackClient"}

ChangeLog.md

@@ -7,16 +7,35 @@ Release notes:
 
 Major changes:
 
-* Drop support for multiple package indices and legacy `00-index.tar` style
-  indices. See [#4137](https://github.com/commercialhaskell/stack/issues/4137).
-* Changes to parsing of packages in `stack.yaml` files:
-    * All package types besides local file paths must now be treated as `extra-dep`s.
-    * Only local filepaths can be specified in `packages`. All other
-      must be specified in `extra-deps`.
-    * The `extra-dep` key in `packages` is no longer supported; please
-      move any such specifications to `extra-deps`.
-* A new command, `stack freeze` has been added which outputs project
-  and snapshot definitions with dependencies pinned to their exact versions.
+* Switch over to pantry for managing packages. This is a major change
+  to Stack's internals, and affects user-visible behavior in a few
+  places. Some highlights:
+    * Drop support for multiple package indices and legacy
+      `00-index.tar` style indices. See
+      [#4137](https://github.com/commercialhaskell/stack/issues/4137).
+    * Support for archives and repos in the `packages` section has
+      been removed. Instead, you must use `extra-deps` for such
+      dependencies. `packages` now only supports local filepaths.
+    * Addition of new configuration options for specifying a "pantry
+      tree" key, which provides more reproducibility around builds,
+      and (in the future) will be used for more efficient package
+      content downloads. You can also specify package name and version
+      for more efficient config parsing.
+          * __NOTE__ The new `stack freeze` command provides support
+            for automatically generating this additional
+            information. @@@TODO ensure `stack freeze` actually makes
+            it in.
+    * Package contents and metadata are stored in an SQLite database
+      in place of files on the filesystem. The `pantry` library can be
+      used for interacting with these contents.
+    * Internally, Stack has changed many datatypes, including moving
+      to Cabal's definition of many data types. As a result of such
+      changes, existing cache files will in general be invalidated,
+      resulting in Stack needing to rebuild many previously cached
+      builds in the new version. Sorry :(.
+    * A new command, `stack freeze` has been added which outputs
+      project and snapshot definitions with dependencies pinned to
+      their exact versions.
 
 Behavior changes:
 
@@ -26,6 +45,17 @@ Other enhancements:
   plan construction errors much faster, and avoid some unnecessary
   work when only building a subset of packages. This is especially
   useful for the curator use case.
+* New command `stack ls stack-colors` lists the styles and the associated 'ANSI'
+  control character sequences that stack uses to color some of its output. See
+  `stack ls stack-colors --help` for more information.
+* New global option `--stack-colors=STYLES`, also available as a
+  non-project-specific yaml configuration parameter, allows a stack user to
+  redefine the default styles that stack uses to color some of its output. See
+  `stack --help` for more information.
+* New build option `--ddump-dir`. (See [#4225](https://github.com/commercialhaskell/stack/issues/4225))
+* Stack parses and respects the `preferred-versions` information from
+  Hackage for choosing latest version of a package in some cases,
+  e.g. `stack unpack packagename`.
 
 Bug fixes:
 

doc/yaml_configuration.md

@@ -790,6 +790,9 @@ build:
 
   # Since 1.8
   interleaved-output: false
+
+  # Since 1.10
+  ddump-dir: ""
 ```
 
 The meanings of these settings correspond directly with the CLI flags of the
@@ -1010,3 +1013,33 @@ Since 1.3.0
 This option specifies which template to use with `stack new`, when none is
 specified. The default is called `new-template`. The other templates are listed
 in [the stack-templates repo](https://github.com/commercialhaskell/stack-templates/).
+
+### stack-colors
+
+Stack uses styles to format some of its output. The default styles do not work
+well with every terminal theme. This option specifies stack's output styles,
+allowing new styles to replace the defaults. The option is used as
+`stack-colors: <STYLES>`, where `<STYLES>` is a colon-delimited sequence of
+key=value, 'key' is a style name and 'value' is a semicolon-delimited list of
+'ANSI' SGR (Select Graphic Rendition) control codes (in decimal). Use the
+command `stack ls stack-colors --basic` to see the current sequence.
+
+The 'ANSI' standards refer to (1) standard ECMA-48 'Control Functions for Coded
+Character Sets' (5th edition, 1991); (2) extensions in ITU-T Recommendation
+(previously CCITT Recommendation) T.416 (03/93) 'Information Technology – Open
+Document Architecture (ODA) and Interchange Format: Character Content
+Architectures' (also published as ISO/IEC International Standard 8613-6); and
+(3) further extensions used by 'XTerm', a terminal emulator for the X Window
+System. The 'ANSI' SGR codes are described in a
+[Wikipedia article](http://en.wikipedia.org/wiki/ANSI_escape_code)
+and those codes supported on current versions of Windows in
+[Microsoft's documentation](https://docs.microsoft.com/en-us/windows/console/console-virtual-terminal-sequences).
+
+For example, users of the popular
+[Solarized Dark](https://ethanschoonover.com/solarized/)
+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
+```
+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.

package.yaml

@@ -45,6 +45,7 @@ dependencies:
 - base >=4.10 && < 5
 - base64-bytestring
 - bytestring
+- colour
 - conduit >= 1.3
 - conduit-extra >= 1.3
 - containers
@@ -80,6 +81,7 @@ dependencies:
 - network-uri
 - open-browser
 - optparse-applicative
+- pantry
 - path
 - path-io
 - persistent
@@ -91,18 +93,15 @@ dependencies:
 - project-template
 - regex-applicative-text
 - resourcet
-- resource-pool
 - retry
 - rio
-- rio-orphans
 - semigroups
 - split
 - stm
 - store
 - store-core
 - streaming-commons
 - tar
-- tar-conduit
 - template-haskell
 - temporary
 - text
@@ -133,16 +132,13 @@ when:
     - bindings-uname
     - unix
 library:
-  source-dirs:
-  - src/
-  - subs/pantry/src
+  source-dirs: src/
   ghc-options:
   - -fwarn-identities
   generated-exposed-modules:
   - Paths_stack
   exposed-modules:
   - Control.Concurrent.Execute
-  - Data.Aeson.Extended
   - Data.Attoparsec.Args
   - Data.Attoparsec.Combinators
   - Data.Attoparsec.Interpreter
@@ -257,6 +253,7 @@ library:
   - Stack.Types.Resolver
   - Stack.Types.Runner
   - Stack.Types.Sig
+  - Stack.Types.StylesUpdate
   - Stack.Types.TemplateName
   - Stack.Types.Version
   - Stack.Types.VersionIntervals
@@ -266,17 +263,6 @@ library:
   - Text.PrettyPrint.Leijen.Extended
   - System.Process.PagerEditor
   - System.Terminal
-  - Pantry
-  other-modules:
-  - Pantry.Archive
-  - Pantry.Hackage
-  - Pantry.Repo
-  - Pantry.StaticBytes
-  - Pantry.StaticSHA256
-  - Pantry.Storage
-  - Pantry.Tree
-  - Pantry.Types
-  - Hackage.Security.Client.Repository.HttpLib.HttpClient
   when:
   - condition: 'os(windows)'
     then:
@@ -311,7 +297,7 @@ executables:
       cpp-options: -DSUPPORTED_BUILD
 tests:
   stack-test:
-    main: Test.hs
+    main: Spec.hs
     source-dirs: src/test
     ghc-options:
     - -threaded

src/Network/HTTP/Download.hs

@@ -16,7 +16,6 @@ module Network.HTTP.Download
     , redownload
     , httpJSON
     , httpLbs
-    , httpLBS
     , parseRequest
     , parseUrlThrow
     , setGithubHeaders
@@ -31,7 +30,7 @@ import qualified Data.Conduit.Binary         as CB
 import           Data.Text.Encoding.Error    (lenientDecode)
 import           Data.Text.Encoding          (decodeUtf8With)
 import           Network.HTTP.Download.Verified
-import           Network.HTTP.StackClient    (Request, Response, HttpException, httpJSON, httpLbs, httpLBS, withResponse, path, checkResponse, parseUrlThrow, parseRequest, setRequestHeader, getResponseHeaders, requestHeaders, getResponseBody, getResponseStatusCode)
+import           Network.HTTP.StackClient    (Request, Response, HttpException, httpJSON, httpLbs, withResponse, path, checkResponse, parseUrlThrow, parseRequest, setRequestHeader, getResponseHeaders, requestHeaders, getResponseBody, getResponseStatusCode)
 import           Path.IO                     (doesFileExist)
 import           System.Directory            (createDirectoryIfMissing,
                                               removeFile)

src/Network/HTTP/StackClient.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- |
@@ -7,27 +8,17 @@
 module Network.HTTP.StackClient
   ( httpJSON
   , httpLbs
-  , httpLBS
   , httpNoBody
   , httpSink
-  , setUserAgent
   , withResponse
-  , withResponseByManager
   , setRequestMethod
   , setRequestHeader
   , addRequestHeader
   , setRequestBody
-  , setRequestManager
   , getResponseHeaders
   , getResponseBody
   , getResponseStatusCode
-  , Network.HTTP.Client.responseHeaders
-  , Network.HTTP.Client.responseStatus
-  , Network.HTTP.Client.responseBody
   , parseRequest
-  , parseRequest_
-  , defaultRequest
-  , setUri
   , getUri
   , path
   , checkResponse
@@ -39,24 +30,11 @@ module Network.HTTP.StackClient
   , Request
   , RequestBody(RequestBodyBS, RequestBodyLBS)
   , Response
-  , Manager
-  , Header
-  , HeaderName
-  , HttpException(HttpExceptionRequest)
-  , HttpExceptionContent(StatusCodeException)
+  , HttpException
   , hAccept
   , hContentLength
   , hContentMD5
-  , hCacheControl
-  , hRange
   , methodPut
-  , ok200
-  , partialContent206
-  , Proxy
-  , useProxy
-  , noProxy
-  , proxyEnvironment
-  , managerSetProxy
   , formDataBody
   , partFileRequestBody
   , partBS
@@ -65,19 +43,16 @@ module Network.HTTP.StackClient
 
 import           Data.Aeson (FromJSON)
 import qualified Data.ByteString as Strict
-import           Data.ByteString.Lazy (ByteString)
-import           Data.Conduit (ConduitM, transPipe)
+import           Data.Conduit (ConduitM)
 import           Data.Void (Void)
-import qualified Network.HTTP.Client
-import           Network.HTTP.Client (BodyReader, Manager, Request, RequestBody(..), Response, Manager, HttpExceptionContent(..), parseRequest, parseRequest_, defaultRequest, getUri, path, checkResponse, parseUrlThrow, responseStatus, responseBody, useProxy, noProxy, proxyEnvironment, managerSetProxy, Proxy)
-import           Network.HTTP.Client.Internal (setUri)
-import           Network.HTTP.Simple (setRequestMethod, setRequestBody, setRequestHeader, addRequestHeader, setRequestManager, HttpException(..), getResponseBody, getResponseStatusCode, getResponseHeaders)
-import           Network.HTTP.Types (hAccept, hContentLength, hContentMD5, hCacheControl, hRange, methodPut, Header, HeaderName, ok200, partialContent206)
+import           Network.HTTP.Client (Request, RequestBody(..), Response, parseRequest, getUri, path, checkResponse, parseUrlThrow)
+import           Network.HTTP.Simple (setRequestMethod, setRequestBody, setRequestHeader, addRequestHeader, HttpException(..), getResponseBody, getResponseStatusCode, getResponseHeaders)
+import           Network.HTTP.Types (hAccept, hContentLength, hContentMD5, methodPut)
 import           Network.HTTP.Conduit (requestHeaders)
 import           Network.HTTP.Client.TLS (getGlobalManager, applyDigestAuth, displayDigestAuthException)
 import qualified Network.HTTP.Simple
 import           Network.HTTP.Client.MultipartFormData (formDataBody, partFileRequestBody, partBS, partLBS)
-import           UnliftIO (MonadIO, MonadUnliftIO, withRunInIO, withUnliftIO, unliftIO)
+import           RIO
 
 
 setUserAgent :: Request -> Request
@@ -88,14 +63,10 @@ httpJSON :: (MonadIO m, FromJSON a) => Request -> m (Response a)
 httpJSON = Network.HTTP.Simple.httpJSON . setUserAgent
 
 
-httpLbs :: MonadIO m => Request -> m (Response ByteString)
+httpLbs :: MonadIO m => Request -> m (Response LByteString)
 httpLbs = Network.HTTP.Simple.httpLbs . setUserAgent
 
 
-httpLBS :: MonadIO m => Request -> m (Response ByteString)
-httpLBS = httpLbs
-
-
 httpNoBody :: MonadIO m => Request -> m (Response ())
 httpNoBody = Network.HTTP.Simple.httpNoBody . setUserAgent
 
@@ -105,17 +76,10 @@ httpSink
   => Request
   -> (Response () -> ConduitM Strict.ByteString Void m a)
   -> m a
-httpSink req inner = withUnliftIO $ \u ->
-  Network.HTTP.Simple.httpSink (setUserAgent req) (transPipe (unliftIO u) . inner)
+httpSink = Network.HTTP.Simple.httpSink . setUserAgent
 
 
 withResponse
   :: (MonadUnliftIO m, MonadIO n)
   => Request -> (Response (ConduitM i Strict.ByteString n ()) -> m a) -> m a
-withResponse req inner = withRunInIO $ \run ->
-  Network.HTTP.Simple.withResponse (setUserAgent req) (run . inner)
-
-
-withResponseByManager :: MonadUnliftIO m => Request -> Manager -> (Response BodyReader -> m a) -> m a
-withResponseByManager req man inner = withRunInIO $ \run ->
-  Network.HTTP.Client.withResponse (setUserAgent req) man (run . inner)
+withResponse = Network.HTTP.Simple.withResponse . setUserAgent

src/Stack/Build/Execute.hs

@@ -35,6 +35,7 @@ import qualified Data.ByteString.Base64.URL as B64URL
 import           Data.Char (isSpace)
 import           Conduit
 import qualified Data.Conduit.Binary as CB
+import qualified Data.Conduit.Filesystem as CF
 import qualified Data.Conduit.List as CL
 import           Data.Conduit.Process.Typed
                     (ExitCodeException (..), waitExitCode,
@@ -1552,6 +1553,28 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
                 _ -> return ()
             when hasLibrary $ cabal KeepTHLoading ["register"]
 
+        -- copy ddump-* files
+        case T.unpack <$> boptsDdumpDir eeBuildOpts of
+          Just ddumpPath | buildingFinals && not (null ddumpPath) -> do
+            distDir <- distRelativeDir
+            ddumpDir <- parseRelDir ddumpPath
+
+            logDebug $ fromString ("ddump-dir: " <> toFilePath ddumpDir)
+            logDebug $ fromString ("dist-dir: " <> toFilePath distDir)
+
+            runConduitRes
+              $ CF.sourceDirectoryDeep False (toFilePath distDir)
+             .| CL.filter (isInfixOf ".dump-")
+             .| CL.mapM_ (\src -> liftIO $ do
+                  parentDir <- parent <$> parseRelDir src
+                  destBaseDir <- (ddumpDir </>) <$> stripProperPrefix distDir parentDir
+                  -- exclude .stack-work dir
+                  unless (".stack-work" `isInfixOf` toFilePath destBaseDir) $ do
+                    ensureDir destBaseDir
+                    src' <- parseRelFile src
+                    copyFile src' (destBaseDir </> filename src'))
+          _ -> pure ()
+
         let (installedPkgDb, installedDumpPkgsTVar) =
                 case taskLocation task of
                     Snap ->