{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Regex.KDE.Compile
  (compileRegex)
  where

import Data.Word (Word8)
import qualified Data.ByteString as B
import Data.ByteString (ByteString)
import qualified Data.ByteString.UTF8 as U
import Safe
import Data.Attoparsec.ByteString as A hiding (match)
import Data.Char
import Control.Applicative
import Regex.KDE.Regex
import Control.Monad.State.Strict
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#endif

-- | Compile a UTF-8 encoded ByteString as a Regex.  If the first
-- parameter is True, then the Regex will be case sensitive.
compileRegex :: Bool -> ByteString -> Either String Regex
compileRegex :: Bool -> ByteString -> Either String Regex
compileRegex Bool
caseSensitive ByteString
bs =
  let !res :: Either String Regex
res = Parser Regex -> ByteString -> Either String Regex
forall a. Parser a -> ByteString -> Either String a
parseOnly (StateT Int Parser Regex -> Int -> Parser Regex
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT Int Parser Regex
parser Int
0) ByteString
bs
   in Either String Regex
res
 where
   parser :: StateT Int Parser Regex
parser = do
     !Regex
re <- Bool -> StateT Int Parser Regex
pRegex Bool
caseSensitive
     (Regex
re Regex -> StateT Int Parser () -> StateT Int Parser Regex
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString () -> StateT Int Parser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput) StateT Int Parser Regex
-> StateT Int Parser Regex -> StateT Int Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       do ByteString
rest <- Parser ByteString ByteString -> StateT Int Parser ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser ByteString ByteString
A.takeByteString
          String -> StateT Int Parser Regex
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> StateT Int Parser Regex)
-> String -> StateT Int Parser Regex
forall a b. (a -> b) -> a -> b
$ String
"parse error at byte position " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                 Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
B.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
rest)

type RParser = StateT Int Parser

pRegex :: Bool -> RParser Regex
pRegex :: Bool -> StateT Int Parser Regex
pRegex Bool
caseSensitive =
  Regex -> StateT Int Parser Regex -> StateT Int Parser Regex
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Regex
MatchNull (StateT Int Parser Regex -> StateT Int Parser Regex)
-> StateT Int Parser Regex -> StateT Int Parser Regex
forall a b. (a -> b) -> a -> b
$
  (Regex -> Regex -> Regex) -> Regex -> [Regex] -> Regex
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Regex -> Regex -> Regex
MatchAlt
    (Regex -> [Regex] -> Regex)
-> StateT Int Parser Regex -> StateT Int Parser ([Regex] -> Regex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> StateT Int Parser Regex
pAltPart Bool
caseSensitive)
    StateT Int Parser ([Regex] -> Regex)
-> StateT Int Parser [Regex] -> StateT Int Parser Regex
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StateT Int Parser Regex -> StateT Int Parser [Regex]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (StateT Int Parser Regex -> StateT Int Parser [Regex])
-> StateT Int Parser Regex -> StateT Int Parser [Regex]
forall a b. (a -> b) -> a -> b
$ Parser ByteString Char -> StateT Int Parser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser ByteString Char
char Char
'|') StateT Int Parser Char
-> StateT Int Parser Regex -> StateT Int Parser Regex
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> StateT Int Parser Regex
pAltPart Bool
caseSensitive StateT Int Parser Regex
-> StateT Int Parser Regex -> StateT Int Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Regex -> StateT Int Parser Regex
forall (f :: * -> *) a. Applicative f => a -> f a
pure Regex
forall a. Monoid a => a
mempty))

pAltPart :: Bool -> RParser Regex
pAltPart :: Bool -> StateT Int Parser Regex
pAltPart Bool
caseSensitive = [Regex] -> Regex
forall a. Monoid a => [a] -> a
mconcat ([Regex] -> Regex)
-> StateT Int Parser [Regex] -> StateT Int Parser Regex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int Parser Regex -> StateT Int Parser [Regex]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Bool -> StateT Int Parser Regex
pRegexPart Bool
caseSensitive)

char :: Char -> Parser Char
char :: Char -> Parser ByteString Char
char Char
c =
  Char
c Char -> Parser ByteString Word8 -> Parser ByteString Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c))

