Filter versions in latestText
All checks were successful
Build / audit (push) Successful in 7s
Build / test (push) Successful in 14m39s

This commit is contained in:
Eugen Wissner 2024-09-28 15:43:18 +02:00
parent ebbdb6f0f7
commit d9bfd2941c
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
2 changed files with 17 additions and 23 deletions

View File

@ -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

View File

@ -120,7 +120,7 @@ autoUpdatable packageSettings =
setting = fromJust $ find ((== "webex") . getField @"name") packageSettings
template = Package.DownloadTemplate $ getField @"template" setting
in Package.Updater
{ detectLatest = latestText textArguments
{ detectLatest = latestText textArguments "(Linux—)*"
, getVersion = downloadWithTemplate template
, is64 = getField @"is64" setting
}
@ -146,7 +146,7 @@ autoUpdatable packageSettings =
setting = fromJust $ find ((== "dmd") . getField @"name") packageSettings
template = Package.DownloadTemplate $ getField @"template" setting
in Package.Updater
{ detectLatest = latestText textArguments
{ detectLatest = latestText textArguments "\\."
, getVersion = downloadWithTemplate template
, is64 = getField @"is64" setting
}
@ -159,7 +159,7 @@ autoUpdatable packageSettings =
setting = fromJust $ find ((== "d-tools") . getField @"name") packageSettings
template = Package.DownloadTemplate $ getField @"template" setting
in Package.Updater
{ detectLatest = latestText textArguments
{ detectLatest = latestText textArguments "\\."
, getVersion = reuploadWithTemplate template []
, is64 = getField @"is64" setting
}