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\