pRegexPart :: Bool -> RParser Regex
pRegexPart :: Bool -> StateT Int Parser Regex
pRegexPart Bool
caseSensitive =
  (Parser Regex -> StateT Int Parser Regex
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Bool -> Parser Regex
pRegexChar Bool
caseSensitive) StateT Int Parser Regex
-> StateT Int Parser Regex -> StateT Int Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> StateT Int Parser Regex
pParenthesized Bool
caseSensitive) StateT Int Parser Regex
-> (Regex -> StateT Int Parser Regex) -> StateT Int Parser Regex
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     Parser Regex -> StateT Int Parser Regex
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Regex -> StateT Int Parser Regex)
-> (Regex -> Parser Regex) -> Regex -> StateT Int Parser Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> Parser Regex
pSuffix

pParenthesized :: Bool -> RParser Regex
pParenthesized :: Bool -> StateT Int Parser Regex
pParenthesized Bool
caseSensitive = do
  Word8
_ <- Parser ByteString Word8 -> StateT Int Parser Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
40))
  -- pcrepattern says: A group that starts with (?| resets the capturing
  -- parentheses numbers in each alternative.
  Bool
resetCaptureNumbers <- Bool -> StateT Int Parser Bool -> StateT Int Parser Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Bool
True Bool -> StateT Int Parser ByteString -> StateT Int Parser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString -> StateT Int Parser ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ByteString -> Parser ByteString ByteString
string ByteString
"?|"))
  Regex -> Regex
modifier <- if Bool
resetCaptureNumbers
                 then (Regex -> Regex) -> StateT Int Parser (Regex -> Regex)
forall (m :: * -> *) a. Monad m => a -> m a
return Regex -> Regex
forall a. a -> a
id
                 else Parser ByteString (Regex -> Regex)
-> StateT Int Parser (Regex -> Regex)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
63) Parser ByteString Word8
-> Parser ByteString (Regex -> Regex)
-> Parser ByteString (Regex -> Regex)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (Regex -> Regex)
pGroupModifiers)
                    StateT Int Parser (Regex -> Regex)
-> StateT Int Parser (Regex -> Regex)
-> StateT Int Parser (Regex -> Regex)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> Regex -> Regex
MatchCapture (Int -> Regex -> Regex)
-> StateT Int Parser Int -> StateT Int Parser (Regex -> Regex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int -> Int) -> StateT Int Parser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) StateT Int Parser ()
-> StateT Int Parser Int -> StateT Int Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT Int Parser Int
forall s (m :: * -> *). MonadState s m => m s
get))
  Int
currentCaptureNumber <- StateT Int Parser Int
forall s (m :: * -> *). MonadState s m => m s
get
  Regex
contents <- Regex -> StateT Int Parser Regex -> StateT Int Parser Regex
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Regex
MatchNull (StateT Int Parser Regex -> StateT Int Parser Regex)
-> StateT Int Parser Regex -> StateT Int Parser Regex
forall a b. (a -> b) -> a -> b
$
    (Regex -> Regex -> Regex) -> Regex -> [Regex] -> Regex
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Regex -> Regex -> Regex
MatchAlt
      (Regex -> [Regex] -> Regex)
-> StateT Int Parser Regex -> StateT Int Parser ([Regex] -> Regex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> StateT Int Parser Regex
pAltPart Bool
caseSensitive)
      StateT Int Parser ([Regex] -> Regex)
-> StateT Int Parser [Regex] -> StateT Int Parser Regex
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StateT Int Parser Regex -> StateT Int Parser [Regex]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (StateT Int Parser Regex -> StateT Int Parser [Regex])
-> StateT Int Parser Regex -> StateT Int Parser [Regex]
forall a b. (a -> b) -> a -> b
$ Parser ByteString Char -> StateT Int Parser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser ByteString Char
char Char
'|') StateT Int Parser Char
-> StateT Int Parser Regex -> StateT Int Parser Regex
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
            (((if Bool
resetCaptureNumbers
                  then Int -> StateT Int Parser ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Int
currentCaptureNumber
                  else () -> StateT Int Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) StateT Int Parser ()
-> StateT Int Parser Regex -> StateT Int Parser Regex
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> StateT Int Parser Regex
pAltPart Bool
caseSensitive) StateT Int Parser Regex
-> StateT Int Parser Regex -> StateT Int Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Regex -> StateT Int Parser Regex
forall (f :: * -> *) a. Applicative f => a -> f a
pure Regex
forall a. Monoid a => a
mempty))
  Word8
