{-# LANGUAGE OverloadedStrings #-}
{- | A module implementing regexp-based split and substitute.

>>> substituteCompile "(a+)" "lapin" "'\\1'"
Right "l'a'pin"

>>> splitCompile "\\d" "a1b2c3"
Right ["a","b","c"]
-}
module Text.Regex.PCRE.ByteString.Utils
    ( -- * Perl-like utility functions
      substitute
    , split
    , substituteCompile
    , splitCompile
    -- * Re-exports from "Text.Regex.PCRE.ByteString"
    , Regex
    , CompOption
    , ExecOption
    , compBlank
    , execBlank
    -- * Pure version of the functions, using 'unsafePerformIO'
    , compile'
    , execute'
    , substitute'
    , split'
    , substituteCompile'
    , splitCompile'
    ) where

import Text.Regex.PCRE.ByteString
import qualified Data.ByteString.Char8 as BS
import Control.Monad.Except
import Data.Attoparsec.ByteString.Char8 as A
import Control.Applicative
import Data.Char (digitToInt)
import System.IO.Unsafe
import qualified Data.Array as A

{-| Substitutes values matched by a `Regex`. References can be used.

It doesn't support anything else than global substitution for now ..

-}
substitute :: Regex             -- ^ The regular expression, taken from a call to `compile`
           -> BS.ByteString     -- ^ The source string
           -> BS.ByteString     -- ^ The replacement string
           -> IO (Either String BS.ByteString)
substitute :: Regex -> ByteString -> ByteString -> IO (Either String ByteString)
substitute Regex
regexp ByteString
srcstring ByteString
repla = ExceptT String IO ByteString -> IO (Either String ByteString)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO ByteString -> IO (Either String ByteString))
-> ExceptT String IO ByteString -> IO (Either String ByteString)
forall a b. (a -> b) -> a -> b
$ do
    [Replacement]
parsedReplacement <- case Parser [Replacement] -> ByteString -> Either String [Replacement]
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser [Replacement]
repparser ByteString
repla of
                             Right [Replacement]
y -> [Replacement] -> ExceptT String IO [Replacement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Replacement]
y
                             Left String
rr -> String -> ExceptT String IO [Replacement]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
rr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" when parsing the replacement string")
    [RegexpSplit ByteString]
matches <- Regex -> ByteString -> ExceptT String IO [RegexpSplit ByteString]
getMatches Regex
regexp ByteString
srcstring
    let applyReplacement :: RegexpSplit BS.ByteString -> BS.ByteString
        applyReplacement :: RegexpSplit ByteString -> ByteString
applyReplacement (Unmatched ByteString
x) = ByteString
x
        applyReplacement (Matched ByteString
captured [ByteString]
mcaptures) = ByteString -> [Replacement] -> [ByteString] -> ByteString
applyCaptures ByteString
captured [Replacement]
parsedReplacement [ByteString]
mcaptures
    ByteString -> ExceptT String IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ExceptT String IO ByteString)
-> ByteString -> ExceptT String IO ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$! (RegexpSplit ByteString -> ByteString)
-> [RegexpSplit ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map RegexpSplit ByteString -> ByteString
applyReplacement [RegexpSplit ByteString]
matches

-- Transforms the parsed replacement and the vector of captured stuff into
-- the destination ByteString.
applyCaptures :: BS.ByteString -> [Replacement] -> [BS.ByteString] -> BS.ByteString
applyCaptures :: ByteString -> [Replacement] -> [ByteString] -> ByteString
applyCaptures ByteString
firstmatch [Replacement]
repl [ByteString]
mcaptures = [ByteString] -> ByteString
BS.concat ((Replacement -> ByteString) -> [Replacement] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Replacement -> ByteString
applyCaptures' [Replacement]
repl)
    where
        ncaptures :: Int
ncaptures = [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
mcaptures
        applyCaptures' :: Replacement -> BS.ByteString
        applyCaptures' :: Replacement -> ByteString
applyCaptures' Replacement
WholeMatch = ByteString
firstmatch
        applyCaptures' (RawReplacement ByteString
r) = ByteString
r
        applyCaptures' (IndexedReplacement Int
idx)
            | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ncaptures Bool -> Bool -> Bool
|| Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = ByteString
""
            | Bool
otherwise = [ByteString]
mcaptures [ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!! (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Splits strings, using a `Regex` as delimiter.
split :: Regex  -- ^ The regular expression, taken from a call to `compile`
      -> BS.ByteString -- ^ The source string
      -> IO (Either String [BS.ByteString])
split :: Regex -> ByteString -> IO (Either String [ByteString])
split Regex
regexp ByteString
srcstring = ([RegexpSplit ByteString] -> [ByteString])
-> Either String [RegexpSplit ByteString]
-> Either String [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ByteString] -> [ByteString]
removeEmptyLeft ([ByteString] -> [ByteString])
-> ([RegexpSplit ByteString] -> [ByteString])
-> [RegexpSplit ByteString]
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RegexpSplit ByteString] -> [ByteString]
forall a. [RegexpSplit a] -> [a]
regexpUnmatched) (Either String [RegexpSplit ByteString]
 -> Either String [ByteString])
-> IO (Either String [RegexpSplit ByteString])
-> IO (Either String [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT String IO [RegexpSplit ByteString]
-> IO (Either String [RegexpSplit ByteString])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Regex -> ByteString -> ExceptT String IO [RegexpSplit ByteString]
getMatches Regex
regexp ByteString
srcstring)
    where
        removeEmptyLeft :: [ByteString] -> [ByteString]
removeEmptyLeft = [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ByteString -> Bool
BS.null ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse

-- | A pure version of 'substitute', using unsafePerformIO.
substitute' :: Regex             -- ^ The regular expression, taken from a call to `compile`
            -> BS.ByteString     -- ^ The source string
            -> BS.ByteString     -- ^ The replacement string
            -> Either String BS.ByteString
substitute' :: Regex -> ByteString -> ByteString -> Either String ByteString
substitute' Regex
regexp ByteString
srcstring ByteString
repla = IO (Either String ByteString) -> Either String ByteString
forall a. IO a -> a
unsafePerformIO (Regex -> ByteString -> ByteString -> IO (Either String ByteString)
substitute Regex
regexp ByteString
srcstring ByteString
repla)

-- | A pure version of 'split', using unsafePerformIO.
split' :: Regex  -- ^ The regular expression, taken from a call to `compile`
       -> BS.ByteString -- ^ The source string
       -> Either String [BS.ByteString]
split' :: Regex -> ByteString -> Either String [ByteString]
split' Regex
regexp ByteString
srcstring = IO (Either String [ByteString]) -> Either String [ByteString]
forall a. IO a -> a
unsafePerformIO (Regex -> ByteString -> IO (Either String [ByteString])
split Regex
regexp ByteString
srcstring)

data RegexpSplit a = Matched a [a]
                   | Unmatched a
                   deriving (Int -> RegexpSplit a -> String -> String
[RegexpSplit a] -> String -> String
RegexpSplit a -> String
(Int -> RegexpSplit a -> String -> String)
-> (RegexpSplit a -> String)
-> ([RegexpSplit a] -> String -> String)
-> Show (RegexpSplit a)
forall a. Show a => Int -> RegexpSplit a -> String -> String
forall a. Show a => [RegexpSplit a] -> String -> String
forall a. Show a => RegexpSplit a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RegexpSplit a] -> String -> String
$cshowList :: forall a. Show a => [RegexpSplit a] -> String -> String
show :: RegexpSplit a -> String
$cshow :: forall a. Show a => RegexpSplit a -> String
showsPrec :: Int -> RegexpSplit a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> RegexpSplit a -> String -> String
Show, RegexpSplit a -> RegexpSplit a -> Bool
(RegexpSplit a -> RegexpSplit a -> Bool)
-> (RegexpSplit a -> RegexpSplit a -> Bool) -> Eq (RegexpSplit a)
forall a. Eq a => RegexpSplit a -> RegexpSplit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegexpSplit a -> RegexpSplit a -> Bool
$c/= :: forall a. Eq a => RegexpSplit a -> RegexpSplit a -> Bool
== :: RegexpSplit a -> RegexpSplit a -> Bool
$c== :: forall a. Eq a => RegexpSplit a -> RegexpSplit a -> Bool
Eq, Eq (RegexpSplit a)
Eq (RegexpSplit a)
-> (RegexpSplit a -> RegexpSplit a -> Ordering)
-> (RegexpSplit a -> RegexpSplit a -> Bool)
-> (RegexpSplit a -> RegexpSplit a -> Bool)
-> (RegexpSplit a -> RegexpSplit a -> Bool)
-> (RegexpSplit a -> RegexpSplit a -> Bool)
-> (RegexpSplit a -> RegexpSplit a -> RegexpSplit a)
-> (RegexpSplit a -> RegexpSplit a -> RegexpSplit a)
-> Ord (RegexpSplit a)
RegexpSplit a -> RegexpSplit a -> Bool
RegexpSplit a -> RegexpSplit a -> Ordering
RegexpSplit a -> RegexpSplit a -> RegexpSplit a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (RegexpSplit a)
forall a. Ord a => RegexpSplit a -> RegexpSplit a -> Bool
forall a. Ord a => RegexpSplit a -> RegexpSplit a -> Ordering
forall a. Ord a => RegexpSplit a -> RegexpSplit a -> RegexpSplit a
min :: RegexpSplit a -> RegexpSplit a -> RegexpSplit a
$cmin :: forall a. Ord a => RegexpSplit a -> RegexpSplit a -> RegexpSplit a
max :: RegexpSplit a -> RegexpSplit a -> RegexpSplit a
$cmax :: forall a. Ord a => RegexpSplit a -> RegexpSplit a -> RegexpSplit a
>= :: RegexpSplit a -> RegexpSplit a -> Bool
$c>= :: forall a. Ord a => RegexpSplit a -> RegexpSplit a -> Bool
> :: RegexpSplit a -> RegexpSplit a -> Bool
$c> :: forall a. Ord a => RegexpSplit a -> RegexpSplit a -> Bool
<= :: RegexpSplit a -> RegexpSplit a -> Bool
$c<= :: forall a. Ord a => RegexpSplit a -> RegexpSplit a -> Bool
< :: RegexpSplit a -> RegexpSplit a -> Bool
$c< :: forall a. Ord a => RegexpSplit a -> RegexpSplit a -> Bool
compare :: RegexpSplit a -> RegexpSplit a -> Ordering
$ccompare :: forall a. Ord a => RegexpSplit a -> RegexpSplit a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (RegexpSplit a)
Ord)

instance Functor RegexpSplit where
    fmap :: (a -> b) -> RegexpSplit a -> RegexpSplit b
fmap a -> b
f (Matched a
x [a]
y)   = b -> [b] -> RegexpSplit b
forall a. a -> [a] -> RegexpSplit a
Matched (a -> b
f a
x) ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
y)
    fmap a -> b
