Я попытался реализовать движок регулярных выражений с использованием комбинаторов синтаксического анализа в Haskell.
Идея состоит в том, чтобы сначала проанализировать шаблон для построения синтаксического анализатора регулярных выражений, а затем использовать анализатор для синтаксического анализа входного текста.
Но мой код не может обработать этот сценарий: если шаблон похож на a?(a|b).*h+
, то h+
после .*
никогда не будет удовлетворен, так как часть .*
будет использовать все входные данные.
(Обычно <|>
реализован с помощью функции try
, из-за эффективности. Но здесь я не думаю, что это так.
Ниже мой код
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Matcher where
import Data.Function (on)
import Data.Functor (($>))
import Control.Monad
import Control.Applicative
newtype Parser a = Parser { runParser :: String -> Maybe (a, String) }
parse :: Parser a -> String -> Maybe a
parse parser inp = case runParser parser inp of
Just (a, []) -> Just a
_ -> Nothing
instance Functor Parser where
fmap t (Parser g) = Parser $ \inp -> fmap (\(a, inp') -> (t a, inp')) (g inp)
instance Applicative Parser where
pure a = Parser $ \inp -> Just (a, inp)
(Parser f) <*> (Parser g) = Parser
$ \inp -> case f inp of
Nothing -> Nothing
Just (t, inp') -> case g inp' of
Nothing -> Nothing
Just (a, inp'') -> Just (t a, inp'')
instance Alternative Parser where
empty = Parser $ const Nothing
(Parser f) <|> (Parser g) = Parser
$ \inp -> case f inp of
Nothing -> g inp
Just r -> Just r
some p = (:) <$> p <*> (some p <|> pure [])
instance Monad Parser where
(Parser f) >>= g = Parser
$ \inp -> case f inp of
Nothing -> Nothing
Just (a, inp') -> runParser (g a) inp'
satisfy p = Parser
$ \case
(x:xs)
| p x -> Just (x, xs)
_ -> Nothing
char :: Char -> Parser Char
char c = satisfy (== c)
string :: String -> Parser String
string "" = pure ""
string (c:cs) = do
char c
string cs
return (c:cs)
between :: Parser a -> Parser b -> Parser c -> Parser b
between left content right = left *> content <* right
unit :: Parser (Parser String)
unit = (do
c <- satisfy (`notElem` ['.', '*', '?', '+', '(', ')', '|'])
return $ fmap (:[]) (char c))
<|> (char '.' $> fmap (:[]) (satisfy (const True)))
<|> oneOf
oneOf :: Parser (Parser String)
oneOf = between (char '(') content (char ')')
where
content = do
p1 <- unit
rest <- many $ char '|' *> unit
return $ foldr (<|>) p1 rest
oneOrMore :: Parser (Parser String)
oneOrMore = do
arp <- unit
char '+'
return $ fmap concat (some arp)
zeroOrMore :: Parser (Parser String)
zeroOrMore = do
arp <- unit
char '*'
return $ fmap concat (many arp)
zeroOrOne :: Parser (Parser String)
zeroOrOne = do
arp <- unit
char '?'
return $ arp <|> pure ""
reg :: Parser (Parser String)
reg = fmap
(foldr (liftA2 (++)) (pure ""))
(some $ zeroOrMore <|> zeroOrOne <|> oneOrMore <|> unit)
createRegParser :: String -> Maybe (Parser String)
createRegParser = parse reg
example = createRegParser "a?(a|b).*h+"