{-# 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.
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 -> Text -> Either String Regex
forall a. Parser a -> Text -> Either String a
parseOnly (StateT RState Parser Regex -> RState -> Parser Regex
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT RState Parser Regex
parser RState :: Int -> Bool -> RState
RState{
                                            rsCurrentCaptureNumber :: Int
rsCurrentCaptureNumber = Int
0,
                                            rsCaseSensitive :: Bool
rsCaseSensitive = Bool
caseSensitive })
                       (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
bs)
   in Either String Regex
res
 where
   parser :: StateT RState Parser Regex
parser = do
     !Regex
re <- StateT RState Parser Regex
pRegex
     (Regex
re Regex -> StateT RState Parser () -> StateT RState Parser Regex
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text () -> StateT RState Parser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput) StateT RState Parser Regex
-> StateT RState Parser Regex -> StateT RState Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       do Text
rest <- Parser Text Text -> StateT RState Parser Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser Text Text
A.takeText
          String -> StateT RState Parser Regex
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> StateT RState Parser Regex)
-> String -> StateT RState 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 (Text -> ByteString
encodeUtf8 Text
rest))

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

type RParser = StateT RState Parser

pRegex :: RParser Regex
pRegex :: StateT RState Parser Regex
pRegex =
  Regex -> StateT RState Parser Regex -> StateT RState Parser Regex
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Regex
MatchNull (StateT RState Parser Regex -> StateT RState Parser Regex)
-> StateT RState Parser Regex -> StateT RState 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 RState Parser Regex
-> StateT RState Parser ([Regex] -> Regex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT RState Parser Regex
pAltPart
    StateT RState Parser ([Regex] -> Regex)
-> StateT RState Parser [Regex] -> StateT RState Parser Regex
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT RState Parser Regex -> StateT RState Parser [Regex]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text Char -> StateT RState Parser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Text Char
char Char
'|') StateT RState Parser Char
-> StateT RState Parser Regex -> StateT RState Parser Regex
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (StateT RState Parser Regex
pAltPart StateT RState Parser Regex
-> StateT RState Parser Regex -> StateT RState Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Regex -> StateT RState Parser Regex
forall (f :: * -> *) a. Applicative f => a -> f a
pure Regex
forall a. Monoid a => a
mempty))

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

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

pParenthesized :: RParser Regex
pParenthesized :: StateT RState Parser Regex
pParenthesized = do
  Char
_ <- Parser Text Char -> StateT RState Parser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Text Char
char Char
'(')
  -- pcrepattern says: A group that starts with (?| resets the capturing
  -- parentheses numbers in each alternative.
  Bool
resetCaptureNumbers <- Bool -> StateT RState Parser Bool -> StateT RState Parser Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Bool
True Bool -> StateT RState Parser Text -> StateT RState Parser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text Text -> StateT RState Parser Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Text -> Parser Text Text
string Text
"?|"))
  (Regex -> Regex
modifier, RState -> RState
stModifier) <-
              if Bool
resetCaptureNumbers
                 then (Regex -> Regex, RState -> RState)
-> StateT RState Parser (Regex -> Regex, RState -> RState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Regex
forall a. a -> a
id, RState -> RState
forall a. a -> a
id)
                 else Parser Text (Regex -> Regex, RState -> RState)
-> StateT RState Parser (Regex -> Regex, RState -> RState)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Text Char
char Char
'?' Parser Text Char
-> Parser Text (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (Regex -> Regex, RState -> RState)
pGroupModifiers)
                    StateT RState Parser (Regex -> Regex, RState -> RState)
-> StateT RState Parser (Regex -> Regex, RState -> RState)
-> StateT RState Parser (Regex -> Regex, RState -> RState)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do (RState -> RState) -> StateT RState Parser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RState
st -> RState
st{
                                      rsCurrentCaptureNumber :: Int
rsCurrentCaptureNumber =
                                             RState -> Int
rsCurrentCaptureNumber RState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1})
                           Int
