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

import qualified Data.ByteString as B
import qualified Data.Text as T
import Data.ByteString (ByteString)
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import Safe
import Data.Attoparsec.Text as A hiding (match)
import Data.Char
import Control.Applicative
import Regex.KDE.Regex
import Control.Monad
import Control.Monad.State.Strict
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#endif

-- I believe the Regex engine used in KatePart is Qt's.
-- It is described here: https://doc.qt.io/qt-6/qregexp.html

-- | Compile a UTF-8 encoded ByteString as a Regex.  If the first
-- parameter is True, then the Regex will be case sensitive.  If the
-- second parameter is True, quantifiers are minimal (lazy) rather
-- than greedy by default, and the @?@ modifier makes them greedy
-- instead of lazy -- this corresponds to PCRE's UNGREEDY option
-- (QRegularExpression's InvertedGreedinessOption, set by
-- @minimal="1"@ in KDE syntax definitions).
compileRegex :: Bool -> Bool -> ByteString -> Either String Regex
compileRegex :: Bool -> Bool -> ByteString -> Either [Char] Regex
compileRegex Bool
caseSensitive Bool
minimal ByteString
bs =
  let !res :: Either [Char] Regex
res = Parser Regex -> Text -> Either [Char] Regex
forall a. Parser a -> Text -> Either [Char] a
parseOnly (StateT RState (Parser Text) Regex -> RState -> Parser Regex
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT RState (Parser Text) Regex
parser RState{
                                            rsCurrentCaptureNumber :: Int
rsCurrentCaptureNumber = Int
0,
                                            rsCaseSensitive :: Bool
rsCaseSensitive = Bool
caseSensitive,
                                            rsMinimal :: Bool
rsMinimal = Bool
minimal })
                       (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
bs)
   in Either [Char] Regex
res
 where
   parser :: StateT RState (Parser Text) Regex
parser = do
     !re <- StateT RState (Parser Text) Regex
pRegex
     (re <$ lift A.endOfInput) <|>
       do rest <- lift A.takeText
          fail $ "parse error at byte position " ++
                 show (B.length bs - B.length (encodeUtf8 rest))

data RState =
  RState
  { RState -> Int
rsCurrentCaptureNumber :: Int
  , RState -> Bool
rsCaseSensitive :: Bool
  , RState -> Bool
rsMinimal :: Bool }
  deriving (Int -> RState -> [Char] -> [Char]
[RState] -> [Char] -> [Char]
RState -> [Char]
(Int -> RState -> [Char] -> [Char])
-> (RState -> [Char])
-> ([RState] -> [Char] -> [Char])
-> Show RState
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> RState -> [Char] -> [Char]
showsPrec :: Int -> RState -> [Char] -> [Char]
$cshow :: RState -> [Char]
show :: RState -> [Char]
$cshowList :: [RState] -> [Char] -> [Char]
showList :: [RState] -> [Char] -> [Char]
Show)

type RParser = StateT RState Parser

pRegex :: RParser Regex
pRegex :: StateT RState (Parser Text) Regex
pRegex =
  Regex
-> StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Regex
MatchNull (StateT RState (Parser Text) Regex
 -> StateT RState (Parser Text) Regex)
-> StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
forall a b. (a -> b) -> a -> b
$
  -- earlier alternatives must be the left operands of MatchAlt, since
  -- the matcher prefers them, as in PCRE.  The first alternative may
  -- be empty, as in (?:|a); as in PCRE, an empty alternative matches
  -- the empty string:
  (\Regex
x [Regex]
xs -> (Regex -> Regex -> Regex) -> [Regex] -> Regex
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Regex -> Regex -> Regex
MatchAlt (Regex
xRegex -> [Regex] -> [Regex]
forall a. a -> [a] -> [a]
:[Regex]
xs))
    (Regex -> [Regex] -> Regex)
-> StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) ([Regex] -> Regex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT RState (Parser Text) Regex
pAltPart StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
forall a.
StateT RState (Parser Text) a
-> StateT RState (Parser Text) a -> StateT RState (Parser Text) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Regex -> StateT RState (Parser Text) Regex
forall a. a -> StateT RState (Parser Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Regex
forall a. Monoid a => a
mempty)
    StateT RState (Parser Text) ([Regex] -> Regex)
-> StateT RState (Parser Text) [Regex]
-> StateT RState (Parser Text) Regex
forall a b.
StateT RState (Parser Text) (a -> b)
-> StateT RState (Parser Text) a -> StateT RState (Parser Text) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) [Regex]
forall a.
StateT RState (Parser Text) a -> StateT RState (Parser Text) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Char -> StateT RState (Parser Text) Char
forall (m :: * -> *) a. Monad m => m a -> StateT RState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Char
char Char
'|') StateT RState (Parser Text) Char
-> StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
forall a b.
StateT RState (Parser Text) a
-> StateT RState (Parser Text) b -> StateT RState (Parser Text) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (StateT RState (Parser Text) Regex
pAltPart StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
forall a.
StateT RState (Parser Text) a
-> StateT RState (Parser Text) a -> StateT RState (Parser Text) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Regex -> StateT RState (Parser Text) Regex
forall a. a -> StateT RState (Parser Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Regex
forall a. Monoid a => a
mempty))

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

