{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.Regex.Posix.ByteString(
Regex,
MatchOffset,
MatchLength,
ReturnCode,
WrapError,
unusedOffset,
compile,
execute,
regexec,
CompOption(CompOption),
compBlank,
compExtended,
compIgnoreCase,
compNoSub,
compNewline,
ExecOption(ExecOption),
execBlank,
execNotBOL,
execNotEOL
) 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
import Text.Regex.Base.Impl(polymatch,polymatchM)
import Foreign.C.String(CString)
instance RegexContext Regex ByteString ByteString where
match = polymatch
matchM = polymatchM
unwrap :: (Show e) => Either e v -> IO v
unwrap x = case x of Left err -> fail ("Text.Regex.Posix.ByteString died: "++ show err)
Right v -> return v
instance RegexMaker Regex CompOption ExecOption ByteString where
makeRegexOpts c e pattern = unsafePerformIO $
compile c e pattern >>= unwrap
makeRegexOptsM c e pattern = either (fail.show) return $ unsafePerformIO $
compile c e pattern
instance RegexLike Regex ByteString where
matchTest regex bs = unsafePerformIO $
asCString bs (wrapTest regex) >>= unwrap
matchOnce regex bs = unsafePerformIO $
execute regex bs >>= unwrap
matchAll regex bs = unsafePerformIO $
asCString bs (wrapMatchAll regex) >>= unwrap
matchCount regex bs = unsafePerformIO $
asCString bs (wrapCount regex) >>= unwrap
compile :: CompOption
-> ExecOption
-> ByteString
-> IO (Either WrapError Regex)
compile c e pattern =
asCString pattern (wrapCompile c e)
execute :: Regex
-> ByteString
-> IO (Either WrapError (Maybe (Array Int (MatchOffset,MatchLength))))
execute regex bs = do
maybeStartEnd <- asCString bs (wrapMatch regex)
case maybeStartEnd of
Right Nothing -> return (Right Nothing)
Right (Just parts) ->
return . Right . Just . listArray (0,pred (length parts))
. map (\(s,e)->(fromIntegral s, fromIntegral (e-s))) $ parts
Left err -> return (Left err)
regexec :: Regex
-> ByteString
-> IO (Either WrapError (Maybe (ByteString, ByteString, ByteString, [ByteString])))
regexec regex bs = do
let getSub (start,stop) | start == unusedRegOffset = B.empty
| otherwise = B.take (fi (stop-start)) . B.drop (fi start) $ bs
matchedParts [] = (B.empty,B.empty,bs,[])
matchedParts (matchedStartStop@(start,stop):subStartStop) =
(B.take (fi start) bs
,getSub matchedStartStop
,B.drop (fi stop) bs
,map getSub subStartStop)
maybeStartEnd <- asCString bs (wrapMatch regex)
case maybeStartEnd of
Right Nothing -> return (Right Nothing)
Right (Just parts) -> return . Right . Just . matchedParts $ parts
Left err -> return (Left err)
unusedOffset :: Int
unusedOffset = fromIntegral unusedRegOffset
fi :: (Integral i,Num n) => i->n
fi = fromIntegral
asCString :: ByteString -> (CString -> IO a) -> IO a
asCString bs = if (not (B.null bs)) && (0==B.last bs)
then B.unsafeUseAsCString bs
else B.useAsCString bs