f (Unmatched a
x) = b -> RegexpSplit b
forall a. a -> RegexpSplit a
Unmatched (a -> b
f a
x)

regexpAll :: [RegexpSplit a] -> [a]
regexpAll :: [RegexpSplit a] -> [a]
regexpAll = (RegexpSplit a -> a) -> [RegexpSplit a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map RegexpSplit a -> a
forall p. RegexpSplit p -> p
unreg
    where
        unreg :: RegexpSplit p -> p
unreg ( Matched p
x [p]
_ ) = p
x
        unreg ( Unmatched p
x ) = p
x

isMatched :: RegexpSplit a -> Bool
isMatched :: RegexpSplit a -> Bool
isMatched (Matched a
_ [a]
_) = Bool
True
isMatched RegexpSplit a
_ = Bool
False

regexpUnmatched :: [RegexpSplit a] -> [a]
regexpUnmatched :: [RegexpSplit a] -> [a]
regexpUnmatched = [RegexpSplit a] -> [a]
forall a. [RegexpSplit a] -> [a]
regexpAll ([RegexpSplit a] -> [a])
-> ([RegexpSplit a] -> [RegexpSplit a]) -> [RegexpSplit a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RegexpSplit a -> Bool) -> [RegexpSplit a] -> [RegexpSplit a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (RegexpSplit a -> Bool) -> RegexpSplit a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegexpSplit a -> Bool
forall a. RegexpSplit a -> Bool
isMatched)

getMatches :: Regex -> BS.ByteString -> ExceptT String IO [RegexpSplit BS.ByteString]
getMatches :: Regex -> ByteString -> ExceptT String IO [RegexpSplit ByteString]
getMatches Regex
_ ByteString
"" = [RegexpSplit ByteString]
-> ExceptT String IO [RegexpSplit ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getMatches Regex
creg ByteString
src = do
    Either
  WrapError
  (Maybe (ByteString, ByteString, ByteString, [ByteString]))
x <- IO
  (Either
     WrapError
     (Maybe (ByteString, ByteString, ByteString, [ByteString])))
-> ExceptT
     String
     IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Either
      WrapError
      (Maybe (ByteString, ByteString, ByteString, [ByteString])))
 -> ExceptT
      String
      IO
      (Either
         WrapError
         (Maybe (ByteString, ByteString, ByteString, [ByteString]))))
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
-> ExceptT
     String
     IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