pRegexPart :: RParser Regex
pRegexPart :: StateT RState (Parser Text) Regex
pRegexPart =
  StateT RState (Parser Text) Regex
pRegexChar StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
forall a.
StateT RState (Parser Text) a
-> StateT RState (Parser Text) a -> StateT RState (Parser Text) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT RState (Parser Text) Regex
pParenthesized StateT RState (Parser Text) Regex
-> (Regex -> StateT RState (Parser Text) Regex)
-> StateT RState (Parser Text) Regex
forall a b.
StateT RState (Parser Text) a
-> (a -> StateT RState (Parser Text) b)
-> StateT RState (Parser Text) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Regex -> StateT RState (Parser Text) Regex
pSuffix

pParenthesized :: RParser Regex
pParenthesized :: StateT RState (Parser Text) Regex
pParenthesized = do
  _ <- Parser Char -> StateT RState (Parser Text) Char
forall (m :: * -> *) a. Monad m => m a -> StateT RState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Char
char Char
'(')
  pInlineModifiers <|> do
    -- pcrepattern says: A group that starts with (?| resets the capturing
    -- parentheses numbers in each alternative.
    resetCaptureNumbers <- option False (True <$ lift (string "?|"))
    (modifier, stModifier) <-
                if resetCaptureNumbers
                   then return (id, id)
                   else lift (char '?' *> pGroupModifiers)
                      <|> do modify (\RState
st -> RState
st{
                                        rsCurrentCaptureNumber =
                                               rsCurrentCaptureNumber st + 1})
                             num <- gets rsCurrentCaptureNumber
                             pure (MatchCapture num, id)
    currentCaptureNumber <- gets rsCurrentCaptureNumber
    -- modifiers like (?i: or (?U: are scoped to the group, so save the
    -- current flags and restore them after the closing parenthesis:
    oldCaseSensitive <- gets rsCaseSensitive
    oldMinimal <- gets rsMinimal
    modify stModifier
    contents <- do
      x <- pAltPart <|> pure mempty
      n0 <- gets rsCurrentCaptureNumber
      let pNextAlt = do
            _ <- Parser Char -> StateT RState (Parser Text) Char
forall (m :: * -> *) a. Monad m => m a -> StateT RState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Char
char Char
'|')
            when resetCaptureNumbers $
              modify (\RState
st ->
                       RState
st{ rsCurrentCaptureNumber = currentCaptureNumber })
            y <- pAltPart <|> pure mempty
            n <- gets rsCurrentCaptureNumber
            pure (y, n)
      rest <- many pNextAlt
      -- with (?|, numbering after the group resumes after the highest
      -- group number used in any alternative, as in PCRE:
      when resetCaptureNumbers $
        modify (\RState
st ->
                 RState
st{ rsCurrentCaptureNumber = maximum (n0 : map snd rest) })
      pure (foldr1 MatchAlt (x : map fst rest))
    _ <- lift (char ')')
    modify $ \RState
st -> RState
st{ rsCaseSensitive = oldCaseSensitive
                      , rsMinimal = oldMinimal }
    return $ modifier contents

-- Inline modifiers like (?i) or (?-i), without a colon, apply from
-- this point to the end of the enclosing group (or pattern).  The
-- state change persists after the closing parenthesis; the enclosing
-- group's save/restore of rsCaseSensitive provides the scoping.
pInlineModifiers :: RParser Regex
pInlineModifiers :: StateT RState (Parser Text) Regex
pInlineModifiers = do
  stModifier <- Parser (RState -> RState)
-> StateT RState (Parser Text) (RState -> RState)
forall (m :: * -> *) a. Monad m => m a -> StateT RState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser (RState -> RState)
 -> StateT RState (Parser Text) (RState -> RState))
-> Parser (RState -> RState)
-> StateT RState (Parser Text) (RState -> RState)
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
'?' Parser Char
-> Parser (RState -> RState) -> Parser (RState -> RState)
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (RState -> RState)
pRegexModifier Parser (RState -> RState)
-> Parser Char -> Parser (RState -> RState)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
')'
  modify stModifier
  return MatchNull

pGroupModifiers :: Parser (Regex -> Regex, RState -> RState)
pGroupModifiers :: Parser (Regex -> Regex, RState -> RState)
pGroupModifiers =
  (do stmod <- Parser (RState -> RState)
pRegexModifier -- (?i:
      void (char ':')
      pure (id, stmod))
   Parser (Regex -> Regex, RState -> RState)
-> Parser (Regex -> Regex, RState -> RState)
-> Parser (Regex -> Regex, RState -> RState)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     do dir <- Direction -> Parser Text Direction -> Parser Text Direction
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Direction
Forward (Parser Text Direction -> Parser Text Direction)
-> Parser Text Direction -> Parser Text Direction
forall a b. (a -> b) -> a -> b
$ Direction
Backward Direction -> Parser Char -> Parser Text Direction
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'<'
        ((AssertPositive dir, id) <$ char '=') <|>
          ((AssertNegative dir, id) <$ char '!')
   Parser (Regex -> Regex, RState -> RState)
-> Parser (Regex -> Regex, RState -> RState)
-> Parser (Regex -> Regex, RState -> RState)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     do ds <- Parser Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Char
digit
        case readMay ds of
          Just !Int
n -> (Regex -> Regex, RState -> RState)
-> Parser (Regex -> Regex, RState -> RState)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (\Regex
_ -> Int -> Regex
Subroutine Int
n, RState -> RState
forall a. a -> a
id)
          Maybe Int
Nothing -> [Char] -> Parser (Regex -> Regex, RState -> RState)
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"not a number"
   Parser (Regex -> Regex, RState -> RState)
-> Parser (Regex -> Regex, RState -> RState)
-> Parser (Regex -> Regex, RState -> RState)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     do Parser Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Char -> Parser ()) -> Parser Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
'R'
        (Regex -> Regex, RState -> RState)
-> Parser (Regex -> Regex, RState -> RState)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return  (\Regex
_ -> Int -> Regex
Subroutine Int
0, RState -> RState
forall a. a -> a
id)
   Parser (Regex -> Regex, RState -> RState)
-> Parser (Regex -> Regex, RState -> RState)
-> Parser (Regex -> Regex, RState -> RState)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> -- atomic group (?>...): no backtracking into the group
     ((Regex -> Regex
Possessive, RState -> RState
forall a. a -> a
id) (Regex -> Regex, RState -> RState)
-> Parser Char -> Parser (Regex -> Regex, RState -> RState)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'>')

pRegexModifier :: Parser (RState -> RState)
pRegexModifier :: Parser (RState -> RState)
pRegexModifier = do
  -- Of PCRE's inline flags we implement i and U (ungreedy).  We also
  -- accept m and s, which are no-ops for us: subjects are single
  -- lines, so there are no newlines for (?s) to let . match or for
  -- (?m) to change the meaning of ^ and $.  Flags that would change
  -- semantics we don't implement (x, n, ...) are rejected, causing a
  -- compile error, as unknown flags do in PCRE.  Turning flags *off*
  -- is always safe, since only i and U are ever on.
  ons <- Parser Char -> Parser Text [Char]
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Char -> Parser Text [Char])
-> Parser Char -> Parser Text [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
satisfy ([Char] -> Char -> Bool
inClass [Char]
"imsU")
  offs <- option [] $ char '-' *>
                      many (satisfy (inClass "imnsxU"))
  pure $ \RState
st -> RState
st{
    rsCaseSensitive =
      if 'i' `elem` ons && 'i' `notElem` offs
         then False
         else ('i' `elem` offs) || rsCaseSensitive st
  , rsMinimal =
      if 'U' `elem` ons && 'U' `notElem` offs
         then True
         else ('U' `notElem` offs) && rsMinimal st
  }

pSuffix :: Regex -> RParser Regex
-- a quantifier after an anchor or word-boundary assertion is a
-- compile error in PCRE ("quantifier does not follow a repeatable
-- item").  We get the same effect by leaving the quantifier
-- unconsumed: *, +, and ? are rejected by pRegexChar as special, and
-- { is rejected there when it begins a valid quantifier.
pSuffix :: Regex -> StateT RState (Parser Text) Regex
pSuffix re :: Regex
re@Regex
AssertBeginning = Regex -> StateT RState (Parser Text) Regex
forall a. a -> StateT RState (Parser Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Regex
re
pSuffix re :: Regex
re@Regex
AssertEnd = Regex -> StateT RState (Parser Text) Regex
forall a. a -> StateT RState (Parser Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Regex
re
pSuffix re :: Regex
re@Regex
AssertWordBoundary = Regex -> StateT RState (Parser Text) Regex
forall a. a -> StateT RState (Parser Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Regex
re
pSuffix Regex
re = Regex
-> StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Regex
re (StateT RState (Parser Text) Regex
 -> StateT RState (Parser Text) Regex)
-> StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
forall a b. (a -> b) -> a -> b
$ do
  w <- Parser Char -> StateT RState (Parser Text) Char
forall (m :: * -> *) a. Monad m => m a -> StateT RState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Char -> StateT RState (Parser Text) Char)
-> Parser Char -> StateT RState (Parser Text) Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
satisfy ([Char] -> Char -> Bool
inClass [Char]
"*+?{")
  case w of
    Char
'*'  -> Regex -> Regex -> StateT RState (Parser Text) Regex
withModifier (Regex -> Regex -> Regex
MatchAlt (Regex -> Regex
MatchSome Regex
re) Regex
MatchNull)
                         (Regex -> Regex -> Regex
MatchAlt Regex
MatchNull (Regex -> Regex
Lazy (Regex -> Regex
MatchSome Regex
re)))
    Char
'+'  -> Regex -> Regex -> StateT RState (Parser Text) Regex
withModifier (Regex -> Regex
MatchSome Regex
re) (Regex -> Regex
Lazy (Regex -> Regex
MatchSome Regex
re))
    Char
'?'  -> Regex -> Regex -> StateT RState (Parser Text) Regex
withModifier (Regex -> Regex -> Regex
MatchAlt Regex
re Regex
MatchNull) (Regex -> Regex -> Regex
MatchAlt Regex
MatchNull Regex
re)
    Char
'{'  -> do
      minn <- Parser (Maybe Int) -> StateT RState (Parser Text) (Maybe Int)
forall (m :: * -> *) a. Monad m => m a -> StateT RState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser (Maybe Int) -> StateT RState (Parser Text) (Maybe Int))
-> Parser (Maybe Int) -> StateT RState (Parser Text) (Maybe Int)
forall a b. (a -> b) -> a -> b
$
        Maybe Int -> Parser (Maybe Int) -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Maybe Int
forall a. Maybe a
Nothing (Parser (Maybe Int) -> Parser (Maybe Int))
-> Parser (Maybe Int) -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMay ([Char] -> Maybe Int) -> (Text -> [Char]) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> Maybe Int) -> Parser Text -> Parser (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
A.takeWhile Char -> Bool
isDigit
      maxn <- lift $ option minn $ char ',' *>
                       (readMay . T.unpack <$> A.takeWhile isDigit)
      _ <- lift $ char '}'
      case (minn, maxn) of
          (Maybe Int, Maybe Int)
_ | Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxRepeat) Maybe Int
minn Bool -> Bool -> Bool
||
              Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxRepeat) Maybe Int
maxn
                             -> StateT RState (Parser Text) Regex
forall a. StateT RState (Parser Text) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero -- the unconsumed {..} then causes a
                                      -- parse error via pRegexChar, as in
                                      -- PCRE ("number too big in {}
                                      -- quantifier")
          (Maybe Int
Nothing, Maybe Int
Nothing) -> StateT RState (Parser Text) Regex
forall a. StateT RState (Parser Text) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero -- {} and {,} are literal
          (Just Int
n, Maybe Int
Nothing)  -> Regex -> Regex -> StateT RState (Parser Text) Regex
withModifier (Int -> Regex -> Regex
atleast Int
n Regex
re) (Int -> Regex -> Regex
atleastLazy Int
n Regex
re)
          (Maybe Int
Nothing, Just Int
n)  -> Regex -> Regex -> StateT RState (Parser Text) Regex
withModifier (Int -> Regex -> Regex
forall {t}. (Ord t, Num t) => t -> Regex -> Regex
atmost Int
n Regex
re) (Int -> Regex -> Regex
forall {t}. (Ord t, Num t) => t -> Regex -> Regex
atmostLazy Int
n Regex
re)
          (Just Int
m, Just Int
n)
            | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n          -> StateT RState (Parser Text) Regex
forall a. StateT RState (Parser Text) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero -- e.g. a{3,1}: the unconsumed {..}
                                      -- then causes a parse error via
                                      -- pRegexChar, as in PCRE ("numbers
                                      -- out of order in {} quantifier")
            | Bool
otherwise      -> Regex -> Regex -> StateT RState (Parser Text) Regex
withModifier (Int -> Int -> Regex -> Regex
between Int
m Int
n Regex
re)
                                             (Int -> Int -> Regex -> Regex
betweenLazy Int
m Int
n Regex
re)
    Char
_   -> [Char] -> StateT RState (Parser Text) Regex
forall a. [Char] -> StateT RState (Parser Text) a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"pSuffix encountered impossible byte"
 where
   -- A lazy quantifier prefers fewer repetitions, which is expressed
   -- by putting the empty alternative first; Lazy itself is only ever
   -- applied to MatchSome (the matcher relies on this).  A possessive
   -- quantifier commits to the preferred match of the greedy version.
   -- In minimal (ungreedy) mode the roles of the bare quantifier and
   -- the ? modifier are swapped, as with PCRE's UNGREEDY option;
   -- possessive quantifiers are unaffected.
   withModifier :: Regex -> Regex -> RParser Regex
   withModifier :: Regex -> Regex -> StateT RState (Parser Text) Regex
withModifier Regex
greedy Regex
lazy = do
     minimal <- (RState -> Bool) -> StateT RState (Parser Text) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> Bool
rsMinimal
     let (bare, questioned) = if minimal
                                 then (lazy, greedy)
                                 else (greedy, lazy)
     lift $ (Possessive greedy <$ char '+') <|> (questioned <$ char '?')
            <|> pure bare

   -- repeat counts larger than this (the limit PCRE2 uses) are not
   -- treated as quantifiers:
   maxRepeat :: Int
maxRepeat = Int
65535 :: Int

   -- nest the optional matches -- r(r(r)?)? -- so that the size of
   -- the compiled regex is linear, not quadratic, in n:
   atmost :: t -> Regex -> Regex
atmost t
n Regex
r
     | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = Regex
MatchNull
     | Bool
otherwise = Regex -> Regex -> Regex
MatchAlt (Regex
r Regex -> Regex -> Regex
forall a. Semigroup a => a -> a -> a
<> t -> Regex -> Regex
atmost (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Regex
r) Regex
MatchNull

   atmostLazy :: t -> Regex -> Regex
atmostLazy t
n Regex
r
     | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = Regex
MatchNull
     | Bool
otherwise = Regex -> Regex -> Regex
MatchAlt Regex
MatchNull (Regex
r Regex -> Regex -> Regex
forall a. Semigroup a => a -> a -> a
<> t -> Regex -> Regex
atmostLazy (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Regex
r)

   between :: Int -> Int -> Regex -> Regex
between Int
0 Int
n Regex
r = Int -> Regex -> Regex
forall {t}. (Ord t, Num t) => t -> 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
forall {t}. (Ord t, Num t) => t -> Regex -> Regex
atmost (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) Regex
r

   betweenLazy :: Int -> Int -> Regex -> Regex
betweenLazy Int
0 Int
n Regex
r = Int -> Regex -> Regex
forall {t}. (Ord t, Num t) => t -> Regex -> Regex
atmostLazy Int
n Regex
r
   betweenLazy 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
forall {t}. (Ord t, Num t) => t -> Regex -> Regex
atmostLazy (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

   atleastLazy :: Int -> Regex -> Regex
atleastLazy 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
MatchNull (Regex -> Regex
Lazy (Regex -> Regex
MatchSome Regex
r))

pRegexChar :: RParser Regex
pRegexChar :: StateT RState (Parser Text) Regex
pRegexChar = do
  w <- Parser Char -> StateT RState (Parser Text) Char
forall (m :: * -> *) a. Monad m => m a -> StateT RState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser Char
anyChar
  caseSensitive <- gets rsCaseSensitive
  case w of
    Char
'.'  -> Regex -> StateT RState (Parser Text) Regex
forall a. a -> StateT RState (Parser Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
MatchAnyChar
    Char
'%' -> (do -- dynamic %1 %2
              ds <- Parser Text [Char] -> StateT RState (Parser Text) [Char]
forall (m :: * -> *) a. Monad m => m a -> StateT RState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Text [Char] -> StateT RState (Parser Text) [Char])
-> Parser Text [Char] -> StateT RState (Parser Text) [Char]
forall a b. (a -> b) -> a -> b
$ Parser Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Char
digit
              case readMay ds of
                Just !Int
n -> Regex -> StateT RState (Parser Text) Regex
forall a. a -> StateT RState (Parser Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT RState (Parser Text) Regex)
-> Regex -> StateT RState (Parser Text) Regex
forall a b. (a -> b) -> a -> b
$ Int -> Regex
MatchDynamic Int
n
                Maybe Int
Nothing -> [Char] -> StateT RState (Parser Text) Regex
forall a. [Char] -> StateT RState (Parser Text) a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"not a number")
            StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
-> StateT RState (Parser Text) Regex
forall a.
StateT RState (Parser Text) a
-> StateT RState (Parser Text) a -> StateT RState (Parser Text) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Regex -> StateT RState (Parser Text) Regex
forall a. a -> StateT RState (Parser Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> Regex
MatchChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%'))
    Char
'\\' -> Parser Regex -> StateT RState (Parser Text) Regex
forall (m :: * -> *) a. Monad m => m a -> StateT RState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Regex -> StateT RState (Parser Text) Regex)
-> Parser Regex -> StateT RState (Parser Text) Regex
forall a b. (a -> b) -> a -> b
$ Bool -> Parser Regex
pRegexEscapedChar Bool
caseSensitive
    Char
'$'  -> Regex -> StateT RState (Parser Text) Regex
forall a. a -> StateT RState (Parser Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
AssertEnd
    Char
'^'  -> Regex -> StateT RState (Parser Text) Regex
forall a. a -> StateT RState (Parser Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
AssertBeginning
    Char
'['  -> Parser Regex -> StateT RState (Parser Text) Regex
forall (m :: * -> *) a. Monad m => m a -> StateT RState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Regex -> StateT RState (Parser Text) Regex)
-> Parser Regex -> StateT RState (Parser Text) Regex
forall a b. (a -> b) -> a -> b
$ Bool -> Parser Regex
pRegexCharClass Bool
caseSensitive
    Char
'{'  -> do
      -- if this { begins a valid quantifier, there is nothing for it
      -- to repeat, which is a compile error in PCRE ("quantifier does
      -- not follow a repeatable item"); the same happens with a
      -- quantifier that pSuffix declined to consume (out-of-order or
      -- too-big repeat counts, which are also compile errors in PCRE):
      isQuantifier <- Parser Bool -> StateT RState (Parser Text) Bool
forall (m :: * -> *) a. Monad m => m a -> StateT RState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Bool -> StateT RState (Parser Text) Bool)
-> Parser Bool -> StateT RState (Parser Text) Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Bool
True Bool -> Parser () -> Parser Bool
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
pQuantifierShape)
      if isQuantifier
         then fail "quantifier does not follow a repeatable item"
         else return $ MatchChar (== '{')
    Char
_ | Char -> Bool
isSpecial Char
w -> StateT RState (Parser Text) Regex
forall a. StateT RState (Parser Text) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      | Bool
otherwise -> Regex -> StateT RState (Parser Text) Regex
forall a. a -> StateT RState (Parser Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT RState (Parser Text) Regex)
-> Regex -> StateT RState (Parser Text) 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
w)
                           else (\Char
d -> Char -> Char
toLower Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toLower Char
w)

-- The forms {m}, {m,}, {m,n}, and {,n} are quantifiers (PCRE also
-- recognizes {,n} as of 10.43); anything else beginning with { --
-- e.g. {}, {,}, {b}, or an unclosed {2 -- is a sequence of literal
-- characters.  Assumes the initial { has already been consumed.
pQuantifierShape :: Parser ()
pQuantifierShape :: Parser ()
pQuantifierShape = do
  _ <- ((Char -> Bool) -> Parser Text
A.takeWhile1 Char -> Bool
isDigit Parser Text -> Parser Char -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Char
',' (Char -> Parser Char
char Char
',' Parser Char -> Parser Text -> Parser Char
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Text
A.takeWhile Char -> Bool
isDigit))
        Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
',' Parser Char -> Parser Text -> Parser Text
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text
A.takeWhile1 Char -> Bool
isDigit)
  void $ char '}'

pRegexEscapedChar :: Bool -> Parser Regex
pRegexEscapedChar :: Bool -> Parser Regex
pRegexEscapedChar Bool
caseSensitive = do
  c <- Parser Char
A.anyChar
  (case c of
    Char
'b' -> Regex -> Parser Regex
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
AssertWordBoundary
    Char
'B' -> Regex -> Parser Regex
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ Direction -> Regex -> Regex
AssertNegative Direction
Forward Regex
AssertWordBoundary
    -- PCRE's \G asserts the position at which the match attempt
    -- started.  Since matching is always anchored at the start of
    -- the input we are given, that is the same as AssertBeginning:
    Char
'G' -> Regex -> Parser Regex
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
AssertBeginning
    -- PCRE's \A asserts the start of the subject.  Since matching is
    -- always anchored at the start of the input we are given, that is
    -- also the same as AssertBeginning:
    Char
'A' -> Regex -> Parser Regex
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
AssertBeginning
    Char
'{' -> do -- captured pattern: \1 \2 \{12}
              ds <- Parser Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Char
digit
              _ <- char '}'
              case readMay ds of
                Just !Int
n -> Regex -> Parser Regex
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> Regex
MatchCaptured Int
n Bool
caseSensitive
                Maybe Int
Nothing -> [Char] -> Parser Regex
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"not a number"
    Char
'g' -> do -- PCRE backreference syntax: \g1 \g{12}
              ds <- (Char -> Parser Char
char Char
'{' Parser Char -> Parser Text [Char] -> Parser Text [Char]
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Char
digit Parser Text [Char] -> Parser Char -> Parser Text [Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'}') Parser Text [Char] -> Parser Text [Char] -> Parser Text [Char]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Char
digit
              case readMay ds of
                Just !Int
n -> Regex -> Parser Regex
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> Regex
MatchCaptured Int
n Bool
caseSensitive
                Maybe Int
Nothing -> [Char] -> Parser Regex
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"not a number"
    Char
'd' -> Regex -> Parser Regex
forall a. a -> Parser Text a
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 a. a -> Parser Text a
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 a. a -> Parser Text a
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 a. a -> Parser Text a
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
'h' -> Regex -> Parser Regex
forall a. a -> Parser Text a
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
isHorizSpace
    Char
'H' -> Regex -> Parser Regex
forall a. a -> Parser Text a
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
isHorizSpace)
    Char
'w' -> Regex -> Parser Regex
forall a. a -> Parser Text a
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 a. a -> Parser Text a
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
'p' -> (Char -> Bool) -> Regex
MatchChar ((Char -> Bool) -> Regex)
-> Parser Text (Char -> Bool) -> Parser Regex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Char -> Bool)
pUnicodeCharClass
    Char
'P' -> (Char -> Bool) -> Regex
MatchChar ((Char -> Bool) -> Regex)
-> ((Char -> Bool) -> Char -> Bool) -> (Char -> Bool) -> Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Char -> Bool) -> Regex)
-> Parser Text (Char -> Bool) -> Parser Regex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Char -> Bool)
pUnicodeCharClass
    Char
_ | Char -> Bool
isDigit Char
c, Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0' -> -- \0 is an octal escape, not a backreference
       Regex -> Parser Regex
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Parser Regex) -> Regex -> Parser Regex
forall a b. (a -> b) -> a -> b
$! Int -> Bool -> Regex
MatchCaptured (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0') Bool
caseSensitive
      | Bool
otherwise -> Parser Regex
forall a. Parser Text a
forall (m :: * -> *) a. MonadPlus m => m a
mzero) <|> (matchLiteralChar <$> pEscaped c)
 where
   matchLiteralChar :: Char -> Regex
matchLiteralChar Char
d = (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
x -> Char -> Char
toLower Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toLower Char
d

pEscaped :: Char -> Parser Char
pEscaped :: Char -> Parser Char
pEscaped Char
c =
  case Char
c of
    Char
'\\' -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
    Char
'a' -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\a'
    -- \b means backspace inside a character class (outside one, it is
    -- a word boundary assertion handled by pRegexEscapedChar):
    Char
'b' -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b'
    Char
'f' -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'
    Char
'n' -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
    Char
'r' -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'
    Char
't' -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'
    Char
'v' -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\v'
    Char
'0' -> do -- \0 followed by up to two octal digits (as in PCRE)
      ds <- Int -> (Int -> Char -> Maybe Int) -> Parser Text
forall s. s -> (s -> Char -> Maybe s) -> Parser Text
A.scan (Int
0 :: Int) (\Int
s Char
w -> if Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 Bool -> Bool -> Bool
&& Char -> Bool
isOctDigit Char
w
                                          then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                                          else Maybe Int
forall a. Maybe a
Nothing)
      case readMay ("'\\o0" ++ T.unpack ds ++ "'") of
        Just Char
x  -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
        Maybe Char
Nothing -> [Char] -> Parser Char
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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 -> Char -> Maybe a
octalDigitScanner a
s Char
w
            | a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
3, Char -> Bool
isOctDigit Char
w = 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
      ds <- Int -> (Int -> Char -> Maybe Int) -> Parser Text
forall s. s -> (s -> Char -> Maybe s) -> Parser Text
A.scan (Int
1 :: Int) Int -> Char -> Maybe Int
forall {a}. (Ord a, Num a) => a -> Char -> Maybe a
octalDigitScanner
      case readMay ("'\\o" ++ [c] ++ T.unpack ds ++ "'") of
        Just Char
x  -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
        Maybe Char
Nothing -> [Char] -> Parser Char
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid octal character escape"
    Char
'z' -> do -- \zhhhh matches unicode hex char hhhh
      ds <- Int -> Parser Text
A.take Int
4
      case readMay ("'\\x" ++ T.unpack ds ++ "'") of
        Just Char
x  -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
        Maybe Char
Nothing -> [Char] -> Parser Char
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid hex character escape"
    Char
'x' -> do -- \xhh matches hex hh, \x{h+} matches hex h+
      ds <- (Char -> Parser Char
char Char
'{' Parser Char -> Parser Text -> Parser Text
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') Parser Text -> Parser Char -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'}')
             Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Text
A.take Int
2
      case readMay ("'\\x" ++ T.unpack ds ++ "'") of
        Just Char
x  -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
        Maybe Char
Nothing -> [Char] -> Parser Char
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid hex character escape"
    Char
_ | Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c -> Char -> Parser Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
      | Bool
otherwise -> [Char] -> Parser Char
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Char) -> [Char] -> Parser Char
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid escape \\" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c]

pRegexCharClass :: Bool -> Parser Regex
pRegexCharClass :: Bool -> Parser Regex
pRegexCharClass Bool
caseSensitive = do
  negated <- Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Parser Bool -> Parser Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> Parser Char -> Parser Bool
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'^'
  let getEscapedClass = do
        _ <- Char -> Parser Char
char Char
'\\'
        (isDigit <$ char 'd')
         <|> (not . isDigit <$ char 'D')
         <|> (isSpace <$ char 's')
         <|> (not . isSpace <$ char 'S')
         <|> (isHorizSpace <$ char 'h')
         <|> (not . isHorizSpace <$ char 'H')
         <|> (isWordChar <$ char 'w')
         <|> (not . isWordChar <$ char 'W')
  let getPosixClass = do
        _ <- Text -> Parser Text
string Text
"[:"
        localNegated <- option False $ True <$ char '^'
        res <- (isAlphaNum <$ string "alnum")
             <|> (isAlpha <$ string "alpha")
             <|> (isAscii <$ string "ascii")
             <|> ((\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\n',Char
'\r',Char
'\f',Char
'\v']) <$
                   string "blank")
             <|> (isControl <$ string "cntrl")
             <|> (isDigit <$ string "digit")
             <|> ((\Char
c -> Char -> Bool
isPrint Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c)) <$ string "graph")
             <|> (isLower <$ string "lower")
             <|> (isUpper <$ string "upper")
             <|> (isPrint <$ string "print")
             <|> (isPunctuation <$ string "punct")
             <|> (isSpace <$ string "space")
             <|> ((\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)
                   <$ string "word")
             <|> (isHexDigit <$ string "xdigit")
        _ <- string ":]"
        return $! if localNegated then not . res else res
  let getC = (Char -> Parser Char
char Char
'\\' Parser Char -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
anyChar Parser Char -> (Char -> Parser Char) -> Parser Char
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Parser Char
pEscaped) Parser Char -> Parser Char -> Parser Char
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
             (Char -> Bool) -> Parser Char
satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']')
  let getCRange = do
        c <- Parser 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 '-' *> getC) <|>
          return (== c)
  let getQELiteral = do
        Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
A.string Text
"\\Q"
        cs <- Parser Char -> Parser Text -> Parser Text [Char]
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Text -> Parser Text
A.string Text
"\\E")
        return $! \Char
c -> (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) [Char]
cs
  -- a ] in first position is a literal; it may also be the start of
  -- a range, as in []-a]:
  brack <- option [] $ do
    _ <- char ']'
    (do d <- char '-' *> getC
        return [\Char
x -> Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
']' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
d])
      <|> return [(== ']')]
  fs <- many (getQELiteral <|> getEscapedClass <|> getPosixClass <|> getCRange
              <|> (A.string "\\p" *> pUnicodeCharClass)
              <|> (A.string "\\P" *> ((not .) <$> pUnicodeCharClass)))
  void $ char ']'
  let 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
  -- for case-insensitive matching, a character matches (or, if
  -- negated, is excluded) if any of its case variants matches:
  let f' Char
