diff options
Diffstat (limited to 'app/SlackBuilder/Updater.hs')
| -rw-r--r-- | app/SlackBuilder/Updater.hs | 61 |
1 files changed, 61 insertions, 0 deletions
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 |