num <- (RState -> Int) -> StateT RState Parser Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> Int
rsCurrentCaptureNumber
                           (Regex -> Regex, RState -> RState)
-> StateT RState Parser (Regex -> Regex, RState -> RState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Regex -> Regex
MatchCapture Int
num, RState -> RState
forall a. a -> a
id)
  Int
currentCaptureNumber <- (RState -> Int) -> StateT RState Parser Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> Int
rsCurrentCaptureNumber
  Regex
contents <- Regex -> StateT RState Parser Regex -> StateT RState Parser Regex
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Regex
MatchNull (StateT RState Parser Regex -> StateT RState Parser Regex)
-> StateT RState Parser Regex -> StateT RState Parser Regex
forall a b. (a -> b) -> a -> b
$ (RState -> RState)
-> StateT RState Parser Regex -> StateT RState Parser Regex
forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
withStateT RState -> RState
stModifier (StateT RState Parser Regex -> StateT RState Parser Regex)
-> StateT RState Parser Regex -> StateT RState 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 RState Parser Regex
-> StateT RState Parser ([Regex] -> Regex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT RState Parser Regex
pAltPart
      StateT RState Parser ([Regex] -> Regex)
-> StateT RState Parser [Regex] -> StateT RState Parser Regex
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT RState Parser Regex -> StateT RState Parser [Regex]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text Char -> StateT RState Parser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Text Char
char Char
'|') StateT RState Parser Char
-> StateT RState Parser Regex -> StateT RState Parser Regex
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
            ((Bool -> StateT RState Parser () -> StateT RState Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
resetCaptureNumbers
                  ((RState -> RState) -> StateT RState Parser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RState
st ->
                        RState
st{ rsCurrentCaptureNumber :: Int
rsCurrentCaptureNumber = Int
currentCaptureNumber }))
               StateT RState Parser ()
-> StateT RState Parser Regex -> StateT RState Parser Regex
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT RState Parser Regex
pAltPart) StateT RState Parser Regex
-> StateT RState Parser Regex -> StateT RState Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Regex -> StateT RState Parser Regex
forall (f :: * -> *) a. Applicative f => a -> f a
pure Regex
forall a. Monoid a => a
mempty))
  Char
_ <- Parser Text Char -> StateT RState Parser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Text Char
char Char
')')
  Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT RState Parser Regex)
-> Regex -> StateT RState Parser Regex
forall a b. (a -> b) -> a -> b
$ Regex -> Regex
modifier Regex
contents

