{-# OPTIONS_GHC -Wno-orphans #-}

{-|
This exports instances of the high level API and the medium level
API of 'compile','execute', and 'regexec'.
-}
{- Copyright   :  (c) Chris Kuklewicz 2007 -}
module Text.Regex.PCRE.ByteString.Lazy(
  -- ** Types
  Regex,
  MatchOffset,
  MatchLength,
  CompOption(CompOption),
  ExecOption(ExecOption),
  ReturnCode,
  WrapError,
  -- ** Miscellaneous
  unusedOffset,
  getVersion,
  -- ** Medium level API functions
  compile,
  execute,
  regexec,
  -- ** CompOption flags
  compBlank,
  compAnchored,
  compAutoCallout,
  compCaseless,
  compDollarEndOnly,
  compDotAll,
  compExtended,
  compExtra,
  compFirstLine,
  compMultiline,
  compNoAutoCapture,
  compUngreedy,
  compUTF8,
  compNoUTF8Check,
  -- ** ExecOption flags
  execBlank,
  execAnchored,
  execNotBOL,
  execNotEOL,
  execNotEmpty,
  execNoUTF8Check,
  execPartial
  ) where

import Prelude
  ( Either(Left,Right), either
  , Int
  , IO, (>>=), return
  , Maybe(Nothing,Just)
  , Show(show)
  , String
  , ($), (.), (==), (&&), otherwise, not
  , (++), map
  )
import Control.Monad.Fail (MonadFail(fail))

import Text.Regex.PCRE.Wrap -- all
import Data.Array(Array)
import qualified Data.ByteString.Lazy as L(ByteString,toChunks,fromChunks,last,null,snoc)
import qualified Data.ByteString as B(ByteString,concat,pack)
import qualified Data.ByteString.Unsafe as B(unsafeUseAsCString,unsafeUseAsCStringLen)
import System.IO.Unsafe(unsafePerformIO)
import Text.Regex.Base.RegexLike(RegexContext(..),RegexMaker(..),RegexLike(..),MatchOffset,MatchLength)
import Text.Regex.Base.Impl(polymatch,polymatchM)
import qualified Text.Regex.PCRE.ByteString as BS(execute,regexec)
import Foreign.C.String(CString,CStringLen)
import Foreign(nullPtr)

instance RegexContext Regex L.ByteString L.ByteString where
  match :: Regex -> ByteString -> ByteString
match = Regex -> ByteString -> ByteString
forall a b. RegexLike a b => a -> b -> b
polymatch
  matchM :: forall (m :: * -> *).
MonadFail m =>
Regex -> ByteString -> m ByteString
matchM = Regex -> ByteString -> m ByteString
forall a b (m :: * -> *).
(RegexLike a b, MonadFail m) =>
a -> b -> m b
polymatchM

{-# INLINE fromLazy #-}
fromLazy :: L.ByteString -> B.ByteString
fromLazy :: ByteString -> ByteString
fromLazy = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks

{-# INLINE toLazy #-}
toLazy :: B.ByteString -> L.ByteString
toLazy :: ByteString -> ByteString
toLazy = [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return

unwrap :: (Show e) => Either e v -> IO v
unwrap :: forall e v. Show e => Either e v -> IO v
unwrap Either e v
x = case Either e v
x of Left e
err -> String -> IO v
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Text.Regex.PCRE.ByteString.Lazy died: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
err)
                     Right v
v -> v -> IO v
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return v
v

{-# INLINE asCString #-}
asCString :: L.ByteString -> (CString -> IO a) -> IO a
asCString :: forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
s = if (Bool -> Bool
not (ByteString -> Bool
L.null ByteString
s)) Bool -> Bool -> Bool
&& (Word8
0Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==HasCallStack => ByteString -> Word8
ByteString -> Word8
L.last ByteString
s)
                then ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString (ByteString -> ByteString
fromLazy ByteString
s)
                else ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString (ByteString -> ByteString
fromLazy (ByteString -> Word8 -> ByteString
L.snoc ByteString
s Word8
0))

{-# INLINE asCStringLen #-}
asCStringLen :: L.ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen :: forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
ls CStringLen -> IO a
op = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen (ByteString -> ByteString
fromLazy ByteString
ls) CStringLen -> IO a
checked
  where checked :: CStringLen -> IO a
checked cs :: CStringLen
cs@(CString
ptr,Int
_) | CString
ptr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
myEmpty (CStringLen -> IO a
op (CStringLen -> IO a)
-> (CStringLen -> CStringLen) -> CStringLen -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStringLen -> CStringLen
forall {b} {a} {b}. Num b => (a, b) -> (a, b)
trim)
                           | Bool
otherwise = CStringLen -> IO a
op CStringLen
cs
        myEmpty :: ByteString
myEmpty = [Word8] -> ByteString
B.pack [Word8
0]
        trim :: (a, b) -> (a, b)
trim (a
ptr,b
_) = (a
ptr,b
0)

instance RegexMaker Regex CompOption ExecOption L.ByteString where
  makeRegexOpts :: CompOption -> ExecOption -> ByteString -> Regex
makeRegexOpts CompOption
c ExecOption
e ByteString
pattern = IO Regex -> Regex
forall a. IO a -> a
unsafePerformIO (IO Regex -> Regex) -> IO Regex -> Regex
forall a b. (a -> b) -> a -> b
$
    CompOption
-> ExecOption -> ByteString -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e ByteString
pattern IO (Either (Int, String) Regex)
-> (Either (Int, String) Regex -> IO Regex) -> IO Regex
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Int, String) Regex -> IO Regex
forall e v. Show e => Either e v -> IO v
unwrap
  makeRegexOptsM :: forall (m :: * -> *).
MonadFail m =>
CompOption -> ExecOption -> ByteString -> m Regex
makeRegexOptsM CompOption
c ExecOption
e ByteString
pattern = ((Int, String) -> m Regex)
-> (Regex -> m Regex) -> Either (Int, String) Regex -> m Regex
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m Regex
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail(String -> m Regex)
-> ((Int, String) -> String) -> (Int, String) -> m Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int, String) -> String
forall a. Show a => a -> String
show) Regex -> m Regex
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, String) Regex -> m Regex)
-> Either (Int, String) Regex -> m Regex
forall a b. (a -> b) -> a -> b
$ IO (Either (Int, String) Regex) -> Either (Int, String) Regex
forall a. IO a -> a
unsafePerformIO (IO (Either (Int, String) Regex) -> Either (Int, String) Regex)
-> IO (Either (Int, String) Regex) -> Either (Int, String) Regex
forall a b. (a -> b) -> a -> b
$
    CompOption