c | Bool
caseSensitive = Char -> Bool
f Char
c
           | Bool
otherwise = Char -> Bool
f Char
c Bool -> Bool -> Bool
|| Char -> Bool
f (Char -> Char
toLower Char
c) Bool -> Bool -> Bool
|| Char -> Bool
f (Char -> Char
toUpper Char
c)
  return $! MatchChar $ if negated
                           then not . f'
                           else f'

-- character class \p{Lo}, \p{^Lo}, or \pL; we assume \p is already
-- parsed
pUnicodeCharClass :: Parser (Char -> Bool)
pUnicodeCharClass :: Parser Text (Char -> Bool)
pUnicodeCharClass = do
  (negated, ds) <-
    (Char -> Parser Char
char Char
'{' Parser Char -> Parser Text (Bool, Text) -> Parser Text (Bool, Text)
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((,) (Bool -> Text -> (Bool, Text))
-> Parser Bool -> Parser Text (Text -> (Bool, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Bool
True Bool -> Parser Char -> Parser Bool
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'^')
                      Parser Text (Text -> (Bool, Text))
-> Parser Text -> Parser Text (Bool, Text)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Char -> Bool) -> Parser Text
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') Parser Text -> Parser Char -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'}')))
     Parser Text (Bool, Text)
-> Parser Text (Bool, Text) -> Parser Text (Bool, Text)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((,) Bool
False (Text -> (Bool, Text)) -> (Char -> Text) -> Char -> (Bool, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> (Bool, Text)) -> Parser Char -> Parser Text (Bool, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isAlpha)
  let neg = if Bool
negated then (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) else (a -> Bool) -> a -> Bool
forall a. a -> a
id
  return $ neg $
    (case ds of
      Text
"Lu" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
UppercaseLetter)
      Text
"Ll" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
LowercaseLetter)
      Text
"Lt" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
TitlecaseLetter)
      Text
