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
|
( main
|
||||||
) where
|
) 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 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)
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Options.Applicative (execParser)
|
||||||
newtype PackagistPackage = PackagistPackage
|
import SlackBuilder.CommandLine
|
||||||
{ version :: Text
|
import SlackBuilder.Updater
|
||||||
} deriving (Eq, Show)
|
|
||||||
|
|
||||||
$(deriveJSON defaultOptions ''PackagistPackage)
|
|
||||||
|
|
||||||
newtype PackagistResponse = PackagistResponse
|
|
||||||
{ packages :: HashMap Text (Vector PackagistPackage)
|
|
||||||
} deriving (Eq, Show)
|
|
||||||
|
|
||||||
$(deriveJSON defaultOptions ''PackagistResponse)
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
packagistResponse <- runReq defaultHttpConfig $
|
programCommand <- execParser slackBuilderParser
|
||||||
let uri = https "repo.packagist.org" /: "p2" /: "composer" /: "composer.json"
|
latestVersion <- case programCommand of
|
||||||
in req GET uri NoReqBody jsonResponse mempty
|
PackagistCommand packagistArguments ->
|
||||||
let packagistPackages = packages $ responseBody packagistResponse
|
latestPackagist packagistArguments
|
||||||
|
TextCommand textArguments -> latestText textArguments
|
||||||
|
|
||||||
Text.IO.putStrLn $ fromMaybe ""
|
Text.IO.putStrLn $ fromMaybe "" latestVersion
|
||||||
$ HashMap.lookup "composer/composer" packagistPackages
|
|
||||||
>>= fmap (version . fst) . Vector.uncons
|
|
||||||
|
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
|
end
|
||||||
|
|
||||||
def latest
|
def latest
|
||||||
`./bin/slackbuilder #{@vendor} #{@name}`.strip
|
`./bin/slackbuilder packagist #{@vendor} #{@name}`.strip
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -86,14 +86,11 @@ module SlackBuilder
|
|||||||
def initialize(latest_url)
|
def initialize(latest_url)
|
||||||
super()
|
super()
|
||||||
|
|
||||||
@latest_url = URI latest_url
|
@latest_url = latest_url
|
||||||
end
|
end
|
||||||
|
|
||||||
def latest
|
def latest
|
||||||
response = Net::HTTP.get @latest_url, {
|
`./bin/slackbuilder text #{@latest_url}`.strip
|
||||||
'content-type' => 'text/plain'
|
|
||||||
}
|
|
||||||
response.strip
|
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -23,15 +23,19 @@ extra-source-files: CHANGELOG.md
|
|||||||
executable slackbuilder
|
executable slackbuilder
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
|
|
||||||
-- Modules included in this executable, other than Main.
|
other-modules:
|
||||||
-- other-modules:
|
SlackBuilder.CommandLine
|
||||||
|
SlackBuilder.Updater
|
||||||
default-extensions:
|
default-extensions:
|
||||||
OverloadedStrings
|
OverloadedStrings
|
||||||
|
RecordWildCards
|
||||||
TemplateHaskell
|
TemplateHaskell
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson ^>= 2.2.0,
|
aeson ^>= 2.2.0,
|
||||||
base ^>= 4.16.4.0,
|
base ^>= 4.16.4.0,
|
||||||
|
bytestring ^>= 0.11.0,
|
||||||
|
modern-uri ^>= 0.3.6,
|
||||||
|
optparse-applicative ^>= 0.18.1,
|
||||||
req ^>=3.13,
|
req ^>=3.13,
|
||||||
text ^>= 2.0,
|
text ^>= 2.0,
|
||||||
unordered-containers ^>= 0.2.19,
|
unordered-containers ^>= 0.2.19,
|
||||||
|
Loading…
Reference in New Issue
Block a user