62 lines
1.9 KiB
Haskell
62 lines
1.9 KiB
Haskell
|
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
|