Mix configuration and PackageDescription

lib/SlackBuilder/Config.hs

@@ -33,6 +33,9 @@ data PackageSettings = PackageSettings
     { name :: Text
     , template :: Text
     , is64 :: Bool
+    , github :: Maybe (Text, Text)
+    , packagist :: Maybe (Text, Text)
+    , text :: Maybe Text
     } deriving (Eq, Show)
 
 settingsCodec :: Toml.TomlCodec Settings
@@ -54,3 +57,6 @@ packageSettingsCodec = PackageSettings
     <$> Toml.text "name" .= name
     <*> Toml.text "template" .= template
     <*> Toml.bool "is64" .= is64
+    <*> Toml.dioptional (flip Toml.table "github" $ Toml.pair (Toml.text "owner") (Toml.text "name")) .= github
+    <*> Toml.dioptional (flip Toml.table "packagist" $ Toml.pair (Toml.text "owner") (Toml.text "name")) .= packagist
+    <*> Toml.dioptional (flip Toml.table "text" $ Toml.text "url") .= text

src/Main.hs

@@ -20,11 +20,11 @@ import qualified Toml
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
-import Control.Monad.Trans.Reader (ReaderT(..))
+import Control.Monad.Trans.Reader (ReaderT(..), asks)
 import SlackBuilder.Package (PackageDescription(..))
 import qualified SlackBuilder.Package as Package
 import Text.URI.QQ (uri)
-import Data.Foldable (for_, find)
+import Data.Foldable (find, traverse_)
 import GHC.Records (HasField(..))
 import System.Process (CmdSpec(..))
 import System.Console.ANSI
@@ -34,95 +34,84 @@ import System.Console.ANSI
     , Color(..)
     , ConsoleLayer(..)
     )
+import Data.Maybe (fromJust)
 
