regex-generator (empty) → 0.1.0.0
raw patch · 12 files changed
+1688/−0 lines, 12 filesdep +HUnitdep +attoparsecdep +basesetup-changed
Dependencies added: HUnit, attoparsec, base, bytestring, containers, exceptions, hspec, random, regex-generator, regex-pcre
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- regex-generator.cabal +50/−0
- src/Text/Regex/Regen.hs +11/−0
- src/Text/Regex/Regen/CClass.hs +106/−0
- src/Text/Regex/Regen/Gen.hs +308/−0
- src/Text/Regex/Regen/Parse.hs +343/−0
- src/Text/Regex/Regen/ParserST.hs +238/−0
- src/Text/Regex/Regen/Pattern.hs +136/−0
- src/Text/Regex/Regen/PatternException.hs +98/−0
- src/Text/Regex/Regen/Util.hs +31/−0
- test/Gen.hs +345/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2018 Ben Hamlin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ regex-generator.cabal view
@@ -0,0 +1,50 @@+-- Initial regex-generator.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: regex-generator+version: 0.1.0.0+synopsis: Generate a random string from a PCRE+-- description: +license: MIT+license-file: LICENSE+author: Ben Hamlin+maintainer: ben.hamlin@formal.tech+-- copyright: +category: Text+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++library+ exposed-modules: Text.Regex.Regen+ Text.Regex.Regen.CClass+ Text.Regex.Regen.Gen+ Text.Regex.Regen.Parse+ Text.Regex.Regen.ParserST+ Text.Regex.Regen.Pattern+ Text.Regex.Regen.PatternException+ Text.Regex.Regen.Util+ -- other-modules: + other-extensions: RecordWildCards+ build-depends: base >=4.0 && <4.9,+ attoparsec >=0.13 && <0.14,+ bytestring >=0.10 && <0.11,+ containers >=0.5 && <0.7,+ exceptions >=0.8 && <0.9,+ random >=1.0 && <1.2+ hs-source-dirs: src+ default-language: Haskell2010++test-suite generate+ ghc-options: -Wall+ type: exitcode-stdio-1.0+ main-is: test/Gen.hs+ default-language: Haskell2010+ build-depends: base >=4.0 && <4.9,+ bytestring >=0.10 && <0.11,+ hspec >=2.2 && <2.5,+ HUnit >=1.2 && <1.7,+ --hspec-expectations >=0.6 && <0.9,+ random >=1.0 && <1.2,+ regex-pcre >=0.82 && <0.95,+ regex-generator
+ src/Text/Regex/Regen.hs view
@@ -0,0 +1,11 @@+module Text.Regex.Regen+ ( module X+ ) where++import Text.Regex.Regen.Gen as X (generate, generateOpts, generatePattern)+import Text.Regex.Regen.Gen as X (generatePatternIO)+import Text.Regex.Regen.Parse as X (parsePatternOpts, parsePattern)+import Text.Regex.Regen.Pattern as X (Options(..), Strategy(..), defaultOptions)+import Text.Regex.Regen.Pattern as X (Part(..), Range(..), Anchor(..))+import Text.Regex.Regen.Pattern as X (Pattern(..), LineEnds(..), Group(..))+import Text.Regex.Regen.PatternException as X
+ src/Text/Regex/Regen/CClass.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE OverloadedStrings #-}+module Text.Regex.Regen.CClass where++import Prelude hiding (takeWhile)++import Control.Applicative (Alternative(..))+import Data.Attoparsec.ByteString.Char8 (isDigit, isSpace, isHorizontalSpace)+import Data.Char (ord)+import Data.Functor (($>))+import Data.List ((\\))++import Text.Regex.Regen.ParserST+import Text.Regex.Regen.Pattern+import Text.Regex.Regen.PatternException+import Text.Regex.Regen.Util++bracketClass :: ParserST Part+bracketClass = bracketed $ negative <|> positive+ where+ positive = fmap (CClass True) $ go []+ negative = fmap (CClass False) $ char '^' *> go []+ cpart = posixRange <|> backslashRange <|> dashRange <|> singleton+ go acc = do+ acc' <- (acc ++) <$> cpart+ mb <- peekChar+ case mb of+ Just ']' -> return acc'+ _ -> go acc'++backslashClass :: ParserST Part+backslashClass = do+ o <- pOptions <$> getPattern+ dot o <|> bsR <|> bsN o <|> range+ where+ dot o = string "." $> CClass False (munless (oDotAll o) (oLineEndChars o))+ bsN o = string "\\N" $> CClass False (oLineEndChars o)+ bsR = string "\\R" $> CClass True ['\r','\n','\f','\v']+ range = CClass True <$> backslashRange++posixRange :: ParserST [Char]+posixRange = toPC =<< string "[:" *> pcname <* string ":]"+ where+ toPC ('^':s) = negate <$> toPC s+ toPC "alnum" = return $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']+ toPC "alpha" = return $ ['a'..'z'] ++ ['A'..'Z']+ toPC "ascii" = return $ ['\x00'..'\x7f']+ toPC "blank" = return $ [' ','\t']+ toPC "cntrl" = return $ '\x7f' : ['\x00'..'\x1f']+ toPC "digit" = return $ ['0'..'9']+ toPC "graph" = return $ ['\x21'..'\x7e']+ toPC "lower" = return $ ['a'..'z']+ toPC "print" = return $ ['\x20'..'\x7e']+ toPC "punct" = return $ "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~"+ toPC "space" = return $ " \t\r\n\v\f" + toPC "word" = return $ '_' : ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']+ toPC "xdigit" = return $ ['a'..'f'] ++ ['A'..'Z'] ++ ['0'..'9']+ toPC name = eNoSuchClass name+ negate cs = ['\x00'..'\xff'] \\ cs+ pcname = many $ satisfy (/=':') <|> char ':' `notFollowedBy` ']'++backslashRange :: ParserST [Char]+backslashRange = let bytes = ['\x00'..'\xff'] in choice+ [ string "\\d" $> [ c | c <- bytes, isDigit c ]+ , string "\\D" $> [ c | c <- bytes, not (isDigit c) ]+ , string "\\h" $> [ c | c <- bytes, isHSpace c ]+ , string "\\H" $> [ c | c <- bytes, not (isHSpace c) ]+ , string "\\s" $> [ c | c <- bytes, isSpace c ]+ , string "\\S" $> [ c | c <- bytes, not (isSpace c) ]+ , string "\\v" $> "\n\v\f\r"+ , string "\\V" $> bytes \\ "\n\v\f\r"+ , string "\\w" $> '_' : ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']+ , string "\\W" $> bytes \\ ('_' : ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'])+ , string "\\N" >> eNotSupported "'\\N' in character class"+ , string "\\L" >> eNotSupported "'\\L'"+ , string "\\l" >> eNotSupported "'\\l'"+ , string "\\U" >> eNotSupported "'\\U'"+ , string "\\u" >> eNotSupported "'\\u'"+ , string "\\Q" >> eNotSupported "'\\Q' in character class"+ , string "\\E" >> eNotSupported "'\\E' in character class"+ , string "\\p{" *> some letter <* char '}' >> eNoProps+ , string "\\p" *> letter >> eNoProps+ , fmap (bytes \\) $ string "\\P{" *> some letter <* char '}' >> eNoProps+ , fmap (bytes \\) $ string "\\P" *> letter >> eNoProps+ ]+ where+ eNoProps = eNotSupported "properties"+ isHSpace = isHorizontalSpace . fromIntegral . ord++dashRange :: ParserST [Char]+dashRange = mkRange =<< (,) <$> singleton <* char '-' <*> singleton+ where+ mkRange p = case p of+ ([a],[b]) | a <= b -> pure [a..b]+ ([_],[_]) -> eClassOutOfOrder+ _ -> eParserError "unreachable"++singleton :: ParserST [Char]+singleton = (:[]) <$> choice+ [ escaped hexByte+ , escaped octalByte+ , escaped cescape+ , escaped literal+ , literal+ ]+ where+ literal = satisfy (/='\\')
+ src/Text/Regex/Regen/Gen.hs view
@@ -0,0 +1,308 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+module Text.Regex.Regen.Gen where++import Control.Applicative (Alternative(..))+import Control.Exception (SomeException, mapException)+import Control.Monad (MonadPlus(..), guard, (<=<), when, void)+import Control.Monad.Catch (MonadThrow(..), MonadCatch(..))+import Control.Monad.Catch (try, fromException, toException)+import Data.List ((\\), foldl')+import Data.Map (Map)+import Data.Maybe (fromMaybe, listToMaybe, maybe, catMaybes)+import Data.Monoid ((<>))+import System.Random (Random, StdGen, random, randomR, newStdGen)+import qualified Data.ByteString.Char8 as S+import qualified Data.Map as Map++import Text.Regex.Regen.Parse+import Text.Regex.Regen.Pattern+import Text.Regex.Regen.PatternException+import Text.Regex.Regen.Util++generate :: S.ByteString -> IO S.ByteString+generate = generateOpts defaultOptions++generateOpts :: Options -> S.ByteString -> IO S.ByteString+generateOpts o bs = parsePatternOpts o bs >>= generatePatternIO++generatePatternIO :: Pattern -> IO S.ByteString+generatePatternIO p = do+ (e,_) <- generatePattern p <$> newStdGen+ either throwM pure e++generatePattern :: Pattern -> StdGen -> (Either SomeException S.ByteString, StdGen)+generatePattern p g = let (s,e) = runGen genTop (makeGenState p g) in (e, gsGen s)+ where+ state = makeGenState p g+ genTop = getGroup 0 >>= genGroup++data GenState = GenState+ { gsGen :: !StdGen+ , gsOptions :: !Options+ , gsGroups :: !(Map Int Group)+ , gsGroupNames :: !(Map S.ByteString Int)+ , gsResolved :: !(Map Int S.ByteString)+ } deriving Show++makeGenState :: Pattern -> StdGen -> GenState+makeGenState Pattern {..} g = GenState g pOptions pGroups pGroupNames Map.empty++newGenState :: Pattern -> IO GenState+newGenState p = makeGenState p <$> newStdGen++newtype Gen a = Gen { runGen :: GenState -> (GenState, Either SomeException a) }+instance Functor Gen where+ fmap f m = Gen $ \s -> let (s',e) = runGen m s in (s', fmap f e)+instance Applicative Gen where+ pure a = Gen $ \s -> (s, Right a)+ m <*> n = Gen $ \s ->+ let (s',f) = runGen m s+ (s'',a) = runGen n s'+ in (s'', f <*> a)+instance Alternative Gen where+ empty = Gen $ \s -> (s, mapException fromPatEx eUnsatisfiable)+ where+ fromPatEx :: PatternException -> SomeException+ fromPatEx = toException+ m <|> n = Gen $ \s -> case runGen m s of+ r@(_, Right _) -> r+ (_, Left _) -> runGen n s+instance Monad Gen where+ m >>= f = Gen $ \s -> case runGen m s of+ (s', Left e) -> (s', Left e)+ (s', Right a) -> runGen (f a) s'+ fail = throwM . EGenError+instance Monoid m => Monoid (Gen m) where+ mempty = pure mempty+ mappend g1 g2 = g1 >>= \m1 -> g2 >>= \m2 -> pure $ m1 <> m2+instance MonadThrow Gen where+ throwM e = Gen $ \s -> (s, Left $ toException e)+instance MonadCatch Gen where+ catch m f = Gen $ \s -> case runGen m s of+ (s', Right a) -> (s', Right a)+ (s, Left e) -> case fromException e of+ Nothing -> (s, Left e)+ Just e' -> runGen (f e') s++evalGen :: Gen a -> GenState -> Either SomeException a+evalGen = snd .: runGen++getGenState :: Gen GenState+getGenState = Gen $ \s -> (s, Right s)++putGenState :: GenState -> Gen ()+putGenState s = Gen $ const (s, Right ())++modifyGenState' :: (GenState -> GenState) -> Gen ()+modifyGenState' f = Gen $ \s -> (f s, Right ())++modifyGenState :: (GenState -> (GenState, a)) -> Gen a+modifyGenState f = Gen $ \s -> let (s',a) = f s in (s', Right a)++getOption :: (Options -> a) -> Gen a+getOption f = f . gsOptions <$> getGenState++getNamedGroup' :: S.ByteString -> Gen (Maybe Group)+getNamedGroup' bs = lookupNamedGroup <$> getGenState+ where+ lookupNamedGroup :: GenState -> Maybe Group+ lookupNamedGroup GenState {..} =+ flip Map.lookup gsGroups =<< Map.lookup bs gsGroupNames++getNamedGroup :: S.ByteString -> Gen Group+getNamedGroup bs = getNamedGroup' bs >>=+ maybe (fail $ "nonexistent group name: " ++ show bs) pure++getGroup' :: Int -> Gen (Maybe Group)+getGroup' ix = Map.lookup ix . gsGroups <$> getGenState++getGroup :: Int -> Gen Group+getGroup ix = getGroup' ix >>=+ maybe (fail $ "nonexistent group index: " ++ show ix) pure++getResolved' :: Int -> Gen (Maybe S.ByteString)+getResolved' ix = Map.lookup ix . gsResolved <$> getGenState++getResolved :: Int -> Gen S.ByteString+getResolved ix = getResolved' ix >>=+ maybe (fail $ "group index not yet resolved: " ++ show ix) pure++resolveRef :: Int -> S.ByteString -> Gen S.ByteString+resolveRef ix bs = modifyGenState f+ where+ f s = (s { gsResolved = Map.insert ix bs (gsResolved s) }, bs)++getStdGen :: Gen StdGen+getStdGen = gsGen <$> getGenState++putStdGen :: StdGen -> Gen ()+putStdGen g = modifyGenState' (\s -> s { gsGen = g })++randomGen :: Random a => Gen a+randomGen = do+ g <- getStdGen+ let (a,g') = random g+ putStdGen g'+ pure a++randomRGen :: Random a => (a,a) -> Gen a+randomRGen r = do+ g <- getStdGen+ let (a,g') = randomR r g+ putStdGen g'+ pure a++randomElemGen :: [a] -> Gen a+randomElemGen l = do+ g <- getStdGen+ guard $ not (null l)+ let (n,g') = randomR (0, length l - 1) g+ putStdGen g'+ pure $ n `th` l+ where+ n `th` l = head $ drop n l++genGroup :: Group -> Gen S.ByteString+genGroup Group {..} = genPart gParts >>= resolveRef gIndex++genPart :: Part -> Gen S.ByteString+genPart Empty = pure S.empty+genPart (Byte c) = pure $ S.singleton c+genPart (Sequence ps) = genSequence ps+genPart (CClass b cs) = genCClass b cs+genPart (Quantified p r t) = genQuantified p r t+genPart (Alternative ps) = genAlternative ps+genPart (Reference ix) = genReference ix+genPart (Call _) = eNotSupported "pattern calls"+genPart (Anchored p as q) = genAnchored p as q++genSequence :: [Part] -> Gen S.ByteString+genSequence ps = mconcat $ genPart <$> ps++genCClass :: Bool -> [Char] -> Gen S.ByteString+genCClass b pos = S.singleton <$> randomElemGen cs+ where+ cs = if b then pos else ['\x00'..'\xff'] \\ pos++genQuantified :: Part -> Range -> Strategy -> Gen S.ByteString+genQuantified p (Range n m) _ = do+ -- TODO: Make default spread configurable? Maybe normally distributed?+ r <- randomRGen (n, fromMaybe (n + 10) m)+ genSequence $ replicate r p++genAlternative :: [Part] -> Gen S.ByteString+genAlternative = genPart <=< randomElemGen++genReference :: Int -> Gen S.ByteString+genReference ix = getResolved ix <|> do+ g <- getGroup ix+ genGroup g++genAnchored :: Part -> [Anchor] -> Part -> Gen S.ByteString+genAnchored p1 as p2 = do+ as' <- mapM (tryMaybe . resolve) as+ alt <- nonEmptyAltM $ catMaybes as'+ genPart alt+ where+ resolve StartOfMatch = eGenError "start-of-match anchors unsupported"+ resolve WordBoundary = endWith isW p1 <> pure p2+ <|> pure p1 <> startWith isW p2+ resolve WordInternal = endWith isw p1 <> startWith isw p2+ resolve Start = nullify p1 <> pure p2+ resolve End = pure p1 <> nullify p2+ resolve BeforeNewline = getLE >>= \le -> pure p1 <> startWith le p2+ resolve AfterNewline = getLE >>= \le -> endWith le p1 <> pure p2+ resolve EndBeforeNewline = getLE >>= \le -> pure p1 <> comprise le p2+ getLE = getOption oLineEndChars >>= \cs -> pure (`elem` cs)+ isw c = c=='_' || ('A'<=c && c<='Z') || ('a'<=c && c<='z') || ('0'<=c && c<='9')+ isW = not . isw++nullify :: Part -> Gen Part+nullify part = case part of+ Empty -> mempty+ Byte _ -> eUnsatisfiable+ Sequence ps -> if null ps then mempty else eUnsatisfiable+ CClass _ _ -> eUnsatisfiable+ Quantified _ r _ -> if rMin r == 0 then mempty else eUnsatisfiable+ Alternative ps -> foldr (<|>) empty $ nullify <$> ps+ Reference ix -> do+ m <- getResolved' ix+ case m of+ Just bs -> if S.null bs then pure () else eUnsatisfiable+ Nothing -> do+ g <- getGroup ix+ p <- nullify $ gParts g+ void . genGroup $ Group ix p+ pure $ Reference ix+ Call _ -> eNotSupported "pattern calls"+ Anchored p1 as p2 -> Anchored <$> nullify p1 <*> pure as <*> nullify p2++comprise :: (Char -> Bool) -> Part -> Gen Part+comprise p part = case part of+ Empty -> mempty+ Byte c -> if p c then pure part else eUnsatisfiable+ Sequence ps -> Sequence <$> mapM (comprise p) ps+ CClass b cs -> nonEmptyCClassM p $ if b then cs else ['\x00'..'\xff'] \\ cs+ Quantified q r t -> Quantified <$> comprise p q <*> pure r <*> pure t+ Alternative ps -> nonEmptyAlt . catMaybes <$> mapM (tryMaybe . comprise p) ps+ Reference ix -> do+ m <- getResolved' ix+ case m of+ Just bs -> if S.all p bs then pure () else eUnsatisfiable+ Nothing -> do+ g <- getGroup ix+ p <- comprise p $ gParts g+ void . genGroup $ Group ix p+ pure $ Reference ix+ Call _ -> eNotSupported "pattern calls"+ Anchored p1 as p2 -> Anchored <$> comprise p p1 <*> pure as <*> comprise p p2++endWith :: (Char -> Bool) -> Part -> Gen Part+endWith p part = case part of+ Empty -> eUnsatisfiable+ Byte c -> if p c then pure part else eUnsatisfiable+ Sequence ps -> case reverse ps of+ [] -> eUnsatisfiable+ part : ps' -> nonEmptySeq . reverse .: (:) <$> endWith p part <*> pure ps'+ CClass b cs -> nonEmptyCClassM p $ if b then cs else ['\x00'..'\xff'] \\ cs+ Quantified q r t -> endWith p q >>= \q' -> nonEmptyQuantM q' r t+ Alternative ps -> nonEmptyAlt . catMaybes <$> mapM (tryMaybe . endWith p) ps+ Reference ix -> do+ m <- getResolved' ix+ case m of+ Just bs -> if S.null bs || p (S.last bs)+ then pure ()+ else eUnsatisfiable+ Nothing -> do+ g <- getGroup ix+ p <- endWith p $ gParts g+ void . genGroup $ Group ix p+ pure $ Reference ix+ Call ix -> eNotSupported "pattern calls"+ Anchored p1 as p2 -> Anchored p1 as <$> endWith p p2++startWith :: (Char -> Bool) -> Part -> Gen Part+startWith p part = case part of+ Empty -> eUnsatisfiable+ Byte c -> if p c then pure part else eUnsatisfiable+ Sequence ps -> case ps of+ [] -> eUnsatisfiable+ part : ps' -> nonEmptySeq .: (:) <$> startWith p part <*> pure ps'+ CClass b cs -> nonEmptyCClassM p $ if b then cs else ['\x00'..'\xff'] \\ cs+ Quantified q r t -> startWith p q >>= \q' -> nonEmptyQuantM q' r t+ Alternative ps -> nonEmptyAlt . catMaybes <$> mapM (tryMaybe . startWith p) ps+ Reference ix -> do+ m <- getResolved' ix+ case m of+ Just bs -> if S.null bs || p (S.head bs)+ then pure ()+ else eUnsatisfiable+ Nothing -> do+ g <- getGroup ix+ p <- startWith p $ gParts g+ void . genGroup $ Group ix p+ pure $ Reference ix+ Call ix -> eNotSupported "pattern calls"+ Anchored p1 as p2 -> Anchored <$> startWith p p1 <*> pure as <*> pure p2
+ src/Text/Regex/Regen/Parse.hs view
@@ -0,0 +1,343 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+module Text.Regex.Regen.Parse where++import Prelude hiding (takeWhile)++import Control.Applicative (Alternative(..), optional)+import Control.Monad (when, unless, guard)+import Control.Monad.Catch (MonadThrow)+import Data.Char (toLower, toUpper, isAlpha)+import Data.Functor (($>))+import Data.List ((\\), nub)+import Data.Map (Map)+import Data.Set (Set)+import qualified Control.Exception as X+import qualified Data.Attoparsec.ByteString.Char8 as P+import qualified Data.Attoparsec.Combinator as P+import qualified Data.ByteString.Char8 as S+import qualified Data.Char as Char+import qualified Data.Map as Map+import qualified Data.Set as Set++import Text.Regex.Regen.ParserST+import Text.Regex.Regen.Pattern+import Text.Regex.Regen.PatternException+import Text.Regex.Regen.Util+import Text.Regex.Regen.CClass (bracketClass, backslashClass, posixRange)++groupName :: Char -> ParserST S.ByteString+groupName term = check =<< takeTill (==term)+ where+ isNameC = (=='_') ||| Char.isAlphaNum+ check n+ | Char.isDigit (S.head n) = eBadGroupName "must not start with a digit"+ | not (S.all isNameC n) = eBadGroupName "invalid character"+ | S.length n > 32 = eBadGroupName "longer than 32 characters"+ | otherwise = pure n++group :: ParserST Part+group = paren $ nonCap <|> atomic <|> reset <|> capture+ where+ nonCap = string "?:" *> parts+ atomic = string "?>" *> parts+ reset = string "?|" *> eNotSupported "reset groups"+ gName = optional (char 'P') *> angled (groupName '>') <|> squoted (groupName '\'')+ capture = do+ num <- nextGroupNum+ name <- Just <$> (char '?' *> gName) <|> pure Nothing+ part <- parts+ case name of+ Just bs -> addNamedGroup bs num part+ Nothing -> addGroup num part+ pure $ Reference num++byte :: ParserST Part+byte = do+ Options {..} <- pOptions <$> getPattern+ let isMeta = isMeta' oFreeSpacing+ meta = satisfy isMeta+ literal = satisfy $ not . isMeta+ escLit = satisfy $ not . (=='\\') &&& not . isSpecial+ c <- choice+ [ escaped cescape+ , escaped hexByte+ , escaped octalByte+ , escaped meta+ , escaped escLit+ , literal+ ]+ pure $ doCases oIgnoreCase c+ where+ isMeta' b c = c `S.elem` ("\\^$.[|()?*+" `S.append` if b then " " else "")+ isSpecial c = c `S.elem` "ABCDEGHKLNPQRSUVWXZabcdefghklnoprstuvwxz1234567"+ doCases True c | isAlpha c = CClass True [toLower c, toUpper c]+ doCases _ c = Byte c++forbidden :: ParserST Part+forbidden = choice+ [ string "\\C" *> eNotSupported "'\\C'"+ , string "\\X" *> eNotSupported "'\\X'"+ , string "\\L" *> eNotSupported "'\\L'"+ , string "\\l" *> eNotSupported "'\\l'"+ , string "\\U" *> eNotSupported "'\\U'"+ , string "\\u" *> eNotSupported "'\\u'"+ , string "\\Q" *> eNotSupported "'\\Q'"+ , string "\\E" *> eNotSupported "'\\E'"+ , posixRange *> eNotSupported "posix range outside of class"+ , range *> eParserError "nothing to quantify"+ ]+ where+ eBadRef c = eNoSuchIndex $ Left (Char.ord c - Char.ord '0')++cclass :: ParserST Part+cclass = doCases =<< (bracketClass <|> backslashClass)+ where+ doCases (CClass b cs) = do+ ignoreCase <- oIgnoreCase . pOptions <$> getPattern+ pure . CClass b . nub $ if ignoreCase+ then foldr (\c -> ([toLower c, toUpper c] ++)) [] cs+ else cs++range :: ParserST Range+range = plus <|> star <|> question <|> braced range'+ where+ plus = Range 1 Nothing <$ char '+'+ star = Range 0 Nothing <$ char '*'+ question = Range 0 (Just 1) <$ char '?'+ range' = check =<< (bounded <|> lower <|> fixed)+ bounded = Range <$> decimal <* char ',' <*> fmap Just decimal+ lower = Range <$> decimal <* char ',' <*> pure Nothing+ fixed = decimal >>= \n -> pure $ Range n (Just n)+ check r@(Range n m)+ | maybe False (n >) m = eQuantOutOfOrder+ | otherwise = pure r++quantified :: ParserST Part -> ParserST Part+quantified p = Quantified <$> p <*> range <*> strategy+ where+ strategy = lazy <|> possessive <|> def+ lazy = Lazy <$ char '?' *> eNotSupported "lazy quantifiers"+ possessive = Possessive <$ char '+' *> eNotSupported "possessive quantifiers"+ def = oDefaultStrategy . pOptions <$> getPattern++reference :: ParserST Part+reference = do+ m <- pGroupCount <$> getPattern+ ix <- numbered m <|> named+ inUse <- either groupNumInUse groupNameInUse ix+ when (not inUse) $ eNoSuchIndex ix+ Reference <$> case ix of+ Left n -> pure n+ Right bs -> lookupGroupIndex bs >>= maybe (eNoSuchName bs) pure+ where+ named = Right <$> choice+ [ string "\\k" *> angled (groupName '>')+ , string "\\k" *> squoted (groupName '\'')+ , string "\\k" *> braced (groupName '}')+ , string "\\g" *> braced (groupName '}')+ , paren $ string "?P=" *> (groupName ')')+ ]+ numbered m = Left <$> choice+ [ string "\\" *> decimal >>= \n -> guard (0 < n && n <= max 7 m) >> pure n+ , string "\\" *> braced decimal+ , string "\\g" *> decimal+ , string "\\g" *> braced decimal+ , string "\\g" *> braced (char '-' *> decimal >>= \n -> pure $ m-n + 1)+ ]+ eNoSuchName = eNoSuchIndex . Right++call :: ParserST Part+call = do+ m <- pGroupCount <$> getPattern+ ix <- numbered m <|> named+ pure $ Call ix+ where+ named = Right <$> choice+ [ paren $ string "?&" *> groupName ')'+ , paren $ string "?P>" *> groupName ')'+ , escaped $ char 'g' *> angled (groupName '>')+ , escaped $ char 'g' *> squoted (groupName '\'')+ ]+ numbered m = Left <$> choice+ [ paren $ string "?R" *> pure 0+ , paren $ char '?' *> decimal+ , paren $ char '?' *> relative m+ , escaped $ char 'g' *> angled decimal+ , escaped $ char 'g' *> angled (relative m)+ , escaped $ char 'g' *> squoted decimal+ , escaped $ char 'g' *> squoted (relative m)+ ]+ relative m = do+ op <- (-) <$ char '-' <|> (+) <$ char '+'+ n <- decimal+ pure $ m `op` n + 1++anchors :: ParserST [Anchor]+anchors = do+ Options {..} <- pOptions <$> getPattern+ choice+ [ string "^" $> if oMultiline then mlCaret else caret+ , string "$" $> if oMultiline then mlDollar else dollar+ , string "\\A" $> [Start]+ , string "\\Z" $> [End, EndBeforeNewline]+ , string "\\z" $> [End]+ , string "\\b" $> [WordBoundary, Start, End]+ , string "\\B" $> [WordInternal]+ , string "\\G" >>= \_ -> eNotSupported "start-of-match anchor"+ , string "\\K" >>= \_ -> eNotSupported "start-of-match reset"+ ]+ where+ caret = [Start]+ mlCaret = [Start, AfterNewline]+ dollar = [End, EndBeforeNewline]+ mlDollar = [End, EndBeforeNewline, BeforeNewline]++conditional :: ParserST Part+conditional = string "(?" *> paren (choice+ [ decimal >> eNoConditionals+ , char '+' *> decimal >> eNoConditionals+ , char '-' *> decimal >> eNoConditionals+ , char 'R' *> decimal >> eNoConditionals+ , string "R&" *> groupName ')' >> eNoConditionals+ , char 'R' >> eNoConditionals+ , angled (groupName '>') >> eNoConditionals+ , squoted (groupName '\'') >> eNoConditionals+ , groupName ')' >> eNoConditionals+ , string "DEFINE" >> eNoConditionals+ , lookAround >> eNoConditionals+ , takeTill (==')') >> eMalformed+ ])+ where+ eMalformed = eParserError "malformed name or number after '(?('"+ eNoConditionals = eNotSupported "conditionals"++empty' :: ParserST Part+empty' = pure Empty++lookAround :: ParserST ()+lookAround = lookAround' *> eNotSupported "lookarounds" <?> "lookaround"+ where+ lookAround' = aheadPos <|> aheadNeg <|> behindPos <|> behindNeg+ aheadPos = string "(?=" *> content <* char ')'+ aheadNeg = string "(?!" *> content <* char ')'+ behindPos = string "(?<=" *> content <* char ')'+ behindNeg = string "(?<!" *> content <* char ')'+ content = many $ satisfy (/=')')++verb :: ParserST ()+verb = paren $ char '*' *> choice+ [ string "ACCEPT" >> eNoBacktrackVerbs+ , string "FAIL" >> eNoBacktrackVerbs+ , string "F" >> eNoBacktrackVerbs+ , string "MARK:" *> name >> eNoBacktrackVerbs+ , string ":" *> name >> eNoBacktrackVerbs+ , string "COMMIT:" *> name >> eNoBacktrackVerbs+ , string "COMMIT" >> eNoBacktrackVerbs+ , string "PRUNE:" *> name >> eNoBacktrackVerbs+ , string "PRUNE" >> eNoBacktrackVerbs+ , string "SKIP:" *> name >> eNoBacktrackVerbs+ , string "SKIP" >> eNoBacktrackVerbs+ , takeTill (==')') >>= eNoSuchVerb . show+ ]+ where+ eNoBacktrackVerbs = eNotSupported "backtracking verbs"+ name = takeTill (/=')')++globalOption :: ParserST ()+globalOption = paren $ char '*' >> choice+ [ () <$ string "LIMIT_MATCH=" <* decimal+ , () <$ string "LIMIT_RECURSION=" <* decimal+ , () <$ string "NO_AUTO_POSSESS"+ , () <$ string "NO_START_OPT"+ , () <$ string "BSR_ANYCRLF"+ , string "BSR_UNICODE" >> noUnicode+ , string "UTF8" >> noUnicode+ , string "UTF16" >> noUnicode+ , string "UTF32" >> noUnicode+ , string "UTF" >> noUnicode+ , string "UCP" >> noUnicode+ , string "CRLF" >> noCRLF+ , string "ANYCRLF" >> setLineEnds AnyCRLF+ , string "ANY" >> setLineEnds Any+ , string "CR" >> setLineEnds CR+ , string "LF" >> setLineEnds LF+ , takeTill (==')') >>= eBadOpt+ ]+ where+ eBadOpt s = eParserError $ "bad global option: " ++ show s+ noUnicode = eNotSupported "unicode"+ noCRLF = eNotSupported "crlf line ends"++localOption :: ParserST ()+localOption = paren $ do+ char '?'+ options+ checkOptions =<< fmap pOptions getPattern+ where+ options = posOpts <* char '-' <* negOpts <|> posOpts+ posOpts = () <$ many (option True)+ negOpts = () <$ many (option False)+ setUngreedy b = setStrategy $ if b then Lazy else Greedy+ option b = choice+ [ setIgnoreCase b <* char 'i'+ , setMultiline b <* char 'm'+ , setDupNames b <* char 'J'+ , setDotAll b <* char 's'+ , setUngreedy b <* char 'U'+ , setFreeSpacing b <* char 'x'+ ]++comment :: ParserST ()+comment = do+ ignoreSpace <- oFreeSpacing . pOptions <$> getPattern+ () <$ (spaceIf ignoreSpace <|> comment')+ where+ spaceIf b = guard b *> fmap S.singleton (satisfy Char.isSpace)+ comment' = paren $ string "?#" *> takeTill (==')')++callout :: ParserST ()+callout = paren $+ string "?C" *> takeTill (==')') *> eNotSupported "callouts"++parts :: ParserST Part+parts = parts' <* many comment+ where+ parts' = alt anchored <|> anchored+ anchored = sequence `anch` anchored <|> sequence+ sequence = nonEmptySeq <$> many grouping+ grouping = quantified atom' <|> atom'+ atom' = silent *> atom' <|> atom+ atom = reference <|> conditional <|> call <|> group <|> forbidden <|> cclass <|> byte+ silent = localOption <|> verb <|> lookAround <|> callout <|> comment+ alt p = Alternative .: (:) <$> p <*> some (char '|' *> p)+ p `anch` q = choice+ [ Anchored <$> p <*> anchors <*> q+ , Anchored <$> empty' <*> anchors <*> q+ , Anchored <$> p <*> anchors <*> empty'+ ]++parsePatternOpts :: Options -> S.ByteString -> IO Pattern+parsePatternOpts o bs = case parseSTOpts o parts' bs of+ Left e -> X.throwIO $ EParserError e+ Right (pattern,ps) -> do+ checkOptions o+ let groups = pGroups pattern+ topLevel = Group 0 ps+ groups' = Map.insert 0 topLevel groups+ pattern' = pattern {pGroups = groups'}+ pure pattern'+ where+ parts' = many globalOption *> parts <* endOfInput++parsePattern :: S.ByteString -> IO Pattern+parsePattern = parsePatternOpts defaultOptions++checkOptions :: MonadThrow m => Options -> m ()+checkOptions Options {..}+ | oRecursion = eNotSupported "recursion"+ | oDefaultStrategy /= Greedy = eNotSupported "lazy quantifiers"+ | oDupNames = eNotSupported "duplicate group names"+ | oLineEnds == Any = eNotSupported "unicode"+ | oLineEnds == CRLF = eNotSupported "crlf line ends"+ | otherwise = pure ()
+ src/Text/Regex/Regen/ParserST.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE RecordWildCards #-}+module Text.Regex.Regen.ParserST where++import Control.Applicative (Alternative(..))+import Control.Monad (guard, when)+import Control.Monad.Catch (MonadThrow(..))+import Data.Attoparsec.Types ()+import Data.Char (chr, ord)+import Data.Functor (($>))+import Numeric (showHex, showOct)+import qualified Control.Exception as X+import qualified Data.Attoparsec.ByteString.Char8 as P+import qualified Data.Attoparsec.Combinator as P+import qualified Data.ByteString.Char8 as S+import qualified Data.Map as Map++import Text.Regex.Regen.Pattern+import Text.Regex.Regen.PatternException++newtype ParserST a = ParserST+ { runParserST :: Pattern -> P.Parser (Pattern, a) }+instance Functor ParserST where+ fmap f p = ParserST $ \s -> do+ (s', a) <- runParserST p s+ pure (s', f a)+instance Applicative ParserST where+ pure a = ParserST $ \s -> pure (s, a)+ f <*> m = ParserST $ \s -> do+ (s', g) <- runParserST f s+ (s'', a) <- runParserST m s'+ pure (s'', g a)+instance Alternative ParserST where+ empty = ParserST $ \s -> mempty+ p <|> q = ParserST $ \s -> runParserST p s <|> runParserST q s+instance Monoid (ParserST a) where+ mempty = lift mempty+ mappend = (<|>)+instance Monad ParserST where+ m >>= f = ParserST $ \s -> do+ (s', a) <- runParserST m s+ (s'', b) <- runParserST (f a) s'+ pure (s'', b)+instance MonadThrow ParserST where+ throwM e = ParserST $ \_ -> X.throw e++getPattern :: ParserST Pattern+getPattern = ParserST $ \s -> pure (s,s)++putPattern :: Pattern -> ParserST ()+putPattern s = ParserST $ \_ -> pure (s,())++modifyPattern :: (Pattern -> (Pattern, a)) -> ParserST a+modifyPattern f = ParserST $ \s -> pure (f s)++modifyPattern' :: (Pattern -> Pattern) -> ParserST ()+modifyPattern' f = modifyPattern $ \s -> (f s, ())++modifyOptions :: (Options -> (Options, a)) -> ParserST a+modifyOptions f = modifyPattern $ \s -> let (o,a) = f (pOptions s)+ in (s { pOptions = o }, a)++modifyOptions' :: (Options -> Options) -> ParserST ()+modifyOptions' f = modifyOptions $ \o -> (f o, ())++setIgnoreCase, setMultiline, setDupNames, setDotAll, setFreeSpacing :: Bool -> ParserST ()+setIgnoreCase b = modifyOptions' $ \o -> o { oIgnoreCase = b }+setMultiline b = modifyOptions' $ \o -> o { oMultiline = b }+setDupNames b = modifyOptions' $ \o -> o { oDupNames = b }+setDotAll b = modifyOptions' $ \o -> o { oDotAll = b }+setFreeSpacing b = modifyOptions' $ \o -> o { oFreeSpacing = b }++setStrategy :: Strategy -> ParserST ()+setStrategy s = modifyOptions' $ \o -> o { oDefaultStrategy = s }++setLineEnds :: LineEnds -> ParserST ()+setLineEnds n = modifyOptions' $ \o -> o { oLineEnds = n }++nextGroupNum :: ParserST Int+nextGroupNum = modifyPattern $+ \p -> let n = pGroupCount p + 1 in (p { pGroupCount = n }, n)++addGroup :: Int -> Part -> ParserST ()+addGroup n part = modifyPattern' $+ \p -> p { pGroups = Map.insert n (Group n part) (pGroups p) }++groupNumInUse :: Int -> ParserST Bool+groupNumInUse n = do+ Pattern {..} <- getPattern+ pure $ 0 < n && n <= pGroupCount++groupNameInUse :: S.ByteString -> ParserST Bool+groupNameInUse bs = do+ Pattern {..} <- getPattern+ pure $ bs `elem` Map.keys pGroupNames++lookupGroupIndex :: S.ByteString -> ParserST (Maybe Int)+lookupGroupIndex bs = do+ Pattern {..} <- getPattern+ pure $ Map.lookup bs pGroupNames++addNamedGroup :: S.ByteString -> Int -> Part -> ParserST ()+addNamedGroup bs n part = do+ inUse <- groupNameInUse bs+ when inUse $ eDupGroupName bs+ addGroup n part+ modifyPattern' $+ \p -> p { pGroupNames = Map.insert bs n (pGroupNames p) }++lift :: P.Parser a -> ParserST a+lift p = ParserST $ \s -> (,) s <$> p++char :: Char -> ParserST Char+char = lift . P.char++string :: S.ByteString -> ParserST S.ByteString+string = lift . P.string++satisfy :: (Char -> Bool) -> ParserST Char+satisfy = lift . P.satisfy++endOfInput :: ParserST ()+endOfInput = lift P.endOfInput++cInRange :: Char -> Char -> ParserST Char+cInRange l u = satisfy $ \c -> l <= c && c <= u++decimal :: Integral a => ParserST a+decimal = lift P.decimal++lookAhead :: ParserST a -> ParserST a+lookAhead p = ParserST $ \s -> P.lookAhead (runParserST p s)++choice :: [ParserST a] -> ParserST a+choice ps = ParserST $ \s -> P.choice (ps' s)+ where+ ps' s = (\p -> runParserST p s) <$> ps++infix 0 <?> +(<?>) :: ParserST a -> String -> ParserST a+p <?> t = ParserST $ \s -> runParserST p s P.<?> t++peekChar :: ParserST (Maybe Char)+peekChar = lift P.peekChar++notFollowedBy :: ParserST a -> Char -> ParserST a+p `notFollowedBy` c = do+ x <- p+ m <- peekChar+ guard $ m /= Just c+ return x++peek :: ParserST a -> ParserST (Maybe a)+peek p = (Just <$> lookAhead p) <|> return Nothing++till :: ParserST a -> S.ByteString -> ParserST [a]+till p s = reverse <$> go []+ where+ go acc = do+ mb <- peek $ string s+ case mb of+ Just t | t == s -> string s $> acc+ _ -> p >>= \a -> go $ a:acc++takeWhile :: (Char -> Bool) -> ParserST S.ByteString+takeWhile p = lift $ P.takeWhile p++takeTill :: (Char -> Bool) -> ParserST S.ByteString+takeTill p = lift $ P.takeTill p++paren, bracketed, braced, angled, squoted, escaped :: ParserST a -> ParserST a+paren p = char '(' *> p <* char ')'+braced p = char '{' *> p <* char '}'+bracketed p = char '[' *> p <* char ']'+angled p = char '<' *> p <* char '>'+squoted p = char '\'' *> p <* char '\''+escaped p = char '\\' *> p++digit, letter :: ParserST Char+digit = lift P.digit+letter = lift P.letter_ascii++hexByte :: ParserST Char+hexByte = inRange $ char 'x' *> (byte' <|> braced byte' <|> pure '\0')+ where+ byte' = byte2 <|> byte1+ byte2 = decode <$> hexDigit <*> hexDigit+ byte1 = decode <$> pure 0 <*> hexDigit+ decode a b = chr $ (a * 0x10) + b+ hexDigit = hexDigit09 <|> hexDigitaz <|> hexDigitAZ+ hexDigit09 = (\c -> ord c - ord '0' + 0x0) <$> cInRange '0' '9'+ hexDigitaz = (\c -> ord c - ord 'a' + 0xa) <$> cInRange 'a' 'z'+ hexDigitAZ = (\c -> ord c - ord 'A' + 0xA) <$> cInRange 'A' 'Z'++octalByte :: ParserST Char+octalByte = inRange $ byte' <|> char 'o' *> (braced byte' <|> eMissingBrace)+ where+ octDigit = (\c -> ord c - ord '0') <$> cInRange '0' '7'+ byte' = byte3 <|> byte2 <|> byte1+ byte3 = decode <$> octDigit <*> octDigit <*> octDigit+ byte2 = decode <$> pure 0 <*> octDigit <*> octDigit+ byte1 = decode <$> pure 0 <*> pure 0 <*> octDigit+ decode a b c = chr $ (a * 64) + (b * 8) + c+ eMissingBrace = eParserError "missing '{' after '\\o'"++inRange :: ParserST Char -> ParserST Char+inRange p = p >>= \c ->+ if '\x00' <= c && c <= '\x7f'+ then pure c+ else eParserError+ $ showString "octal and hex escapes must be in range "+ $ showRange '\x00' '\x7f' ""+ where+ showHex' c = showString "0x" . zeroPad 2 (showHex (ord c) "")+ showOct' c = zeroPad 3 $ showOct (ord c) ""+ zeroPad n s = showString (replicate (n - length s) '0') . showString s+ showHexR c d = showHex' c . showString "-" . showHex' d+ showOctR c d = showOct' c . showString "-" . showOct' d+ showRange c d = showHexR c d . showString " (" . showOctR c d . showString ")"++cescape :: ParserST Char+cescape = choice+ [ '\t' <$ char 't'+ , '\x1b' <$ char 'e'+ , '\n' <$ char 'n'+ , '\f' <$ char 'f'+ , '\r' <$ char 'r'+ , '\a' <$ char 'a'+ , '\v' <$ char 'v'+ , '\\' <$ char '\\'+ , char 'c' *> eNotSupported "'\\cx' escapes"+ ]++parseST :: ParserST a -> S.ByteString -> Either String (Pattern, a)+parseST = parseSTOpts defaultOptions++parseSTOpts :: Options -> ParserST a -> S.ByteString+ -> Either String (Pattern, a)+parseSTOpts o p = P.parseOnly $ runParserST p (emptyPattern o)
+ src/Text/Regex/Regen/Pattern.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE RecordWildCards #-}+module Text.Regex.Regen.Pattern where++import Control.Monad.Catch (MonadThrow)+import Data.Map (Map)+import Data.Monoid ((<>))+import qualified Data.ByteString.Char8 as S+import qualified Data.Map as Map++import Text.Regex.Regen.PatternException++data Pattern = Pattern+ { pGroups :: !(Map Int Group)+ , pGroupNames :: !(Map S.ByteString Int)+ , pGroupCount :: !Int+ , pOptions :: !Options+ } deriving (Show, Eq)++emptyPattern :: Options -> Pattern+emptyPattern = Pattern Map.empty Map.empty 0++lookupGroupByNum :: Int -> Pattern -> Maybe Group+lookupGroupByNum n Pattern {..} = Map.lookup n pGroups++lookupGroupByName :: S.ByteString -> Pattern -> Maybe Group+lookupGroupByName bs Pattern {..} = do+ n <- Map.lookup bs pGroupNames+ Map.lookup n pGroups++data Part+ = Empty+ | Byte Char+ | Sequence [Part]+ | CClass Bool [Char]+ | Quantified Part Range Strategy+ | Alternative [Part]+ | Reference Int+ | Call (Either Int S.ByteString)+ | Anchored Part [Anchor] Part+ deriving (Show, Eq)+instance Monoid Part where+ mempty = Empty+ Empty `mappend` p = p+ p `mappend` Empty = p+ Sequence ps1 `mappend` Sequence ps2 = nonEmptySeq $ ps1 <> ps2+ Sequence ps `mappend` p = nonEmptySeq $ reverse (p : reverse ps)+ p `mappend` Sequence ps = nonEmptySeq $ p : ps+ p1 `mappend` p2 = Sequence [p1,p2]++data Anchor+ = WordBoundary+ | WordInternal+ | Start+ | End+ | EndBeforeNewline+ | BeforeNewline+ | AfterNewline+ | StartOfMatch+ deriving (Show, Eq)++data Group = Group+ { gIndex :: !Int+ , gParts :: !Part+ } deriving (Show, Eq)++data Range = Range+ { rMin :: !Int+ , rMax :: !(Maybe Int)+ } deriving (Show, Eq)++oLineEndChars :: Options -> [Char]+oLineEndChars o = case oLineEnds o of+ CR -> ['\r']+ LF -> ['\n']+ CRLF -> []+ AnyCRLF -> ['\r','\n']+ Any -> ['\r','\n']++nonEmptyAltM :: MonadThrow m => [Part] -> m Part+nonEmptyAltM [] = eUnsatisfiable+nonEmptyAltM ps = pure $ Alternative ps++nonEmptyCClassM :: MonadThrow m => (Char -> Bool) -> [Char] -> m Part+nonEmptyCClassM p cs = case filter p cs of+ [] -> eUnsatisfiable+ cs' -> pure $ CClass True cs'++nonEmptyQuantM :: MonadThrow m => Part -> Range -> Strategy -> m Part+nonEmptyQuantM p (Range 0 (Just 0)) s = eUnsatisfiable+nonEmptyQuantM p (Range 0 m) s = pure $ Quantified p (Range 1 m) s+nonEmptyQuantM p r s = pure $ Quantified p r s++nonEmptyAlt :: [Part] -> Part+nonEmptyAlt [] = Empty+nonEmptyAlt ps = Alternative ps++nonEmptySeq :: [Part] -> Part+nonEmptySeq [] = Empty+nonEmptySeq ps = Sequence ps++data Options = Options+ { oDefaultStrategy :: !Strategy+ , oMultiline :: !Bool+ , oIgnoreCase :: !Bool+ , oLineEnds :: !LineEnds+ , oRecursion :: !Bool+ , oDotAll :: !Bool+ , oFreeSpacing :: !Bool+ , oDupNames :: !Bool+ } deriving (Show, Eq)++defaultOptions :: Options+defaultOptions = Options+ { oDefaultStrategy = Greedy+ , oMultiline = False+ , oIgnoreCase = False+ , oLineEnds = AnyCRLF+ , oRecursion = False+ , oDotAll = False+ , oFreeSpacing = False+ , oDupNames = False+ }++data LineEnds+ = CR -- \r+ | LF -- \n+ | CRLF -- \r\n+ | AnyCRLF -- (\r|\n|\r\n)+ | Any -- Any unicode newline sequence+ deriving (Show, Eq)++data Strategy+ = Greedy+ | Lazy+ | Possessive+ deriving (Show, Eq)
+ src/Text/Regex/Regen/PatternException.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-}+module Text.Regex.Regen.PatternException where++import Control.Monad.Catch (MonadThrow(..))+import Data.Typeable (Typeable(..))+import qualified Control.Exception as X+import qualified Data.ByteString.Char8 as S++data PatternException+ = EParserError String+ | EGenError String+ | ENotSupported String+ | ENoSuchClass String+ | ENoSuchVerb String+ | EBadGroupName S.ByteString+ | EDupGroupName S.ByteString+ | ENoSuchIndex (Either Int S.ByteString)+ | EClassOutOfOrder+ | EQuantOutOfOrder+ deriving (Eq, Typeable)+instance Show PatternException where+ show (EParserError s) = "parser error: " ++ s+ show (EGenError s) = "generator error: " ++ s+ show (ENotSupported s) = s ++ " not supported"+ show (ENoSuchClass s) = "unknown POSIX class name: " ++ show s+ show (ENoSuchVerb s) = "verb not recognized or malformed: " ++ s+ show (EBadGroupName s) = "bad sub-pattern name: " ++ show s+ show (EDupGroupName s) = "duplicate sub-pattern name: " ++ show s+ show (ENoSuchIndex e) = "non-existent sub-pattern: " ++ either show show e+ show EClassOutOfOrder = "out of order range in character class"+ show EQuantOutOfOrder = "numbers out of order in quantifier"+instance X.Exception PatternException++eParserError, eGenError, eNotSupported, eNoSuchClass, eNoSuchVerb :: MonadThrow m => String -> m a+eParserError = throwM . EParserError+eGenError = throwM . EGenError+eNotSupported = throwM . ENotSupported+eNoSuchClass = throwM . ENoSuchClass+eNoSuchVerb = throwM . ENoSuchVerb++eBadGroupName, eDupGroupName :: MonadThrow m => S.ByteString -> m a+eBadGroupName = throwM . EBadGroupName+eDupGroupName = throwM . EDupGroupName++eNoSuchIndex :: MonadThrow m => Either Int S.ByteString -> m a+eNoSuchIndex = throwM . ENoSuchIndex++eClassOutOfOrder, eQuantOutOfOrder, eUnsatisfiable :: MonadThrow m => m a+eClassOutOfOrder = throwM EClassOutOfOrder+eQuantOutOfOrder = throwM EQuantOutOfOrder+eUnsatisfiable = eGenError "pattern unsatisfiable"++isPatternException :: X.Exception e => e -> Bool+isPatternException e = case X.fromException (X.toException e) of+ Just (pe::PatternException) -> True+ Nothing -> False++isEParserError :: PatternException -> Bool+isEParserError (EParserError _) = True+isEParserError _ = False++isEGenError :: PatternException -> Bool+isEGenError (EGenError _) = True+isEGenError _ = False++isENotSupported :: PatternException -> Bool+isENotSupported (ENotSupported _) = True+isENotSupported _ = False++isENoSuchClass :: PatternException -> Bool+isENoSuchClass (ENoSuchClass _) = True+isENoSuchClass _ = False++isEBadGroupName :: PatternException -> Bool+isEBadGroupName (EBadGroupName _) = True+isEBadGroupName _ = False++isEDupGroupName :: PatternException -> Bool+isEDupGroupName (EDupGroupName _) = True+isEDupGroupName _ = False++isENoSuchVerb :: PatternException -> Bool+isENoSuchVerb (ENoSuchVerb _) = True+isENoSuchVerb _ = False++isENoSuchIndex :: PatternException -> Bool+isENoSuchIndex (ENoSuchIndex _) = True+isENoSuchIndex _ = False++isEClassOutOfOrder :: PatternException -> Bool+isEClassOutOfOrder EClassOutOfOrder = True+isEClassOutOfOrder _ = False++isEQuantOutOfOrder :: PatternException -> Bool+isEQuantOutOfOrder EQuantOutOfOrder = True+isEQuantOutOfOrder _ = False+
+ src/Text/Regex/Regen/Util.hs view
@@ -0,0 +1,31 @@+module Text.Regex.Regen.Util where++import Control.Monad.Catch (Exception, MonadCatch, SomeException, try)+import Data.Either (either)++mwhen :: Monoid m => Bool -> m -> m+mwhen b m = if b then m else mempty++munless :: Monoid m => Bool -> m -> m+munless b m = if b then mempty else m++infixr 8 .:+(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d+(.:) = (.).(.)++infixr 3 &&&+(&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool+p &&& q = \a -> p a && q a++infixr 2 |||+(|||) :: (a -> Bool) -> (a -> Bool) -> a -> Bool+p ||| q = \a -> p a || q a++hush :: Either e a -> Maybe a+hush = either (const Nothing) Just++tryMaybe :: MonadCatch m => m a -> m (Maybe a)+tryMaybe m = hush <$> try' m+ where+ try' :: MonadCatch m => m a -> m (Either SomeException a)+ try' = try
+ test/Gen.hs view
@@ -0,0 +1,345 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Exception (evaluate)+import System.Random+import Test.Hspec+import Test.HUnit.Lang+import Control.Monad (when)+import Text.Regex.PCRE+import qualified Data.ByteString.Char8 as S++import Text.Regex.Regen++shouldGenOpts :: StdGen -> Options -> S.ByteString -> Expectation+shouldGenOpts gen o reg = do+ p <- parsePatternOpts o reg+ case let (e,_) = generatePattern p gen in e of+ Left e -> assertFailure (eThrown e)+ Right bs -> do+ bs' <- evaluate $ bs =~ reg+ when (bs /= bs') $ assertFailure (eUnexp bs bs')+ where+ eThrown e = "`generate` threw exception on " ++ show reg ++ ": " ++ show e+ eUnexp bs bs' = show reg ++ " generated " ++ show bs ++ " but matched " ++ show bs'++main :: IO ()+main = do+ seed <- randomIO+ let gen = mkStdGen seed+ shouldGen = shouldGenOpts gen defaultOptions+ hspec $ test seed shouldGen++test :: Int -> (S.ByteString -> Expectation) -> Spec+test seed f = describe ("generate (seed = " ++ show seed ++ ")") $ mapM_ ($f)+ [ literals+ , classes+ , subpatterns+ , quantifiers+ , anchors+ , globalOpts+ , localOpts+ , verbs+ , callouts+ , lookarounds+ , calls+ ]++literals :: (S.ByteString -> Expectation) -> Spec+literals shouldGen = describe "handles literals and escapes" $ do+ it "accepts a literal string" $ shouldGen "foo"+ it "accepts an escaped literal" $ shouldGen "\\F\\H\\8\\9"+ it "accepts hex escapes" $ shouldGen "\\x0\\x61\\x{62}\\x7f"+ it "accepts octal escapes" $ shouldGen "\\0\\o{141}\\177"+ it "accepts whitespace escape" $ shouldGen "\\R"+ it "accepts C escapes" $ shouldGen "\\a\\n\\f\\t"+ it "accepts escaped specials" $ shouldGen "\\[\\(\\|\\$\\^\\.\\*"+ it "rejects out-of-range hex escapes" $+ generate "\\x80" `shouldThrow` isEParserError+ it "rejects out-of-range octal escapes" $+ generate "\\200" `shouldThrow` isEParserError+ it "rejects '\\C'" $+ generate "\\C" `shouldThrow` isENotSupported+ it "rejects '\\X'" $+ generate "\\X" `shouldThrow` isENotSupported+ it "rejects '\\L'" $+ generate "\\L" `shouldThrow` isENotSupported+ it "rejects '\\l'" $+ generate "\\l" `shouldThrow` isENotSupported+ it "rejects '\\U'" $+ generate "\\U" `shouldThrow` isENotSupported+ it "rejects '\\u'" $+ generate "\\u" `shouldThrow` isENotSupported+ it "rejects '\\Q'" $+ generate "\\Q" `shouldThrow` isENotSupported+ it "rejects '\\E'" $+ generate "\\E" `shouldThrow` isENotSupported+ it "rejects '\\o'" $+ generate "\\o" `shouldThrow` isEParserError+ it "rejects '\\cx'" $+ generate "\\c" `shouldThrow` isENotSupported++classes :: (S.ByteString -> Expectation) -> Spec+classes shouldGen = describe "handles character classes" $ do+ it "accepts '.'" $ shouldGen "."+ it "accepts character class" $ shouldGen "[asdf]"+ it "accepts negated class" $ shouldGen "[^asdf]"+ it "accepts class with '-'" $ shouldGen "[-]"+ it "accepts negated class with '-'" $ shouldGen "[^-]"+ it "accepts class with ']'" $ shouldGen "[]]"+ it "accepts negated class with ']'" $ shouldGen "[^]]"+ it "accepts class range" $ shouldGen "[a-c]"+ it "accepts multiple-range class" $ shouldGen "[a-cd-f]"+ it "accepts negated class range" $ shouldGen "[^A-z]"+ it "accepts canned range in class" $ shouldGen "[\\d]"+ it "accepts negated canned range" $ shouldGen "[^\\d]"+ it "accepts posix class" $ shouldGen "[[:alpha:]]"+ it "accepts negated posix class" $ shouldGen "[^[:alpha:]]"+ it "accepts class with everything" $ shouldGen "[]\\wxa-b[:digit:]-]"+ it "accepts partial posix class" $ shouldGen "[[:f]"+ it "accepts class with repeats" $ shouldGen "[ooo]"+ it "accepts class with escapes" $ shouldGen "[\\x61\\141\\0\\n\\A]"+ it "accepts canned classes" $ shouldGen "\\d\\D\\w\\W"+ it "rejects malformed class ranges" $+ generate "[z-a]" `shouldThrow` isEClassOutOfOrder+ it "rejects good property ranges" $+ generate "\\p{Ll}" `shouldThrow` isENotSupported+ it "rejects bad property ranges" $+ generate "\\p{bad}" `shouldThrow` isENotSupported+ it "rejects unicode '\\X'" $+ generate "\\X" `shouldThrow` isENotSupported+ it "rejects unicode '\\C'" $+ generate "\\C" `shouldThrow` isENotSupported+ it "rejects posix range out of class" $+ generate "[:alpha:]" `shouldThrow` isENotSupported+ it "rejects bad posix classes" $+ generate "[[:foo:]]" `shouldThrow` isENoSuchClass++subpatterns :: (S.ByteString -> Expectation) -> Spec+subpatterns shouldGen = describe "handles subpatterns" $ do+ it "accepts numbered groups" $ shouldGen "(x)\\1"+ it "accepts each numbered ref syntax" $ shouldGen "(x)\\1\\g1\\g{1}"+ it "accepts nested numbered groups" $ shouldGen "((x)y)\\1\\2"+ it "accepts named groups" $ shouldGen "(?P<foo>x)(?P=foo)"+ it "accepts numbered refs to named groups" $ shouldGen "(?P<foo>x)\\1"+ it "accepts non-capturing groups" $ shouldGen "(?:foo)(x)\\1"+ it "accepts atomic groups" $ shouldGen "(?>foo)(x)\\1"+ it "accepts relative group refs" $+ shouldGen "(x)(y)(z)\\g{-2}\\g{-1}\\g{-3}"+ it "accepts nested named groups" $+ shouldGen "(?P<xy>(?P<x>x)y)(?P=xy)(?P=x)"+ it "accepts each named group syntax" $+ shouldGen "(?<x>x)(?'y'y)(?P<z>z)(?P=x)(?P=z)(?P=y)"+ it "accepts each named ref syntax" $+ shouldGen "(?<x>x)\\k'x'\\k<x>\\k{x}\\g{x}(?P=x)"+ it "rejects duplicate ref names" $+ generate "(?<x>x)(?<x>y)" `shouldThrow` isEDupGroupName+ it "rejects refs to non-existent group numbers" $+ generate "\\g1" `shouldThrow` isENoSuchIndex+ it "rejects refs to non-existent group names" $+ generate "(?P=foo)" `shouldThrow` isENoSuchIndex+ it "rejects bad group names" $+ generate "(?P<9foo>)" `shouldThrow` isEBadGroupName+ it "rejects bad group names in references" $+ generate "(?P=9foo)" `shouldThrow` isEBadGroupName+ it "rejects reset groups" $+ generate "(?|foo)" `shouldThrow` isENotSupported++quantifiers :: (S.ByteString -> Expectation) -> Spec+quantifiers shouldGen = describe "handles quantifiers" $ do+ it "accepts fixed quantifiers" $ shouldGen "a{5}"+ it "accepts bounded quantifiers" $ shouldGen "a{1,3}"+ it "accepts upper-bounded quantifiers" $ shouldGen "a{,3}"+ it "accepts lower-bounded quantifiers" $ shouldGen "a{3,}"+ it "accepts star quantifer" $ shouldGen "a*"+ it "accepts plus quantifer" $ shouldGen "a+"+ it "accepts question-mark quantifier" $ shouldGen "a?"+ it "accepts quantified char classes" $ shouldGen "[asdf]{1,3}"+ it "accepts quantified C escapes" $ shouldGen "\\a{1,3}"+ it "accepts quantified canned classes" $ shouldGen "\\d{1,3}"+ it "accepts quantified hex escapes" $ shouldGen "\\x61{1,3}"+ it "accepts quantified octal escapes" $ shouldGen "\\141{1,3}"+ it "accepts quantified dot" $ shouldGen ".{1,3}"+ it "accepts quantified groups" $ shouldGen "(asdf){1,3}"+ it "rejects lazy quantifiers" $+ generate "a{1,3}?a" `shouldThrow` isENotSupported+ it "rejects possessive quantifiers" $+ generate "a{1,3}+a" `shouldThrow` isENotSupported+ it "rejects out-of-order ranges in quantifiers" $+ generate "a{3,1}" `shouldThrow` isEQuantOutOfOrder+ it "rejects naked quantifiers" $+ generate "{1,3}" `shouldThrow` isEParserError+ it "rejects quantifier after quantifier" $+ generate "a{1,3}{1,3}" `shouldThrow` isEParserError+ it "rejects quantifier after anchor" $+ generate "^{1,3}" `shouldThrow` isEParserError++anchors :: (S.ByteString -> Expectation) -> Spec+anchors shouldGen = describe "handles anchors" $ do+ describe "carat" $ do+ it "works at start of pattern" $ shouldGen "^foo"+ it "works in alternation" $ shouldGen "aa|^zz"+ it "fails within pattern" $+ generate "a^" `shouldThrow` isEGenError+ describe "dollar" $ do+ it "works at end of pattern" $ shouldGen "foo$"+ it "works in alternation" $ shouldGen "aa$|zz"+ it "works before newlines" $ shouldGen "foo$\\n\\n"+ it "fails within pattern" $+ generate "$a" `shouldThrow` isEGenError+ describe "\\A" $ do+ it "works at start of pattern" $ shouldGen "\\Afoo"+ it "works in alteration" $ shouldGen "aa|\\Azz"+ it "fails within pattern" $+ generate "a\\A" `shouldThrow` isEGenError+ describe "\\Z" $ do+ it "works at end of pattern" $ shouldGen "foo\\Z"+ it "works in alternation" $ shouldGen "aa\\Z|zz"+ it "fails within pattern" $+ generate "\\Za" `shouldThrow` isEGenError+ describe "\\z" $ do+ it "works at end of pattern" $ shouldGen "foo\\z"+ it "works in alternation" $ shouldGen "aa\\z|zz"+ it "fails within pattern" $+ generate "\\za" `shouldThrow` isEGenError+ describe "\\b" $ do+ it "works before space" $ shouldGen "foo\\b bar"+ it "works after space" $ shouldGen "foo \\bbar"+ it "works at start of pattern" $ shouldGen "\\baa"+ it "works at end of pattern" $ shouldGen "zz\\b"+ it "fails within word" $+ generate "foo\\bbar" `shouldThrow` isEGenError+ describe "\\B" $ do+ it "works within word" $ shouldGen "foo\\Bbar"+ it "fails before space" $+ generate "foo\\B bar" `shouldThrow` isEGenError+ it "fails after space" $+ generate "foo \\Bbar" `shouldThrow` isEGenError+ it "fails at start of pattern" $+ generate "\\Baa" `shouldThrow` isEGenError+ it "fails at end of pattern" $+ generate "zz\\B" `shouldThrow` isEGenError+ describe "\\G" $ do+ it "is unsupported" $+ generate "foo\\G." `shouldThrow` isENotSupported++globalOpts :: (S.ByteString -> Expectation) -> Spec+globalOpts shouldGen = describe "global options" $ do+ it "ignores 'LIMIT_MATCH='" $ shouldGen "(*LIMIT_MATCH=10)foo"+ it "ignores 'LIMIT_RECURSION='" $ shouldGen "(*LIMIT_RECURSION=10)foo"+ it "ignores 'NO_AUTO_POSSESS'" $ shouldGen "(*NO_AUTO_POSSESS)foo"+ it "ignores 'NO_START_OPT'" $ shouldGen "(*NO_START_OPT)foo"+ it "ignores 'BSR_ANYCRLF'" $ shouldGen "(*BSR_ANYCRLF)foo"+ it "allows 'LF'" $ shouldGen "(*LF)foo"+ it "allows 'CR'" $ shouldGen "(*CR)foo"+ it "allows 'ANY'" $ shouldGen "(*ANY)foo"+ it "allows 'ANYCRLF'" $ shouldGen "(*ANYCRLF)foo"+ it "rejects 'CRLF'" $+ generate "(*CRLF)foo" `shouldThrow` isENotSupported+ it "rejects 'BSR_UNICODE'" $+ generate "(*BSR_UNICODE)foo" `shouldThrow` isENotSupported+ it "rejects 'UTF8'" $+ generate "(*UTF8)foo" `shouldThrow` isENotSupported+ it "rejects 'UTF16'" $+ generate "(*UTF16)foo" `shouldThrow` isENotSupported+ it "rejects 'UTF32'" $+ generate "(*UTF32)foo" `shouldThrow` isENotSupported+ it "rejects 'UTF'" $+ generate "(*UTF)foo" `shouldThrow` isENotSupported+ it "rejects 'UCP'" $+ generate "(*UCP)foo" `shouldThrow` isENotSupported+ it "rejects bad global options" $+ generate "(*BLAH)foo" `shouldThrow` isEParserError++localOpts :: (S.ByteString -> Expectation) -> Spec+localOpts shouldGen = describe "local options" $ do+ it "allows setting ignore-case" $ shouldGen "(?i)asdf[asdf]{5}"+ it "allows unsetting ignore-case" $ shouldGen "(?i)asdf(?-i)asdf[asdf]{5}"+ it "allows unsetting multiline" $ shouldGen "(?-m)foo"+ it "allows unsetting dup-groups" $ shouldGen "(?-J)foo"+ it "allows setting dotall" $ shouldGen "(?s).{100}"+ it "allows unsetting dotall" $ shouldGen "(?s).{100}(?-s).{100}"+ it "allows unsetting ungreedy" $ shouldGen "(?-U)foo"+ it "allows setting free-spacing" $ shouldGen "(?x)a s\\td\\nf(?#x)g"+ it "allows unsetting free-spacing" $ shouldGen "(?x)a s(?-x)a s\\td\\nf(?#x)g"+ it "allows setting multi options" $ shouldGen "(?ix)a s\\td\\nf(?#x)g"+ it "allows unsetting multi options" $ shouldGen "(?ix)(?-ix)a s\\td\\nf(?#x)g"+ it "allows setting and unsetting" $ shouldGen "(?i)(?x-i)a s\\td\\nf(?#x)g"+ it "rejects setting dup-groups" $+ generate "(?J)foo" `shouldThrow` isENotSupported+ it "rejects setting ungreedy" $+ generate "(?U)foo" `shouldThrow` isENotSupported++verbs :: (S.ByteString -> Expectation) -> Spec+verbs _ = describe "backtracking verbs" $ do+ it "rejects 'ACCEPT' verb" $+ generate "foo(*ACCEPT)bar" `shouldThrow` isENotSupported+ it "rejects 'FAIL' verb" $+ generate "foo(*FAIL)bar" `shouldThrow` isENotSupported+ it "rejects 'F' verb" $+ generate "foo(*F)bar" `shouldThrow` isENotSupported+ it "rejects 'COMMIT' verb" $+ generate "foo(*COMMIT)bar" `shouldThrow` isENotSupported+ it "rejects 'PRUNE' verb" $+ generate "foo(*PRUNE)bar" `shouldThrow` isENotSupported+ it "rejects 'SKIP' verb" $+ generate "foo(*SKIP)bar" `shouldThrow` isENotSupported+ it "rejects 'MARK:' verb" $+ generate "foo(*MARK:blah)bar" `shouldThrow` isENotSupported+ it "rejects ':' verb" $+ generate "foo(*:blah)bar" `shouldThrow` isENotSupported+ it "rejects 'COMMIT:' verb" $+ generate "foo(*COMMIT:blah)bar" `shouldThrow` isENotSupported+ it "rejects 'PRUNE:' verb" $+ generate "foo(*PRUNE:blah)bar" `shouldThrow` isENotSupported+ it "rejects 'SKIP:' verb" $+ generate "foo(*SKIP:blah)bar" `shouldThrow` isENotSupported++callouts :: (S.ByteString -> Expectation) -> Spec+callouts _ = describe "callouts" $ do+ it "rejects callouts" $+ generate "(?C)" `shouldThrow` isENotSupported+ it "rejects callouts with arguments" $+ generate "(?C42)" `shouldThrow` isENotSupported++lookarounds :: (S.ByteString -> Expectation) -> Spec+lookarounds _ = describe "lookarounds" $ do+ it "rejects positive lookahead" $+ generate "(?=blah)" `shouldThrow` isENotSupported+ it "rejects negative lookahead" $+ generate "(?!blah)" `shouldThrow` isENotSupported+ it "rejects positive lookbehind" $+ generate "(?<=blah)" `shouldThrow` isENotSupported+ it "rejects negative lookbehind" $+ generate "(?<!blah)" `shouldThrow` isENotSupported++calls :: (S.ByteString -> Expectation) -> Spec+calls _ = describe "pattern calls" $ do+ it "rejects global recursive calls" $+ generate "(?R)" `shouldThrow` isENotSupported+ it "rejects absolutely numbered calls with (?n)" $+ generate "(...)(?1)" `shouldThrow` isENotSupported+ it "rejects relatively numbered calls with (?-n)" $+ generate "(...)(?-1)" `shouldThrow` isENotSupported+ it "rejects relatively numbered calls with (?+n)" $+ generate "(x)(?+1)(...)" `shouldThrow` isENotSupported+ it "rejects absolutely numbered calls with \\g'n'" $+ generate "(...)\\g'1'" `shouldThrow` isENotSupported+ it "rejects relatively numbered calls with \\g'-n'" $+ generate "(...)\\g'-1'" `shouldThrow` isENotSupported+ it "rejects relatively numbered calls with \\g'+n'" $+ generate "(x)\\g'+1'(...)" `shouldThrow` isENotSupported+ it "rejects absolutely numbered calls with \\g<n>" $+ generate "(...)\\g<1>" `shouldThrow` isENotSupported+ it "rejects relatively numbered calls with \\g<-n>" $+ generate "(...)\\g<-1>" `shouldThrow` isENotSupported+ it "rejects relatively numbered calls with \\g<+n>" $+ generate "(x)\\g<+1>(...)" `shouldThrow` isENotSupported+ it "rejects named calls with (?&)" $+ generate "(?<x>...)(?&x)" `shouldThrow` isENotSupported+ it "rejects named calls with (?P>)" $+ generate "(?<x>...)(?P>x)" `shouldThrow` isENotSupported+ it "rejects named calls with \\g''" $+ generate "(?<x>...)\\g'x'" `shouldThrow` isENotSupported+ it "rejects named calls with \\g<>" $+ generate "(?<x>...)\\g<x>" `shouldThrow` isENotSupported