    {-# 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 [Char] Regex
    compileRegex Bool
    caseSensitive 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 })
                           (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 }
      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
    $
      (Regex -> Regex -> Regex) -> Regex -> [Regex] -> Regex
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Regex -> Regex -> Regex
    MatchAlt
        (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] -> 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
    '(')
      -- 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
      contents <- option MatchNull $ withStateT stModifier $
        foldr MatchAlt
          <$> pAltPart
          <*> many (lift (char '|') *>
                ((when resetCaptureNumbers
                      (modify (\RState
    st ->
                            RState
    st{ rsCurrentCaptureNumber = currentCaptureNumber }))
                   >> pAltPart) <|> pure mempty))
      _ <- lift (char ')')
      return $ modifier contents

    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 c <- Parser Char
    digit
            return (\Regex
    _ -> Int -> Regex
    Subroutine (Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    48), 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
    <|>
         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)

    pRegexModifier :: Parser (RState -> RState)
    pRegexModifier :: Parser (RState -> RState)
    pRegexModifier = do
      -- "adlupimnsx-imnsx"
      -- i = 105  - = 45
      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]
    "adlupimnsx")
      offs <- option [] $ char '-' *>
                          many (satisfy (inClass "imnsx"))
      pure $ \RState
    st -> RState
    st{
        rsCaseSensitive =
          if 'i' `elem` ons && 'i' `notElem` offs
             then False
             else ('i' `elem` offs) || rsCaseSensitive st
      }

    pSuffix :: Regex -> RParser Regex
    pSuffix :: Regex -> StateT RState (Parser Text) Regex
    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 -> 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
    $ Regex -> Regex -> Regex
    MatchAlt (Regex -> Regex
    MatchSome Regex
    re) Regex
    MatchNull
        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 -> StateT RState (Parser Text) Regex)
    -> Regex -> StateT RState (Parser Text) Regex
    forall a b. (a -> b) -> a -> b
    $ Regex -> Regex
    MatchSome Regex
    re
        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 -> StateT RState (Parser Text) Regex)
    -> Regex -> StateT RState (Parser Text) Regex
    forall a b. (a -> b) -> a -> b
    $ Regex -> Regex -> Regex
    MatchAlt Regex
    re Regex
    MatchNull
        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
    Nothing, Maybe Int
    Nothing) -> StateT RState (Parser Text) Regex
    forall a. StateT RState (Parser Text) a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
              (Just Int
    n, Maybe Int
    Nothing)  -> 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 -> Regex
    atleast Int
    n Regex
    re
              (Maybe Int
    Nothing, 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 -> Regex
    atmost Int
    n Regex
    re
              (Just Int
    m, 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 -> Int -> Regex -> Regex
    between 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") >>=
                 lift . 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 Char -> Parser Regex
    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 Regex -> Parser Regex -> Parser Regex
    forall a. Parser Text a -> Parser Text a -> Parser Text a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Regex -> Regex
    Lazy Regex
    re Regex -> Parser Char -> Parser Regex
    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
    '?')

    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
    pRegexEscapedChar
        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
    pRegexCharClass
        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)

    pRegexEscapedChar :: Parser Regex
    pRegexEscapedChar :: Parser Regex
    pRegexEscapedChar = 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
        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 -> Regex
    MatchCaptured Int
    n
                    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
    '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
    _ | Char -> Bool
    isDigit Char
    c ->
           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 -> 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 a. Parser Text a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero) <|> (MatchChar . (==) <$> pEscaped c)

    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'
        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 -- \0ooo matches octal ooo
          ds <- Int -> Parser Text
    A.take Int
    3
          case readMay ("'\\o" ++ 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 :: Parser Regex
    pRegexCharClass :: Parser Regex
    pRegexCharClass = do
      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 Char -> Parser Text 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')
             <|> (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")
                 <|> ((\Char
    c -> Char -> Bool
    isPrint Char
    c Bool -> Bool -> Bool
    || 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
      brack <- option [] $ [(==']')] <$ char ']'
      fs <- many (getQELiteral <|> getEscapedClass <|> getPosixClass <|> getCRange
                  <|> (A.string "\\p" *> 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
      return $! MatchChar $ if negated
                               then not . f
                               else f

    -- character class \p{Lo}; we assume \p is already parsed
    pUnicodeCharClass :: Parser (Char -> Bool)
    pUnicodeCharClass :: Parser Text (Char -> Bool)
    pUnicodeCharClass = do
      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
    '}'
      return $
        (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

    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