From a4521e99e902e226c8dc281822fca363191def86 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Thu, 3 Jul 2025 21:12:48 +0200
Subject: Directories as artifacts

Changelog: Support whole directories as artifacts
---
 src/Job.hs | 26 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

(limited to 'src/Job.hs')

diff --git a/src/Job.hs b/src/Job.hs
index ee901ee..6782f6b 100644
--- a/src/Job.hs
+++ b/src/Job.hs
@@ -9,6 +9,9 @@ module Job (
     JobManager(..), newJobManager, cancelAllJobs,
     runJobs,
     jobStorageSubdir,
+
+    copyRecursive,
+    copyRecursiveForce,
 ) where
 
 import Control.Concurrent
@@ -309,7 +312,7 @@ runJob job uses checkoutPath jdir = do
     liftIO $ forM_ uses $ \aout -> do
         let target = checkoutPath </> aoutWorkPath aout
         createDirectoryIfMissing True $ takeDirectory target
-        copyFile (aoutStorePath aout) target
+        copyRecursive (aoutStorePath aout) target
 
     bracket (liftIO $ openFile (jdir </> "log") WriteMode) (liftIO . hClose) $ \logs -> do
         forM_ (jobRecipe job) $ \p -> do
@@ -338,7 +341,7 @@ runJob job uses checkoutPath jdir = do
             let target = adir </> T.unpack tname </> takeFileName path
             liftIO $ do
                 createDirectoryIfMissing True $ takeDirectory target
-                copyFile path target
+                copyRecursiveForce path target
             return $ ArtifactOutput
                 { aoutName = name
                 , aoutWorkPath = makeRelative checkoutPath path
@@ -349,3 +352,22 @@ runJob job uses checkoutPath jdir = do
             { outName = jobName job
             , outArtifacts = artifacts
             }
+
+
+copyRecursive :: FilePath -> FilePath -> IO ()
+copyRecursive from to = do
+    doesDirectoryExist from >>= \case
+        False -> do
+            copyFile from to
+        True -> do
+            createDirectory to
+            content <- listDirectory from
+            forM_ content $ \name -> do
+                copyRecursive  (from </> name) (to </> name)
+
+copyRecursiveForce :: FilePath -> FilePath -> IO ()
+copyRecursiveForce from to = do
+    doesDirectoryExist to >>= \case
+        False -> return ()
+        True  -> removeDirectoryRecursive to
+    copyRecursive from to
-- 
cgit v1.2.3