Delete regex, replace it with mkRegex

Author: jamesdbrock

CHANGELOG.md

@@ -25,6 +25,7 @@ Breaking changes:
   `<|>` was made right associative. Decreasing these two operators
   prevents a compiler error (i.e. `MixedAssociativityError`)
   without causing issues with `<$>`.
+- Delete the `regex` parser and replace it with `mkRegex`. ( by @jamesdbrock)
 
 New features:
 

bench/Json/Parsing.purs

@@ -4,13 +4,17 @@ import Prelude hiding (between)
 
 import Bench.Json.Common (Json(..))
 import Control.Lazy (defer)
+import Data.Either (Either(..))
 import Data.List (List)
 import Data.Maybe (Maybe(..))
 import Data.Number as Number
+import Data.String.Regex.Flags (noFlags)
 import Data.Tuple (Tuple(..))
+import Effect.Exception (throw)
+import Effect.Unsafe (unsafePerformEffect)
 import Text.Parsing.Parser (ParserT, fail)
 import Text.Parsing.Parser.Combinators (between, choice, sepBy, try)
-import Text.Parsing.Parser.String (regex, skipSpaces, string)
+import Text.Parsing.Parser.String (mkRegex, skipSpaces, string)
 
 json :: forall m. Monad m => ParserT String m Json
 json = defer \_ ->
@@ -38,15 +42,18 @@ jsonArray = defer \_ ->
     json `sepBy` (try (skipSpaces *> string ","))
 
 jsonString :: forall m. Monad m => ParserT String m String
-jsonString = between (string "\"") (string "\"") do
-  regex {} """\\"|[^"]*"""
+jsonString = case mkRegex """\\"|[^"]*""" noFlags of
+  Left err -> unsafePerformEffect $ throw err
+  Right p -> between (string "\"") (string "\"") p
 
 jsonNumber :: forall m. Monad m => ParserT String m Number
-jsonNumber = do
-  n <- regex {} """(\+|-)?(\d+(\.\d*)?|\d*\.\d+)([eE](\+|-)?\d+)?"""
-  case Number.fromString n of
-    Just n' -> pure n'
-    Nothing -> fail "Expected number"
+jsonNumber = case mkRegex """(\+|-)?(\d+(\.\d*)?|\d*\.\d+)([eE](\+|-)?\d+)?""" noFlags of
+  Left err -> unsafePerformEffect $ throw err
+  Right p -> do
+    n <- p
+    case Number.fromString n of
+      Just n' -> pure n'
+      Nothing -> fail "Expected number"
 
 jsonBoolean :: forall m. Monad m => ParserT String m Boolean
 jsonBoolean = choice

packages.dhall

@@ -1,4 +1,5 @@
 let upstream =
       https://raw.githubusercontent.com/purescript/package-sets/prepare-0.15/src/packages.dhall
+        sha256:5f32c078b014909642302b328bd9bebcdcedc301956a709b302f19521680a0aa
 
 in  upstream

spago.dhall

@@ -17,7 +17,6 @@
   , "numbers"
   , "partial"
   , "prelude"
-  , "record"
   , "strings"
   , "tailrec"
   , "transformers"

src/Text/Parsing/Parser/String.purs

@@ -36,8 +36,7 @@ module Text.Parsing.Parser.String
   , noneOf
   , noneOfCodePoints
   , match
-  , regex
-  , RegexFlagsRow
+  , mkRegex
   , consumeWith
   ) where
 
