summaryrefslogtreecommitdiff
path: root/src/SlackBuilder
diff options
context:
space:
mode:
Diffstat (limited to 'src/SlackBuilder')
-rw-r--r--src/SlackBuilder/CommandLine.hs22
-rw-r--r--src/SlackBuilder/LatestVersionCheck.hs (renamed from src/SlackBuilder/Updater.hs)81
2 files changed, 55 insertions, 48 deletions
diff --git a/src/SlackBuilder/CommandLine.hs b/src/SlackBuilder/CommandLine.hs
index bbd7bad..7639327 100644
--- 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
diff --git a/src/SlackBuilder/Updater.hs b/src/SlackBuilder/LatestVersionCheck.hs
index 0b87d90..a66d2c7 100644
--- a/src/SlackBuilder/Updater.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"