{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Regex.Posix.ByteString
-- Copyright   :  (c) Chris Kuklewicz 2006
-- License     :  BSD-3-Clause
--
-- Maintainer  :  hvr@gnu.org, Andreas Abel
-- Stability   :  stable
-- Portability :  non-portable (regex-base needs MPTC+FD)
--
-- This provides 'ByteString' instances for RegexMaker and RegexLike
-- based on "Text.Regex.Posix.Wrap", and a (RegexContext Regex
-- ByteString ByteString) instance.
--
-- To use these instance, you would normally import
-- "Text.Regex.Posix".  You only need to import this module to use
-- the medium level API of the compile, regexec, and execute
-- functions.  All of these report error by returning Left values
-- instead of undefined or error or fail.
--
-- The ByteString will only be passed to the library efficiently (as a
-- pointer) if it ends in a NUL byte.  Otherwise a temporary copy must
-- be made with the 0 byte appended.
-----------------------------------------------------------------------------

module Text.Regex.Posix.ByteString(
  -- ** Types
  Regex,
  MatchOffset,
  MatchLength,
  ReturnCode,
  WrapError,
  -- ** Miscellaneous
  unusedOffset,
  -- ** Medium level API functions
  compile,
  execute,
  regexec,
  -- ** Compilation options
  CompOption(CompOption),
  compBlank,
  compExtended,   -- use extended regex syntax
  compIgnoreCase, -- ignore case when matching
  compNoSub,      -- no substring matching needed
  compNewline,    -- '.' doesn't match newline
  -- ** Execution options
  ExecOption(ExecOption),
  execBlank,
  execNotBOL,      -- not at begining of line
  execNotEOL       -- not at end of line
  ) where

import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail(fail))

import Data.Array(Array,listArray)
import Data.ByteString(ByteString)
import qualified Data.ByteString as B(empty,useAsCString,last,take,drop,null)
import qualified Data.ByteString.Unsafe as B(unsafeUseAsCString)
import System.IO.Unsafe(unsafePerformIO)
import Text.Regex.Base.RegexLike(RegexMaker(..),RegexContext(..),RegexLike(..),MatchOffset,MatchLength)
import Text.Regex.Posix.Wrap -- all
import Text.Regex.Base.Impl(polymatch,polymatchM)
import Foreign.C.String(CString)

instance RegexContext Regex ByteString 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

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 (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Text.Regex.Posix.ByteString 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 (m :: * -> *) a. Monad m => a -> m a
return v
v

instance RegexMaker Regex CompOption ExecOption 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 WrapError Regex)
compile CompOption
c ExecOption
e ByteString
pattern IO (Either WrapError Regex)
-> (Either WrapError Regex -> IO Regex) -> IO Regex
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError 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 = (WrapError -> m Regex)
-> (Regex -> m Regex) -> Either WrapError Regex -> m Regex
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m Regex
forall (m :: * -> *) a. MonadFail m => String -> m a
fail(String -> m Regex)
-> (WrapError -> String) -> WrapError -> m Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WrapError -> String
forall a. Show a => a -> String
show) Regex -> m Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Either WrapError Regex -> m Regex)
-> Either WrapError Regex -> m Regex
forall a b. (a -> b) -> a -> b
$ IO (Either WrapError Regex) -> Either WrapError Regex
forall a. IO a -> a
unsafePerformIO (IO (Either WrapError Regex) -> Either WrapError Regex)
-> IO (Either WrapError Regex) -> Either WrapError Regex
forall a b. (a -> b) -> a -> b
$
    CompOption
-> ExecOption -> ByteString -> IO (Either WrapError Regex)
compile CompOption
c ExecOption
e ByteString
pattern

