From d9bfd2941cf6fd2302293cb9186e829bad490415 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Sat, 28 Sep 2024 15:43:18 +0200
Subject: [PATCH] Filter versions in latestText

---
 lib/SlackBuilder/LatestVersionCheck.hs | 34 +++++++++++---------------
 src/Main.hs                            |  6 ++---
 2 files changed, 17 insertions(+), 23 deletions(-)

diff --git a/lib/SlackBuilder/LatestVersionCheck.hs b/lib/SlackBuilder/LatestVersionCheck.hs
index 8cbee34..d2d7d22 100644
--- a/lib/SlackBuilder/LatestVersionCheck.hs
+++ b/lib/SlackBuilder/LatestVersionCheck.hs
@@ -35,24 +35,22 @@ import Network.HTTP.Req
     , NoReqBody(..)
     , (/:)
     , responseBody
-    , useHttpsURI
-    , bsResponse
     , POST(..)
-    , ReqBodyJson(..), JsonResponse
+    , ReqBodyJson(..)
+    , JsonResponse
     )
 import Text.URI (mkURI)
 import SlackBuilder.Trans
 import qualified Data.Aeson.KeyMap as KeyMap
 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 (decodeUtf8C, (.|), linesUnboundedC, sinkNull)
+import Conduit (decodeUtf8C, (.|), linesUnboundedC, sinkNull, runConduit)
 import qualified Data.Conduit.List as CL
 import Data.Conduit.Process (sourceProcessWithStreams, proc)
-import Data.Maybe (listToMaybe)
+import Data.Maybe (listToMaybe, mapMaybe)
 
 data PackageOwner = PackageOwner
     { owner :: Text
@@ -201,26 +199,22 @@ data TextArguments = TextArguments
     , versionPicker :: [String]
     }
 
-latestText :: TextArguments -> SlackBuilderT (Maybe Text)
-latestText TextArguments{..} = do
-    case versionPicker of
-        (command : arguments) -> do
-            uri' <- mkURI textURL
+latestText :: TextArguments -> Text -> SlackBuilderT (Maybe Text)
+latestText TextArguments{..} pattern' = do
+    uri' <- mkURI textURL
+    versions <- case versionPicker of
+        (command : arguments) ->
             runReq defaultHttpConfig $ reqGet uri' $ readResponse command arguments
-        [] -> do
-            uri <- liftIO $ useHttpsURI <$> mkURI textURL
-
-            packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
-            pure $ Text.strip . Text.Encoding.decodeUtf8 . Network.HTTP.Req.responseBody
-                <$> packagistResponse
+        [] -> runReq defaultHttpConfig $ reqGet uri' go
+    pure $ listToMaybe $ mapMaybe (match pattern') versions
   where
-    readResponse :: String -> [String] -> Response BodyReader -> IO (Maybe Text)
+    readResponse :: String -> [String] -> Response BodyReader -> IO [Text]
     readResponse command arguments response = do
         let createProcess' = proc command arguments
         (_, stdout', _) <- sourceProcessWithStreams createProcess' (responseBodySource response) stdoutReader sinkNull
-        pure $ Text.drop 6 <$> listToMaybe stdout'
+        pure stdout'
     stdoutReader = decodeUtf8C .| linesUnboundedC .| CL.consume
-    go uri = req GET uri NoReqBody bsResponse mempty
+    go response = runConduit $ responseBodySource response .| stdoutReader
 
 -- * GitHub
 
diff --git a/src/Main.hs b/src/Main.hs
index 17546fb..14b89e5 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -120,7 +120,7 @@ autoUpdatable packageSettings =
                 setting = fromJust $ find ((== "webex") . getField @"name") packageSettings
                 template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
-                { detectLatest = latestText textArguments
+                { detectLatest = latestText textArguments "(Linux—)*"
                 , getVersion = downloadWithTemplate template
                 , is64 = getField @"is64" setting
                 }
@@ -146,7 +146,7 @@ autoUpdatable packageSettings =
                 setting = fromJust $ find ((== "dmd") . getField @"name") packageSettings
                 template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
-                { detectLatest = latestText textArguments
+                { detectLatest = latestText textArguments "\\."
                 , getVersion = downloadWithTemplate template
                 , is64 = getField @"is64" setting
                 }
@@ -159,7 +159,7 @@ autoUpdatable packageSettings =
                 setting = fromJust $ find ((== "d-tools") . getField @"name") packageSettings
                 template = Package.DownloadTemplate $ getField @"template" setting
              in Package.Updater
-                { detectLatest = latestText textArguments
+                { detectLatest = latestText textArguments "\\."
                 , getVersion = reuploadWithTemplate template []
                 , is64 = getField @"is64" setting
                 }