diff options
Diffstat (limited to 'lib/SlackBuilder')
| -rw-r--r-- | lib/SlackBuilder/LatestVersionCheck.hs | 34 |
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 |
