summaryrefslogtreecommitdiff
path: root/lib/SlackBuilder/LatestVersionCheck.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/SlackBuilder/LatestVersionCheck.hs')
-rw-r--r--lib/SlackBuilder/LatestVersionCheck.hs34
1 files changed, 14 insertions, 20 deletions
diff --git a/lib/SlackBuilder/LatestVersionCheck.hs b/lib/SlackBuilder/LatestVersionCheck.hs
index 8cbee34..d2d7d22 100644
--- a/lib/SlackBuilder/LatestVersionCheck.hs
+++ b/lib/SlackBuilder/LatestVersionCheck.hs
@@ -35,24 +35,22 @@ import Network.HTTP.Req
, NoReqBody(..)
, (/:)
, responseBody
- , useHttpsURI
- , bsResponse
, POST(..)
- , ReqBodyJson(..), JsonResponse
+ , ReqBodyJson(..)
+ , JsonResponse
)
import Text.URI (mkURI)
import SlackBuilder.Trans
import qualified Data.Aeson.KeyMap as KeyMap
import GHC.Records (HasField(..))
import Control.Monad.Trans.Reader (asks)
-import Control.Monad.IO.Class (MonadIO(..))
import Data.Char (isAlpha)
import SlackBuilder.Download (responseBodySource, reqGet)
import Network.HTTP.Client (BodyReader, Response(..))
-import Conduit (decodeUtf8C, (.|), linesUnboundedC, sinkNull)
+import Conduit (decodeUtf8C, (.|), linesUnboundedC, sinkNull, runConduit)
import qualified Data.Conduit.List as CL
import Data.Conduit.Process (sourceProcessWithStreams, proc)
-import Data.Maybe (listToMaybe)
+import Data.Maybe (listToMaybe, mapMaybe)
data PackageOwner = PackageOwner
{ owner :: Text
@@ -201,26 +199,22 @@ data TextArguments = TextArguments
, versionPicker :: [String]
}
-latestText :: TextArguments -> SlackBuilderT (Maybe Text)
-latestText TextArguments{..} = do
- case versionPicker of
- (command : arguments) -> do
- uri' <- mkURI textURL
+latestText :: TextArguments -> Text -> SlackBuilderT (Maybe Text)
+latestText TextArguments{..} pattern' = do
+ uri' <- mkURI textURL
+ versions <- case versionPicker of
+ (command : arguments) ->
runReq defaultHttpConfig $ reqGet uri' $ readResponse command arguments
- [] -> do
- uri <- liftIO $ useHttpsURI <$> mkURI textURL
-
- packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
- pure $ Text.strip . Text.Encoding.decodeUtf8 . Network.HTTP.Req.responseBody
- <$> packagistResponse
+ [] -> runReq defaultHttpConfig $ reqGet uri' go
+ pure $ listToMaybe $ mapMaybe (match pattern') versions
where
- readResponse :: String -> [String] -> Response BodyReader -> IO (Maybe Text)
+ readResponse :: String -> [String] -> Response BodyReader -> IO [Text]
readResponse command arguments response = do
let createProcess' = proc command arguments
(_, stdout', _) <- sourceProcessWithStreams createProcess' (responseBodySource response) stdoutReader sinkNull
- pure $ Text.drop 6 <$> listToMaybe stdout'
+ pure stdout'
stdoutReader = decodeUtf8C .| linesUnboundedC .| CL.consume
- go uri = req GET uri NoReqBody bsResponse mempty
+ go response = runConduit $ responseBodySource response .| stdoutReader
-- * GitHub