Move latest version checker to a separate module

2024-01-01 19:44:45 +01:00
parent 34d7dbd68f
commit a25655c2b2
4 changed files with 69 additions and 67 deletions
--- a/slackbuilder.cabal
+++ b/slackbuilder.cabal
@@ -69,7 +69,7 @@ executable slackbuilder

  other-modules:
    SlackBuilder.CommandLine
-    SlackBuilder.Updater
+    SlackBuilder.LatestVersionCheck
  build-depends:
    aeson ^>= 2.2.0,
    ansi-terminal ^>= 1.0,
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -18,7 +18,7 @@ import Options.Applicative (execParser)
 import SlackBuilder.CommandLine
 import SlackBuilder.Config
 import SlackBuilder.Trans
-import SlackBuilder.Updater
+import SlackBuilder.LatestVersionCheck
 import qualified Toml
 import qualified Data.ByteString as ByteString
 import Data.Text (Text)
@@ -59,8 +59,8 @@ autoUpdatable :: [Package]
 autoUpdatable =
    [ Package
        { latest =
-            let ghArguments = GhArguments{ owner = "universal-ctags", name = "ctags", transform = Nothing}
-                latest' = latestGitHub ghArguments pure
+            let ghArguments = PackageOwner{ owner = "universal-ctags", name = "ctags" }
+                latest' = latestGitHub ghArguments stableTagTransform
                templateTail =
                    [ Package.VersionPlaceholder
                    , Package.StaticPlaceholder "/ctags-"
@@ -77,7 +77,7 @@ autoUpdatable =
        }
    , Package
        { latest =
-            let packagistArguments = PackagistArguments{ vendor = "composer", name = "composer" }
+            let packagistArguments = PackageOwner{ owner = "composer", name = "composer" }
                latest' = latestPackagist packagistArguments
                template = Package.DownloadTemplate
                    $ Package.StaticPlaceholder "https://getcomposer.org/download/"
@@ -89,10 +89,9 @@ autoUpdatable =
        }
    , Package
        { latest =
-            let ghArguments = GhArguments
+            let ghArguments = PackageOwner
                    { owner = "jitsi"
                    , name = "jitsi-meet-electron"
-                    , transform = Nothing
                    }
                latest' = latestGitHub ghArguments $ Text.stripPrefix "v"
                template = Package.DownloadTemplate
@@ -106,10 +105,9 @@ autoUpdatable =
        }
    , Package
        { latest =
-            let ghArguments = GhArguments
+            let ghArguments = PackageOwner
                    { owner = "php"
                    , name = "php-src"
-                    , transform = Nothing
                    }
                checkVersion x
                    | not $ Text.isInfixOf "RC" x
@@ -127,12 +125,11 @@ autoUpdatable =
        }
    , Package
        { latest =
-            let ghArguments = GhArguments
+            let ghArguments = PackageOwner
                    { owner = "kovidgoyal"
                    , name = "kitty"
-                    , transform = Nothing
                    }
-                latest' = latestGitHub ghArguments $ Text.stripPrefix "v"
+                latest' = latestGitHub ghArguments stableTagTransform
                templateTail =
                    [ Package.StaticPlaceholder "/kitty-"
                    , Package.VersionPlaceholder
@@ -149,10 +146,9 @@ autoUpdatable =
        }
    , Package
        { latest =
-            let ghArguments = GhArguments
+            let ghArguments = PackageOwner
                    { owner = "rdiff-backup"
                    , name = "rdiff-backup"
-                    , transform = Nothing
                    }
                latest' = latestGitHub ghArguments $ Text.stripPrefix "v"
                template = Package.DownloadTemplate
@@ -187,10 +183,9 @@ autoUpdatable =
        }
    , Package
        { latest =
-            let ghArguments = GhArguments
+            let ghArguments = PackageOwner
                    { owner = "librsync"
                    , name = "librsync"
-                    , transform = Nothing
                    }
                latest' = latestGitHub ghArguments $ Text.stripPrefix "v"
                template = Package.DownloadTemplate
@@ -236,9 +231,9 @@ autoUpdatable =
        , category = "development"
        , name = "d-tools"
        , downloaders =
-            let dubArguments = GhArguments{ owner = "dlang", name = "dub", transform = Nothing}
-                dscannerArguments = GhArguments{ owner = "dlang-community", name = "D-Scanner", transform = Nothing }
-                dcdArguments = GhArguments{ owner = "dlang-community", name = "DCD", transform = Nothing }
+            let dubArguments = PackageOwner{ owner = "dlang", name = "dub" }
+                dscannerArguments = PackageOwner{ owner = "dlang-community", name = "D-Scanner" }
+                dcdArguments = PackageOwner{ owner = "dlang-community", name = "DCD" }
                latestDub = latestGitHub dubArguments pure
                latestDscanner = latestGitHub dscannerArguments pure
                latestDcd = latestGitHub dcdArguments pure
--- a/src/SlackBuilder/CommandLine.hs
+++ b/src/SlackBuilder/CommandLine.hs
@@ -2,11 +2,9 @@
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}

+-- | Command line parser.
 module SlackBuilder.CommandLine
-    ( GhArguments(..)
-    , SlackBuilderCommand(..)
-    , PackagistArguments(..)
-    , TextArguments(..)
+    ( SlackBuilderCommand(..)
    , slackBuilderParser
    ) where

@@ -29,22 +27,6 @@ data SlackBuilderCommand
    | CheckCommand
    | Up2DateCommand (Maybe Text)

-data PackagistArguments = PackagistArguments
-    { vendor :: Text
-    , name :: Text
-    } deriving (Eq, Show)
-
-data GhArguments = GhArguments
-    { owner :: Text
-    , name :: Text
-    , transform :: Maybe Text
-    } deriving (Eq, Show)
-
-data TextArguments = TextArguments
-    { versionPicker :: Text -> Text
-    , textURL :: Text
-    }
-
 slackBuilderParser :: ParserInfo SlackBuilderCommand
 slackBuilderParser = info slackBuilderCommand fullDesc

--- a/src/SlackBuilder/LatestVersionCheck.hs
+++ b/src/SlackBuilder/LatestVersionCheck.hs
@@ -2,10 +2,15 @@
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}

-module SlackBuilder.Updater
-    ( latestGitHub
+-- | This module contains implementations to check the latest version of a
+-- package hosted by a specific service.
+module SlackBuilder.LatestVersionCheck
+    ( PackageOwner(..)
+    , TextArguments(..)
+    , latestGitHub
    , latestPackagist
    , latestText
+    , stableTagTransform
    ) where

 import SlackBuilder.Config
@@ -36,13 +41,24 @@ import Network.HTTP.Req
    , ReqBodyJson(..)
    )
 import Text.URI (mkURI)
-import SlackBuilder.CommandLine
 import SlackBuilder.Trans
 import qualified Data.Aeson.KeyMap as KeyMap
 import GHC.Records (HasField(..))
 import Control.Monad.Trans.Reader (asks)
 import Control.Monad.IO.Class (MonadIO(..))

+data PackageOwner = PackageOwner
+    { owner :: Text
+    , name :: Text
+    } deriving (Eq, Show)
+
+-- | Removes the leading "v" from the version string and returns the result if
+-- it looks like a version.
+stableTagTransform :: Text -> Maybe Text
+stableTagTransform = Text.stripPrefix "v"
+
+-- * Packagist
+
 newtype PackagistPackage = PackagistPackage
    { version :: Text
    } deriving (Eq, Show)
@@ -55,6 +71,38 @@ newtype PackagistResponse = PackagistResponse

 $(deriveJSON defaultOptions ''PackagistResponse)

+latestPackagist :: PackageOwner -> SlackBuilderT (Maybe Text)
+latestPackagist PackageOwner{..} = do
+    packagistResponse <- runReq defaultHttpConfig $
+        let uri = https "repo.packagist.org" /: "p2"
+                /: owner
+                /: name <> ".json"
+         in req GET uri NoReqBody jsonResponse mempty
+    let packagistPackages = packages $ responseBody packagistResponse
+        fullName = Text.intercalate "/" [owner, name]
+
+    pure $ HashMap.lookup fullName packagistPackages
+        >>= fmap (version . fst) . Vector.uncons
+
+-- * Remote text file
+
+data TextArguments = TextArguments
+    { versionPicker :: Text -> Text
+    , textURL :: Text
+    }
+
+latestText :: TextArguments -> SlackBuilderT (Maybe Text)
+latestText TextArguments{..} = do
+    uri <- liftIO $ useHttpsURI <$> mkURI textURL
+    packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
+
+    pure $ versionPicker . Text.Encoding.decodeUtf8 . responseBody
+        <$> packagistResponse
+  where
+    go uri = req GET uri NoReqBody bsResponse mempty
+
+-- * GitHub
+
 newtype GhRefNode = GhRefNode
    { name :: Text
    } deriving (Eq, Show)
@@ -97,34 +145,11 @@ data GhQuery = GhQuery

 $(deriveJSON defaultOptions ''GhQuery)

-latestPackagist :: PackagistArguments -> SlackBuilderT (Maybe Text)
-latestPackagist PackagistArguments{..} = do
-    packagistResponse <- runReq defaultHttpConfig $
-        let uri = https "repo.packagist.org" /: "p2"
-                /: vendor
-                /: name <> ".json"
-         in req GET uri NoReqBody jsonResponse mempty
-    let packagistPackages = packages $ responseBody packagistResponse
-        fullName = Text.intercalate "/" [vendor, name]
-
-    pure $ HashMap.lookup fullName packagistPackages
-        >>= fmap (version . fst) . Vector.uncons
-
-latestText :: TextArguments -> SlackBuilderT (Maybe Text)
-latestText TextArguments{..} = do
-    uri <- liftIO $ useHttpsURI <$> mkURI textURL
-    packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
-
-    pure $ versionPicker . Text.Encoding.decodeUtf8 . responseBody
-        <$> packagistResponse
-  where
-    go uri = req GET uri NoReqBody bsResponse mempty
-
 latestGitHub
-    :: GhArguments
+    :: PackageOwner
    -> (Text -> Maybe Text)
    -> SlackBuilderT (Maybe Text)
-latestGitHub GhArguments{..} versionTransform = do
+latestGitHub PackageOwner{..} versionTransform = do
    ghToken' <- SlackBuilderT $ asks ghToken
    ghResponse <- runReq defaultHttpConfig $
        let uri = https "api.github.com" /: "graphql"