-autoUpdatable :: [PackageDescription]
-autoUpdatable =
+autoUpdatable :: [PackageSettings] -> [PackageDescription]
+autoUpdatable packageSettings =
     [ PackageDescription
         { latest =
-            let ghArguments = PackageOwner{ owner = "universal-ctags", name = "ctags" }
-                template = Package.DownloadTemplate
-                    "https://github.com/universal-ctags/ctags/archive/{version}/ctags-{version}.tar.gz"
+            let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting
+                setting = fromJust $ find ((== "universal-ctags") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestGitHub ghArguments "(v)\\."
                 , getVersion = reuploadWithTemplate template []
-                , is64 = False
+                , is64 = getField @"is64" setting
                 }
         , name = "universal-ctags"
         , downloaders = mempty
         }
     , PackageDescription
         { latest =
-            let packagistArguments = PackageOwner{ owner = "composer", name = "composer" }
-                template = Package.DownloadTemplate
-                    "https://getcomposer.org/download/{version}/composer.phar"
+            let packagistArguments = uncurry PackageOwner $ fromJust $ getField @"packagist" setting
+                setting = fromJust $ find ((== "composer") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestPackagist packagistArguments
                 , getVersion = downloadWithTemplate template
-                , is64 = False
+                , is64 = getField @"is64" setting
                 }
         , name = "composer"
         , downloaders = mempty
         }
     , PackageDescription
         { latest =
-            let ghArguments = PackageOwner
-                    { owner = "jitsi"
-                    , name = "jitsi-meet-electron"
-                    }
-                template = Package.DownloadTemplate
-                    "https://github.com/jitsi/jitsi-meet-electron/releases/download/v{version}/jitsi-meet-x86_64.AppImage"
+            let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting
+                setting = fromJust $ find ((== "jitsi-meet-desktop") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestGitHub ghArguments "(v)*"
                 , getVersion = downloadWithTemplate template
-                , is64 = True
+                , is64 = getField @"is64" setting
                 }
         , name = "jitsi-meet-desktop"
         , downloaders = mempty
         }
     , PackageDescription
         { latest =
-            let ghArguments = PackageOwner
-                    { owner = "php"
-                    , name = "php-src"
-                    }
-                template = Package.DownloadTemplate
-                    "https://www.php.net/distributions/php-{version}.tar.xz"
+            let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting
+                setting = fromJust $ find ((== "php82") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestGitHub ghArguments "(php-)8.2.\\d"
                 , getVersion = downloadWithTemplate template
-                , is64 = False
+                , is64 = getField @"is64" setting
                 }
         , name = "php82"
         , downloaders = mempty
         }
     , PackageDescription
         { latest =
-            let ghArguments = PackageOwner
-                    { owner = "kovidgoyal"
-                    , name = "kitty"
-                    }
-                template = Package.DownloadTemplate
-                    "https://github.com/kovidgoyal/kitty/releases/download/v{version}/kitty-{version}.tar.xz"
+            let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting
+                setting = fromJust $ find ((== "kitty") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestGitHub ghArguments "(v)\\."
                 , getVersion = reuploadWithTemplate template [RawCommand "go" ["mod", "vendor"]]
-                , is64 = False
+                , is64 = getField @"is64" setting
                 }
         , name = "kitty"
         , downloaders = mempty
         }
     , PackageDescription
         { latest =
-            let ghArguments = PackageOwner
-                    { owner = "rdiff-backup"
-                    , name = "rdiff-backup"
-                    }
-                template = Package.DownloadTemplate
-                    "https://github.com/rdiff-backup/rdiff-backup/releases/download/v{version}/rdiff-backup-{version}.tar.gz"
+            let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting
+                setting = fromJust $ find ((== "rdiff-backup") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestGitHub ghArguments "(v)\\."
                 , getVersion = reuploadWithTemplate template []
-                , is64 = False
+                , is64 = getField @"is64" setting
                 }
         , name = "rdiff-backup"
         , downloaders = mempty
@@ -131,34 +120,31 @@ autoUpdatable =
         { latest =
             let needle = "Linux—"
                 textArguments = TextArguments
-                    { textURL = "https://help.webex.com/en-us/article/mqkve8/Webex-App-%7C-Release-notes"
+                    { textURL = fromJust $ getField @"text" setting
                     , versionPicker = Text.takeWhile (liftA2 (||) (== '.') isNumber)
                         . Text.drop (Text.length needle)
                         . snd
                         . Text.breakOn needle
                     }
-                template = Package.DownloadTemplate
-                    "https://binaries.webex.com/WebexDesktop-Ubuntu-Official-Package/Webex.deb"
+                setting = fromJust $ find ((== "webex") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestText textArguments
                 , getVersion = downloadWithTemplate template
-                , is64 = True
+                , is64 = getField @"is64" setting
                 }
         , name = "webex"
         , downloaders = mempty
         }
     , PackageDescription
         { latest =
-            let ghArguments = PackageOwner
-                    { owner = "librsync"
-                    , name = "librsync"
-                    }
-                template = Package.DownloadTemplate
-                    "https://github.com/librsync/librsync/archive/v{version}/librsync-{version}.tar.gz"
+            let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting
+                setting = fromJust $ find ((== "librsync") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestGitHub ghArguments "(v)\\."
                 , getVersion = reuploadWithTemplate template []
-                , is64 = False
+                , is64 = getField @"is64" setting
                 }
         , name = "librsync"
         , downloaders = mempty
@@ -166,15 +152,15 @@ autoUpdatable =
     , PackageDescription
         { latest =
             let textArguments = TextArguments
-                    { textURL = "https://downloads.dlang.org/releases/LATEST"
+                    { textURL = fromJust $ getField @"text" setting
                     , versionPicker = Text.strip
                     }
-                template = Package.DownloadTemplate
-                    "https://downloads.dlang.org/releases/2.x/{version}/dmd.{version}.linux.tar.xz"
+                setting = fromJust $ find ((== "dmd") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestText textArguments
                 , getVersion = downloadWithTemplate template
-                , is64 = False
+                , is64 = getField @"is64" setting
                 }
         , name = "dmd"
         , downloaders = mempty
@@ -182,14 +168,15 @@ autoUpdatable =
     , PackageDescription
         { latest =
             let textArguments = TextArguments
-                    { textURL = "https://downloads.dlang.org/releases/LATEST"
+                    { textURL = fromJust $ getField @"text" setting
                     , versionPicker = Text.strip
                     }
-                template = Package.DownloadTemplate "https://codeload.github.com/dlang/tools/tar.gz/v{version}"
+                setting = fromJust $ find ((== "d-tools") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestText textArguments
                 , getVersion = reuploadWithTemplate template []
-                , is64 = False
+                , is64 = getField @"is64" setting
                 }
         , name = "d-tools"
         , downloaders =
@@ -222,32 +209,26 @@ autoUpdatable =
         }
     , PackageDescription
         { latest =
-            let ghArguments = PackageOwner
-                    { owner = "simd-everywhere"
-                    , name = "simde"
-                    }
-                template = Package.DownloadTemplate
-                    "https://github.com/simd-everywhere/simde/releases/download/v{version}/simde-amalgamated-{version}.tar.xz"
+            let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting
+                setting = fromJust $ find ((== "simde") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestGitHub ghArguments "(v)\\."
                 , getVersion = downloadWithTemplate template
-                , is64 = False
+                , is64 = getField @"is64" setting
                 }
         , name = "simde"
         , downloaders = mempty
         }
     , PackageDescription
         { latest =
-            let ghArguments = PackageOwner
-                    { owner = "nginx"
-                    , name = "nginx"
-                    }
-                template = Package.DownloadTemplate
-                    "http://nginx.org/download/nginx-{version}.tar.gz"
+            let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting
+                setting = fromJust $ find ((== "nginx") . getField @"name") packageSettings
+                template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
                 { detectLatest = latestGitHub ghArguments "(release-)\\d.[02468].\\d"
                 , getVersion = downloadWithTemplate template
-                , is64 = False
+                , is64 = getField @"is64" setting
                 }
         , name = "nginx"
         , downloaders = mempty
@@ -255,19 +236,22 @@ autoUpdatable =
     ]
 
 up2Date :: Maybe Text -> SlackBuilderT ()
-up2Date = \case
-    Nothing -> for_ autoUpdatable $ handle handleException . go
-    Just packageName
-        | Just foundPackage <- find ((packageName ==) . getField @"name") autoUpdatable ->
-            go foundPackage
-        | otherwise -> throwM $ UpdaterNotFound packageName
+up2Date selectedPackage = do
+    packages' <- SlackBuilderT $ asks (getField @"packages")
+    case selectedPackage of
+        Nothing -> traverse_ (handle handleException . go) $ autoUpdatable packages'
+        Just packageName
+            | Just foundPackage <- find ((packageName ==) . getField @"name") (autoUpdatable packages') ->
+                go foundPackage
+            | otherwise -> throwM $ UpdaterNotFound packageName
   where
     go package = getAndLogLatest package
         >>= mapM_ updatePackageIfRequired
         >> liftIO (putStrLn "")
 
 check :: SlackBuilderT ()
-check = for_ autoUpdatable $ handle handleException . go
+check = SlackBuilderT (asks (getField @"packages"))
+    >>= traverse_ (handle handleException . go) . autoUpdatable
   where
     go package = getAndLogLatest package
         >>= mapM_ checkUpdateAvailability