forall a b. (a -> b) -> a -> b
$ Regex
-> ByteString
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
regexec Regex
creg ByteString
src
    case Either
  WrapError
  (Maybe (ByteString, ByteString, ByteString, [ByteString]))
x of
        Left (ReturnCode
rcode, String
rerror) -> String -> ExceptT String IO [RegexpSplit ByteString]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Regexp application error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rerror String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ReturnCode -> String
forall a. Show a => a -> String
show ReturnCode
rcode String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
        Right Maybe (ByteString, ByteString, ByteString, [ByteString])
Nothing -> [RegexpSplit ByteString]
-> ExceptT String IO [RegexpSplit ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString -> RegexpSplit ByteString
forall a. a -> RegexpSplit a
Unmatched ByteString
src]

        -- Now this is a trick, I don't know exactly why this happens, but this happens with empty regexps. We are going to cheat here
        Right (Just (ByteString
"",ByteString
"",ByteString
rm,[ByteString]
_)) -> [RegexpSplit ByteString]
-> ExceptT String IO [RegexpSplit ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> RegexpSplit ByteString)
-> String -> [RegexpSplit ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> RegexpSplit ByteString
forall a. a -> RegexpSplit a
Unmatched (ByteString -> RegexpSplit ByteString)
-> (Char -> ByteString) -> Char -> RegexpSplit ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString
BS.singleton) (ByteString -> String
BS.unpack ByteString
rm))

        Right (Just (ByteString
before,ByteString
current,ByteString
remaining,[ByteString]
captures)) -> do
            [RegexpSplit ByteString]
remain <- Regex -> ByteString -> ExceptT String IO [RegexpSplit ByteString]
getMatches Regex
creg ByteString
remaining
            [RegexpSplit ByteString]
