Implement experimental version picking command

... for webex.

2 files changed, 24 insertions, 9 deletions

diff --git a/lib/SlackBuilder/Download.hs b/lib/SlackBuilder/Download.hs
index 37f0eed..0907218 100644
--- a/lib/SlackBuilder/Download.hs
+++ b/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)
diff --git a/lib/SlackBuilder/LatestVersionCheck.hs b/lib/SlackBuilder/LatestVersionCheck.hs
index 874cd14..9fc1b7e 100644
--- a/lib/SlackBuilder/LatestVersionCheck.hs
+++ b/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
-
-    pure $ versionPicker . Text.Encoding.decodeUtf8 . responseBody
-        <$> packagistResponse
+    case versionPicker of
+        Left versionPicker' -> do
+            uri <- liftIO $ useHttpsURI <$> mkURI textURL
+
+            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