-> ExecOption -> ByteString -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e ByteString
pattern

instance RegexLike Regex L.ByteString where
  matchTest :: Regex -> ByteString -> Bool
matchTest Regex
regex ByteString
bs = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    ByteString
-> (CStringLen -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Int -> Regex -> CStringLen -> IO (Either WrapError Bool)
wrapTest Int
0 Regex
regex) IO (Either WrapError Bool)
-> (Either WrapError Bool -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError Bool -> IO Bool
forall e v. Show e => Either e v -> IO v
unwrap
  matchOnce :: Regex -> ByteString -> Maybe MatchArray
matchOnce Regex
regex ByteString
bs = IO (Maybe MatchArray) -> Maybe MatchArray
forall a. IO a -> a
unsafePerformIO (IO (Maybe MatchArray) -> Maybe MatchArray)
-> IO (Maybe MatchArray) -> Maybe MatchArray
forall a b. (a -> b) -> a -> b
$
    Regex -> ByteString -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex ByteString
bs IO (Either WrapError (Maybe MatchArray))
-> (Either WrapError (Maybe MatchArray) -> IO (Maybe MatchArray))
-> IO (Maybe MatchArray)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError (Maybe MatchArray) -> IO (Maybe MatchArray)
forall e v. Show e => Either e v -> IO v
unwrap
  matchAll :: Regex -> ByteString -> [MatchArray]
matchAll Regex
regex ByteString
bs = IO [MatchArray] -> [MatchArray]
forall a. IO a -> a
unsafePerformIO (IO [MatchArray] -> [MatchArray])
-> IO [MatchArray] -> [MatchArray]
forall a b. (a -> b) -> a -> b
$
    ByteString
-> (CStringLen -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Regex -> CStringLen -> IO (Either WrapError [MatchArray])
wrapMatchAll Regex
regex) IO (Either WrapError [MatchArray])
-> (Either WrapError [MatchArray] -> IO [MatchArray])
-> IO [MatchArray]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError [MatchArray] -> IO [MatchArray]
forall e v. Show e => Either e v -> IO v
unwrap
  matchCount :: Regex -> ByteString -> Int
matchCount Regex
regex ByteString
bs = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$
    ByteString
-> (CStringLen -> IO (Either WrapError Int))
-> IO (Either WrapError Int)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Regex -> CStringLen -> IO (Either WrapError Int)
wrapCount Regex
regex) IO (Either WrapError Int)
-> (Either WrapError Int -> IO Int) -> IO Int
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError Int -> IO Int
forall e v. Show e => Either e v -> IO v
unwrap

