Allow updater save a function for each download

There are source that can be downloaded as archive, for example cloning
repositories with submodules. So how source are downloaded should be
changable per download.

2 files changed, 45 insertions, 44 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 5954918..29c332e 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -64,10 +64,9 @@ autoUpdatable =
                 template = Package.DownloadTemplate
                     $ Package.StaticPlaceholder "https://github.com/universal-ctags/ctags/archive/"
                     :| templateTail
-             in Package.Updater latest' template
+             in Package.Updater latest' $ reuploadWithTemplate template []
         , category = "development"
         , name = "universal-ctags"
-        , reupload = Just []
         , downloaders = mempty
         }
     , Package
@@ -77,10 +76,9 @@ autoUpdatable =
                 template = Package.DownloadTemplate
                     $ Package.StaticPlaceholder "https://getcomposer.org/download/"
                     :| [Package.VersionPlaceholder, Package.StaticPlaceholder "/composer.phar"]
-             in Package.Updater latest' template
+             in Package.Updater latest' $ downloadWithTemplate template
         , category = "development"
         , name = "composer"
-        , reupload = Nothing
         , downloaders = mempty
         }
     , Package
@@ -95,10 +93,9 @@ autoUpdatable =
                     $ Package.StaticPlaceholder "https://github.com/jitsi/jitsi-meet-electron/releases/download/v"
                     :| Package.VersionPlaceholder
                     : [Package.StaticPlaceholder "/jitsi-meet-x86_64.AppImage"]
-             in Package.Updater latest' template
+             in Package.Updater latest' $ downloadWithTemplate template
         , category = "network"
         , name = "jitsi-meet-desktop"
-        , reupload = Nothing
         , downloaders = mempty
         }
     , Package
@@ -117,10 +114,9 @@ autoUpdatable =
                     $ Package.StaticPlaceholder "https://www.php.net/distributions/php-"
                     :| Package.VersionPlaceholder
                     : [Package.StaticPlaceholder ".tar.xz"]
-             in Package.Updater latest' template
+             in Package.Updater latest' $ downloadWithTemplate template
         , category = "development"
         , name = "php82"
-        , reupload = Nothing
         , downloaders = mempty
         }
     , Package
@@ -140,10 +136,9 @@ autoUpdatable =
                     $ Package.StaticPlaceholder "https://github.com/kovidgoyal/kitty/releases/download/v"
                     :| Package.VersionPlaceholder
                     : templateTail
-             in Package.Updater latest' template
+             in Package.Updater latest' $ reuploadWithTemplate template [RawCommand "go" ["mod", "vendor"]]
         , category = "system"
         , name = "kitty"
-        , reupload = Just [RawCommand "go" ["mod", "vendor"]]
         , downloaders = mempty
         }
     , Package
@@ -160,10 +155,9 @@ autoUpdatable =
                     : Package.StaticPlaceholder "/rdiff-backup-"
                     : Package.VersionPlaceholder
                     : [Package.StaticPlaceholder ".tar.gz"]
-             in Package.Updater latest' template
+             in Package.Updater latest' $ reuploadWithTemplate template []
         , category = "system"
         , name = "rdiff-backup"
-        , reupload = Just mempty
         , downloaders = mempty
         }
     , Package
@@ -180,10 +174,9 @@ autoUpdatable =
                 template = Package.DownloadTemplate $ pure
                     $ Package.StaticPlaceholder
                         "https://binaries.webex.com/WebexDesktop-Ubuntu-Official-Package/Webex.deb"
-             in Package.Updater latest' template
+             in Package.Updater latest' $ downloadWithTemplate template
         , category = "network"
         , name = "webex"
-        , reupload = Nothing
         , downloaders = mempty
         }
     , Package
@@ -200,10 +193,9 @@ autoUpdatable =
                     : Package.StaticPlaceholder "/librsync-"
                     : Package.VersionPlaceholder
                     : [Package.StaticPlaceholder ".tar.gz"]
-             in Package.Updater latest' template
+             in Package.Updater latest' $ reuploadWithTemplate template []
         , category = "libraries"
         , name = "librsync"
