summaryrefslogtreecommitdiff
path: root/app/SlackBuilder
diff options
context:
space:
mode:
Diffstat (limited to 'app/SlackBuilder')
-rw-r--r--app/SlackBuilder/CommandLine.hs46
-rw-r--r--app/SlackBuilder/Updater.hs61
2 files changed, 107 insertions, 0 deletions
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