_ <- Parser ByteString Word8 -> StateT Int Parser Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
41))
  Regex -> StateT Int Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT Int Parser Regex)
-> Regex -> StateT Int Parser Regex
forall a b. (a -> b) -> a -> b
$ Regex -> Regex
modifier Regex
contents

pGroupModifiers :: Parser (Regex -> Regex)
pGroupModifiers :: Parser ByteString (Regex -> Regex)
pGroupModifiers =
  (Regex -> Regex
forall a. a -> a
id (Regex -> Regex)
-> Parser ByteString Char -> Parser ByteString (Regex -> Regex)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
':')
   Parser ByteString (Regex -> Regex)
-> Parser ByteString (Regex -> Regex)
-> Parser ByteString (Regex -> Regex)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     do Direction
dir <- Direction
-> Parser ByteString Direction -> Parser ByteString Direction
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Direction
Forward (Parser ByteString Direction -> Parser ByteString Direction)
-> Parser ByteString Direction -> Parser ByteString Direction
forall a b. (a -> b) -> a -> b
$ Direction
Backward Direction -> Parser ByteString Char -> Parser ByteString Direction
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
'<'
        (Direction -> Regex -> Regex
AssertPositive Direction
dir (Regex -> Regex)
-> Parser ByteString Char -> Parser ByteString (Regex -> Regex)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
'=') Parser ByteString (Regex -> Regex)
-> Parser ByteString (Regex -> Regex)
-> Parser ByteString (Regex -> Regex)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Direction -> Regex -> Regex
AssertNegative Direction
dir (Regex -> Regex)
-> Parser ByteString Char -> Parser ByteString (Regex -> Regex)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
'!')
   Parser ByteString (Regex -> Regex)
-> Parser ByteString (Regex -> Regex)
-> Parser ByteString (Regex -> Regex)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     do Word8
n <- (Word8 -> Bool) -> Parser ByteString Word8
satisfy (\Word8
d -> Word8
d Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
d Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57)
        (Regex -> Regex) -> Parser ByteString (Regex -> Regex)
forall (m :: * -> *) a. Monad m => a -> m a
return (\Regex
_ -> Int -> Regex
Subroutine (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48))
   Parser ByteString (Regex -> Regex)
-> Parser ByteString (Regex -> Regex)
-> Parser ByteString (Regex -> Regex)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     do Word8
_ <- (Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
82) -- R
        (Regex -> Regex) -> Parser ByteString (Regex -> Regex)
forall (m :: * -> *) a. Monad m => a -> m a
return  (\Regex
_ -> Int -> Regex
Subroutine Int
0)

pSuffix :: Regex -> Parser Regex
pSuffix :: Regex -> Parser Regex
pSuffix Regex
re = Regex -> Parser Regex -> Parser Regex
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Regex
re (Parser Regex -> Parser Regex) -> Parser Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ do
  Word8
w <- (Word8 -> Bool) -> Parser ByteString Word8
satisfy (\Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
42 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
43 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
63 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
123)
  (case Word8
w of
    Word8
42  -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ Regex -> Regex -> Regex
MatchAlt (Regex -> Regex
MatchSome Regex
re) Regex
MatchNull
    Word8
43  -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ Regex -> Regex
MatchSome Regex
re
    Word8
63  -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ Regex -> Regex -> Regex
MatchAlt Regex
re Regex
MatchNull
    Word8
123 -> do
      let isDig :: a -> Bool
isDig a
x = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
48 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
58
      Maybe Int
minn <- Maybe Int
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Maybe Int
forall a. Maybe a
Nothing (Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int))
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int)
-> (ByteString -> String) -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
U.toString (ByteString -> Maybe Int)
-> Parser ByteString ByteString -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile Word8 -> Bool
forall a. (Ord a, Num a) => a -> Bool
isDig
      Maybe Int
