fix: use tar to copy paths into code volume

A simple `docker cp x/y` will fail because `x` doesn't exist. The
documentation is vague, but it appears we need to pre-create parents in
order to copy nested paths.

To do that would require starting/running the container, which we don't
have reason to do yet. To avoid it, we can switch to using a tar archive
as input to `docker cp -`. This will create create any parents as
necessary.

Author: pbrisbin

src/Restyler/Config/CopyFiles.hs

@@ -17,7 +17,6 @@ import Restyler.Prelude
 
 import Autodocodec hiding ((.=))
 import OptEnvConf hiding (env)
-import Path ((</>))
 import Restyler.CodeVolume
 import Restyler.Config.Glob
 import Restyler.Config.RemoteFile
@@ -110,9 +109,6 @@ copyCodeFiles remoteFiles paths vol = \case
     -- docker cp . container:/path
     dockerCp "." $ vol.container.unwrap <> ":" <> toFilePath vol.path.unwrap
 
-  dockerCpAll = traverse_ $ \p -> do
-    -- docker cp foo/bar.x container:/path/foo/bar.x
-    dockerCp (toFilePath p)
-      $ vol.container.unwrap
-      <> ":"
-      <> toFilePath (vol.path.unwrap </> p)
+  dockerCpAll ps =
+    -- tar -cf - ps | docker cp - container:/path
+    dockerCpTar ps $ vol.container.unwrap <> ":" <> toFilePath vol.path.unwrap

src/Restyler/Monad/Docker.hs

@@ -31,6 +31,7 @@ class Monad m => MonadDocker m where
   dockerVolumeCreate :: HasCallStack => String -> m ()
   dockerVolumeRm :: HasCallStack => String -> m ()
   dockerCp :: String -> String -> m ()
+  dockerCpTar :: [Path Rel File] -> String -> m ()
   dockerRm :: String -> m ()
 
 -- | An instance that invokes the real @docker@
@@ -59,6 +60,19 @@ instance
   dockerVolumeCreate name = runDocker_ ["volume", "create", name]
   dockerVolumeRm name = runDocker_ ["volume", "rm", name]
   dockerCp src dst = runDocker_ ["cp", "--quiet", src, dst]
+  dockerCpTar ps dst = do
+    let
+      tArgs :: [String]
+      tArgs = ["-cf", "-"] <> map toFilePath ps
+
+      dArgs :: [String]
+      dArgs = ["cp", "--quiet", "-", dst]
+
+    logProc "tar" tArgs
+    withProcessWait_ (setStdout createPipe $ proc "tar" tArgs) $ \p -> do
+      logProc "docker" dArgs
+      runProcess_ $ setStdin (useHandleClose $ getStdout p) $ proc "docker" dArgs
+
   dockerRm name = runDocker_ ["rm", name]
 
 runDocker
@@ -103,4 +117,5 @@ instance Monad m => MonadDocker (NullDocker m) where
   dockerVolumeCreate _ = pure ()
   dockerVolumeRm _ = pure ()
   dockerCp _ _ = pure ()
+  dockerCpTar _ _ = pure ()
   dockerRm _ = pure ()