diff options
Diffstat (limited to 'app/SlackBuilder')
| -rw-r--r-- | app/SlackBuilder/CommandLine.hs | 46 | ||||
| -rw-r--r-- | app/SlackBuilder/Updater.hs | 61 |
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 |
