{-# OPTIONS_GHC -fno-warn-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(
  -- ** 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 hiding (fail)
import Control.Monad.Fail (MonadFail(fail))

import Text.Regex.PCRE.Wrap -- all
import Data.Array(Array,listArray)
import Data.ByteString(ByteString)
import qualified Data.ByteString as B(empty,useAsCString,last,take,drop,null,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 Foreign.C.String(CStringLen)
import Foreign(nullPtr)

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

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 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Text.Regex.PCRE.ByteString died: "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show e
err)
                     Right v
v -> forall (m :: * -> *) a. Monad m => a -> m a
return v
v

{-# INLINE asCStringLen #-}
asCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen :: forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
s CStringLen -> IO a
op = forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
s CStringLen -> IO a
checked
  where checked :: CStringLen -> IO a
checked cs :: CStringLen
cs@(Ptr CChar
ptr,Int
_) | Ptr CChar
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr = forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
myEmpty (CStringLen -> IO a
op forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 ByteString where
  makeRegexOpts :: CompOption -> ExecOption -> ByteString -> Regex
makeRegexOpts CompOption
c ExecOption
e ByteString
pattern = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    CompOption
-> ExecOption -> ByteString -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e ByteString
pattern forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
failforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> String
show) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO 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 ByteString where
  matchTest :: Regex -> ByteString -> Bool
matchTest Regex
regex ByteString
bs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Int -> Regex -> CStringLen -> IO (Either WrapError Bool)
wrapTest Int
0 Regex
regex) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e v. Show e => Either e v -> IO v
unwrap
  matchOnce :: Regex -> ByteString -> Maybe MatchArray
matchOnce Regex
regex ByteString
bs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    Regex -> ByteString -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e v. Show e => Either e v -> IO v
unwrap
  matchAll :: Regex -> ByteString -> [MatchArray]
matchAll Regex
regex ByteString
bs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Regex -> CStringLen -> IO (Either WrapError [MatchArray])
wrapMatchAll Regex
regex) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e v. Show e => Either e v -> IO v
unwrap
  matchCount :: Regex -> ByteString -> Int
matchCount Regex
regex ByteString
bs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Regex -> CStringLen -> IO (Either WrapError Int)
wrapCount Regex
regex) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e v. Show e => Either e v -> IO v
unwrap

-- ---------------------------------------------------------------------
-- | Compiles a regular expression
--
compile :: CompOption  -- ^ (summed together)
        -> ExecOption  -- ^ (summed together)
        -> 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
  -- PCRE does not allow one to specify a length for the regular expression, it must by 0 terminated
  let asCString :: ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
bs = if (Bool -> Bool
not (ByteString -> Bool
B.null ByteString
bs)) Bool -> Bool -> Bool
&& (Word8
0forall a. Eq a => a -> a -> Bool
==HasCallStack => ByteString -> Word8
B.last ByteString
bs)
                       then forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
B.unsafeUseAsCString ByteString
bs
                       else forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
B.useAsCString ByteString
bs
  forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
pattern (CompOption
-> ExecOption -> Ptr CChar -> 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
        -> 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 = do
  Either WrapError (Maybe [(Int, Int)])
maybeStartEnd <- forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Int
-> Regex
-> CStringLen
-> IO (Either WrapError (Maybe [(Int, Int)]))
wrapMatch Int
0 Regex
regex)
  case Either WrapError (Maybe [(Int, Int)])
maybeStartEnd of
    Right Maybe [(Int, Int)]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)
    Right (Just [(Int, Int)]
parts) ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall a. Enum a => a -> a
pred (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
parts))
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Int
s,Int
e)->(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s, forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
eforall a. Num a => a -> a -> a
-Int
s))) forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
parts
    Left WrapError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left WrapError
err)

regexec :: Regex      -- ^ Compiled regular expression
        -> ByteString -- ^ String to match against
        -> IO (Either WrapError (Maybe (ByteString, ByteString, ByteString, [ByteString])))
regexec :: Regex
-> ByteString
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
regexec Regex
regex ByteString
bs = do
  let getSub :: (Int, Int) -> ByteString
getSub (Int
start,Int
stop) | Int
start forall a. Eq a => a -> a -> Bool
== Int
unusedOffset = ByteString
B.empty
                          | Bool
otherwise = Int -> ByteString -> ByteString
B.take (Int
stopforall a. Num a => a -> a -> a
-Int
start) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop Int
start forall a b. (a -> b) -> a -> b
$ ByteString
bs
      matchedParts :: [(Int, Int)] -> (ByteString, ByteString, ByteString, [ByteString])
matchedParts [] = (ByteString
B.empty,ByteString
B.empty,ByteString
bs,[]) -- no information
      matchedParts (matchedStartStop :: (Int, Int)
matchedStartStop@(Int
start,Int
stop):[(Int, Int)]
subStartStop) =
        (Int -> ByteString -> ByteString
B.take Int
start ByteString
bs
        ,(Int, Int) -> ByteString
getSub (Int, Int)
matchedStartStop
        ,Int -> ByteString -> ByteString
B.drop Int
stop ByteString
bs
        ,forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> ByteString
getSub [(Int, Int)]
subStartStop)
  Either WrapError (Maybe [(Int, Int)])
maybeStartEnd <- forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Int
-> Regex
-> CStringLen
-> IO (Either WrapError (Maybe [(Int, Int)]))
wrapMatch Int
0 Regex
regex)
  case Either WrapError (Maybe [(Int, Int)])
maybeStartEnd of
    Right Maybe [(Int, Int)]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)
    Right (Just [(Int, Int)]
parts) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> (ByteString, ByteString, ByteString, [ByteString])
matchedParts forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
parts
    Left WrapError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left WrapError
err)