pGroupModifiers :: Parser (Regex -> Regex, RState -> RState)
pGroupModifiers :: Parser Text (Regex -> Regex, RState -> RState)
pGroupModifiers =
  (do RState -> RState
stmod <- Parser (RState -> RState)
pRegexModifier -- (?i:
      Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Text Char
char Char
':')
      (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Regex -> Regex
forall a. a -> a
id, RState -> RState
stmod))
   Parser Text (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     do Direction
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 Text Char -> Parser Text Direction
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'<'
        ((Direction -> Regex -> Regex
AssertPositive Direction
dir, RState -> RState
forall a. a -> a
id) (Regex -> Regex, RState -> RState)
-> Parser Text Char
-> Parser Text (Regex -> Regex, RState -> RState)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'=') Parser Text (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          ((Direction -> Regex -> Regex
AssertNegative Direction
dir, RState -> RState
forall a. a -> a
id) (Regex -> Regex, RState -> RState)
-> Parser Text Char
-> Parser Text (Regex -> Regex, RState -> RState)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'!')
   Parser Text (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     do Char
c <- Parser Text Char
digit
        (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
forall (m :: * -> *) a. Monad m => a -> m a
return (\Regex
_ -> Int -> Regex
Subroutine (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48), RState -> RState
forall a. a -> a
id)
   Parser Text (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     do Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Char -> Parser Text ())
-> Parser Text Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
char Char
'R'
        (Regex -> Regex, RState -> RState)
-> Parser Text (Regex -> Regex, RState -> RState)
forall (m :: * -> *) a. Monad m => a -> m a
return  (\Regex
_ -> Int -> Regex
Subroutine Int
0, RState -> RState
forall a. a -> a
id)

pRegexModifier :: Parser (RState -> RState)
pRegexModifier :: Parser (RState -> RState)
pRegexModifier = do
  -- "adlupimnsx-imnsx"
  -- i = 105  - = 45
  String
ons <- Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text Char -> Parser Text String)
-> Parser Text Char -> Parser Text String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text Char
satisfy (String -> Char -> Bool
inClass String
"adlupimnsx")
  String
offs <- String -> Parser Text String -> Parser Text String
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] (Parser Text String -> Parser Text String)
-> Parser Text String -> Parser Text String
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
char Char
'-' Parser Text Char -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                      Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser Text Char
satisfy (String -> Char -> Bool
inClass String
"imnsx"))
  (RState -> RState) -> Parser (RState -> RState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((RState -> RState) -> Parser (RState -> RState))
-> (RState -> RState) -> Parser (RState -> RState)
forall a b. (a -> b) -> a -> b
$ \RState
st -> RState
st{
    rsCaseSensitive :: Bool
rsCaseSensitive =
      if Char
'i' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
ons Bool -> Bool -> Bool
&& Char
'i' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
offs
         then Bool
False
         else (Char
'i' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
offs) Bool -> Bool -> Bool
|| RState -> Bool
rsCaseSensitive RState
st
  }

pSuffix :: Regex -> RParser Regex
pSuffix :: Regex -> StateT RState Parser Regex
pSuffix Regex
re = Regex -> StateT RState Parser Regex -> StateT RState Parser Regex
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Regex
re (StateT RState Parser Regex -> StateT RState Parser Regex)
-> StateT RState Parser Regex -> StateT RState Parser Regex
forall a b. (a -> b) -> a -> b
$ do
  Char
w <- Parser Text Char -> StateT RState Parser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Text Char -> StateT RState Parser Char)
-> Parser Text Char -> StateT RState Parser Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text Char
satisfy (String -> Char -> Bool
inClass String
"*+?{")
  (case Char
w of
    Char
'*'  -> Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT RState Parser Regex)
-> Regex -> StateT RState Parser Regex
forall a b. (a -> b) -> a -> b
$ Regex -> Regex -> Regex
MatchAlt (Regex -> Regex
MatchSome Regex
re) Regex
MatchNull
    Char
'+'  -> Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT RState Parser Regex)
-> Regex -> StateT RState Parser Regex
forall a b. (a -> b) -> a -> b
$ Regex -> Regex
MatchSome Regex
re
    Char
'?'  -> Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT RState Parser Regex)
-> Regex -> StateT RState Parser Regex
forall a b. (a -> b) -> a -> b
$ Regex -> Regex -> Regex
MatchAlt Regex
re Regex
MatchNull
    Char
'{'  -> do
      Maybe Int
minn <- Parser Text (Maybe Int) -> StateT RState Parser (Maybe Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Text (Maybe Int) -> StateT RState Parser (Maybe Int))
-> Parser Text (Maybe Int) -> StateT RState Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$
        Maybe Int -> Parser Text (Maybe Int) -> Parser Text (Maybe Int)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Maybe Int