instance RegexLike Regex 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
-> (CString -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool)
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
bs (Regex -> CString -> IO (Either WrapError Bool)
wrapTest Regex
regex) IO (Either WrapError Bool)
-> (Either WrapError Bool -> IO Bool) -> IO Bool
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 (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
-> (CString -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
bs (Regex -> CString -> IO (Either WrapError [MatchArray])
wrapMatchAll Regex
regex) IO (Either WrapError [MatchArray])
-> (Either WrapError [MatchArray] -> IO [MatchArray])
-> IO [MatchArray]
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
-> (CString -> IO (Either WrapError Int))
-> IO (Either WrapError Int)
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
bs (Regex -> CString -> IO (Either WrapError Int)
wrapCount Regex
regex) IO (Either WrapError Int)
-> (Either WrapError Int -> IO Int) -> IO Int
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    -- ^ Flags (summed together)
        -> ExecOption    -- ^ Flags (summed together)
        -> ByteString  -- ^ The regular expression to compile
        -> IO (Either WrapError Regex)      -- ^ Returns: the compiled regular expression
compile :: CompOption
-> ExecOption -> ByteString -> IO (Either WrapError Regex)
compile CompOption
c ExecOption
e ByteString
pattern =
  ByteString
-> (CString -> IO (Either WrapError Regex))
-> IO (Either WrapError Regex)
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
pattern (CompOption -> ExecOption -> CString -> IO (Either WrapError 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 [(RegOffset, RegOffset)])
maybeStartEnd <- ByteString
-> (CString
    -> IO (Either WrapError (Maybe [(RegOffset, RegOffset)])))
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
bs (Regex
-> CString
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
wrapMatch Regex
regex)
  case Either WrapError (Maybe [(RegOffset, RegOffset)])
maybeStartEnd of
    Right Maybe [(RegOffset, RegOffset)]
Nothing -> Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MatchArray -> Either WrapError (Maybe MatchArray)
forall a b. b -> Either a b
Right Maybe MatchArray
forall a. Maybe a
Nothing)
--  Right (Just []) -> ...
    Right (Just [(RegOffset, RegOffset)]
parts) ->
      Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either WrapError (Maybe MatchArray)
 -> IO (Either WrapError (Maybe MatchArray)))
-> ([(RegOffset, RegOffset)]
    -> Either WrapError (Maybe MatchArray))
-> [(RegOffset, RegOffset)]
-> IO (Either WrapError (Maybe MatchArray))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe MatchArray -> Either WrapError (Maybe MatchArray)
forall a b. b -> Either a b
Right (Maybe MatchArray -> Either WrapError (Maybe MatchArray))
-> ([(RegOffset, RegOffset)] -> Maybe MatchArray)
-> [(RegOffset, RegOffset)]
-> Either WrapError (Maybe MatchArray)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchArray -> Maybe MatchArray
forall a. a -> Maybe a
Just (MatchArray -> Maybe MatchArray)
-> ([(RegOffset, RegOffset)] -> MatchArray)
-> [(RegOffset, RegOffset)]
-> Maybe MatchArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [(Int, Int)] -> MatchArray
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int -> Int
forall a. Enum a => a -> a
pred ([(RegOffset, RegOffset)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(RegOffset, RegOffset)]
parts))
      ([(Int, Int)] -> MatchArray)
-> ([(RegOffset, RegOffset)] -> [(Int, Int)])
-> [(RegOffset, RegOffset)]
-> MatchArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RegOffset, RegOffset) -> (Int, Int))
-> [(RegOffset, RegOffset)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(RegOffset
s,RegOffset
e)->(RegOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral RegOffset
s, RegOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (RegOffset
eRegOffset -> RegOffset -> RegOffset
forall a. Num a => a -> a -> a
-RegOffset
s))) ([(RegOffset, RegOffset)]
 -> IO (Either WrapError (Maybe MatchArray)))
-> [(RegOffset, RegOffset)]
-> IO (Either WrapError (Maybe MatchArray))
forall a b. (a -> b) -> a -> b
$ [(RegOffset, RegOffset)]
parts
    Left WrapError
err -> Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapError -> Either WrapError (Maybe MatchArray)
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 :: (RegOffset, RegOffset) -> ByteString
getSub (RegOffset
start,RegOffset
stop) | RegOffset
start RegOffset -> RegOffset -> Bool
forall a. Eq a => a -> a -> Bool
== RegOffset
unusedRegOffset = ByteString
B.empty
                          | Bool
otherwise = Int -> ByteString -> ByteString
B.take (RegOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fi (RegOffset
stopRegOffset -> RegOffset -> RegOffset
forall a. Num a => a -> a -> a
-RegOffset
start)) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop (RegOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fi RegOffset
start) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
      matchedParts :: [(RegOffset, RegOffset)]