-> ExceptT String IO [RegexpSplit ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> RegexpSplit ByteString
forall a. a -> RegexpSplit a
Unmatched ByteString
before RegexpSplit ByteString
-> [RegexpSplit ByteString] -> [RegexpSplit ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> RegexpSplit ByteString
forall a. a -> [a] -> RegexpSplit a
Matched ByteString
current [ByteString]
captures RegexpSplit ByteString
-> [RegexpSplit ByteString] -> [RegexpSplit ByteString]
forall a. a -> [a] -> [a]
: [RegexpSplit ByteString]
remain)


data Replacement = RawReplacement BS.ByteString
                 | IndexedReplacement Int
                 | WholeMatch
                 deriving (Int -> Replacement -> String -> String
[Replacement] -> String -> String
Replacement -> String
(Int -> Replacement -> String -> String)
-> (Replacement -> String)
-> ([Replacement] -> String -> String)
-> Show Replacement
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Replacement] -> String -> String
$cshowList :: [Replacement] -> String -> String
show :: Replacement -> String
$cshow :: Replacement -> String
showsPrec :: Int -> Replacement -> String -> String
$cshowsPrec :: Int -> Replacement -> String -> String
Show)

repparser :: Parser [Replacement]
repparser :: Parser [Replacement]
repparser = Parser ByteString Replacement -> Parser [Replacement]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString Replacement
replacement Parser [Replacement]
-> Parser ByteString () -> Parser [Replacement]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput

replacement :: Parser Replacement
replacement :: Parser ByteString Replacement
replacement = (ByteString -> Replacement)
-> Parser ByteString ByteString -> Parser ByteString Replacement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Replacement
RawReplacement Parser ByteString ByteString
rawData Parser ByteString Replacement
-> Parser ByteString Replacement -> Parser ByteString Replacement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Replacement
escapedThing

rawData :: Parser BS.ByteString
rawData :: Parser ByteString ByteString
rawData = (Char -> Bool) -> Parser ByteString ByteString
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\')

escapedThing :: Parser Replacement
escapedThing :: Parser ByteString Replacement
escapedThing = do
    Parser ByteString Char -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser ByteString Char
char Char
'\\')
    let ac :: Parser ByteString ByteString
ac = do
            Char
n <- Parser ByteString Char
anyChar
            ByteString
r <- Parser ByteString ByteString
rawData
            ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Parser ByteString ByteString)
-> ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> ByteString
BS.cons Char
n ByteString
r
        toReplacement :: Int -> Replacement
toReplacement Int
0 = Replacement
WholeMatch
        toReplacement Int
n = Int -> Replacement
IndexedReplacement Int
n
    (Char -> Replacement)
-> Parser ByteString Char -> Parser ByteString Replacement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Replacement
toReplacement (Int -> Replacement) -> (Char -> Int) -> Char -> Replacement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt) Parser ByteString Char
digit Parser ByteString Replacement
-> Parser ByteString Replacement -> Parser ByteString Replacement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Replacement)
-> Parser ByteString ByteString -> Parser ByteString Replacement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Replacement
RawReplacement (ByteString -> Replacement)
-> (ByteString -> ByteString) -> ByteString -> Replacement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
BS.cons Char
'\\') Parser ByteString ByteString
ac

-- | Compiles the regular expression (using default options) and `substitute`s
substituteCompile :: BS.ByteString     -- ^ The regular expression
                  -> BS.ByteString     -- ^ The source string
                  -> BS.ByteString     -- ^ The replacement string
                  -> IO (Either String BS.ByteString)
substituteCompile :: ByteString
-> ByteString -> ByteString -> IO (Either String ByteString)
substituteCompile ByteString
regexp ByteString
srcstring ByteString
repla = do
    Either (Int, String) Regex
re <- CompOption
-> ExecOption -> ByteString -> IO (Either (Int, String) Regex)
compile CompOption
compBlank ExecOption
execBlank ByteString
regexp
    case Either (Int, String) Regex
re of
        Right Regex
cre -> Regex -> ByteString -> ByteString -> IO (Either String ByteString)
substitute Regex
cre ByteString
srcstring ByteString
repla
        Left (Int, String)
rr   -> Either String ByteString -> IO (Either String ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ByteString -> IO (Either String ByteString))
-> Either String ByteString -> IO (Either String ByteString)
forall a b. (a -> b) -> a -> b
$ String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ String
"Regexp compilation failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, String) -> String
forall a. Show a => a -> String
show (Int, String)
rr