maxn <- Maybe Int
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Maybe Int
forall a. Maybe a
Nothing (Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int))
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
char Char
',' Parser ByteString Char
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                       (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int)
-> (ByteString -> String) -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
U.toString (ByteString -> Maybe Int)
-> Parser ByteString ByteString -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile Word8 -> Bool
forall a. (Ord a, Num a) => a -> Bool
isDig)
      Char
_ <- Char -> Parser ByteString Char
char Char
'}'
      case (Maybe Int
minn, Maybe Int
maxn) of
          (Maybe Int
Nothing, Maybe Int
Nothing) -> Parser Regex
forall (m :: * -> *) a. MonadPlus m => m a
mzero
          (Just Int
n, Maybe Int
Nothing)  -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$! Int -> Regex -> Regex
atleast Int
n Regex
re
          (Maybe Int
Nothing, Just Int
n)  -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$! Int -> Regex -> Regex
atmost Int
n Regex
re
          (Just Int
m, Just Int
n)   -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$! Int -> Int -> Regex -> Regex
between Int
m Int
n Regex
re
    Word8
_   -> String -> Parser Regex
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"pSuffix encountered impossible byte") Parser Regex -> (Regex -> Parser Regex) -> Parser Regex
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Regex -> Parser Regex
pQuantifierModifier
 where
   atmost :: Int -> Regex -> Regex
atmost Int
0 Regex
_ = Regex
MatchNull
   atmost Int
n Regex
r = Regex -> Regex -> Regex
MatchAlt ([Regex] -> Regex
forall a. Monoid a => [a] -> a
mconcat (Int -> Regex -> [Regex]
forall a. Int -> a -> [a]
replicate Int
n Regex
r)) (Int -> Regex -> Regex
atmost (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Regex
r)

   between :: Int -> Int -> Regex -> Regex
between Int
0 Int
n Regex
r = Int -> Regex -> Regex
atmost Int
n Regex
r
   between Int
m Int
n Regex
r = [Regex] -> Regex
forall a. Monoid a => [a] -> a
mconcat (Int -> Regex -> [Regex]
forall a. Int -> a -> [a]
replicate Int
m Regex
r) Regex -> Regex -> Regex
forall a. Semigroup a => a -> a -> a
<> Int -> Regex -> Regex
atmost (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) Regex
r

   atleast :: Int -> Regex -> Regex
atleast Int
n Regex
r = [Regex] -> Regex
forall a. Monoid a => [a] -> a
mconcat (Int -> Regex -> [Regex]
forall a. Int -> a -> [a]
replicate Int
n Regex
r) Regex -> Regex -> Regex
forall a. Semigroup a => a -> a -> a
<> Regex -> Regex -> Regex
MatchAlt (Regex -> Regex
MatchSome Regex
r) Regex
MatchNull

pQuantifierModifier :: Regex -> Parser Regex
pQuantifierModifier :: Regex -> Parser Regex
pQuantifierModifier Regex
re = Regex -> Parser Regex -> Parser Regex
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Regex
re (Parser Regex -> Parser Regex) -> Parser Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$
  (Regex -> Regex
Possessive Regex
re Regex -> Parser ByteString Word8 -> Parser Regex
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
43)) Parser Regex -> Parser Regex -> Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Regex -> Regex
Lazy Regex
re Regex -> Parser ByteString Word8 -> Parser Regex
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==Word8
63))

pRegexChar :: Bool -> Parser Regex
pRegexChar :: Bool -> Parser Regex
pRegexChar Bool
caseSensitive = do
  Word8
w <- (Word8 -> Bool) -> Parser ByteString Word8
satisfy ((Word8 -> Bool) -> Parser ByteString Word8)
-> (Word8 -> Bool) -> Parser ByteString Word8
forall a b. (a -> b) -> a -> b
$ Bool -> Word8 -> Bool
forall a b. a -> b -> a
const Bool
True
  case Word8
w of
    Word8
46  -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
MatchAnyChar
    Word8
