diff --git a/Text/Matchers.hs b/Text/Matchers.hs --- a/Text/Matchers.hs +++ b/Text/Matchers.hs @@ -12,16 +12,14 @@ import Control.Applicative ((<$>), (<*>), (<*), (<$), optional, (<|>)) import Control.Monad (replicateM, mzero) -import qualified Data.ByteString as BS import Data.Fixed (Pico) -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe) import Data.Text (Text, pack, unpack, toCaseFold, isInfixOf) -import Data.Text.Encoding (encodeUtf8) -import qualified Text.Regex.PCRE.Light as PCRE import Text.Parsec (many, satisfy) import qualified Text.Parsec as P import Text.Parsec.Text (Parser) import qualified Data.Time as Time +import Text.Matchers.Pcre as PCRE data CaseSensitive = Sensitive | Insensitive deriving (Eq, Ord, Show) @@ -56,13 +54,13 @@ -- ^ The Matcher if the pattern is good; if the pattern is bad, -- returns an error message. -pcre c t = case pcrePrim c (encodeUtf8 t) of - Left e -> Left $ pack e - Right f -> +pcre c t = case PCRE.compile (c == Insensitive) t of + Left e -> Left . pack $ e + Right r -> let sDesc = pack "Perl-compatible regular expression" mrDesc = pack $ "matches the PCRE pattern \"" ++ unpack t ++ "\"" ++ descSensitive c - mr = f . encodeUtf8 + mr = maybe False id . PCRE.exec r in return $ Matcher sDesc mrDesc mr -- | Matcher that succeeds if the pattern text is found anywhere @@ -126,21 +124,6 @@ Just (c, t) -> let cmp = compUTCtoCmp c in return $ subjDT `cmp` t - ------------------------------------------------------------- --- PCRE primitives ------------------------------------------------------------- - -pcrePrim :: CaseSensitive - -> BS.ByteString - -> Either String (BS.ByteString -> Bool) -pcrePrim c bs = - let u8 = [PCRE.utf8] - opts = case c of - Sensitive -> u8 - Insensitive -> PCRE.caseless:u8 - doMatch rx s = isJust $ PCRE.match rx s [] - in fmap doMatch $ PCRE.compileM bs opts ------------------------------------------------------------ -- Date parsers diff --git a/Text/Matchers/Pcre.hs b/Text/Matchers/Pcre.hs new file mode 100644 --- /dev/null +++ b/Text/Matchers/Pcre.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE Trustworthy #-} +module Text.Matchers.Pcre + ( B.Caseless + , B.Regex + , B.reCaseless + , B.rePattern + , compile + , exec + ) where + +import qualified Text.Matchers.Pcre.Base as B +import qualified Data.Text as X +import System.IO.Unsafe (unsafePerformIO) + +compile + :: B.Caseless + -> X.Text + -> Either String B.Regex +compile cl x = unsafePerformIO $ B.compile cl x + +exec + :: B.Regex + -> X.Text + -> Maybe Bool +exec r x = unsafePerformIO $ B.exec r x + diff --git a/Text/Matchers/Pcre/Base.hsc b/Text/Matchers/Pcre/Base.hsc new file mode 100644 --- /dev/null +++ b/Text/Matchers/Pcre/Base.hsc @@ -0,0 +1,135 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, Safe #-} + +module Text.Matchers.Pcre.Base + ( caseless + , PCRE + , PCRE_Extra + , c_free + , c_pcre_compile + , c_pcre_exec + , Caseless + , pcre_compile + , pcre_exec + , Regex + , reCaseless + , rePattern + , compile + , exec + ) where + +import Foreign.Storable +import Foreign.C +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.ForeignPtr.Safe +import Foreign.Ptr +import Data.ByteString +import Data.Text +import Data.Text.Encoding + +#include +#include + +caseless :: CInt +caseless = #const PCRE_CASELESS + +data PCRE + +instance Show PCRE where + show _ = "PCRE" + +data PCRE_Extra + +instance Show PCRE_Extra where + show _ = "PCRE_Extra" + +foreign import ccall unsafe "stdlib.h &free" + c_free :: FunPtr (Ptr a -> IO ()) + +foreign import ccall unsafe "pcre.h pcre_compile" + c_pcre_compile + :: CString + -- ^ Pattern + -> CInt + -- ^ Options + -> Ptr CString + -- ^ OUT error message + -> Ptr CInt + -- ^ OUT Error offset + -> Ptr CUChar + -- ^ Pointer to character table. Use NULL for default. + -> IO (Ptr PCRE) + +foreign import ccall unsafe "pcre.h pcre_exec" + c_pcre_exec + :: Ptr PCRE + -- ^ Regex + -> Ptr PCRE_Extra + -- ^ Result of study + -> CString + -- ^ Subject + -> CInt + -- ^ Length of subject string. (Apparently it does not have to be + -- null terminated?) + -> CInt + -- ^ Start at this offset in the subject string. + -> CInt + -- ^ Options + -> Ptr CInt + -- ^ OUT Output vector. Information about matching substrings is + -- stored in this array. + -> CInt + -- ^ Output vector size + -> IO CInt + -- ^ One more than the highest numbered pair that has been set. + +type Caseless = Bool + +pcre_compile + :: Caseless + -> Text + -- ^ Pattern + -> IO (Either String (Ptr PCRE)) + -- ^ Errors are indicated with a Left with the error message. +pcre_compile cl pat + = useAsCString (encodeUtf8 pat) $ \patC -> + alloca $ \ptrMsg -> + alloca $ \ptrOffset -> do + let cOpt = if cl then caseless else 0 + ptrPcre <- c_pcre_compile patC cOpt ptrMsg ptrOffset nullPtr + if ptrPcre == nullPtr + then do + ptrErr <- peek ptrMsg + msg <- peekCAString ptrErr + return . Left $ msg + else return . Right $ ptrPcre + + +pcre_exec :: Ptr PCRE -> Text -> IO (Maybe Bool) +pcre_exec ptr txt + = useAsCStringLen (encodeUtf8 txt) $ \(ptrSubj, len) -> + allocaArray 30 $ \array -> do + r <- c_pcre_exec ptr nullPtr ptrSubj (fromIntegral len) + 0 0 array 30 + return $ case () of + _ | r == (-1) -> Just False + | r < (-1) -> Nothing + | otherwise -> Just True + +data Regex = Regex + { reCaseless :: Caseless + , rePattern :: Text + , _rePtr :: ForeignPtr PCRE + } deriving Show + +compile :: Caseless -> Text -> IO (Either String Regex) +compile cl pat = do + ei <- pcre_compile cl pat + case ei of + Left e -> return . Left $ e + Right ptr -> do + fp <- newForeignPtr c_free ptr + return . Right $ Regex cl pat fp + +exec :: Regex -> Text -> IO (Maybe Bool) +exec (Regex _ _ fp) s = withForeignPtr fp $ \p -> pcre_exec p s diff --git a/matchers.cabal b/matchers.cabal --- a/matchers.cabal +++ b/matchers.cabal @@ -1,5 +1,5 @@ Name: matchers -Version: 0.10.0.0 +Version: 0.12.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3 @@ -24,12 +24,15 @@ base ==4.6.* , bytestring ==0.10.* , parsec >= 3.1.2 && < 3.2 - , pcre-light ==0.4.* , text ==0.11.* , time ==1.4.* Exposed-modules: Text.Matchers + , Text.Matchers.Pcre + , Text.Matchers.Pcre.Base - ghc-options: -Wall + extra-libraries: pcre + + ghc-options: -Wall