"Lm" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
ModifierLetter)
      Text
"Lo" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OtherLetter)
      Text
"L" -> (\GeneralCategory
c -> GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
UppercaseLetter Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
LowercaseLetter Bool -> Bool -> Bool
||
                    GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
TitlecaseLetter Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
ModifierLetter Bool -> Bool -> Bool
||
                    GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OtherLetter)
      Text
"Mn" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
NonSpacingMark)
      Text
"Mc" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
SpacingCombiningMark)
      Text
"Me" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
EnclosingMark)
      Text
"M" -> (\GeneralCategory
c -> GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
NonSpacingMark Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
SpacingCombiningMark Bool -> Bool -> Bool
||
                    GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
EnclosingMark)
      Text
"Nd" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
DecimalNumber)
      Text
"Nl" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
LetterNumber)
      Text
"No" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OtherNumber)
      Text
"N" -> (\GeneralCategory
c -> GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
DecimalNumber Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
LetterNumber Bool -> Bool -> Bool
||
                    GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OtherNumber)
      Text
"Pc" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
ConnectorPunctuation)
      Text
"Pd" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
DashPunctuation)
      Text
"Ps" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OpenPunctuation)
      Text
"Pe" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
ClosePunctuation)
      Text
"Pi" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
InitialQuote)
      Text
