Implement experimental version picking command

... for webex.

lib/SlackBuilder/Download.hs

@@ -12,6 +12,7 @@ module SlackBuilder.Download
     , hostedSources
     , remoteFileExists
     , responseBodySource
+    , reqGet
     , sinkFileAndHash
     , sinkHash
     , updateSlackBuildVersion
@@ -76,7 +77,8 @@ import Conduit
     , ZipSink(..)
     , await
     , sourceFile
-    , leftover, awaitNonNull
+    , leftover
+    , awaitNonNull
     )
 import Data.Conduit.Tar (FileInfo(..), tarFilePath, untar)
 import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate)

lib/SlackBuilder/LatestVersionCheck.hs

@@ -47,6 +47,10 @@ 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 (await)
+import Data.Conduit.Process (sourceCmdWithStreams)
 
 data PackageOwner = PackageOwner
     { owner :: Text
@@ -182,7 +186,7 @@ latestPackagist PackageOwner{..} = do
                 /: name <> ".json"
          in req GET uri NoReqBody jsonResponse mempty
     let packagistPackages = getField @"packages"
-            $ responseBody (packagistResponse :: JsonResponse PackagistResponse)
+            $ Network.HTTP.Req.responseBody (packagistResponse :: JsonResponse PackagistResponse)
         fullName = Text.intercalate "/" [owner, name]
 
     pure $ HashMap.lookup fullName packagistPackages
@@ -191,18 +195,27 @@ latestPackagist PackageOwner{..} = do
 -- * Remote text file
 
 data TextArguments = TextArguments
-    { versionPicker :: Text -> Text
+    { versionPicker :: Either (Text -> Text) [Text]
     , textURL :: Text
     }
 
 latestText :: TextArguments -> SlackBuilderT (Maybe Text)
 latestText TextArguments{..} = do
-    uri <- liftIO $ useHttpsURI <$> mkURI textURL
-    packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
+    case versionPicker of
+        Left versionPicker' -> do
+            uri <- liftIO $ useHttpsURI <$> mkURI textURL
 
-    pure $ versionPicker . Text.Encoding.decodeUtf8 . responseBody
-        <$> packagistResponse
+            packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
+            pure $ versionPicker' . 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'
     go uri = req GET uri NoReqBody bsResponse mempty
 
 -- * GitHub
@@ -276,7 +289,7 @@ latestGitHub PackageOwner{..} pattern' = do
     let ghNodes = nodes
             $ refs
             $ (getField @"repository" :: GhData -> GhRepository)
-            $ responseBody ghResponse
+            $ Network.HTTP.Req.responseBody ghResponse
         refs' = Vector.catMaybes
             $ match pattern' . getField @"name" <$> ghNodes
     pure $ refs' !? 0

src/Main.hs

@@ -6,7 +6,6 @@ module Main
     ( main
     ) where
 
-import Data.Char (isNumber)
 import Control.Monad.Catch (MonadThrow(..), handle)
 import Control.Monad.IO.Class (MonadIO(..))
 import qualified Data.Map as Map
@@ -118,13 +117,9 @@ autoUpdatable packageSettings =
         }
     , PackageDescription
         { latest =
-            let needle = "Linux—"
-                textArguments = TextArguments
+            let textArguments = TextArguments
                     { textURL = fromJust $ getField @"text" setting
-                    , versionPicker = Text.takeWhile (liftA2 (||) (== '.') isNumber)
-                        . Text.drop (Text.length needle)
-                        . snd
-                        . Text.breakOn needle
+                    , versionPicker = Right ["grep", "-oh", "Linux—[[:digit:].]\\+"]
                     }
                 setting = fromJust $ find ((== "webex") . getField @"name") packageSettings
                 template = Package.DownloadTemplate $ getField @"template" setting
@@ -153,7 +148,7 @@ autoUpdatable packageSettings =
         { latest =
             let textArguments = TextArguments
                     { textURL = fromJust $ getField @"text" setting
-                    , versionPicker = Text.strip
+                    , versionPicker = Left Text.strip
                     }
                 setting = fromJust $ find ((== "dmd") . getField @"name") packageSettings
                 template = Package.DownloadTemplate $ getField @"template" setting
@@ -169,7 +164,7 @@ autoUpdatable packageSettings =
         { latest =
             let textArguments = TextArguments
                     { textURL = fromJust $ getField @"text" setting
-                    , versionPicker = Text.strip
+                    , versionPicker = Left Text.strip
                     }
                 setting = fromJust $ find ((== "d-tools") . getField @"name") packageSettings
                 template = Package.DownloadTemplate $ getField @"template" setting