Make version picker a command
All checks were successful
Build / audit (push) Successful in 8s
Build / test (push) Successful in 15m28s

This commit is contained in:
2024-09-27 12:20:34 +02:00
parent f758ea7904
commit ebbdb6f0f7
3 changed files with 28 additions and 30 deletions

View File

@@ -49,8 +49,10 @@ import Control.Monad.IO.Class (MonadIO(..))
import Data.Char (isAlpha)
import SlackBuilder.Download (responseBodySource, reqGet)
import Network.HTTP.Client (BodyReader, Response(..))
import Conduit (await)
import Data.Conduit.Process (sourceCmdWithStreams)
import Conduit (decodeUtf8C, (.|), linesUnboundedC, sinkNull)
import qualified Data.Conduit.List as CL
import Data.Conduit.Process (sourceProcessWithStreams, proc)
import Data.Maybe (listToMaybe)
data PackageOwner = PackageOwner
{ owner :: Text
@@ -195,27 +197,29 @@ latestPackagist PackageOwner{..} = do
-- * Remote text file
data TextArguments = TextArguments
{ versionPicker :: Either (Text -> Text) [Text]
, textURL :: Text
{ textURL :: Text
, versionPicker :: [String]
}
latestText :: TextArguments -> SlackBuilderT (Maybe Text)
latestText TextArguments{..} = do
case versionPicker of
Left versionPicker' -> do
(command : arguments) -> do
uri' <- mkURI textURL
runReq defaultHttpConfig $ reqGet uri' $ readResponse command arguments
[] -> do
uri <- liftIO $ useHttpsURI <$> mkURI textURL
packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
pure $ versionPicker' . Text.Encoding.decodeUtf8 . Network.HTTP.Req.responseBody
pure $ Text.strip . Text.Encoding.decodeUtf8 . Network.HTTP.Req.responseBody
<$> packagistResponse
Right _ -> do
uri' <- mkURI textURL
runReq defaultHttpConfig $ reqGet uri' readResponse
where
readResponse :: Response BodyReader -> IO (Maybe Text)
readResponse response = do
(_, stdout', _) <- sourceCmdWithStreams "grep -oh 'Linux—[[:digit:].]\\+'" (responseBodySource response) await (pure ())
pure $ Text.drop 6 . head . Text.lines . Text.Encoding.decodeUtf8 <$> stdout'
readResponse :: String -> [String] -> Response BodyReader -> IO (Maybe Text)
readResponse command arguments response = do
let createProcess' = proc command arguments
(_, stdout', _) <- sourceProcessWithStreams createProcess' (responseBodySource response) stdoutReader sinkNull
pure $ Text.drop 6 <$> listToMaybe stdout'
stdoutReader = decodeUtf8C .| linesUnboundedC .| CL.consume
go uri = req GET uri NoReqBody bsResponse mempty
-- * GitHub