37 -> (do -- dynamic %1 %2
              ByteString
ds <- (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (\Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57)
              case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (ByteString -> String
U.toString ByteString
ds) of
                Just !Int
n -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ Int -> Regex
MatchDynamic Int
n
                Maybe Int
Nothing -> String -> Parser Regex
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a number")
            Parser Regex -> Parser Regex -> Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> Regex
MatchChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%'))
    Word8
92  -> Parser Regex
pRegexEscapedChar
    Word8
36  -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
AssertEnd
    Word8
94  -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
AssertBeginning
    Word8
91  -> Parser Regex
pRegexCharClass
    Word8
_ | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128
      , Bool -> Bool
not (Word8 -> Bool
isSpecial Word8
w)
         -> do let c :: Char
c = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
               Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$! (Char -> Bool) -> Regex
MatchChar ((Char -> Bool) -> Regex) -> (Char -> Bool) -> Regex
forall a b. (a -> b) -> a -> b
$
                        if Bool
caseSensitive
                           then (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
                           else (\Char
d -> Char -> Char
toLower Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toLower Char
c)
      | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0xc0 -> do
          ByteString
rest <- case Word8
w of
                    Word8
_ | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0xf0 -> Int -> Parser ByteString ByteString
A.take Int
3
                      | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0xe0 -> Int -> Parser ByteString ByteString
A.take Int
2
                      | Bool
otherwise -> Int -> Parser ByteString ByteString
A.take Int
1
          case ByteString -> Maybe (Char, ByteString)
U.uncons (Word8 -> ByteString -> ByteString
B.cons Word8
w ByteString
rest) of
            Just (Char
d, ByteString
_) -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$! (Char -> Bool) -> Regex
MatchChar ((Char -> Bool) -> Regex) -> (Char -> Bool) -> Regex
forall a b. (a -> b) -> a -> b
$
                             if Bool
caseSensitive
                                then (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
d)
                                else (\Char
e -> Char -> Char
toLower Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toLower Char
d)
            Maybe (Char, ByteString)
Nothing     -> String -> Parser Regex
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not decode as UTF8"
      | Bool
otherwise -> Parser Regex
forall (m :: * -> *) a. MonadPlus m => m a
mzero

pRegexEscapedChar :: Parser Regex
pRegexEscapedChar :: Parser Regex
pRegexEscapedChar = do
  Char
c <- Parser ByteString Char
anyChar
  (case Char
c of
    Char
'b' -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
AssertWordBoundary
    Char
'{' -> do -- captured pattern: \1 \2 \{12}
              ByteString
ds <- (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (\Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57)
              Char
_ <- Char -> Parser ByteString Char
char Char
'}'
              case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (ByteString -> String
U.toString ByteString
ds) of
                Just !Int
n -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ Int -> Regex
MatchCaptured (Int -> Regex) -> Int -> Regex
forall a b. (a -> b) -> a -> b
$ Int
n
                Maybe Int
Nothing -> String -> Parser Regex
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a number"
    Char
'd' -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Regex
MatchChar Char -> Bool
isDigit
    Char
'D' -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Regex
MatchChar (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit)
    Char
's' -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Regex
MatchChar Char -> Bool
isSpace
    Char
'S' -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Regex
MatchChar (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)
    Char
'w' -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Regex
MatchChar Char -> Bool
isWordChar
    Char
'W' -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Regex
MatchChar (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isWordChar)
    Char
_ | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' ->
       Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$! Int -> Regex
MatchCaptured (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
      | Bool
otherwise -> Parser Regex
forall (m :: * -> *) a. MonadPlus m => m a
mzero) Parser Regex -> Parser Regex -> Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Char -> Bool) -> Regex
MatchChar ((Char -> Bool) -> Regex)
-> (Char -> Char -> Bool) -> Char -> Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Char -> Regex) -> Parser ByteString Char -> Parser Regex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser ByteString Char
pEscaped Char
c)

pEscaped :: Char -> Parser Char
pEscaped :: Char -> Parser ByteString Char
pEscaped Char
c =
  case Char
c of
    Char
'\\' -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
    Char
'a' -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\a'
    Char
'f' -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'
    Char
'n' -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
    Char
'r' -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'
    Char
't' -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'
    Char
'v' -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\v'
    Char
'0' -> do -- \0ooo matches octal ooo
      ByteString
ds <- Int -> Parser ByteString ByteString
A.take Int
3
      case String -> Maybe Char
forall a. Read a => String -> Maybe a
readMay (String
"'\\o" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
U.toString ByteString
ds String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") of
        Just Char
x  -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
        Maybe Char
Nothing -> String -> Parser ByteString Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid octal character escape"
    Char
_ | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'1' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'7' -> do
      -- \123 matches octal 123, \1 matches octal 1
      let octalDigitScanner :: a -> a -> Maybe a
octalDigitScanner a
s a
w
            | a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
3, a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
48 Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
55
                        = a -> Maybe a
forall a. a -> Maybe a
Just (a
s a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) -- digits 0-7
            | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
      ByteString
ds <- Int -> (Int -> Word8 -> Maybe Int) -> Parser ByteString ByteString
forall s.
s -> (s -> Word8 -> Maybe s) -> Parser ByteString ByteString
A.scan (Int
1 :: Int) Int -> Word8 -> Maybe Int
forall a a. (Ord a, Ord a, Num a, Num a) => a -> a -> Maybe a
octalDigitScanner
      case String -> Maybe Char
forall a. Read a => String -> Maybe a
readMay (String
"'\\o" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c] String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
U.toString ByteString
ds String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") of
        Just Char
x  -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
        Maybe Char
Nothing -> String -> Parser ByteString Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid octal character escape"
    Char
'z' -> do -- \zhhhh matches unicode hex char hhhh
      ByteString
ds <- Int -> Parser ByteString ByteString
A.take Int
4
      case String -> Maybe Char
forall a. Read a => String -> Maybe a
readMay (String
"'\\x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
U.toString ByteString
ds String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") of
        Just Char
x  -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
        Maybe Char
Nothing -> String -> Parser ByteString Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid hex character escape"
    Char
_ | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'1' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'7' -> do -- \ooo octal undocument form but works
         ByteString
ds <- Int -> Parser ByteString ByteString
A.take Int
2
         case String -> Maybe Char
forall a. Read a => String -> Maybe a
readMay (String
"'\\o" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: ByteString -> String
U.toString ByteString
ds String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") of
           Just Char
x  -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
           Maybe Char
Nothing -> String -> Parser ByteString Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid octal character escape"
      | Bool
otherwise -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c

pRegexCharClass :: Parser Regex
pRegexCharClass :: Parser Regex
pRegexCharClass = do
  Bool
negated <- Bool -> Parser ByteString Bool -> Parser ByteString Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Parser ByteString Bool -> Parser ByteString Bool)
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> Parser ByteString Word8 -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
94) -- '^'
  let getEscapedClass :: Parser ByteString (Char -> Bool)
getEscapedClass = do
        Word8
_ <- (Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92) -- backslash
        (Char -> Bool
isDigit (Char -> Bool)
-> Parser ByteString Char -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
'd')
         Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit (Char -> Bool)
-> Parser ByteString Char -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
'D')
         Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isSpace (Char -> Bool)
-> Parser ByteString Char -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
's')
         Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace (Char -> Bool)
-> Parser ByteString Char -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
'S')
         Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isWordChar (Char -> Bool)
