summaryrefslogtreecommitdiff
path: root/lib/SlackBuilder/LatestVersionCheck.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/SlackBuilder/LatestVersionCheck.hs')
-rw-r--r--lib/SlackBuilder/LatestVersionCheck.hs109
1 files changed, 55 insertions, 54 deletions
diff --git a/lib/SlackBuilder/LatestVersionCheck.hs b/lib/SlackBuilder/LatestVersionCheck.hs
index d6410dc..a1ed946 100644
--- a/lib/SlackBuilder/LatestVersionCheck.hs
+++ b/lib/SlackBuilder/LatestVersionCheck.hs
@@ -89,72 +89,73 @@ data MatchToken
-- (v)\\.
-- @
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
- Just state@MatchState{ pattern' = [OneOfMatchToken _] } ->
- Just $ getField @"matched" state
- _ -> Nothing
+match fullPattern = go startState
where
- 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'
- , firstChar == '['
- , Just lastBracket <- Text.findIndex (== ']') remaining
- = OneOfMatchToken (Text.unpack $ Text.take lastBracket remaining)
- : parsePattern (Text.drop (succ lastBracket) remaining)
- | Just (firstChar, remaining) <- Text.uncons input' =
- let token =
- case firstChar of
- '*' -> AsteriskMatchToken
- '(' -> 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 -> 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
+ 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
+ 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'
+ , firstChar == '['
+ , Just lastBracket <- Text.findIndex (== ']') remaining
+ = OneOfMatchToken (Text.unpack $ Text.take lastBracket remaining)
+ : parsePattern (Text.drop (succ lastBracket) remaining)
+ | Just (firstChar, remaining) <- Text.uncons input' =
+ let token =
+ case firstChar of
+ '*' -> AsteriskMatchToken
+ '(' -> OpenParenMatchToken
+ ')' -> CloseParenMatchToken
+ s -> SymbolMatchToken s
+ in token : parsePattern remaining
+ | otherwise = []
+ where
+ digits = toEnum <$> [fromEnum '0' .. fromEnum '9']
+
-- * Packagist
newtype PackagistPackage = PackagistPackage