From 1094ba7a3300cd1ba6e0f2773c73cbd28fb45b63 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sat, 17 Feb 2024 14:15:01 +0100 Subject: [PATCH] Find the package category automatically --- lib/SlackBuilder/Package.hs | 12 +++-- src/Main.hs | 90 ++++++++++++++++++------------------- 2 files changed, 54 insertions(+), 48 deletions(-) diff --git a/lib/SlackBuilder/Package.hs b/lib/SlackBuilder/Package.hs index 7d73976..1fdb29e 100644 --- a/lib/SlackBuilder/Package.hs +++ b/lib/SlackBuilder/Package.hs @@ -6,7 +6,8 @@ module SlackBuilder.Package ( DownloadPlaceholder(..) , Download(..) , DownloadTemplate(..) - , Package(..) + , PackageDescription(..) + , PackageUpdateData(..) , Maintainer(..) , Updater(..) , renderDownloadWithVersion @@ -23,13 +24,18 @@ import Control.Monad.Catch (MonadThrow) import Data.Map (Map) -- | Contains information how a package can be updated. -data Package = Package +data PackageDescription = PackageDescription { latest :: Updater , downloaders :: Map Text Updater - , category :: Text , name :: Text } +data PackageUpdateData = PackageUpdateData + { description :: PackageDescription + , category :: Text + , version :: Text + } + -- | Download URI with the MD5 checksum of the target. data Download = Download { download :: URI diff --git a/src/Main.hs b/src/Main.hs index 24f52c6..8b03773 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -12,7 +12,7 @@ import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.IO.Class (MonadIO(..)) -import Data.Maybe (fromJust) +import Data.Maybe (fromJust, listToMaybe) import qualified Data.Map as Map import Options.Applicative (execParser) import SlackBuilder.CommandLine @@ -26,7 +26,7 @@ import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO import Control.Monad.Trans.Reader (ReaderT(..), asks) import SlackBuilder.Download -import SlackBuilder.Package (Package(..)) +import SlackBuilder.Package (PackageDescription(..), PackageUpdateData(..)) import qualified SlackBuilder.Package as Package import Text.URI (URI(..), mkURI) import Text.URI.QQ (uri) @@ -56,9 +56,9 @@ import Control.Monad (filterM) import Data.List (isPrefixOf, isSuffixOf, partition) import Conduit (runConduitRes, (.|), sourceFile) -autoUpdatable :: [Package] +autoUpdatable :: [PackageDescription] autoUpdatable = - [ Package + [ PackageDescription { latest = let ghArguments = PackageOwner{ owner = "universal-ctags", name = "ctags" } templateTail = @@ -75,11 +75,10 @@ autoUpdatable = , getVersion = reuploadWithTemplate template [] , is64 = False } - , category = "development" , name = "universal-ctags" , downloaders = mempty } - , Package + , PackageDescription { latest = let packagistArguments = PackageOwner{ owner = "composer", name = "composer" } template = Package.DownloadTemplate @@ -90,11 +89,10 @@ autoUpdatable = , getVersion = downloadWithTemplate template , is64 = False } - , category = "development" , name = "composer" , downloaders = mempty } - , Package + , PackageDescription { latest = let ghArguments = PackageOwner { owner = "jitsi" @@ -109,11 +107,10 @@ autoUpdatable = , getVersion = downloadWithTemplate template , is64 = True } - , category = "network" , name = "jitsi-meet-desktop" , downloaders = mempty } - , Package + , PackageDescription { latest = let ghArguments = PackageOwner { owner = "php" @@ -132,11 +129,10 @@ autoUpdatable = , getVersion = downloadWithTemplate template , is64 = False } - , category = "development" , name = "php82" , downloaders = mempty } - , Package + , PackageDescription { latest = let ghArguments = PackageOwner { owner = "kovidgoyal" @@ -156,11 +152,10 @@ autoUpdatable = , getVersion = reuploadWithTemplate template [RawCommand "go" ["mod", "vendor"]] , is64 = False } - , category = "system" , name = "kitty" , downloaders = mempty } - , Package + , PackageDescription { latest = let ghArguments = PackageOwner { owner = "rdiff-backup" @@ -177,11 +172,10 @@ autoUpdatable = , getVersion = reuploadWithTemplate template [] , is64 = False } - , category = "system" , name = "rdiff-backup" , downloaders = mempty } - , Package + , PackageDescription { latest = let needle = "Linux—" textArguments = TextArguments @@ -199,11 +193,10 @@ autoUpdatable = , getVersion = downloadWithTemplate template , is64 = True } - , category = "network" , name = "webex" , downloaders = mempty } - , Package + , PackageDescription { latest = let ghArguments = PackageOwner { owner = "librsync" @@ -220,11 +213,10 @@ autoUpdatable = , getVersion = reuploadWithTemplate template [] , is64 = True } - , category = "libraries" , name = "librsync" , downloaders = mempty } - , Package + , PackageDescription { latest = let textArguments = TextArguments { textURL = "https://downloads.dlang.org/releases/LATEST" @@ -241,11 +233,10 @@ autoUpdatable = , getVersion = downloadWithTemplate template , is64 = False } - , category = "development" , name = "dmd" , downloaders = mempty } - , Package + , PackageDescription { latest = let textArguments = TextArguments { textURL = "https://downloads.dlang.org/releases/LATEST" @@ -259,7 +250,6 @@ autoUpdatable = , getVersion = reuploadWithTemplate template [] , is64 = False } - , category = "development" , name = "d-tools" , downloaders = let dubArguments = PackageOwner{ owner = "dlang", name = "dub" } @@ -302,24 +292,31 @@ up2Date = \case | otherwise -> throwM $ UpdaterNotFound packageName where go package = getAndLogLatest package - >>= mapM_ (updatePackageIfRequired package) + >>= mapM_ updatePackageIfRequired >> liftIO (putStrLn "") check :: SlackBuilderT () check = for_ autoUpdatable go where go package = getAndLogLatest package - >>= mapM_ (checkUpdateAvailability package) + >>= mapM_ checkUpdateAvailability >> liftIO (putStrLn "") -getAndLogLatest :: Package -> SlackBuilderT (Maybe Text) -getAndLogLatest Package{ latest = Package.Updater{ detectLatest }, name } - = liftIO (putStrLn $ Text.unpack name <> ": Retreiving the latest version.") - >> detectLatest +getAndLogLatest :: PackageDescription -> SlackBuilderT (Maybe PackageUpdateData) +getAndLogLatest description = do + let PackageDescription{ latest = Package.Updater{ detectLatest }, name } = description + liftIO (putStrLn $ Text.unpack name <> ": Retreiving the latest version.") + detectedVersion <- detectLatest + category <- liftIO $ fmap Text.pack . listToMaybe + <$> findCategory (Text.unpack name) + pure $ PackageUpdateData description + <$> category + <*> detectedVersion -checkUpdateAvailability :: Package -> Text -> SlackBuilderT (Maybe PackageInfo) -checkUpdateAvailability Package{..} version = do - let packagePath = Text.unpack category Text.unpack name (Text.unpack name <.> "info") +checkUpdateAvailability :: PackageUpdateData -> SlackBuilderT (Maybe PackageInfo) +checkUpdateAvailability PackageUpdateData{..} = do + let name' = Text.unpack $ getField @"name" description + packagePath = Text.unpack category name' (name' <.> "info") repository' <- SlackBuilderT $ asks repository infoContents <- liftIO $ ByteString.readFile $ repository' packagePath @@ -329,7 +326,7 @@ checkUpdateAvailability Package{..} version = do liftIO $ do setSGR [SetColor Foreground Dull Green] Text.IO.putStrLn - $ name <> " is up to date (Version " <> version <> ")." + $ getField @"name" description <> " is up to date (Version " <> version <> ")." setSGR [Reset] pure Nothing | otherwise -> @@ -337,7 +334,8 @@ checkUpdateAvailability Package{..} version = do setSGR [SetColor Foreground Dull Yellow] Text.IO.putStr $ "A new version of " - <> name <> " " <> getField @"version" parsedInfoFile + <> getField @"name" description + <> " " <> getField @"version" parsedInfoFile <> " is available (" <> version <> ")." setSGR [Reset] putStrLn "" @@ -345,10 +343,10 @@ checkUpdateAvailability Package{..} version = do Left errorBundle -> liftIO (putStr $ errorBundlePretty errorBundle) >> pure Nothing -updatePackageIfRequired :: Package -> Text -> SlackBuilderT () -updatePackageIfRequired package version - = checkUpdateAvailability package version - >>= mapM_ (updatePackage package version) +updatePackageIfRequired :: PackageUpdateData -> SlackBuilderT () +updatePackageIfRequired updateData + = checkUpdateAvailability updateData + >>= mapM_ (updatePackage updateData) data DownloadUpdated = DownloadUpdated { result :: Package.Download @@ -443,19 +441,21 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do , child_group = Nothing } -updatePackage :: Package -> Text -> PackageInfo -> SlackBuilderT () -updatePackage Package{..} version info = do - let packagePath = category <> "/" <> name +updatePackage :: PackageUpdateData -> PackageInfo -> SlackBuilderT () +updatePackage PackageUpdateData{..} info = do + let packagePath = category <> "/" <> getField @"name" description + latest' = getField @"latest" description repository' <- SlackBuilderT $ asks repository - mainDownload <- (, getField @"is64" latest) - <$> getField @"getVersion" latest packagePath version - moreDownloads <- traverse (updateDownload packagePath) downloaders + mainDownload <- (, getField @"is64" latest') + <$> getField @"getVersion" latest' packagePath version + moreDownloads <- traverse (updateDownload packagePath) + $ getField @"downloaders" description let (downloads64, allDownloads) = partition snd $ mainDownload : (liftA2 (,) (getField @"result") (getField @"is64") <$> toList moreDownloads) let infoFilePath = repository' Text.unpack packagePath - (Text.unpack name <.> "info") + (Text.unpack (getField @"name" description) <.> "info") package' = info { version = version , downloads = getField @"download" . fst <$> allDownloads