"Pf" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
FinalQuote)
      Text
"Po" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OtherPunctuation)
      Text
"P" -> (\GeneralCategory
c -> GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
ConnectorPunctuation Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
DashPunctuation Bool -> Bool -> Bool
||
                    GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OpenPunctuation Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
ClosePunctuation Bool -> Bool -> Bool
||
                    GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
InitialQuote Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
FinalQuote Bool -> Bool -> Bool
||
                    GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OtherPunctuation)
      Text
"Sm" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
MathSymbol)
      Text
"Sc" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
CurrencySymbol)
      Text
"Sk" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
ModifierSymbol)
      Text
"So" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OtherSymbol)
      Text
"S" -> (\GeneralCategory
c -> GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
MathSymbol Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
CurrencySymbol Bool -> Bool -> Bool
||
                    GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
ModifierSymbol Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OtherSymbol)
      Text
"Zs" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
Space)
      Text
"Zl" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
LineSeparator)
      Text
"Zp" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
ParagraphSeparator)
      Text
"Z" -> (\GeneralCategory
c -> GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
Space Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
LineSeparator Bool -> Bool -> Bool
||
                    GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
ParagraphSeparator)
      Text
"Cc" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
Control)
      Text
"Cf" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
Format)
      Text
"Cs" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
Surrogate)
      Text
