Make version picker a command
This commit is contained in:
parent
f758ea7904
commit
ebbdb6f0f7
@ -35,7 +35,7 @@ data PackageSettings = PackageSettings
|
|||||||
, is64 :: Bool
|
, is64 :: Bool
|
||||||
, github :: Maybe (Text, Text)
|
, github :: Maybe (Text, Text)
|
||||||
, packagist :: Maybe (Text, Text)
|
, packagist :: Maybe (Text, Text)
|
||||||
, text :: Maybe Text
|
, text :: Maybe (Text, [String])
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
settingsCodec :: Toml.TomlCodec Settings
|
settingsCodec :: Toml.TomlCodec Settings
|
||||||
@ -57,6 +57,10 @@ packageSettingsCodec = PackageSettings
|
|||||||
<$> Toml.text "name" .= name
|
<$> Toml.text "name" .= name
|
||||||
<*> Toml.text "template" .= template
|
<*> Toml.text "template" .= template
|
||||||
<*> Toml.bool "is64" .= is64
|
<*> Toml.bool "is64" .= is64
|
||||||
<*> Toml.dioptional (flip Toml.table "github" $ Toml.pair (Toml.text "owner") (Toml.text "name")) .= github
|
<*> Toml.dioptional (Toml.table githubCodec "github") .= github
|
||||||
<*> Toml.dioptional (flip Toml.table "packagist" $ Toml.pair (Toml.text "owner") (Toml.text "name")) .= packagist
|
<*> Toml.dioptional (Toml.table packagistCodec "packagist") .= packagist
|
||||||
<*> Toml.dioptional (flip Toml.table "text" $ Toml.text "url") .= text
|
<*> 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")
|
||||||
|
@ -49,8 +49,10 @@ 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 (await)
|
import Conduit (decodeUtf8C, (.|), linesUnboundedC, sinkNull)
|
||||||
import Data.Conduit.Process (sourceCmdWithStreams)
|
import qualified Data.Conduit.List as CL
|
||||||
|
import Data.Conduit.Process (sourceProcessWithStreams, proc)
|
||||||
|
import Data.Maybe (listToMaybe)
|
||||||
|
|
||||||
data PackageOwner = PackageOwner
|
data PackageOwner = PackageOwner
|
||||||
{ owner :: Text
|
{ owner :: Text
|
||||||
@ -195,27 +197,29 @@ latestPackagist PackageOwner{..} = do
|
|||||||
-- * Remote text file
|
-- * Remote text file
|
||||||
|
|
||||||
data TextArguments = TextArguments
|
data TextArguments = TextArguments
|
||||||
{ versionPicker :: Either (Text -> Text) [Text]
|
{ textURL :: Text
|
||||||
, textURL :: Text
|
, versionPicker :: [String]
|
||||||
}
|
}
|
||||||
|
|
||||||
latestText :: TextArguments -> SlackBuilderT (Maybe Text)
|
latestText :: TextArguments -> SlackBuilderT (Maybe Text)
|
||||||
latestText TextArguments{..} = do
|
latestText TextArguments{..} = do
|
||||||
case versionPicker of
|
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
|
uri <- liftIO $ useHttpsURI <$> mkURI textURL
|
||||||
|
|
||||||
packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
|
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
|
<$> packagistResponse
|
||||||
Right _ -> do
|
|
||||||
uri' <- mkURI textURL
|
|
||||||
runReq defaultHttpConfig $ reqGet uri' readResponse
|
|
||||||
where
|
where
|
||||||
readResponse :: Response BodyReader -> IO (Maybe Text)
|
readResponse :: String -> [String] -> Response BodyReader -> IO (Maybe Text)
|
||||||
readResponse response = do
|
readResponse command arguments response = do
|
||||||
(_, stdout', _) <- sourceCmdWithStreams "grep -oh 'Linux—[[:digit:].]\\+'" (responseBodySource response) await (pure ())
|
let createProcess' = proc command arguments
|
||||||
pure $ Text.drop 6 . head . Text.lines . Text.Encoding.decodeUtf8 <$> stdout'
|
(_, 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
|
go uri = req GET uri NoReqBody bsResponse mempty
|
||||||
|
|
||||||
-- * GitHub
|
-- * GitHub
|
||||||
|
16
src/Main.hs
16
src/Main.hs
@ -17,7 +17,6 @@ import SlackBuilder.LatestVersionCheck
|
|||||||
import SlackBuilder.Update
|
import SlackBuilder.Update
|
||||||
import qualified Toml
|
import qualified Toml
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as Text
|
|
||||||
import qualified Data.Text.IO as Text
|
import qualified Data.Text.IO as Text
|
||||||
import Control.Monad.Trans.Reader (ReaderT(..), asks)
|
import Control.Monad.Trans.Reader (ReaderT(..), asks)
|
||||||
import SlackBuilder.Package (PackageDescription(..))
|
import SlackBuilder.Package (PackageDescription(..))
|
||||||
@ -117,10 +116,7 @@ autoUpdatable packageSettings =
|
|||||||
}
|
}
|
||||||
, PackageDescription
|
, PackageDescription
|
||||||
{ latest =
|
{ latest =
|
||||||
let textArguments = TextArguments
|
let textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting
|
||||||
{ textURL = fromJust $ getField @"text" setting
|
|
||||||
, versionPicker = Right ["grep", "-oh", "Linux—[[:digit:].]\\+"]
|
|
||||||
}
|
|
||||||
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
|
||||||
@ -146,10 +142,7 @@ autoUpdatable packageSettings =
|
|||||||
}
|
}
|
||||||
, PackageDescription
|
, PackageDescription
|
||||||
{ latest =
|
{ latest =
|
||||||
let textArguments = TextArguments
|
let textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting
|
||||||
{ textURL = fromJust $ getField @"text" setting
|
|
||||||
, versionPicker = Left Text.strip
|
|
||||||
}
|
|
||||||
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
|
||||||
@ -162,10 +155,7 @@ autoUpdatable packageSettings =
|
|||||||
}
|
}
|
||||||
, PackageDescription
|
, PackageDescription
|
||||||
{ latest =
|
{ latest =
|
||||||
let textArguments = TextArguments
|
let textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting
|
||||||
{ textURL = fromJust $ getField @"text" setting
|
|
||||||
, versionPicker = Left Text.strip
|
|
||||||
}
|
|
||||||
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
|
||||||
|
Loading…
Reference in New Issue
Block a user