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(..) , NoReqBody(..)
, (/:) , (/:)
, responseBody , responseBody
, useHttpsURI
, bsResponse
, POST(..) , POST(..)
, ReqBodyJson(..), JsonResponse , ReqBodyJson(..)
, JsonResponse
) )
import Text.URI (mkURI) import Text.URI (mkURI)
import SlackBuilder.Trans import SlackBuilder.Trans
import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.KeyMap as KeyMap
import GHC.Records (HasField(..)) import GHC.Records (HasField(..))
import Control.Monad.Trans.Reader (asks) import Control.Monad.Trans.Reader (asks)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Char (isAlpha) import Data.Char (isAlpha)
import SlackBuilder.Download (responseBodySource, reqGet) import SlackBuilder.Download (responseBodySource, reqGet)
import Network.HTTP.Client (BodyReader, Response(..)) 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 qualified Data.Conduit.List as CL
import Data.Conduit.Process (sourceProcessWithStreams, proc) import Data.Conduit.Process (sourceProcessWithStreams, proc)
import Data.Maybe (listToMaybe) import Data.Maybe (listToMaybe, mapMaybe)
data PackageOwner = PackageOwner data PackageOwner = PackageOwner
{ owner :: Text { owner :: Text
@ -201,26 +199,22 @@ data TextArguments = TextArguments
, versionPicker :: [String] , versionPicker :: [String]
} }
latestText :: TextArguments -> SlackBuilderT (Maybe Text) latestText :: TextArguments -> Text -> SlackBuilderT (Maybe Text)
latestText TextArguments{..} = do latestText TextArguments{..} pattern' = do
case versionPicker of uri' <- mkURI textURL
(command : arguments) -> do versions <- case versionPicker of
uri' <- mkURI textURL (command : arguments) ->
runReq defaultHttpConfig $ reqGet uri' $ readResponse command arguments runReq defaultHttpConfig $ reqGet uri' $ readResponse command arguments
[] -> do [] -> runReq defaultHttpConfig $ reqGet uri' go
uri <- liftIO $ useHttpsURI <$> mkURI textURL pure $ listToMaybe $ mapMaybe (match pattern') versions
packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
pure $ Text.strip . Text.Encoding.decodeUtf8 . Network.HTTP.Req.responseBody
<$> packagistResponse
where where
readResponse :: String -> [String] -> Response BodyReader -> IO (Maybe Text) readResponse :: String -> [String] -> Response BodyReader -> IO [Text]
readResponse command arguments response = do readResponse command arguments response = do
let createProcess' = proc command arguments let createProcess' = proc command arguments
(_, stdout', _) <- sourceProcessWithStreams createProcess' (responseBodySource response) stdoutReader sinkNull (_, stdout', _) <- sourceProcessWithStreams createProcess' (responseBodySource response) stdoutReader sinkNull
pure $ Text.drop 6 <$> listToMaybe stdout' pure stdout'
stdoutReader = decodeUtf8C .| linesUnboundedC .| CL.consume stdoutReader = decodeUtf8C .| linesUnboundedC .| CL.consume
go uri = req GET uri NoReqBody bsResponse mempty go response = runConduit $ responseBodySource response .| stdoutReader
-- * GitHub -- * GitHub

View File

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