-- | Compiles the regular expression (using default options) and `split`s.
splitCompile :: BS.ByteString -- ^ The regular expression
             -> BS.ByteString -- ^ The source string
             -> IO (Either String [BS.ByteString])
splitCompile :: ByteString -> ByteString -> IO (Either String [ByteString])
splitCompile ByteString
regexp ByteString
srcstring = do
    Either (Int, String) Regex
re <- CompOption
-> ExecOption -> ByteString -> IO (Either (Int, String) Regex)
compile CompOption
compBlank ExecOption
execBlank ByteString
regexp
    case Either (Int, String) Regex
re of
        Right Regex
cre -> Regex -> ByteString -> IO (Either String [ByteString])
split Regex
cre ByteString
srcstring
        Left (Int, String)
rr   -> Either String [ByteString] -> IO (Either String [ByteString])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [ByteString] -> IO (Either String [ByteString]))
-> Either String [ByteString] -> IO (Either String [ByteString])
forall a b. (a -> b) -> a -> b
$ String -> Either String [ByteString]
forall a b. a -> Either a b
Left (String -> Either String [ByteString])
-> String -> Either String [ByteString]
forall a b. (a -> b) -> a -> b
$ String
"Regexp compilation failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, String) -> String
forall a. Show a => a -> String
show (Int, String)
rr

-- | A pure version of 'compile', using unsafePerformIO.
compile' :: CompOption -> ExecOption -> BS.ByteString -> Either (MatchOffset, String) Regex
compile' :: CompOption
-> ExecOption -> ByteString -> Either (Int, String) Regex
compile' CompOption
co ExecOption
eo ByteString
s = IO (Either (Int, String) Regex) -> Either (Int, String) Regex
forall a. IO a -> a
unsafePerformIO (CompOption
-> ExecOption -> ByteString -> IO (Either (Int, String) Regex)
compile CompOption
co ExecOption
eo ByteString
s)

-- | A pure version of 'execute', using unsafePerformIO.
execute' :: Regex -> BS.ByteString -> Either WrapError (Maybe (A.Array Int (MatchOffset, MatchLength)))
execute' :: Regex
-> ByteString -> Either WrapError (Maybe (Array Int (Int, Int)))
execute' Regex
r ByteString
s = IO (Either WrapError (Maybe (Array Int (Int, Int))))
-> Either WrapError (Maybe (Array Int (Int, Int)))
forall a. IO a -> a
unsafePerformIO (Regex
-> ByteString
-> IO (Either WrapError (Maybe (Array Int (Int, Int))))
execute Regex
r ByteString
s)

-- | A pure version of 'substituteCompile', using unsafePerformIO.
substituteCompile' :: BS.ByteString     -- ^ The regular expression
                   -> BS.ByteString     -- ^ The source string
                   -> BS.ByteString     -- ^ The replacement string
                   -> Either String BS.ByteString
substituteCompile' :: ByteString -> ByteString -> ByteString -> Either String ByteString
substituteCompile' ByteString
regexp ByteString
srcstring ByteString
repla = IO (Either String ByteString) -> Either String ByteString
forall a. IO a -> a
unsafePerformIO (ByteString
-> ByteString -> ByteString -> IO (Either String ByteString)
substituteCompile ByteString
regexp ByteString
srcstring ByteString
repla)

-- | A pure version of 'splitCompile', using unsafePerformIO.
splitCompile' :: BS.ByteString -- ^ The regular expression
              -> BS.ByteString -- ^ The source string
              -> Either String [BS.ByteString]
splitCompile' :: ByteString -> ByteString -> Either String [ByteString]
splitCompile' ByteString
regexp ByteString
srcstring = IO (Either String [ByteString]) -> Either String [ByteString]
forall a. IO a -> a
unsafePerformIO (ByteString -> ByteString -> IO (Either String [ByteString])
splitCompile ByteString
regexp ByteString
srcstring)