-> (ByteString, ByteString, ByteString, [ByteString])
matchedParts [] = (ByteString
B.empty,ByteString
B.empty,ByteString
bs,[]) -- no information
      matchedParts (matchedStartStop :: (RegOffset, RegOffset)
matchedStartStop@(RegOffset
start,RegOffset
stop):[(RegOffset, RegOffset)]
subStartStop) =
        (Int -> ByteString -> ByteString
B.take (RegOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fi RegOffset
start) ByteString
bs
        ,(RegOffset, RegOffset) -> ByteString
getSub (RegOffset, RegOffset)
matchedStartStop
        ,Int -> ByteString -> ByteString
B.drop (RegOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fi RegOffset
stop) ByteString
bs
        ,((RegOffset, RegOffset) -> ByteString)
-> [(RegOffset, RegOffset)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (RegOffset, RegOffset) -> ByteString
getSub [(RegOffset, RegOffset)]
subStartStop)
  Either WrapError (Maybe [(RegOffset, RegOffset)])
maybeStartEnd <- ByteString
-> (CString
    -> IO (Either WrapError (Maybe [(RegOffset, RegOffset)])))
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
bs (Regex
-> CString
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
wrapMatch Regex
regex)
  case Either WrapError (Maybe [(RegOffset, RegOffset)])
maybeStartEnd of
    Right Maybe [(RegOffset, RegOffset)]
Nothing -> Either
  WrapError
  (Maybe (ByteString, ByteString, ByteString, [ByteString]))
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
forall (m :: * -> *) a. Monad m => a -> m a
return (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 []) -> ...
    Right (Just [(RegOffset, RegOffset)]
parts) -> Either
  WrapError
  (Maybe (ByteString, ByteString, ByteString, [ByteString]))
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   WrapError
   (Maybe (ByteString, ByteString, ByteString, [ByteString]))
 -> IO
      (Either
         WrapError
         (Maybe (ByteString, ByteString, ByteString, [ByteString]))))
-> ([(RegOffset, RegOffset)]
    -> Either
         WrapError
         (Maybe (ByteString, ByteString, ByteString, [ByteString])))
-> [(RegOffset, RegOffset)]
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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])
 -> Either
      WrapError
      (Maybe (ByteString, ByteString, ByteString, [ByteString])))
-> ([(RegOffset, RegOffset)]
    -> Maybe (ByteString, ByteString, ByteString, [ByteString]))
-> [(RegOffset, RegOffset)]
-> Either
     WrapError
     (Maybe (ByteString, ByteString, ByteString, [ByteString]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString, ByteString, [ByteString])
-> Maybe (ByteString, ByteString, ByteString, [ByteString])
forall a. a -> Maybe a
Just ((ByteString, ByteString, ByteString, [ByteString])
 -> Maybe (ByteString, ByteString, ByteString, [ByteString]))
-> ([(RegOffset, RegOffset)]
    -> (ByteString, ByteString, ByteString, [ByteString]))
-> [(RegOffset, RegOffset)]
-> Maybe (ByteString, ByteString, ByteString, [ByteString])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RegOffset, RegOffset)]
-> (ByteString, ByteString, ByteString, [ByteString])
matchedParts ([(RegOffset, RegOffset)]
 -> IO
      (Either
         WrapError
         (Maybe (ByteString, ByteString, ByteString, [ByteString]))))
-> [(RegOffset, RegOffset)]
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
forall a b. (a -> b) -> a -> b
$ [(RegOffset, RegOffset)]
parts
    Left WrapError
err -> Either
  WrapError
  (Maybe (ByteString, ByteString, ByteString, [ByteString]))
-> IO
     (Either
        WrapError
        (Maybe (ByteString, ByteString, ByteString, [ByteString])))
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapError
-> Either
     WrapError
     (Maybe (ByteString, ByteString, ByteString, [ByteString]))
forall a b. a -> Either a b
Left WrapError
err)

unusedOffset :: Int
unusedOffset :: Int
unusedOffset = RegOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral RegOffset
unusedRegOffset

fi :: (Integral i,Num n) => i->n
fi :: forall a b. (Integral a, Num b) => a -> b
fi = i -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral

asCString :: ByteString -> (CString -> IO a) -> IO a
asCString :: forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
bs = if (Bool -> Bool
not (ByteString -> Bool
B.null ByteString
bs)) Bool -> Bool -> Bool
&& (Word8
0Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==ByteString -> Word8
B.last ByteString
bs)
                  then ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
bs
                  else ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
bs