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:
Eugen Wissner 2024-09-27 12:20:34 +02:00
parent f758ea7904
commit ebbdb6f0f7
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
3 changed files with 28 additions and 30 deletions

View File

@ -35,7 +35,7 @@ data PackageSettings = PackageSettings
, is64 :: Bool
, github :: Maybe (Text, Text)
, packagist :: Maybe (Text, Text)
, text :: Maybe Text
, text :: Maybe (Text, [String])
} deriving (Eq, Show)
settingsCodec :: Toml.TomlCodec Settings
@ -57,6 +57,10 @@ packageSettingsCodec = PackageSettings
<$> Toml.text "name" .= name
<*> Toml.text "template" .= template
<*> Toml.bool "is64" .= is64
<*> Toml.dioptional (flip Toml.table "github" $ Toml.pair (Toml.text "owner") (Toml.text "name")) .= github
<*> Toml.dioptional (flip Toml.table "packagist" $ Toml.pair (Toml.text "owner") (Toml.text "name")) .= packagist
<*> Toml.dioptional (flip Toml.table "text" $ Toml.text "url") .= text
<*> Toml.dioptional (Toml.table githubCodec "github") .= github
<*> Toml.dioptional (Toml.table packagistCodec "packagist") .= packagist
<*> Toml.dioptional (Toml.table textCodec "text") .= text
where
githubCodec = Toml.pair (Toml.text "owner") (Toml.text "name")
packagistCodec = Toml.pair (Toml.text "owner") (Toml.text "name")
textCodec = Toml.pair (Toml.text "url") (Toml.arrayOf Toml._String "picker")

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

View File

@ -17,7 +17,6 @@ import SlackBuilder.LatestVersionCheck
import SlackBuilder.Update
import qualified Toml
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Control.Monad.Trans.Reader (ReaderT(..), asks)
import SlackBuilder.Package (PackageDescription(..))
@ -117,10 +116,7 @@ autoUpdatable packageSettings =
}
, PackageDescription
{ latest =
let textArguments = TextArguments
{ textURL = fromJust $ getField @"text" setting
, versionPicker = Right ["grep", "-oh", "Linux—[[:digit:].]\\+"]
}
let textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting
setting = fromJust $ find ((== "webex") . getField @"name") packageSettings
template = Package.DownloadTemplate $ getField @"template" setting
in Package.Updater
@ -146,10 +142,7 @@ autoUpdatable packageSettings =
}
, PackageDescription
{ latest =
let textArguments = TextArguments
{ textURL = fromJust $ getField @"text" setting
, versionPicker = Left Text.strip
}
let textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting
setting = fromJust $ find ((== "dmd") . getField @"name") packageSettings
template = Package.DownloadTemplate $ getField @"template" setting
in Package.Updater
@ -162,10 +155,7 @@ autoUpdatable packageSettings =
}
, PackageDescription
{ latest =
let textArguments = TextArguments
{ textURL = fromJust $ getField @"text" setting
, versionPicker = Left Text.strip
}
let textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting
setting = fromJust $ find ((== "d-tools") . getField @"name") packageSettings
template = Package.DownloadTemplate $ getField @"template" setting
in Package.Updater