-        , reupload = Just mempty
         , downloaders = []
         }
     , Package
@@ -219,10 +211,9 @@ autoUpdatable =
                     : Package.StaticPlaceholder "/dmd."
                     : Package.VersionPlaceholder
                     : [Package.StaticPlaceholder ".linux.tar.xz"]
-             in Package.Updater latest' template
+             in Package.Updater latest' $ downloadWithTemplate template
         , category = "development"
         , name = "dmd"
-        , reupload = Nothing
         , downloaders = mempty
         }
     , Package
@@ -235,17 +226,16 @@ autoUpdatable =
                 template = Package.DownloadTemplate
                     $ Package.StaticPlaceholder "https://codeload.github.com/dlang/tools/tar.gz/v"
                     :| [Package.VersionPlaceholder]
-             in Package.Updater latest' template
+             in Package.Updater latest' $ reuploadWithTemplate template []
         , category = "development"
         , name = "d-tools"
-        , reupload = Just []
         , downloaders =
             let dubArguments = GhArguments{ owner = "dlang", name = "dub", transform = Nothing}
                 latestDub = latestGitHub dubArguments pure
                 dubTemplate = Package.DownloadTemplate
                     $ Package.StaticPlaceholder "https://codeload.github.com/dlang/dub/tar.gz/v"
                     :| [Package.VersionPlaceholder]
-             in [Package.Updater latestDub dubTemplate]
+             in [Package.Updater latestDub $ downloadWithTemplate dubTemplate]
         }
     ]
 
@@ -255,9 +245,9 @@ up2Date = for_ autoUpdatable go
     go package = getAndLogLatest package
         >>= mapM_ (updatePackageIfRequired package)
         >> liftIO (putStrLn "")
-    getAndLogLatest Package{ latest = Package.Updater getLatest _, name }
+    getAndLogLatest Package{ latest = Package.Updater{ detectLatest }, name }
         = liftIO (putStrLn $ Text.unpack name <> ": Retreiving the latest version.")
-        >> getLatest
+        >> detectLatest
 
 updatePackageIfRequired :: Package -> Text -> SlackBuilderT ()
 updatePackageIfRequired package@Package{..} version = do
@@ -285,42 +275,46 @@ updatePackageIfRequired package@Package{..} version = do
         Left errorBundle -> liftIO $ putStr $ errorBundlePretty errorBundle
 
 updateDownload :: Package -> Package.Updater -> SlackBuilderT (URI, Digest MD5)
-updateDownload package (Package.Updater updater downloadTemplate) = updater
-    >>= renderAndDownload package downloadTemplate . fromJust
-
-renderAndDownload :: Package -> Package.DownloadTemplate -> Text -> SlackBuilderT (URI, Digest MD5)
-renderAndDownload Package{..} downloadTemplate version = do
-    let packagePath = category <> "/" <> name
+updateDownload package Package.Updater{ detectLatest } = detectLatest
+    >>= renderAndDownload package . fromJust
 
+downloadWithTemplate :: Package.DownloadTemplate -> Text -> Text -> SlackBuilderT (URI, Digest MD5)
+downloadWithTemplate downloadTemplate packagePath version = do
     repository' <- SlackBuilderT $ asks repository
     uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
     let downloadFileName = URI.unRText
             $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
         relativeTarball = packagePath <> "/" <> downloadFileName
         tarball = repository' </> Text.unpack relativeTarball