"Co" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
PrivateUse)
      Text
"Cn" -> (GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
NotAssigned)
      Text
"C" -> (\GeneralCategory
c -> GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
Control Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
Format Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
Surrogate Bool -> Bool -> Bool
||
                    GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
PrivateUse Bool -> Bool -> Bool
|| GeneralCategory
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
NotAssigned)
      Text
_    -> Bool -> GeneralCategory -> Bool
forall a b. a -> b -> a
const Bool
False) . generalCategory


-- PCRE's \h matches this fixed list of horizontal whitespace
-- characters (which is not the same as Unicode category Zs):
isHorizSpace :: Char -> Bool
isHorizSpace :: Char -> Bool
isHorizSpace Char
c =
  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\xA0' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x1680' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x180E' Bool -> Bool -> Bool
||
  (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x200A') Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x202F' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x205F' Bool -> Bool -> Bool
||
  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x3000'

isSpecial :: Char -> Bool
isSpecial :: Char -> Bool
isSpecial Char
'\\' = Bool
True
isSpecial Char
'?'  = Bool
True
isSpecial Char
'*'  = Bool
True
isSpecial Char
'+'  = Bool
True
-- isSpecial '{' = True -- this is okay except in suffixes
isSpecial Char
'[' = Bool
True
-- an unmatched ] is treated as a literal (as in PCRE), so it is
-- not included here; the ] terminating a character class is consumed
-- by pRegexCharClass:
isSpecial Char
'%' = Bool
True
isSpecial Char
'(' = Bool
True
isSpecial Char
')' = Bool
True
isSpecial Char
'|' = Bool
True
isSpecial Char
'.' = Bool
True
isSpecial Char
'$' = Bool
True
isSpecial Char
'^' = Bool
True
isSpecial Char
_  = Bool
False