diff --git a/src/Text/Parsing/StringParser/String.purs b/src/Text/Parsing/StringParser/String.purs index f45f1ca..83ab9b7 100644 --- a/src/Text/Parsing/StringParser/String.purs +++ b/src/Text/Parsing/StringParser/String.purs @@ -15,17 +15,20 @@ module Text.Parsing.StringParser.String , upperCaseChar , anyLetter , alphaNum + , regex ) where import Prelude import Control.Alt ((<|>)) -import Data.Array ((..)) +import Data.Array ((..), uncons) import Data.Char (toCharCode) import Data.Either (Either(..)) import Data.Foldable (class Foldable, foldMap, elem, notElem) -import Data.Maybe (Maybe(..)) -import Data.String (Pattern(..), charAt, length, indexOf', singleton) +import Data.Maybe (Maybe(..), fromMaybe) +import Data.String (Pattern(..), charAt, drop, length, indexOf', singleton, stripPrefix) +import Data.String.Regex as Regex +import Data.String.Regex.Flags (noFlags) import Text.Parsing.StringParser (Parser(..), ParseError(..), try, fail) import Text.Parsing.StringParser.Combinators (many, (<?>)) @@ -111,3 +114,31 @@ anyLetter = lowerCaseChar <|> upperCaseChar <?> "Expected a letter" -- | Match a letter or a number. alphaNum :: Parser Char alphaNum = anyLetter <|> anyDigit <?> "Expected a letter or a number" + +-- | match the regular expression +regex :: String -> Parser String +regex pat = + case Regex.regex pattern noFlags of + Left _ -> + fail $ "Text.Parsing.StringParser.String.regex': illegal regex " <> pat + Right r -> + matchRegex r + where + -- ensure the pattern only matches the current position in the parse + pattern = + case stripPrefix (Pattern "^") pat of + Nothing -> + "^" <> pat + _ -> + pat + matchRegex :: Regex.Regex -> Parser String + matchRegex r = + Parser \{ str, pos } -> + let + remainder = drop pos str + in + case uncons $ fromMaybe [] $ Regex.match r remainder of + Just { head: Just matched, tail: _ } -> + Right { result: matched, suffix: { str, pos: pos + length matched } } + _ -> + Left { pos, error: ParseError "no match" } diff --git a/test/Main.purs b/test/Main.purs index 0ebac2c..e68ef2f 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -15,7 +15,7 @@ import Test.Assert (assert', ASSERT, assert) import Text.Parsing.StringParser (Parser, runParser, try) import Text.Parsing.StringParser.Combinators (many1, endBy1, sepBy1, optionMaybe, many, chainl, fix, between) import Text.Parsing.StringParser.Expr (Assoc(..), Operator(..), buildExprParser) -import Text.Parsing.StringParser.String (anyDigit, eof, string, anyChar) +import Text.Parsing.StringParser.String (anyDigit, eof, string, anyChar, regex) parens :: forall a. Parser a -> Parser a parens = between (string "(") (string ")") @@ -48,6 +48,7 @@ exprTest = buildExprParser [ [Infix (string "/" >>= \_ -> pure div) AssocRight] ] digit tryTest :: Parser String + -- reduce the possible array of matches to 0 or 1 elements to aid Array pattern matching tryTest = try ((<>) <$> string "aa" <*> string "bb") <|> (<>) <$> string "aa" <*> string "cc" @@ -84,3 +85,4 @@ main = do assert' "tryTest "$ canParse tryTest "aacc" assert $ expectResult ('0':'1':'2':'3':'4':Nil) (many1 anyDigit) "01234/" assert $ expectResult ('5':'6':'7':'8':'9':Nil) (many1 anyDigit) "56789:" + assert $ expectResult "aaaa" (regex "a+") "aaaab"