-    liftIO $ putStrLn
-        $ "Downloading " <> Text.unpack (URI.render uri') <> " to " <> tarball <> "."
     checksum <- fromJust <$> download uri' tarball
-    download' <- handleReupload uri' relativeTarball downloadFileName
+    pure (uri', checksum)
+
+reuploadWithTemplate :: Package.DownloadTemplate -> [CmdSpec] -> Text -> Text -> SlackBuilderT (URI, Digest MD5)
+reuploadWithTemplate downloadTemplate commands packagePath version = do
+    (uri', checksum) <- downloadWithTemplate downloadTemplate packagePath version
+    let downloadFileName = URI.unRText
+            $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
+        relativeTarball = packagePath <> "/" <> downloadFileName
+    download' <- handleReupload relativeTarball downloadFileName
 
     pure (download', checksum)
   where
-    handleReupload uri' relativeTarball downloadFileName = do
+    name' = Text.pack $ takeBaseName $ Text.unpack packagePath
+    handleReupload relativeTarball downloadFileName = do
         repository' <- SlackBuilderT $ asks repository
-        case reupload of
-            Just [] -> uploadTarball relativeTarball downloadFileName
-            Just commands ->
+        case commands of
+            [] -> uploadTarball relativeTarball downloadFileName
+            _ ->
                 let tarballPath = repository' </> Text.unpack relativeTarball
                     packedDirectory = takeBaseName $ dropExtension tarballPath
                  in liftIO (callProcess "tar" ["xvf", tarballPath])
                 >> liftIO (traverse (defaultCreateProcess packedDirectory) commands)
                 >> liftIO (callProcess "tar" ["Jcvf", tarballPath, packedDirectory])
                 >> uploadTarball relativeTarball downloadFileName
-            Nothing -> pure uri'
     uploadTarball relativeTarball downloadFileName
         = liftIO (putStrLn $ "Upload the source tarball " <> Text.unpack relativeTarball)
-        >> uploadCommand relativeTarball ("/" <> name)
-        >> liftIO (mkURI $ "https://download.dlackware.com/hosted-sources/" <> name <> "/" <> downloadFileName)
+        >> uploadCommand relativeTarball ("/" <> name')
+        >> liftIO (mkURI $ "https://download.dlackware.com/hosted-sources/" <> name' <> "/" <> downloadFileName)
     defaultCreateProcess cwd' cmdSpec
         = flip withCreateProcess (const . const . const waitForProcess)
         $ CreateProcess
@@ -341,13 +335,19 @@ renderAndDownload Package{..} downloadTemplate version = do
             , child_group = Nothing
             }
 
+renderAndDownload :: Package -> Text -> SlackBuilderT (URI, Digest MD5)
+renderAndDownload Package{..} version = do
+    let packagePath = category <> "/" <> name
+        Package.Updater _ getVersion = latest
+
+    getVersion packagePath version
+
 updatePackage :: Package -> PackageInfo -> Text -> SlackBuilderT ()
 updatePackage package@Package{..} info version = do
     let packagePath = category <> "/" <> name
-        Package.Updater _ downloadTemplate = latest
 
     repository' <- SlackBuilderT $ asks repository
-    mainDownload <- renderAndDownload package downloadTemplate version
+    mainDownload <- renderAndDownload package version
     moreDownloads <- traverse (updateDownload package) downloaders
     let (allDownloads, allChecksums) = unzip $ mainDownload : moreDownloads
     let infoFilePath = repository' </> Text.unpack packagePath
diff --git a/lib/SlackBuilder/Package.hs b/lib/SlackBuilder/Package.hs
index 6907d47..8310858 100644
--- a/lib/SlackBuilder/Package.hs
+++ b/lib/SlackBuilder/Package.hs
@@ -17,7 +17,6 @@ import qualified Text.URI as URI
 import Crypto.Hash (Digest, MD5)
 import SlackBuilder.Trans
 import Control.Monad.Catch (MonadThrow)
-import System.Process (CmdSpec(..))
 
 -- | Contains information how a package can be updated.
 data Package = Package
@@ -25,7 +24,6 @@ data Package = Package
     , downloaders :: [Updater]
     , category :: Text
     , name :: Text
-    , reupload :: Maybe [CmdSpec]
     }
 
 -- | Download URI with the MD5 checksum of the target.
@@ -79,4 +77,7 @@ renderDownloadWithVersion (DownloadTemplate components) version =
     f VersionPlaceholder = (version <>)
 
 -- | Function used to get the latest version of a source.
-data Updater = Updater (SlackBuilderT (Maybe Text)) DownloadTemplate
+data Updater = Updater
+    { detectLatest :: SlackBuilderT (Maybe Text)
+    , getVersion :: Text -> Text -> SlackBuilderT (URI, Digest MD5)
+    }