forall a. Maybe a
Nothing (Parser Text (Maybe Int) -> Parser Text (Maybe Int))
-> Parser Text (Maybe Int) -> Parser Text (Maybe Int)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int) -> Parser Text Text -> Parser Text (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
A.takeWhile Char -> Bool
isDigit
      Maybe Int
maxn <- Parser Text (Maybe Int) -> StateT RState Parser (Maybe Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Text (Maybe Int) -> StateT RState Parser (Maybe Int))
-> Parser Text (Maybe Int) -> StateT RState Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Parser Text (Maybe Int) -> Parser Text (Maybe Int)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Maybe Int
minn (Parser Text (Maybe Int) -> Parser Text (Maybe Int))
-> Parser Text (Maybe Int) -> Parser Text (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
char Char
',' Parser Text Char
-> Parser Text (Maybe Int) -> Parser Text (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) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int) -> Parser Text Text -> Parser Text (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
A.takeWhile Char -> Bool
isDigit)
      Char
_ <- Parser Text Char -> StateT RState Parser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Text Char -> StateT RState Parser Char)
-> Parser Text Char -> StateT RState Parser Char
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
char Char
'}'
      case (Maybe Int
minn, Maybe Int
maxn) of
          (Maybe Int
Nothing, Maybe Int
Nothing) -> StateT RState Parser Regex
forall (m :: * -> *) a. MonadPlus m => m a
mzero
          (Just Int
n, Maybe Int
Nothing)  -> Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT RState Parser Regex)
-> Regex -> StateT RState Parser Regex
forall a b. (a -> b) -> a -> b
$! Int -> Regex -> Regex
atleast Int
n Regex
re
          (Maybe Int
Nothing, Just Int
n)  -> Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT RState Parser Regex)
-> Regex -> StateT RState Parser Regex
forall a b. (a -> b) -> a -> b
$! Int -> Regex -> Regex
atmost Int
n Regex
re
          (Just Int
m, Just Int
n)   -> Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT RState Parser Regex)
-> Regex -> StateT RState Parser Regex
forall a b. (a -> b) -> a -> b
$! Int -> Int -> Regex -> Regex
between Int
m Int
n Regex
re
    Char
_   -> String -> StateT RState Parser Regex
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"pSuffix encountered impossible byte") StateT RState Parser Regex
-> (Regex -> StateT RState Parser Regex)
-> StateT RState Parser Regex
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
             Parser Regex -> StateT RState Parser Regex
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Regex -> StateT RState Parser Regex)
-> (Regex -> Parser Regex) -> Regex -> StateT RState Parser Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Text Char -> Parser Regex
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'+') Parser Regex -> Parser Regex -> Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Regex -> Regex
Lazy Regex
re Regex -> Parser Text Char -> Parser Regex
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'?')

pRegexChar :: RParser Regex
pRegexChar :: StateT RState Parser Regex
pRegexChar = do
  Char
w <- Parser Text Char -> StateT RState Parser Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser Text Char
anyChar
  Bool
caseSensitive <- (RState -> Bool) -> StateT RState Parser Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RState -> Bool
rsCaseSensitive
  case Char
w of
    Char
'.'  -> Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
MatchAnyChar
    Char
'%' -> (do -- dynamic %1 %2
              String
ds <- Parser Text String -> StateT RState Parser String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Text String -> StateT RState Parser String)
-> Parser Text String -> StateT RState Parser String
forall a b. (a -> b) -> a -> b
$ Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text Char
digit
              case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay String
ds of
                Just !Int
n -> Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT RState Parser Regex)
-> Regex -> StateT RState Parser Regex
forall a b. (a -> b) -> a -> b
$ Int -> Regex
MatchDynamic Int
n
                Maybe Int
Nothing -> String -> StateT RState Parser Regex
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a number")
            StateT RState Parser Regex
-> StateT RState Parser Regex -> StateT RState Parser Regex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Regex -> StateT RState 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
'%'))
    Char
'\\' -> Parser Regex -> StateT RState Parser Regex
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser Regex
pRegexEscapedChar
    Char
'$'  -> Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
AssertEnd
    Char
'^'  -> Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
AssertBeginning
    Char
'['  -> Parser Regex -> StateT RState Parser Regex
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser Regex
pRegexCharClass
    Char
_ | Char -> Bool
isSpecial Char
w -> StateT RState Parser Regex
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      | Bool
otherwise -> Regex -> StateT RState Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> StateT RState Parser Regex)
-> Regex -> StateT RState 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
w)
                           else (\Char
d -> Char -> Char
toLower Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toLower Char
w)

pRegexEscapedChar :: Parser Regex
pRegexEscapedChar :: Parser Regex
pRegexEscapedChar = do
  Char
