Add match function for simple tag globbing

lib/SlackBuilder/LatestVersionCheck.hs

@@ -10,6 +10,7 @@ module SlackBuilder.LatestVersionCheck
     , latestGitHub
     , latestPackagist
     , latestText
+    , match
     , stableTagTransform
     ) where
 
@@ -62,6 +63,67 @@ stableTagTransform = Text.stripPrefix "v" >=> checkForStable
         | Text.any (`elem` ['-', '+']) tag = Nothing
         | otherwise = Just tag
 
+data MatchState = MatchState
+    { ignoring :: Bool
+    , matched :: Text
+    , pattern' :: [MatchToken]
+    } deriving (Eq, Show)
+
+data MatchToken
+    = OpenParenMatchToken
+    | CloseParenMatchToken
+    | AsteriskMatchToken (Maybe Char)
+    | SymbolMatchToken Char
+    deriving (Eq, Show)
+
+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 $ getField @"matched" state
+        _ -> Nothing
+  where
+    reserved = ['*', '(', ')']
+    parsePattern :: Text -> [MatchToken]
+    parsePattern input'
+        | Just (firstChar, remaining) <- Text.uncons input' =
+            let token =
+                    case firstChar of
+                        '*' -> AsteriskMatchToken
+                            $ Text.find (not . (`elem` reserved)) remaining
+                        '(' -> OpenParenMatchToken
+                        ')' -> CloseParenMatchToken
+                        s -> SymbolMatchToken s
+             in token : parsePattern remaining
+        | otherwise = []
+    startState = MatchState
+        { ignoring = False
+        , matched = mempty
+        , pattern' = parsePattern fullPattern
+        }
+    go :: Maybe MatchState -> Char -> Maybe MatchState
+    go (Just state@MatchState{ pattern' = token : remaining }) nextCharacter =
+        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
+            SymbolMatchToken patternCharacter
+                | patternCharacter == nextCharacter -> Just
+                    $ matchSymbolToken state{ pattern' = remaining } nextCharacter
+                | otherwise -> Nothing
+    go _ _ = Nothing
+    matchSymbolToken state nextCharacter
+        | getField @"ignoring" state = state
+        | otherwise = state
+            { matched = Text.snoc (getField @"matched" state) nextCharacter
+            }
+
 -- * Packagist
 
 newtype PackagistPackage = PackagistPackage
@@ -177,12 +239,13 @@ latestGitHub PackageOwner{..} versionTransform = do
         refs' = Vector.reverse
             $ Vector.catMaybes
             $ versionTransform . getField @"name" <$> ghNodes
+    liftIO $ print $ getField @"name" <$> ghNodes
     pure $ refs' !? 0
   where
     githubQuery =
         "query ($name: String!, $owner: String!) {\n\
         \  repository(name: $name, owner: $owner) {\n\
-        \    refs(last: 10, refPrefix: \"refs/tags/\", orderBy: { field: TAG_COMMIT_DATE, direction: ASC }) {\n\
+        \    refs(last: 10, query: \"!(RC3)\", refPrefix: \"refs/tags/\", orderBy: { field: TAG_COMMIT_DATE, direction: ASC }) {\n\
         \      nodes {\n\
         \        id,\n\
         \        name\n\

tests/SlackBuilder/LatestVersionCheckSpec.hs

@@ -22,3 +22,19 @@ spec = do
                 actual = stableTagTransform given
                 expected = Just "2.6.0"
              in actual `shouldBe` expected
+
+    describe "match" $ do
+        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" $ 
+            let expected = Just "2.6.0"
+                actual = match "(v)*" "v2.6.0"
+             in actual `shouldBe` expected
+
+        it "ignores suffix after wildcard" $ 
+            let expected = Just "2.6.0"
+                actual = match "(v)*(-rc1)" "v2.6.0-rc1"
+             in actual `shouldBe` expected