From 69ba04a7314aa5750a5fedbb9533cf775486870f Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 6 Aug 2023 14:25:19 +0200 Subject: [PATCH] Move text URL check to the Haskell binary --- app/Main.hs | 45 +++++------------------- app/SlackBuilder/CommandLine.hs | 46 +++++++++++++++++++++++++ app/SlackBuilder/Updater.hs | 61 +++++++++++++++++++++++++++++++++ lib/up2date.rb | 9 ++--- slackbuilder.cabal | 10 ++++-- 5 files changed, 126 insertions(+), 45 deletions(-) create mode 100644 app/SlackBuilder/CommandLine.hs create mode 100644 app/SlackBuilder/Updater.hs diff --git a/app/Main.hs b/app/Main.hs index 75a4396..ac1aae2 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -2,45 +2,18 @@ module Main ( main ) where -import Data.Aeson.TH (defaultOptions, deriveJSON) -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HashMap -import Data.Text (Text) import qualified Data.Text.IO as Text.IO -import Data.Vector (Vector) -import qualified Data.Vector as Vector -import Network.HTTP.Req - ( runReq - , defaultHttpConfig - , req - , GET(..) - , https - , jsonResponse - , NoReqBody(..) - , (/:) - , responseBody - ) import Data.Maybe (fromMaybe) - -newtype PackagistPackage = PackagistPackage - { version :: Text - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''PackagistPackage) - -newtype PackagistResponse = PackagistResponse - { packages :: HashMap Text (Vector PackagistPackage) - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''PackagistResponse) +import Options.Applicative (execParser) +import SlackBuilder.CommandLine +import SlackBuilder.Updater main :: IO () main = do - packagistResponse <- runReq defaultHttpConfig $ - let uri = https "repo.packagist.org" /: "p2" /: "composer" /: "composer.json" - in req GET uri NoReqBody jsonResponse mempty - let packagistPackages = packages $ responseBody packagistResponse + programCommand <- execParser slackBuilderParser + latestVersion <- case programCommand of + PackagistCommand packagistArguments -> + latestPackagist packagistArguments + TextCommand textArguments -> latestText textArguments - Text.IO.putStrLn $ fromMaybe "" - $ HashMap.lookup "composer/composer" packagistPackages - >>= fmap (version . fst) . Vector.uncons + Text.IO.putStrLn $ fromMaybe "" latestVersion diff --git a/app/SlackBuilder/CommandLine.hs b/app/SlackBuilder/CommandLine.hs new file mode 100644 index 0000000..2459bb5 --- /dev/null +++ b/app/SlackBuilder/CommandLine.hs @@ -0,0 +1,46 @@ +module SlackBuilder.CommandLine + ( SlackBuilderCommand(..) + , PackagistArguments(..) + , TextArguments(..) + , slackBuilderParser + ) where + +import Data.Text (Text) +import Options.Applicative + ( Parser + , ParserInfo(..) + , metavar + , argument + , str + , info + , fullDesc + , subparser + , command + ) + +data SlackBuilderCommand + = PackagistCommand PackagistArguments + | TextCommand TextArguments + +data PackagistArguments = PackagistArguments + { vendor :: Text + , name :: Text + } deriving (Eq, Show) + +newtype TextArguments = TextArguments Text + +packagistArguments :: Parser PackagistArguments +packagistArguments = PackagistArguments + <$> argument str (metavar "VENDOR") + <*> argument str (metavar"NAME") + +textArguments :: Parser TextArguments +textArguments = TextArguments <$> argument str (metavar "URL") + +slackBuilderParser :: ParserInfo SlackBuilderCommand +slackBuilderParser = info slackBuilderCommand fullDesc + +slackBuilderCommand :: Parser SlackBuilderCommand +slackBuilderCommand = subparser + $ command "packagist" (info (PackagistCommand <$> packagistArguments) mempty) + <> command "text" (info (TextCommand <$> textArguments) mempty) diff --git a/app/SlackBuilder/Updater.hs b/app/SlackBuilder/Updater.hs new file mode 100644 index 0000000..5373f7e --- /dev/null +++ b/app/SlackBuilder/Updater.hs @@ -0,0 +1,61 @@ +module SlackBuilder.Updater + ( latestPackagist + , latestText + ) where + +import Data.Aeson.TH (defaultOptions, deriveJSON) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text.Encoding +import Data.Vector (Vector) +import qualified Data.Vector as Vector +import Network.HTTP.Req + ( runReq + , defaultHttpConfig + , req + , GET(..) + , https + , jsonResponse + , NoReqBody(..) + , (/:) + , responseBody, useHttpsURI, bsResponse + ) +import Text.URI (mkURI) +import SlackBuilder.CommandLine + +newtype PackagistPackage = PackagistPackage + { version :: Text + } deriving (Eq, Show) + +$(deriveJSON defaultOptions ''PackagistPackage) + +newtype PackagistResponse = PackagistResponse + { packages :: HashMap Text (Vector PackagistPackage) + } deriving (Eq, Show) + +$(deriveJSON defaultOptions ''PackagistResponse) + +latestPackagist :: PackagistArguments -> IO (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 -> IO (Maybe Text) +latestText (TextArguments textArguments) = do + uri <- useHttpsURI <$> mkURI textArguments + packagistResponse <- traverse (runReq defaultHttpConfig) $ go . fst <$> uri + + pure $ Text.strip . Text.Encoding.decodeASCII . responseBody + <$> packagistResponse + where + go uri = req GET uri NoReqBody bsResponse mempty diff --git a/lib/up2date.rb b/lib/up2date.rb index 322cb9c..06e46e3 100644 --- a/lib/up2date.rb +++ b/lib/up2date.rb @@ -77,7 +77,7 @@ module SlackBuilder end def latest - `./bin/slackbuilder #{@vendor} #{@name}`.strip + `./bin/slackbuilder packagist #{@vendor} #{@name}`.strip end end @@ -86,14 +86,11 @@ module SlackBuilder def initialize(latest_url) super() - @latest_url = URI latest_url + @latest_url = latest_url end def latest - response = Net::HTTP.get @latest_url, { - 'content-type' => 'text/plain' - } - response.strip + `./bin/slackbuilder text #{@latest_url}`.strip end end diff --git a/slackbuilder.cabal b/slackbuilder.cabal index 66418de..29c2a9d 100644 --- a/slackbuilder.cabal +++ b/slackbuilder.cabal @@ -23,15 +23,19 @@ extra-source-files: CHANGELOG.md executable slackbuilder main-is: Main.hs - -- Modules included in this executable, other than Main. - -- other-modules: - + other-modules: + SlackBuilder.CommandLine + SlackBuilder.Updater default-extensions: OverloadedStrings + RecordWildCards TemplateHaskell build-depends: aeson ^>= 2.2.0, base ^>= 4.16.4.0, + bytestring ^>= 0.11.0, + modern-uri ^>= 0.3.6, + optparse-applicative ^>= 0.18.1, req ^>=3.13, text ^>= 2.0, unordered-containers ^>= 0.2.19,