Move text URL check to the Haskell binary
This commit is contained in:
parent
028f64d25a
commit
69ba04a731
45
app/Main.hs
45
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
|
||||
|
46
app/SlackBuilder/CommandLine.hs
Normal file
46
app/SlackBuilder/CommandLine.hs
Normal file
@ -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)
|
61
app/SlackBuilder/Updater.hs
Normal file
61
app/SlackBuilder/Updater.hs
Normal file
@ -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
|
@ -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
|
||||
|
||||
|
@ -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,
|
||||
|
Loading…
Reference in New Issue
Block a user