Consume tokens matching 0 characters at the end

lib/SlackBuilder/LatestVersionCheck.hs

@@ -89,20 +89,45 @@ data MatchToken
 -- (v)\\.
 -- @
 match :: Text -> Text -> Maybe Text
-match fullPattern input =
+match fullPattern = go startState
-    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
-        Just state@MatchState{ pattern' = [OneOfMatchToken _] } ->
-            Just $ getField @"matched" state
-        _ -> Nothing
   where
-    digits = toEnum <$> [fromEnum '0' .. fromEnum '9']
+    startState = MatchState
-    parsePattern :: Text -> [MatchToken]
+        { ignoring = False
-    parsePattern input'
+        , matched = mempty
+        , pattern' = parsePattern fullPattern
+        }
+    go :: MatchState -> Text -> Maybe Text
+    -- There is no input, look at the remaining tokens.
+    go MatchState{ pattern' = [], matched } "" = Just matched
+    go state@MatchState{ pattern' = OpenParenMatchToken : tokens } input' =
+        go (state{ ignoring = True, pattern' = tokens }) input'
+    go state@MatchState{ pattern' = CloseParenMatchToken : tokens } input' =
+        go (state{ ignoring = False, pattern' = tokens }) input'
+    go state@MatchState{ pattern' = AsteriskMatchToken : tokens } input'
+        | Just (nextCharacter, leftOver) <- Text.uncons input' =
+            go (matchSymbolToken state nextCharacter) leftOver
+        | otherwise = go state{ pattern' = tokens } ""
+    go state@MatchState{ pattern' = OneOfMatchToken chars : tokens } input'
+        | Just (nextCharacter, leftOver) <- Text.uncons input'
+        , nextCharacter `elem` chars =
+            go (matchSymbolToken state nextCharacter) leftOver
+        | otherwise =
+            go (state{ pattern' = tokens }) input'
+    go state@MatchState{ pattern' = SymbolMatchToken patternCharacter : tokens } input'
+        | Just (nextCharacter, leftOver) <- Text.uncons input'
+        , patternCharacter == nextCharacter =
+            go (matchSymbolToken state{ pattern' = tokens } nextCharacter) leftOver
+        | otherwise = Nothing
+    -- All tokens are processed, but there is still some input left.
+    go MatchState{ pattern' = [] } _ = Nothing
+    matchSymbolToken state nextCharacter
+        | getField @"ignoring" state = state
+        | otherwise = state
+            { matched = Text.snoc (getField @"matched" state) nextCharacter
+            }
+
+parsePattern :: Text -> [MatchToken]
+parsePattern input'
     | Just (firstChar, remaining) <- Text.uncons input'
     , firstChar == '\\' =
         case Text.uncons remaining of
@@ -128,32 +153,8 @@ match fullPattern input =
                     s -> SymbolMatchToken s
             in token : parsePattern remaining
     | otherwise = []
-    startState = MatchState
+  where
-        { ignoring = False
+    digits = toEnum <$> [fromEnum '0' .. fromEnum '9']
-        , 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 -> 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
-        | otherwise = state
-            { matched = Text.snoc (getField @"matched" state) nextCharacter
-            }
 
 -- * Packagist
 

tests/SlackBuilder/LatestVersionCheckSpec.hs

@@ -41,3 +41,8 @@ spec = do
             let expected = Nothing
                 actual = match "2.6.0-rc1" "2.6.0"
              in actual `shouldBe` expected
+
+        it "consumes the last token matching nothing" $
+            let expected = Just "abc"
+                actual = match "abc\\d\\d" "abc"
+             in actual `shouldBe` expected