c <- Parser Text Char
A.anyChar
  (case Char
c of
    Char
'b' -> Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
AssertWordBoundary
    Char
'B' -> 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
$ Direction -> Regex -> Regex
AssertNegative Direction
Forward Regex
AssertWordBoundary
    Char
'{' -> do -- captured pattern: \1 \2 \{12}
              String
ds <- Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text Char
digit
              Char
_ <- Char -> Parser Text Char
char Char
'}'
              case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay String
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
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
'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
_ | Char -> Bool
isDigit Char
c ->
       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 Text Char -> Parser Regex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser Text Char
pEscaped Char
c)

pEscaped :: Char -> Parser Char
pEscaped :: Char -> Parser Text Char
pEscaped Char
c =
  case Char
c of
    Char
'\\' -> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
    Char
'a' -> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\a'
    Char
'f' -> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'
    Char
'n' -> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
    Char
'r' -> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'
    Char
't' -> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'
    Char
'v' -> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\v'
    Char
'0' -> do -- \0ooo matches octal ooo
      Text
ds <- Int -> Parser Text Text
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]
++ Text -> String
T.unpack Text
ds String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") of
        Just Char
x  -> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
        Maybe Char
Nothing -> String -> Parser Text 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 -> 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
      Text
ds <- Int -> (Int -> Char -> Maybe Int) -> Parser Text Text
forall s. s -> (s -> Char -> Maybe s) -> Parser Text Text
A.scan (Int
1 :: Int) Int -> Char -> Maybe Int
forall a. (Ord a, Num a) => a -> Char -> 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]
++ Text -> String
T.unpack Text
ds String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") of
        Just Char
x  -> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
        Maybe Char
Nothing -> String -> Parser Text Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid octal character escape"
    Char
'z' -> do -- \zhhhh matches unicode hex char hhhh
      Text
ds <- Int -> Parser Text Text
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]
++ Text -> String
T.unpack Text
ds String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") of
        Just Char
x  -> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
        Maybe Char
Nothing -> String -> Parser Text Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid hex character escape"
    Char
'x' -> do -- \xhh matches hex hh, \x{h+} matches hex h+
      Text
ds <- (Char -> Parser Text Char
char Char
'{' Parser Text Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') Parser Text Text -> Parser Text Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'}')
             Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Text Text
A.take Int
2
      case String -> Maybe Char
forall a. Read a => String -> Maybe a
readMay (String
"'\\x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
ds String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") of
        Just Char
x  -> Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
x
        Maybe Char
Nothing -> String -> Parser Text Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
      | Bool
otherwise -> String -> Parser Text Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text Char) -> String -> Parser Text Char
forall a b. (a -> b) -> a -> b
$ String
"invalid escape \\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]

pRegexCharClass :: Parser Regex
pRegexCharClass :: Parser Regex
pRegexCharClass = do
  Bool
negated <- Bool -> Parser Text Bool -> Parser Text Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Parser Text Bool -> Parser Text Bool)
-> Parser Text Bool -> Parser Text Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> Parser Text Char -> Parser Text Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'^'
  let getEscapedClass :: Parser Text (Char -> Bool)
getEscapedClass = do
        Char
_ <- Char -> Parser Text Char
char Char
'\\'
        (Char -> Bool
isDigit (Char -> Bool) -> Parser Text Char -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'd')
         Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (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 Text Char -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'D')
         Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isSpace (Char -> Bool) -> Parser Text Char -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
's')
         Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (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 Text Char -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'S')
         Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isWordChar (Char -> Bool) -> Parser Text Char -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'w')
         Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (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 Text Char -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'W')
  let getPosixClass :: Parser Text (Char -> Bool)
getPosixClass = do
        Text
_ <- Text -> Parser Text Text
string Text
"[:"
        Bool
localNegated <- Bool -> Parser Text Bool -> Parser Text Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Parser Text Bool -> Parser Text Bool)
-> Parser Text Bool -> Parser Text Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> Parser Text Char -> Parser Text Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'^'
        Char -> Bool
