Publish artifacts to destinationsHEADmaster

Changelog: Job section to publish artifacts to specified destination

1 files changed, 44 insertions, 4 deletions

diff --git a/src/Destination.hs b/src/Destination.hs
index f96e88c..dccac03 100644
--- a/src/Destination.hs
+++ b/src/Destination.hs
@@ -1,14 +1,22 @@
 module Destination (
     Destination,
     DeclaredDestination(..),
-    DestinationName(..),
+    DestinationName(..), textDestinationName, showDestinationName,
 
     openDestination,
+    copyToDestination,
+
+    copyRecursive,
+    copyRecursiveForce,
 ) where
 
+import Control.Monad
+import Control.Monad.IO.Class
+
 import Data.Text (Text)
 import Data.Text qualified as T
 
+import System.FilePath
 import System.Directory
 
 
@@ -24,9 +32,41 @@ data DeclaredDestination = DeclaredDestination
 newtype DestinationName = DestinationName Text
     deriving (Eq, Ord, Show)
 
+textDestinationName :: DestinationName -> Text
+textDestinationName (DestinationName text) = text
+
+showDestinationName :: DestinationName -> String
+showDestinationName = T.unpack . textDestinationName
+
 
-openDestination :: Text -> IO Destination
-openDestination url = do
-    let path = T.unpack url
+openDestination :: FilePath -> Text -> IO Destination
+openDestination baseDir url = do
+    let path = baseDir </> T.unpack url
     createDirectoryIfMissing True path
     return $ FilesystemDestination path
+
+copyToDestination :: MonadIO m => FilePath -> Destination -> FilePath -> m ()
+copyToDestination source (FilesystemDestination base) inner = do
+    let target = base </> dropWhile isPathSeparator inner
+    liftIO $ do
+        createDirectoryIfMissing True $ takeDirectory target
+        copyRecursiveForce source target
+
+
+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