@@ -55,12 +54,10 @@ import Data.String (CodePoint, Pattern(..), codePointAt, length, null, singleton
 import Data.String as String
 import Data.String.CodeUnits as SCU
 import Data.String.Regex as Regex
-import Data.String.Regex.Flags (RegexFlags(..), RegexFlagsRec)
+import Data.String.Regex.Flags (RegexFlags)
 import Data.Tuple (Tuple(..), fst)
 import Partial.Unsafe (unsafePartial)
-import Prim.Row (class Nub, class Union)
-import Record (merge)
-import Text.Parsing.Parser (ParseError(..), ParseState(..), ParserT(..), fail)
+import Text.Parsing.Parser (ParseError(..), ParseState(..), ParserT(..))
 import Text.Parsing.Parser.Combinators ((<?>), (<~?>))
 import Text.Parsing.Parser.Pos (Position(..))
 
@@ -229,101 +226,72 @@ match p = do
   -- boundary.
   pure $ Tuple (SCU.take (SCU.length input1 - SCU.length input2) input1) x
 
--- | Parser which uses the `Data.String.Regex` module to match the regular
--- | expression pattern passed as the `String`
--- | argument to the parser.
+-- | Compile a regular expression string into a regular expression parser.
+-- |
+-- | This function will use the `Data.String.Regex.regex` function to compile and return a parser which can be used
+-- | in a `ParserT String m` monad.
 -- |
 -- | This parser will try to match the regular expression pattern starting
 -- | at the current parser position. On success, it will return the matched
 -- | substring.
 -- |
--- | If the `Regex` pattern string fails to compile then this parser will fail.
--- | (Note: It’s not possible to use a precompiled `Regex` because this parser
--- | must set flags and make adjustments to the `Regex` pattern string.)
+-- | [*MDN Regular Expressions Cheatsheet*](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Regular_Expressions/Cheatsheet)
+-- |
+-- | This function should be called outside the context of a `ParserT String m` monad, because this function might
+-- | fail with a `Left` RegExp compilation error message.
+-- | If you call this function inside of the `ParserT String m` monad and then `fail` the parse when the compilation fails,
+-- | then that could be confusing because a parser failure is supposed to indicate an invalid input string.
+-- | If the compilation failure occurs in an `alt` then the compilation failure might not be reported at all and instead
+-- | the input string would be parsed incorrectly.
 -- |
 -- | This parser may be useful for quickly consuming a large section of the
 -- | input `String`, because in a JavaScript runtime environment the `RegExp`
 -- | runtime is a lot faster than primitive parsers.
 -- |
--- | [*MDN Regular Expressions Cheatsheet*](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Regular_Expressions/Cheatsheet)
--- |
--- | #### Flags
+-- | #### Example
 -- |
--- | The `Record flags` argument to the parser is for `Regex` flags. Here are
--- | the default flags.
+-- | This example shows how to compile and run the `xMany` parser which will capture the regular expression pattern `x*`.
 -- |
 -- | ```purescript
--- | { dotAll: true
--- |   ignoreCase: false
--- |   unicode: true
--- | }
+-- | case mkRegex "x*" noFlags of
+-- |   Left compileError -> unsafePerformEffect $ throw $ "xMany failed to compile: " <> compileError
+-- |   Right xMany -> case runParser "xxxZ" xMany of
+-- |     Left (ParseError parseError _) -> -- parse failed
+-- |     Right capture -> -- capture should be "xxx"
 -- | ```
 -- |
--- | To use the defaults, pass
--- | `{}` as the flags argument. For case-insensitive pattern matching, pass
--- | `{ignoreCase: true}` as the flags argument.
+-- | #### Flags
 -- |
--- | The other `Data.String.Regex.Flags.RegexFlagsRec` fields are mostly
--- | nonsense in the context of parsing
--- | and use of the other flags may cause strange behavior in the parser.
+-- | Set `RegexFlags` with the `Semigroup` instance like this.
 -- |
--- | [*MDN Advanced searching with flags*](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Regular_Expressions#advanced_searching_with_flags)
+-- | ```purescript
+-- | mkRegex "x*" (dotAll <> ignoreCase)
+-- | ```
 -- |
--- | #### Example
+-- | The `dotAll`, `unicode`, and `ignoreCase` flags might make sense for a `mkRegex` parser. The other flags will
+-- | probably cause surprising behavior and you should avoid them.
 -- |
--- | ```
--- | runParser "ababXX" (regex {} "(ab)+")
--- | ```
--- | ```
--- | (Right "abab")
--- | ```
-regex
-  :: forall m flags f_
-   . Monad m
-  => Union flags RegexFlagsRow f_
-  => Nub f_ RegexFlagsRow
-  => Record flags
-  -> String
-  -> ParserT String m String
-regex flags pattern =
-  -- Prefix a ^ to ensure the pattern only matches the current position in the parse
-  case Regex.regex ("^(" <> pattern <> ")") flags' of
-    Left paterr ->
-      fail $ "Regex pattern error " <> paterr
-    Right regexobj ->
+-- | [*MDN Advanced searching with flags*](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Regular_Expressions#advanced_searching_with_flags)
+mkRegex :: forall m. String -> RegexFlags -> Either String (ParserT String m String)
+mkRegex pattern flags =
+  Regex.regex ("^(" <> pattern <> ")") flags <#> \regexobj ->
       consumeWith \input -> do
         case NonEmptyArray.head <$> Regex.match regexobj input of
           Just (Just consumed) -> do
             let remainder = SCU.drop (SCU.length consumed) input
             Right { value: consumed, consumed, remainder }
           _ ->
             Left "No Regex pattern match"
-  where
-  flags' = RegexFlags
-    ( merge flags
-        { dotAll: true
-        , global: false
-        , ignoreCase: false
-        , multiline: false
-        , sticky: false
-        , unicode: true
-        } :: RegexFlagsRec
-    )
 
--- | The fields from `Data.String.Regex.Flags.RegexFlagsRec`.
-type RegexFlagsRow =
-  ( dotAll :: Boolean
-  , global :: Boolean
-  , ignoreCase :: Boolean
-  , multiline :: Boolean
-  , sticky :: Boolean
-  , unicode :: Boolean
-  )
 
--- | Consumes a portion of the input string while yielding a value.
+-- | Consume a portion of the input string while yielding a value.
+-- |
+-- | Takes a consumption function which takes the remaining input `String`
+-- | as its argument and returns three fields:
+-- |
 -- | * `value` is the value to return.
--- | * `consumed` is the input that was consumed and is used to update the parser position.
--- | * `remainder` is the new input state.
+-- | * `consumed` is the input `String` that was consumed. It is used to update the parser position.
+-- | * `remainder` is the new remaining input `String`.
 consumeWith
   :: forall m a
    . (String -> Either String { value :: a, consumed :: String, remainder :: String })

test/Main.purs

@@ -1,3 +1,8 @@
+-- Run tests:
+--
+--     spago -x spago-dev.dhall test
+--
+
 module Test.Main where
 
 import Prelude hiding (between, when)
@@ -16,6 +21,7 @@ import Data.Number (infinity, isNaN)
 import Data.String.CodePoints as SCP
 import Data.String.CodeUnits (fromCharArray, singleton)
 import Data.String.CodeUnits as SCU
+import Data.String.Regex.Flags (RegexFlags, ignoreCase, noFlags)
 import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Console (logShow)
@@ -26,7 +32,7 @@ import Text.Parsing.Parser.Combinators (between, chainl, chainl1Rec, chainlRec,
 import Text.Parsing.Parser.Expr (Assoc(..), Operator(..), buildExprParser)
 import Text.Parsing.Parser.Language (haskellDef, haskellStyle, javaStyle)
 import Text.Parsing.Parser.Pos (Position(..), initialPos)
-import Text.Parsing.Parser.String (anyChar, anyCodePoint, char, eof, noneOfCodePoints, oneOfCodePoints, regex, rest, satisfy, string, takeN, whiteSpace)
+import Text.Parsing.Parser.String (anyChar, anyCodePoint, char, eof, mkRegex, noneOfCodePoints, oneOfCodePoints, rest, satisfy, string, takeN, whiteSpace)
 import Text.Parsing.Parser.String.Basic (intDecimal, number, letter)
 import Text.Parsing.Parser.Token (TokenParser, makeTokenParser, match, token, when)
 import Text.Parsing.Parser.Token as Parser.Token
@@ -94,6 +100,15 @@ manySatisfyTest = do
   _ <- char '?'
   pure (fromCharArray r)
 
+mkRegexTest :: String -> String -> String -> RegexFlags -> (Parser String String -> Parser String String) -> Effect Unit
+mkRegexTest input expected pattern flags pars =
+  case mkRegex pattern flags of
+    Left err -> assert' ("error: " <> show err) false
+    Right p -> parseTest input expected $ pars p
+
+
+-- TODO everything is stack-safe now.
+--
 -- This test doesn't test the actual stack safety of these combinators, mainly
 -- because I don't know how to come up with an example guaranteed to be large
 -- enough to overflow the stack. But thankfully, their stack safety is more or
@@ -749,19 +764,13 @@ main = do
 
   parseTest "-300" (-300) intDecimal
 
-  parseTest "regex-" "regex" (regex {} "regex" <* char '-' <* eof)
-  parseTest "-regex" "regex" (char '-' *> regex {} "regex" <* eof)
-  parseTest "regexregex" "regexregex" (regex {} "(regex)*")
-  parseTest "regexregex" "regex" (regex {} "(^regex)*")
-  parseTest "ReGeX" "ReGeX" (regex { ignoreCase: true } "regex")
-  parseTest "regexcapregexcap" "regexcap" (regex {} "(?<CaptureGroupName>regexcap)")
-  parseTest "regexcapregexcap" "regexcap" (regex {} "(((?<CaptureGroupName>(r)e(g)excap)))")
-
-  -- Maybe it is nonsense to allow multiline regex.
-  -- Because an end-of-line regex pattern `$` will match but then the
-  -- newline character will not be consumed.
-  -- Also why does this test fail? I think it should succeed.
-  -- parseTest "regex\nregex\n" "regex\nregex\n" (regex {dotAll: false, multiline: true} "(^regex$)+")
+  mkRegexTest "regex-" "regex" "regex" noFlags (\p -> p <* char '-' <* eof)
+  mkRegexTest "-regex" "regex" "regex" noFlags (\p -> char '-' *> p <* eof)
+  mkRegexTest "regexregex" "regexregex" "(regex)*" noFlags identity
+  mkRegexTest "regexregex" "regex" "(^regex)*" noFlags identity
+  mkRegexTest "ReGeX" "ReGeX" "regex" ignoreCase identity
+  mkRegexTest "regexcapregexcap" "regexcap" "(?<CaptureGroupName>regexcap)" noFlags identity
+  mkRegexTest "regexcapregexcap" "regexcap" "(((?<CaptureGroupName>(r)e(g)excap)))" noFlags identity
 
   stackSafeLoopsTest