res <- (Char -> Bool
isAlphaNum (Char -> Bool) -> Parser Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"alnum")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isAlpha (Char -> Bool) -> Parser Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"alpha")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isAscii (Char -> Bool) -> Parser Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"ascii")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (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 Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
                   Text -> Parser Text Text
string Text
"blank")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isControl (Char -> Bool) -> Parser Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"cntrl")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (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 Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"graph:")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isLower (Char -> Bool) -> Parser Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"lower")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isUpper (Char -> Bool) -> Parser Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"upper")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isPrint (Char -> Bool) -> Parser Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"print")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isPunctuation (Char -> Bool) -> Parser Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"punct")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isSpace (Char -> Bool) -> Parser Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"space")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (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 Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"word:")
             Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool
isHexDigit (Char -> Bool) -> Parser Text Text -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"xdigit")
        Text
_ <- Text -> Parser Text Text
string Text
":]"
        (Char -> Bool) -> Parser Text (Char -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> Parser Text (Char -> Bool))
-> (Char -> Bool) -> Parser Text (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 Text Char
getC = (Char -> Parser Text Char
char Char
'\\' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char
anyChar Parser Text Char -> (Char -> Parser Text Char) -> Parser Text Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Parser Text Char
pEscaped) Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
             (Char -> Bool) -> Parser Text 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 :: Parser Text (Char -> Bool)
getCRange = do
        Char
c <- Parser Text 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 Text Char -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Text Char
char Char
'-' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char
getC) Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          (Char -> Bool) -> Parser Text (Char -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
  let getQELiteral :: Parser Text (Char -> Bool)
getQELiteral = do
        Parser Text Text -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser Text ())
-> Parser Text Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
A.string Text
"\\Q"
        String
cs <- Parser Text Char -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Text Char
anyChar (Text -> Parser Text Text
A.string Text
"\\E")
        (Char -> Bool) -> Parser Text (Char -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> Parser Text (Char -> Bool))
-> (Char -> Bool) -> Parser Text (Char -> Bool)
forall a b. (a -> b) -> a -> b
$! \Char
c -> (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) String
cs
  [Char -> Bool]
brack <- [Char -> Bool]
-> Parser Text [Char -> Bool] -> Parser Text [Char -> Bool]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] (Parser Text [Char -> Bool] -> Parser Text [Char -> Bool])
-> Parser Text [Char -> Bool] -> Parser Text [Char -> Bool]
forall a b. (a -> b) -> a -> b
$ [(Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
']')] [Char -> Bool] -> Parser Text Char -> Parser Text [Char -> Bool]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
']'
  [Char -> Bool]
fs <- Parser Text (Char -> Bool) -> Parser Text [Char -> Bool]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text (Char -> Bool)
getQELiteral Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (Char -> Bool)
getEscapedClass Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (Char -> Bool)
getPosixClass Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (Char -> Bool)
getCRange
              Parser Text (Char -> Bool)
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text Text
A.string Text
"\\p" Parser Text Text
-> Parser Text (Char -> Bool) -> Parser Text (Char -> Bool)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (Char -> Bool)
pUnicodeCharClass))
  Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Char -> Parser Text ())
-> Parser Text Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
char Char
']'
  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 ((Char -> Bool) -> Regex) -> (Char -> Bool) -> Regex
forall a b. (a -> b) -> a -> b
$ 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

-- character class \p{Lo}; we assume \p is already parsed
pUnicodeCharClass :: Parser (Char -> Bool)
pUnicodeCharClass :: Parser Text (Char -> Bool)
pUnicodeCharClass = do
  Text
ds <- Char -> Parser Text Char
char Char
'{' Parser Text Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') Parser Text Text -> Parser Text Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'}'
  (Char -> Bool) -> Parser Text (Char -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> Parser Text (Char -> Bool))
-> (Char -> Bool) -> Parser Text (Char -> Bool)
forall a b. (a -> b) -> a -> b
$
    (case Text
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 -> Bool)
-> (Char -> GeneralCategory) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> GeneralCategory
generalCategory


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
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
True
isSpecial Char
_  = Bool
False