Extern tag matcher with digit and dot patterns

lib/SlackBuilder/LatestVersionCheck.hs

@@ -11,7 +11,6 @@ module SlackBuilder.LatestVersionCheck
     , latestPackagist
     , latestText
     , match
-    , stableTagTransform
     ) where
 
 import SlackBuilder.Config
@@ -47,22 +46,12 @@ import qualified Data.Aeson.KeyMap as KeyMap
 import GHC.Records (HasField(..))
 import Control.Monad.Trans.Reader (asks)
 import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad ((>=>))
 
 data PackageOwner = PackageOwner
     { owner :: Text
     , name :: Text
     } deriving (Eq, Show)
 
--- | Removes the leading "v" from the version string and returns the result if
--- it looks like a version.
-stableTagTransform :: Text -> Maybe Text
-stableTagTransform = Text.stripPrefix "v" >=> checkForStable
-  where
-    checkForStable tag
-        | Text.any (`elem` ['-', '+']) tag = Nothing
-        | otherwise = Just tag
-
 data MatchState = MatchState
     { ignoring :: Bool
     , matched :: Text
@@ -72,28 +61,43 @@ data MatchState = MatchState
 data MatchToken
     = OpenParenMatchToken
     | CloseParenMatchToken
-    | AsteriskMatchToken (Maybe Char)
+    | AsteriskMatchToken
     | SymbolMatchToken Char
+    | OneOfMatchToken [Char]
     deriving (Eq, Show)
 
+-- | Removes the leading "v" from the version string and returns the result if
+-- it looks like a version.
 match :: Text -> Text -> Maybe Text
 match fullPattern input =
     case Text.foldl' go (Just startState) input of
         Just state@MatchState{ pattern' = [] } -> Just $ getField @"matched" state
         Just state@MatchState{ pattern' = [CloseParenMatchToken] } ->
             Just $ getField @"matched" state
-        Just state@MatchState{ pattern' = [AsteriskMatchToken _] } ->
+        Just state@MatchState{ pattern' = [AsteriskMatchToken] } ->
+            Just $ getField @"matched" state
+        Just state@MatchState{ pattern' = [OneOfMatchToken _] } ->
             Just $ getField @"matched" state
         _ -> Nothing
   where
-    reserved = ['*', '(', ')']
+    digits = toEnum <$> [fromEnum '0' .. fromEnum '9']
     parsePattern :: Text -> [MatchToken]
     parsePattern input'
+        | Just (firstChar, remaining) <- Text.uncons input'
+        , firstChar == '\\' =
+            case Text.uncons remaining of
+                Nothing -> []
+                Just ('d', remaining') -> OneOfMatchToken digits
+                    : parsePattern remaining'
+                Just ('.', remaining') -> OneOfMatchToken ('.' : digits)
+                    : parsePattern remaining'
+                Just ('\\', remaining') -> SymbolMatchToken '\\'
+                    : parsePattern remaining'
+                Just (_, remaining') -> parsePattern remaining'
         | Just (firstChar, remaining) <- Text.uncons input' =
             let token =
                     case firstChar of
                         '*' -> AsteriskMatchToken
-                            $ Text.find (not . (`elem` reserved)) remaining
                         '(' -> OpenParenMatchToken
                         ')' -> CloseParenMatchToken
                         s -> SymbolMatchToken s
@@ -109,14 +113,16 @@ match fullPattern input =
         case token of
             OpenParenMatchToken -> go (Just state{ ignoring = True, pattern' = remaining }) nextCharacter
             CloseParenMatchToken -> go (Just state{ ignoring = False, pattern' = remaining }) nextCharacter
-            AsteriskMatchToken stopChar
-                | Just nextCharacter == stopChar ->
-                    go (Just state{ pattern' = remaining }) nextCharacter
-                | otherwise -> Just $ matchSymbolToken state nextCharacter
+            AsteriskMatchToken -> Just $ matchSymbolToken state nextCharacter
             SymbolMatchToken patternCharacter
                 | patternCharacter == nextCharacter -> Just
                     $ matchSymbolToken state{ pattern' = remaining } nextCharacter
                 | otherwise -> Nothing
+            OneOfMatchToken chars
+                | nextCharacter `elem` chars ->
+                    Just $ matchSymbolToken state nextCharacter
+                | otherwise ->
+                    go (Just state{ pattern' = remaining }) nextCharacter
     go _ _ = Nothing
     matchSymbolToken state nextCharacter
         | getField @"ignoring" state = state
@@ -214,9 +220,9 @@ $(deriveJSON defaultOptions ''GhQuery)
 
 latestGitHub
     :: PackageOwner
-    -> (Text -> Maybe Text)
+    -> Text
     -> SlackBuilderT (Maybe Text)
-latestGitHub PackageOwner{..} versionTransform = do
+latestGitHub PackageOwner{..} pattern' = do
     ghToken' <- SlackBuilderT $ asks ghToken
     ghResponse <- runReq defaultHttpConfig $
         let uri = https "api.github.com" /: "graphql"
@@ -238,14 +244,13 @@ latestGitHub PackageOwner{..} versionTransform = do
             $ responseBody ghResponse
         refs' = Vector.reverse
             $ Vector.catMaybes
-            $ versionTransform . getField @"name" <$> ghNodes
-    liftIO $ print $ getField @"name" <$> ghNodes
+            $ match pattern' . getField @"name" <$> ghNodes
     pure $ refs' !? 0
   where
     githubQuery =
         "query ($name: String!, $owner: String!) {\n\
         \  repository(name: $name, owner: $owner) {\n\
-        \    refs(last: 10, query: \"!(RC3)\", refPrefix: \"refs/tags/\", orderBy: { field: TAG_COMMIT_DATE, direction: ASC }) {\n\
+        \    refs(last: 10, refPrefix: \"refs/tags/\", orderBy: { field: TAG_COMMIT_DATE, direction: ASC }) {\n\
         \      nodes {\n\
         \        id,\n\
         \        name\n\

src/Main.hs

@@ -45,7 +45,7 @@ autoUpdatable =
                     $ Package.StaticPlaceholder "https://github.com/universal-ctags/ctags/archive/"
                     :| templateTail
              in Package.Updater
-                { detectLatest = latestGitHub ghArguments stableTagTransform
+                { detectLatest = latestGitHub ghArguments "(v)\\."
                 , getVersion = reuploadWithTemplate template []
                 , is64 = False
                 }
@@ -77,7 +77,7 @@ autoUpdatable =
                     :| Package.VersionPlaceholder
                     : [Package.StaticPlaceholder "/jitsi-meet-x86_64.AppImage"]
              in Package.Updater
-                { detectLatest = latestGitHub ghArguments $ Text.stripPrefix "v"
+                { detectLatest = latestGitHub ghArguments "(v)*"
                 , getVersion = downloadWithTemplate template
                 , is64 = True
                 }
@@ -90,16 +90,12 @@ autoUpdatable =
                     { owner = "php"
                     , name = "php-src"
                     }
-                checkVersion x
-                    | not $ Text.isInfixOf "RC" x
-                    , Text.isPrefixOf "php-8.2." x = Text.stripPrefix "php-" x
-                    | otherwise = Nothing
                 template = Package.DownloadTemplate
                     $ Package.StaticPlaceholder "https://www.php.net/distributions/php-"
                     :| Package.VersionPlaceholder
                     : [Package.StaticPlaceholder ".tar.xz"]
              in Package.Updater
-                { detectLatest = latestGitHub ghArguments checkVersion
+                { detectLatest = latestGitHub ghArguments "(php-)8.2.\\d"
                 , getVersion = downloadWithTemplate template
                 , is64 = False
                 }
@@ -122,7 +118,7 @@ autoUpdatable =
                     :| Package.VersionPlaceholder
                     : templateTail
              in Package.Updater
-                { detectLatest = latestGitHub ghArguments stableTagTransform
+                { detectLatest = latestGitHub ghArguments "(v)\\."
                 , getVersion = reuploadWithTemplate template [RawCommand "go" ["mod", "vendor"]]
                 , is64 = False
                 }
@@ -142,7 +138,7 @@ autoUpdatable =
                     : Package.VersionPlaceholder
                     : [Package.StaticPlaceholder ".tar.gz"]
              in Package.Updater
-                { detectLatest = latestGitHub ghArguments stableTagTransform
+                { detectLatest = latestGitHub ghArguments "(v)\\."
                 , getVersion = reuploadWithTemplate template []
                 , is64 = False
                 }
@@ -183,7 +179,7 @@ autoUpdatable =
                     : Package.VersionPlaceholder
                     : [Package.StaticPlaceholder ".tar.gz"]
              in Package.Updater
-                { detectLatest = latestGitHub ghArguments $ Text.stripPrefix "v"
+                { detectLatest = latestGitHub ghArguments "(v)\\."
                 , getVersion = reuploadWithTemplate template []
                 , is64 = True
                 }
@@ -230,18 +226,18 @@ autoUpdatable =
                 dscannerArguments = PackageOwner{ owner = "dlang-community", name = "D-Scanner" }
                 dcdArguments = PackageOwner{ owner = "dlang-community", name = "DCD" }
                 latestDub = Package.Updater
-                    { detectLatest = latestGitHub dubArguments stableTagTransform
+                    { detectLatest = latestGitHub dubArguments "(v)\\."
                     , getVersion = downloadWithTemplate dubTemplate
                     , is64 = False
                     }
                 latestDscanner = Package.Updater
-                    { detectLatest = latestGitHub dscannerArguments stableTagTransform
+                    { detectLatest = latestGitHub dscannerArguments "(v)\\."
                     , getVersion = cloneFromGit dscannerURI "v"
                     , is64 = False
                     }
                 dcdURI = [uri|https://github.com/dlang-community/DCD.git|]
                 latestDcd = Package.Updater
-                    { detectLatest = latestGitHub dcdArguments stableTagTransform
+                    { detectLatest = latestGitHub dcdArguments "(v)\\."
                     , getVersion = cloneFromGit dcdURI "v"
                     , is64 = False
                     }

tests/SlackBuilder/LatestVersionCheckSpec.hs

@@ -11,30 +11,33 @@ import Test.Hspec (Spec, describe, it, shouldBe)
 
 spec :: Spec
 spec = do
-    describe "stableTagTransform" $ do
-        it "excludes tags with +" $
-            let given = "v2.6.0+unreleased"
-                actual = stableTagTransform given
-             in actual `shouldBe` Nothing
-
-        it "recognizes a stable version" $
-            let given = "v2.6.0"
-                actual = stableTagTransform given
-                expected = Just "2.6.0"
-             in actual `shouldBe` expected
-
     describe "match" $ do
-        it "matches an exact tag prefixed with v" $ 
+        it "matches an exact tag prefixed with v" $
             let expected = Just "2.6.0"
                 actual = match "(v)2.6.0" "v2.6.0"
              in actual `shouldBe` expected
 
-        it "matches a glob pattern prefixed with v" $ 
+        it "matches a glob pattern prefixed with v" $
             let expected = Just "2.6.0"
                 actual = match "(v)*" "v2.6.0"
              in actual `shouldBe` expected
 
-        it "ignores suffix after wildcard" $ 
+        it "matches digits" $
             let expected = Just "2.6.0"
-                actual = match "(v)*(-rc1)" "v2.6.0-rc1"
+                actual = match "(v)2.6.\\d" "v2.6.0"
+             in actual `shouldBe` expected
+
+        it "matches digits and dot" $
+            let expected = Just "2.6.0"
+                actual = match "(v)\\." "v2.6.0"
+             in actual `shouldBe` expected
+
+        it "rejects unexpected suffix" $
+            let expected = Nothing
+                actual = match "(v)\\." "v2.6.0-rc1"
+             in actual `shouldBe` expected
+
+        it "rejects remaining umatched characters" $
+            let expected = Nothing
+                actual = match "2.6.0-rc1" "2.6.0"
              in actual `shouldBe` expected