-- ---------------------------------------------------------------------
-- | Compiles a regular expression
--
compile :: CompOption  -- ^ (summed together)
        -> ExecOption  -- ^ (summed together)
        -> L.ByteString  -- ^ The regular expression to compile
        -> IO (Either (MatchOffset,String) Regex) -- ^ Returns: the compiled regular expression
compile :: CompOption
-> ExecOption -> ByteString -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e ByteString
pattern = do
  ByteString
-> (CString -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
pattern (CompOption
-> ExecOption -> CString -> IO (Either (Int, String) Regex)
wrapCompile CompOption
c ExecOption
e)

-- ---------------------------------------------------------------------
-- | Matches a regular expression against a buffer, returning the buffer
-- indicies of the match, and any submatches
--
-- | Matches a regular expression against a string
execute :: Regex      -- ^ Compiled regular expression
        -> L.ByteString -- ^ String to match against
        -> IO (Either WrapError (Maybe (Array Int (MatchOffset,MatchLength))))
                -- ^ Returns: 'Nothing' if the regex did not match the
                -- string, or:
                --   'Just' an array of (offset,length) pairs where index 0 is whole match, and the rest are the captured subexpressions.
execute :: Regex -> ByteString -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex ByteString
bs = Regex -> ByteString -> IO (Either WrapError (Maybe MatchArray))
BS.execute Regex
regex (ByteString -> ByteString
fromLazy ByteString
bs)

regexec :: Regex      -- ^ Compiled regular expression
        -> L.ByteString -- ^ String to match against
        -> IO (Either WrapError (Maybe (L.ByteString, L.ByteString, L.ByteString, [L.ByteString])))
regexec :: Regex
-> ByteString
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
regexec Regex
regex ByteString
bs = do
  Either
  WrapError
  (Maybe (ByteString, ByteString, ByteString, [ByteString]))
x <- Regex
-> ByteString
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
BS.regexec Regex
regex (ByteString -> ByteString
fromLazy ByteString
bs)
  Either
  WrapError
  (Maybe (ByteString, ByteString, ByteString, [ByteString]))
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   WrapError
   (Maybe (ByteString, ByteString, ByteString, [ByteString]))
 -> IO
      (Either
         WrapError
         (Maybe (ByteString, ByteString, ByteString, [ByteString]))))
-> Either
     WrapError
     (Maybe (ByteString, ByteString, ByteString, [ByteString]))
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
forall a b. (a -> b) -> a -> b
$ case Either
  WrapError
  (Maybe (ByteString, ByteString, ByteString, [ByteString]))
x of
             Left WrapError
e -> WrapError
-> Either
     WrapError
     (Maybe (ByteString, ByteString, ByteString, [ByteString]))
forall a b. a -> Either a b
Left WrapError
e
             Right Maybe (ByteString, ByteString, ByteString, [ByteString])
Nothing -> Maybe (ByteString, ByteString, ByteString, [ByteString])
-> Either
     WrapError
     (Maybe (ByteString, ByteString, ByteString, [ByteString]))
forall a b. b -> Either a b
Right Maybe (ByteString, ByteString, ByteString, [ByteString])
forall a. Maybe a
Nothing
             Right (Just (ByteString
a,ByteString
b,ByteString
c,[ByteString]
ds)) -> Maybe (ByteString, ByteString, ByteString, [ByteString])
-> Either
     WrapError
     (Maybe (ByteString, ByteString, ByteString, [ByteString]))
forall a b. b -> Either a b
Right ((ByteString, ByteString, ByteString, [ByteString])
-> Maybe (ByteString, ByteString, ByteString, [ByteString])
forall a. a -> Maybe a
Just (ByteString -> ByteString
toLazy ByteString
a,ByteString -> ByteString
toLazy ByteString
b,ByteString -> ByteString
toLazy ByteString
c,(ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
toLazy [ByteString]
ds))