-> Parser ByteString Char -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
'w')
         Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isWordChar (Char -> Bool)
-> Parser ByteString Char -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
'W')
  let getPosixClass :: Parser ByteString (Char -> Bool)
getPosixClass = do
        ByteString
_ <- ByteString -> Parser ByteString ByteString
string ByteString
"[:"
        Bool
localNegated <- Bool -> Parser ByteString Bool -> Parser ByteString Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Parser ByteString Bool -> Parser ByteString Bool)
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> Parser ByteString Word8 -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
94) -- '^'
        Char -> Bool
res <- (Char -> Bool
isAlphaNum (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"alnum")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isAlpha (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"alpha")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isAscii (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"ascii")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\n',Char
'\r',Char
'\f',Char
'\v']) (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
                   ByteString -> Parser ByteString ByteString
string ByteString
"blank")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isControl (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"cntrl")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\Char
c -> Char -> Bool
isPrint Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c) (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"graph:")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isLower (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"lower")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isUpper (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"upper")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isPrint (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"print")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isPunctuation (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"punct")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isSpace (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"space")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
||
                         Char -> GeneralCategory
generalCategory Char
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
ConnectorPunctuation)
                   (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"word:")
             Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isHexDigit (Char -> Bool)
-> Parser ByteString ByteString -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"xdigit")
        ByteString
