Add the ddump-dir option/config value #4225

ChangeLog.md

@@ -22,6 +22,7 @@ Other enhancements:
   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))
 
 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

src/Stack/Build/Execute.hs

@@ -35,6 +35,7 @@ import qualified Data.ByteString.Base64.URL as B64URL
 import           Data.Char (isSpace)
 import           Data.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,
@@ -1532,6 +1533,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 ->

src/Stack/Config/Build.hs

@@ -75,6 +75,7 @@ buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts
     , boptsInterleavedOutput = fromFirst
           (boptsInterleavedOutput defaultBuildOpts)
           buildMonoidInterleavedOutput
+    , boptsDdumpDir = getFirst buildMonoidDdumpDir
     }
   where
     -- These options are not directly used in bopts, instead they

src/Stack/Options/BuildMonoidParser.hs

@@ -22,7 +22,7 @@ buildOptsMonoidParser hide0 =
     preFetch <*> keepGoing <*> keepTmpFiles <*> forceDirty <*>
     tests <*> testOptsParser hideBool <*> benches <*>
     benchOptsParser hideBool <*> reconfigure <*> cabalVerbose <*> splitObjs <*> skipComponents <*>
-    interleavedOutput
+    interleavedOutput <*> ddumpDir
   where
     hideBool = hide0 /= BuildCmdGlobalOpts
     hide =
@@ -173,3 +173,9 @@ buildOptsMonoidParser hide0 =
             "interleaved-output"
             "Print concurrent GHC output to the console with a prefix for the package name"
             hide
+    ddumpDir =
+        optionalFirst
+            (strOption
+                (long "ddump-dir" <>
+                 help "Specify output ddump-files" <>
+                 hide))

src/Stack/Types/Config/Build.hs

@@ -91,6 +91,7 @@ data BuildOpts =
             ,boptsInterleavedOutput :: !Bool
             -- ^ Should we use the interleaved GHC output when building
             -- multiple packages?
+            ,boptsDdumpDir :: !(Maybe Text)
             }
   deriving (Show)
 
@@ -121,6 +122,7 @@ defaultBuildOpts = BuildOpts
     , boptsSplitObjs = False
     , boptsSkipComponents = []
     , boptsInterleavedOutput = False
+    , boptsDdumpDir = Nothing
     }
 
 defaultBuildOptsCLI ::BuildOptsCLI
@@ -190,6 +192,7 @@ data BuildOptsMonoid = BuildOptsMonoid
     , buildMonoidSplitObjs :: !(First Bool)
     , buildMonoidSkipComponents :: ![Text]
     , buildMonoidInterleavedOutput :: !(First Bool)
+    , buildMonoidDdumpDir :: !(First Text)
     } deriving (Show, Generic)
 
 instance FromJSON (WithJSONWarnings BuildOptsMonoid) where
@@ -222,6 +225,7 @@ instance FromJSON (WithJSONWarnings BuildOptsMonoid) where
               buildMonoidSplitObjs <- First <$> o ..:? buildMonoidSplitObjsName
               buildMonoidSkipComponents <- o ..:? buildMonoidSkipComponentsName ..!= mempty
               buildMonoidInterleavedOutput <- First <$> o ..:? buildMonoidInterleavedOutputName
+              buildMonoidDdumpDir <- o ..:? buildMonoidDdumpDirName ..!= mempty
               return BuildOptsMonoid{..})
 
 buildMonoidLibProfileArgName :: Text
@@ -299,6 +303,9 @@ buildMonoidSkipComponentsName = "skip-components"
 buildMonoidInterleavedOutputName :: Text
 buildMonoidInterleavedOutputName = "interleaved-output"
 
+buildMonoidDdumpDirName :: Text
+buildMonoidDdumpDirName = "ddump-dir"
+
 instance Semigroup BuildOptsMonoid where
     (<>) = mappenddefault