From 8168804d71c8f1248f7f339e88fecf9fb82a9af1 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Sun, 29 Sep 2024 21:24:40 +0200
Subject: Include repackaging command into configuration

---
 src/SlackBuilder/Update.hs | 57 +++++++++++++++++++++++++++++-----------------
 1 file changed, 36 insertions(+), 21 deletions(-)

(limited to 'src/SlackBuilder/Update.hs')

diff --git a/src/SlackBuilder/Update.hs b/src/SlackBuilder/Update.hs
index 003afb7..773903d 100644
--- a/src/SlackBuilder/Update.hs
+++ b/src/SlackBuilder/Update.hs
@@ -8,6 +8,7 @@ module SlackBuilder.Update
     , downloadWithTemplate
     , getAndLogLatest
     , handleException
+    , repackageWithTemplate
     , reuploadWithTemplate
     , updatePackageIfRequired
     ) where
@@ -142,6 +143,12 @@ cloneFromGit repo tagPrefix packagePath version = do
         , download = uri'
         }
 
+repackageWithTemplate :: Maybe [String] -> Package.DownloadTemplate -> Text -> Text -> SlackBuilderT Package.Download
+repackageWithTemplate Nothing template' = downloadWithTemplate template'
+repackageWithTemplate (Just (cmd : arguments)) template' =
+    reuploadWithTemplate' template' (RawCommand cmd arguments)
+repackageWithTemplate (Just []) template' = reuploadWithTemplate template'
+
 downloadWithTemplate :: Package.DownloadTemplate -> Text -> Text -> SlackBuilderT Package.Download
 downloadWithTemplate downloadTemplate packagePath version = do
     repository' <- SlackBuilderT $ asks repository
@@ -149,8 +156,19 @@ downloadWithTemplate downloadTemplate packagePath version = do
     checksum <- download uri' $ repository' </> Text.unpack packagePath
     pure $ Package.Download uri' $ snd checksum
 
-reuploadWithTemplate :: Package.DownloadTemplate -> [CmdSpec] -> Text -> Text -> SlackBuilderT Package.Download
-reuploadWithTemplate downloadTemplate commands packagePath version = do
+reuploadWithTemplate :: Package.DownloadTemplate -> Text -> Text -> SlackBuilderT Package.Download
+reuploadWithTemplate downloadTemplate packagePath version = do
+    repository' <- SlackBuilderT $ asks repository
+    uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
+    let packagePathRelativeToCurrent = repository' </> Text.unpack packagePath
+    (downloadedFileName, checksum) <- download uri' packagePathRelativeToCurrent
+
+    download' <- handleReupload packagePath
+        $ packagePathRelativeToCurrent </> downloadedFileName
+    pure $ Package.Download download' checksum
+
+reuploadWithTemplate' :: Package.DownloadTemplate -> CmdSpec -> Text -> Text -> SlackBuilderT Package.Download
+reuploadWithTemplate' downloadTemplate commands packagePath version = do
     repository' <- SlackBuilderT $ asks repository
     uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
     let downloadFileName = Text.unpack
@@ -158,22 +176,16 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
             $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
         packagePathRelativeToCurrent = repository' </> Text.unpack packagePath
 
-    (relativeTarball', checksum) <- case commands of
-        [] -> do
-            (downloadedFileName, checksum) <- download uri' packagePathRelativeToCurrent
-            pure (packagePathRelativeToCurrent </> downloadedFileName, checksum)
-        _ -> do
-            changedArchiveRootName <- extractRemote uri' packagePathRelativeToCurrent
-            let relativeTarball = packagePathRelativeToCurrent
-                    </> fromMaybe downloadFileName changedArchiveRootName
-            prepareSource relativeTarball
+    changedArchiveRootName <- extractRemote uri' packagePathRelativeToCurrent
+    let relativeTarball = packagePathRelativeToCurrent
+            </> fromMaybe downloadFileName changedArchiveRootName
+    (relativeTarball', checksum) <- prepareSource relativeTarball
 
-    download' <- handleReupload relativeTarball'
+    download' <- handleReupload packagePath relativeTarball'
     pure $ Package.Download download' checksum
   where
-    category' = Text.pack $ takeBaseName $ Text.unpack packagePath
     prepareSource tarballPath =
-        liftIO (traverse (defaultCreateProcess tarballPath) commands)
+        liftIO (defaultCreateProcess tarballPath commands)
             >> liftIO (tarCompress tarballPath)
             <* liftIO (removeDirectoryRecursive tarballPath)
     tarCompress tarballPath =
@@ -182,13 +194,6 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
          in fmap (appendTarExtension tarballPath,)
             $ withCurrentDirectory (takeDirectory tarballPath)
             $ createLzmaTarball archiveBaseFilename (appendTarExtension archiveBaseFilename)
-    handleReupload relativeTarball = do
-        liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball
-        uploadSource relativeTarball category'
-
-        hostedSources $ NonEmpty.cons category'
-            $ pure $ Text.pack $ takeFileName relativeTarball
-
     defaultCreateProcess cwd' cmdSpec
         = flip withCreateProcess (const . const . const waitForProcess)
         $ CreateProcess
@@ -209,6 +214,16 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
             , child_group = Nothing
             }
 
+handleReupload :: Text -> String -> SlackBuilderT URI
+handleReupload packagePath relativeTarball = do
+    liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball
+    uploadSource relativeTarball category'
+
+    hostedSources $ NonEmpty.cons category'
+        $ pure $ Text.pack $ takeFileName relativeTarball
+  where
+    category' = Text.pack $ takeBaseName $ Text.unpack packagePath
+
 updatePackage :: PackageUpdateData -> PackageInfo -> SlackBuilderT ()
 updatePackage PackageUpdateData{..} info = do
     let packagePath = category <> "/" <> getField @"name" description
-- 
cgit v1.2.3