_ <- ByteString -> Parser ByteString ByteString
string ByteString
":]"
        (Char -> Bool) -> Parser ByteString (Char -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> Parser ByteString (Char -> Bool))
-> (Char -> Bool) -> Parser ByteString (Char -> Bool)
forall a b. (a -> b) -> a -> b
$! if Bool
localNegated then Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
res else Char -> Bool
res
  let getC :: Parser ByteString Char
getC = ((Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92) Parser ByteString Word8
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
anyChar Parser ByteString Char
-> (Char -> Parser ByteString Char) -> Parser ByteString Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Parser ByteString Char
pEscaped) Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Char)
-> Parser ByteString Word8 -> Parser ByteString Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString Word8
satisfy (\Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
92 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
93)) -- \ ]
  let getCRange :: Parser ByteString (Char -> Bool)
getCRange = do
        Char
c <- Parser ByteString Char
getC
        (\Char
d -> (\Char
x -> Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
c Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
d)) (Char -> Char -> Bool)
-> Parser ByteString Char -> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser ByteString Char
char Char
'-' Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
getC) Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          (Char -> Bool) -> Parser ByteString (Char -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
  [Char -> Bool]
brack <- [Char -> Bool]
-> Parser ByteString [Char -> Bool]
-> Parser ByteString [Char -> Bool]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] (Parser ByteString [Char -> Bool]
 -> Parser ByteString [Char -> Bool])
-> Parser ByteString [Char -> Bool]
-> Parser ByteString [Char -> Bool]
forall a b. (a -> b) -> a -> b
$ [(Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
']')] [Char -> Bool]
-> Parser ByteString Char -> Parser ByteString [Char -> Bool]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
']'
  [Char -> Bool]
fs <- Parser ByteString (Char -> Bool)
-> Parser ByteString [Char -> Bool]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString (Char -> Bool)
getEscapedClass Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString (Char -> Bool)
getPosixClass Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
-> Parser ByteString (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString (Char -> Bool)
getCRange)
  Word8
_ <- (Word8 -> Bool) -> Parser ByteString Word8
satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
93) -- ]
  let f :: Char -> Bool
f Char
c = ((Char -> Bool) -> Bool) -> [Char -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ Char
c) ([Char -> Bool] -> Bool) -> [Char -> Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char -> Bool]
brack [Char -> Bool] -> [Char -> Bool] -> [Char -> Bool]
forall a. [a] -> [a] -> [a]
++ [Char -> Bool]
fs
  Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$! (Char -> Bool) -> Regex
MatchChar (if Bool
negated then (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f) else Char -> Bool
f)

anyChar :: Parser Char
anyChar :: Parser ByteString Char
anyChar = do
  Word8
w <- (Word8 -> Bool) -> Parser ByteString Word8
satisfy (Bool -> Word8 -> Bool
forall a b. a -> b -> a
const Bool
True)
  Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser ByteString Char) -> Char -> Parser ByteString Char
forall a b. (a -> b) -> a -> b
$! Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w

isSpecial :: Word8 -> Bool
isSpecial :: Word8 -> Bool
isSpecial Word8
92 = Bool
True -- '\\'
isSpecial Word8
63 = Bool
True -- '?'
isSpecial Word8
42 = Bool
True -- '*'
isSpecial Word8
43 = Bool
True -- '+'
-- isSpecial 123 = True -- '{'  -- this is okay except in suffixes
isSpecial Word8
91 = Bool
True -- '['
isSpecial Word8
93 = Bool
True -- ']'
isSpecial Word8
37 = Bool
True -- '%'
isSpecial Word8
40 = Bool
True -- '('
isSpecial Word8
41 = Bool
True -- ')'
isSpecial Word8
124 = Bool
True -- '|'
isSpecial Word8
46 = Bool
True -- '.'
isSpecial Word8
36 = Bool
True -- '$'
isSpecial Word8
94 = Bool
True -- '^'
isSpecial Word8
_  = Bool
False