diff --git a/Text/Regex/Posix.hs b/Text/Regex/Posix.hs --- a/Text/Regex/Posix.hs +++ b/Text/Regex/Posix.hs @@ -37,7 +37,7 @@ -- does not understand Unicode. If you need Unicode support you will -- have to use a different backend. -- --- When offsets are reported for subexpression captures, a subexrepssion +-- When offsets are reported for subexpression captures, a subexpression -- that did not match anything (as opposed to matching an empty string) -- will have its offset set to the 'unusedRegOffset' value, which is (-1). -- diff --git a/Text/Regex/Posix/Wrap.hs b/Text/Regex/Posix/Wrap.hs deleted file mode 100644 --- a/Text/Regex/Posix/Wrap.hs +++ /dev/null @@ -1,574 +0,0 @@ -{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-} -{-# OPTIONS_GHC -optc-DHAVE_REGEX_H #-} -{-# OPTIONS_GHC -optc-DHAVE_REGCOMP=1 #-} -{-# INCLUDE #-} -{-# INCLUDE "regex.h" #-} -{-# LINE 1 "Text/Regex/Posix/Wrap.hsc" #-} -{-# OPTIONS_GHC -fglasgow-exts -fffi #-} -{-# LINE 2 "Text/Regex/Posix/Wrap.hsc" #-} ------------------------------------------------------------------------------ --- | --- Module : Text.Regex.Posix.Wrap --- Copyright : (c) Chris Kuklewicz 2006 derived from (c) The University of Glasgow 2002 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : libraries@haskell.org, textregexlazy@personal.mightyreason.com --- Stability : experimental --- Portability : non-portable (regex-base needs MPTC+FD) --- --- WrapPosix.hsc exports a wrapped version of the ffi imports. To --- increase type safety, the flags are newtype'd. The other important --- export is a 'Regex' type that is specific to the Posix library --- backend. The flags are documented in "Text.Regex.Posix". The --- 'defaultCompOpt' is @(compExtended .|. compNewline)@. --- --- The 'Regex', 'CompOption', and 'ExecOption' types and their 'RegexOptions' --- instance is declared. The '=~' and '=~~' convenience functions are --- defined. --- --- The exported symbols are the same whether HAVE_REGEX_H is defined, but --- when it is not defined then @getVersion == Nothing@ and all other --- exported values will call error or fail. --- --- This module will fail or error only if allocation fails or a nullPtr --- is passed in. --- ------------------------------------------------------------------------------ - -module Text.Regex.Posix.Wrap( - -- ** High-level API - Regex, - RegOffset, - (=~), - (=~~), - - -- ** Low-level API - WrapError, - wrapCompile, - wrapTest, - wrapMatch, - wrapMatchAll, - wrapCount, - - -- ** Miscellaneous - unusedRegOffset, - - -- ** 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 - - -- ** Return codes - ReturnCode(ReturnCode), - retBadbr, - retBadpat, - retBadrpt, - retEcollate, - retEctype, - retEescape, - retEsubreg, - retEbrack, - retEparen, - retEbrace, - retErange, - retEspace - ) where - - -{-# LINE 80 "Text/Regex/Posix/Wrap.hsc" #-} - -{-# LINE 81 "Text/Regex/Posix/Wrap.hsc" #-} - -{-# LINE 89 "Text/Regex/Posix/Wrap.hsc" #-} - - -{-# LINE 91 "Text/Regex/Posix/Wrap.hsc" #-} - - -{-# LINE 93 "Text/Regex/Posix/Wrap.hsc" #-} - -{-# LINE 94 "Text/Regex/Posix/Wrap.hsc" #-} - -{-# LINE 104 "Text/Regex/Posix/Wrap.hsc" #-} - -import Control.Monad(mapM) -import Data.Array(Array,listArray) -import Data.Bits(Bits(..)) -import Data.Int -- need whatever #regoff_t type will be -import Foreign(Ptr, FunPtr, nullPtr, mallocForeignPtrBytes, - addForeignPtrFinalizer, Storable(peekByteOff), allocaArray, - allocaBytes, withForeignPtr,ForeignPtr,plusPtr) -import Foreign.C(CSize,CInt) -import Foreign.C.String(peekCAString, CString) -import Text.Regex.Base.RegexLike(RegexOptions(..),RegexMaker(..),RegexContext(..),MatchArray) - -type CRegex = () -- dummy regex_t used below to read out nsub value - --- | RegOffset is "typedef int regoff_t" on Linux and ultimately "typedef --- long long __int64_t" on Max OS X. So rather than saying --- 2,147,483,647 is all the length you need, I'll take the larger: --- 9,223,372,036,854,775,807 should be enough bytes for anyone, no --- need for Integer. The alternative is to compile to different sizes --- in a platform dependent manner with "type RegOffset = (#type --- regoff_t)", which I do not want to do. --- --- There is also a special value 'unusedRegOffset' :: 'RegOffset' which is --- (-1) and as a starting index means that the subgroup capture was --- unused. Otherwise the RegOffset indicates a character boundary that --- is before the character at that index offset, with the first --- character at index offset 0. So starting at 1 and ending at 2 means --- to take only the second character. -type RegOffset = Int64 - --- | A bitmapped 'CInt' containing options for compilation of regular --- expressions. Option values (and their man 3 regcomp names) are --- --- * 'compBlank' which is a completely zero value for all the flags. --- This is also the 'blankCompOpt' value. --- --- * 'compExtended' (REG_EXTENDED) which can be set to use extended instead --- of basic regular expressions. --- This is set in the 'defaultCompOpt' value. --- --- * 'compNewline' (REG_NEWLINE) turns on newline sensitivity: The dot (.) --- and inverted set @[^ ]@ never match newline, and ^ and $ anchors do --- match after and before newlines. --- This is set in the 'defaultCompOpt' value. --- --- * 'compIgnoreCase' (REG_ICASE) which can be set to match ignoring upper --- and lower distinctions. --- --- * 'compNoSub' (REG_NOSUB) which turns off all information from matching --- except whether a match exists. - -{-# LINE 155 "Text/Regex/Posix/Wrap.hsc" #-} -newtype CompOption = CompOption CInt deriving (Eq,Show,Num,Bits) - -{-# LINE 177 "Text/Regex/Posix/Wrap.hsc" #-} - --- | A bitmapped 'CInt' containing options for execution of compiled --- regular expressions. Option values (and their man 3 regexec names) are --- --- * 'execBlank' which is a complete zero value for all the flags. This is --- the blankExecOpt value. --- --- * 'execNotBOL' (REG_NOTBOL) can be set to prevent ^ from matching at the --- start of the input. --- --- * 'execNotEOL' (REG_NOTEOL) can be set to prevent $ from matching at the --- end of the input (before the terminating NUL). - -{-# LINE 190 "Text/Regex/Posix/Wrap.hsc" #-} -newtype ExecOption = ExecOption CInt deriving (Eq,Show,Num,Bits) - -{-# LINE 212 "Text/Regex/Posix/Wrap.hsc" #-} - --- | ReturnCode is an enumerated 'CInt', corresponding to the error codes --- from @man 3 regex@: --- --- * 'retBadbr' (@REG_BADBR@) invalid repetition count(s) in @{ }@ --- --- * 'retBadpat' (@REG_BADPAT@) invalid regular expression --- --- * 'retBadrpt' (@REG_BADRPT@) @?@, @*@, or @+@ operand invalid --- --- * 'retEcollate' (@REG_ECOLLATE@) invalid collating element --- --- * 'retEctype' (@REG_ECTYPE@) invalid character class --- --- * 'retEescape' (@REG_EESCAPE@) @\\@ applied to unescapable character --- --- * 'retEsubreg' (@REG_ESUBREG@) invalid backreference number --- --- * 'retEbrack' (@REG_EBRACK@) brackets @[ ]@ not balanced --- --- * 'retEparen' (@REG_EPAREN@) parentheses @( )@ not balanced --- --- * 'retEbrace' (@REG_EBRACE@) braces @{ }@ not balanced --- --- * 'retErange' (@REG_ERANGE@) invalid character range in @[ ]@ --- --- * 'retEspace' (@REG_ESPACE@) ran out of memory --- --- * 'retNoMatch' (@REG_NOMATCH@) The regexec() function failed to match --- -newtype ReturnCode = ReturnCode CInt deriving (Eq,Show) - --- | A compiled regular expression. -data Regex = Regex (ForeignPtr CRegex) CompOption ExecOption - --- | A completely zero value for all the flags. --- This is also the 'blankCompOpt' value. -compBlank :: CompOption -compBlank = CompOption 0 - --- | A completely zero value for all the flags. --- This is also the 'blankExecOpt' value. -execBlank :: ExecOption -execBlank = ExecOption 0 - -unusedRegOffset :: RegOffset -unusedRegOffset = (-1) - --- | The return code will be retOk when it is the Haskell wrapper and --- not the underlying library generating the error message. -type WrapError = (ReturnCode,String) - -wrapCompile :: CompOption -- ^ Flags (bitmapped) - -> ExecOption -- ^ Flags (bitmapped) - -> CString -- ^ The regular expression to compile (ASCII only, no null bytes) - -> IO (Either WrapError Regex) -- ^ Returns: the compiled regular expression - -wrapTest :: Regex -> CString - -> IO (Either WrapError Bool) - --- | wrapMatch returns offsets for the begin and end of each capture. --- Unused captures have offsets of unusedRegOffset which is (-1) -wrapMatch :: Regex -> CString - -> IO (Either WrapError (Maybe [(RegOffset,RegOffset)])) - --- | wrapMatchAll returns the offset and length of each capture. --- Unused captures have an offset of unusedRegOffset which is (-1) and --- length of 0. -wrapMatchAll :: Regex -> CString - -> IO (Either WrapError [MatchArray]) - -wrapCount :: Regex -> CString - -> IO (Either WrapError Int) - -(=~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target) - => source1 -> source -> target -(=~~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target,Monad m) - => source1 -> source -> m target - -instance RegexOptions Regex CompOption ExecOption where - blankCompOpt = compBlank - blankExecOpt = execBlank - defaultCompOpt = compExtended .|. compNewline - defaultExecOpt = execBlank - setExecOpts e' (Regex r c _) = Regex r c e' - getExecOpts (Regex _ _ e) = e - --- (=~) ::(RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target) => source1 -> source -> target -(=~) x r = let make :: RegexMaker Regex CompOption ExecOption a => a -> Regex - make = makeRegex - in match (make r) x - --- (=~~) ::(RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target,Monad m) => source1 -> source -> m target -(=~~) x r = let make :: RegexMaker Regex CompOption ExecOption a => a -> Regex - make = makeRegex - in matchM (make r) x - -type CRegMatch = () -- dummy regmatch_t used below to read out so and eo values - --- ----------------------------------------------------------------------------- --- The POSIX regex C interface - - -{-# LINE 315 "Text/Regex/Posix/Wrap.hsc" #-} - -foreign import ccall unsafe "regcomp" - c_regcomp :: Ptr CRegex -> CString -> CompOption -> IO ReturnCode - -foreign import ccall unsafe "®free" - c_regfree :: FunPtr (Ptr CRegex -> IO ()) - -foreign import ccall unsafe "regexec" - c_regexec :: Ptr CRegex -> CString -> CSize - -> Ptr CRegMatch -> ExecOption -> IO ReturnCode - -foreign import ccall unsafe "regerror" - c_regerror :: ReturnCode -> Ptr CRegex - -> CString -> CSize -> IO CSize - - -{-# LINE 362 "Text/Regex/Posix/Wrap.hsc" #-} - -retOk :: ReturnCode -retOk = ReturnCode 0 - --- Flags for regexec -execNotBOL :: ExecOption -execNotBOL = ExecOption 1 -execNotEOL :: ExecOption -execNotEOL = ExecOption 2 - -{-# LINE 370 "Text/Regex/Posix/Wrap.hsc" #-} - --- Flags for regcomp -compExtended :: CompOption -compExtended = CompOption 1 -compIgnoreCase :: CompOption -compIgnoreCase = CompOption 2 -compNoSub :: CompOption -compNoSub = CompOption 4 -compNewline :: CompOption -compNewline = CompOption 8 - -{-# LINE 377 "Text/Regex/Posix/Wrap.hsc" #-} - --- Return values from regexec (REG_NOMATCH, REG_ESPACE,...) --- Error codes from regcomp (not REG_NOMATCH) --- Though calling retNoMatch an error is rather missing the point... -retNoMatch :: ReturnCode -retNoMatch = ReturnCode 1 -retBadbr :: ReturnCode -retBadbr = ReturnCode 10 -retBadpat :: ReturnCode -retBadpat = ReturnCode 2 -retBadrpt :: ReturnCode -retBadrpt = ReturnCode 13 -retEcollate :: ReturnCode -retEcollate = ReturnCode 3 -retEctype :: ReturnCode -retEctype = ReturnCode 4 -retEescape :: ReturnCode -retEescape = ReturnCode 5 -retEsubreg :: ReturnCode -retEsubreg = ReturnCode 6 -retEbrack :: ReturnCode -retEbrack = ReturnCode 7 -retEparen :: ReturnCode -retEparen = ReturnCode 8 -retEbrace :: ReturnCode -retEbrace = ReturnCode 9 -retErange :: ReturnCode -retErange = ReturnCode 11 -retEspace :: ReturnCode -retEspace = ReturnCode 12 - -{-# LINE 395 "Text/Regex/Posix/Wrap.hsc" #-} ----- --- error helpers - -nullTest :: Ptr a -> String -> IO (Either WrapError b) -> IO (Either WrapError b) -{-# INLINE nullTest #-} -nullTest ptr msg io = do - if nullPtr == ptr - then return (Left (retOk,"Ptr parameter was nullPtr in Text.Regex.TRE.Wrap."++msg)) - else io - -{- -wrapRC :: ReturnCode -> IO (Either WrapError b) -{-# INLINE wrapRC #-} -wrapRC r = return (Left (r,"Error in Text.Regex.Posix.Wrap: "++show r)) --} -wrapError :: ReturnCode -> Ptr CRegex -> IO (Either WrapError b) -wrapError errCode regex_ptr = do - -- Call once to compute the error message buffer size - errBufSize <- c_regerror errCode regex_ptr nullPtr 0 - -- Allocate a temporary buffer to hold the error message - allocaArray (fromIntegral errBufSize) $ \errBuf -> do - nullTest errBuf "wrapError errBuf" $ do - c_regerror errCode regex_ptr errBuf errBufSize - msg <- peekCAString errBuf :: IO String - return (Left (errCode, msg)) - ----------- -wrapCompile flags e pattern = do - nullTest pattern "wrapCompile pattern" $ do - regex_fptr <- mallocForeignPtrBytes (16) -{-# LINE 425 "Text/Regex/Posix/Wrap.hsc" #-} - withForeignPtr regex_fptr $ \regex_ptr -> do - if nullPtr == regex_ptr - then return (Left (retOk,"Text.Regex.Posix.Wrap.wrapCompile could not malloc")) - else do - errCode <- c_regcomp regex_ptr pattern flags - addForeignPtrFinalizer c_regfree regex_fptr - if (errCode == retOk) - then return . Right $ Regex regex_fptr flags e - else wrapError errCode regex_ptr - ---------- -wrapTest (Regex regex_fptr _ flags) cstr = do - nullTest cstr "wrapTest" $ do - withForeignPtr regex_fptr $ \regex_ptr -> do - r <- c_regexec regex_ptr cstr 0 nullPtr flags - if r == retOk - then return (Right True) - else if r == retNoMatch - then return (Right False) - else wrapError r regex_ptr - ---------- -wrapMatch regex@(Regex regex_fptr compileOptions flags) cstr = do - nullTest cstr "wrapMatch cstr" $ do - if (0 /= compNoSub .&. compileOptions) - then do - r <- wrapTest regex cstr - case r of - Right True -> return (Right (Just [])) -- Source of much "wtf?" crap - Right False -> return (Right Nothing) - Left err -> return (Left err) - else do - withForeignPtr regex_fptr $ \regex_ptr -> do - nsub <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) regex_ptr :: IO CSize -{-# LINE 459 "Text/Regex/Posix/Wrap.hsc" #-} - let nsub_int,nsub_bytes :: Int - nsub_int = fromIntegral nsub - nsub_bytes = ((1 + nsub_int) * (16)) -{-# LINE 462 "Text/Regex/Posix/Wrap.hsc" #-} - -- add one because index zero covers the whole match - allocaBytes nsub_bytes $ \p_match -> do - nullTest p_match "wrapMatch allocaBytes" $ do - doMatch regex_ptr cstr nsub p_match flags - --- Very very thin wrapper --- Requires, but does not check, that nsub>=0 --- Cannot return (Right (Just [])) -doMatch :: Ptr CRegex -> CString -> CSize -> Ptr CRegMatch -> ExecOption - -> IO (Either WrapError (Maybe [(RegOffset,RegOffset)])) -{-# INLINE doMatch #-} -doMatch regex_ptr cstr nsub p_match flags = do - r <- c_regexec regex_ptr cstr (1 + nsub) p_match flags - if r == retOk - then do - regions <- mapM getOffsets . take (1+fromIntegral nsub) - . iterate (`plusPtr` (16)) $ p_match -{-# LINE 479 "Text/Regex/Posix/Wrap.hsc" #-} - return (Right (Just regions)) -- regions will not be [] - else if r == retNoMatch - then return (Right Nothing) - else wrapError r regex_ptr - where - getOffsets :: Ptr CRegMatch -> IO (RegOffset,RegOffset) - {-# INLINE getOffsets #-} - getOffsets pmatch' = do - start <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pmatch' :: IO (Int64) -{-# LINE 488 "Text/Regex/Posix/Wrap.hsc" #-} - end <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) pmatch' :: IO (Int64) -{-# LINE 489 "Text/Regex/Posix/Wrap.hsc" #-} - return (fromIntegral start,fromIntegral end) - -wrapMatchAll regex@(Regex regex_fptr compileOptions flags) cstr = do - nullTest cstr "wrapMatchAll cstr" $ do - if (0 /= compNoSub .&. compileOptions) - then do - r <- wrapTest regex cstr - case r of - Right True -> return (Right [(toMA 0 [])]) -- Source of much "wtf?" crap - Right False -> return (Right []) - Left err -> return (Left err) - else do - withForeignPtr regex_fptr $ \regex_ptr -> do - nsub <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) regex_ptr :: IO CSize -{-# LINE 503 "Text/Regex/Posix/Wrap.hsc" #-} - let nsub_int,nsub_bytes :: Int - nsub_int = fromIntegral nsub - nsub_bytes = ((1 + nsub_int) * (16)) -{-# LINE 506 "Text/Regex/Posix/Wrap.hsc" #-} - -- add one because index zero covers the whole match - allocaBytes nsub_bytes $ \p_match -> do - nullTest cstr "wrapMatchAll p_match" $ do - let flags' = (execNotBOL .|. flags) - at pos = doMatch regex_ptr (plusPtr cstr pos) nsub p_match flags' - loop acc old (s,e) | old `seq` s == e = return (Right (acc [])) - | otherwise = do - let pos = old + fromIntegral e - result <- at pos - case result of - Right Nothing -> return (Right (acc [])) - Right (Just parts@(whole:_)) -> let ma = toMA pos parts - in loop (acc.(ma:)) pos whole - Left err -> return (Left err) - Right (Just []) -> return (Right (acc [(toMA pos [])])) -- should never happen - result <- doMatch regex_ptr cstr nsub p_match flags - case result of - Right Nothing -> return (Right []) - Right (Just parts@(whole:_)) -> let ma = toMA 0 parts - in loop (ma:) 0 whole - Left err -> return (Left err) - Right (Just []) -> return (Right [(toMA 0 [])]) -- should never happen - where - toMA :: Int -> [(RegOffset,RegOffset)] -> Array Int (Int,Int) - toMA pos [] = listArray (0,0) [(pos,0)] -- wtf? - toMA pos parts = listArray (0,pred (length parts)) - . map (\(s,e)-> if s>=0 then (pos+fromIntegral s, fromIntegral (e-s)) else (-1,0)) - $ parts - ---------- -wrapCount regex@(Regex regex_fptr compileOptions flags) cstr = do - nullTest cstr "wrapCount cstr" $ do - if (0 /= compNoSub .&. compileOptions) - then do - r <- wrapTest regex cstr - case r of - Right True -> return (Right 1) - Right False -> return (Right 0) - Left err -> return (Left err) - else do - withForeignPtr regex_fptr $ \regex_ptr -> do - let nsub_bytes = ((16)) -{-# LINE 548 "Text/Regex/Posix/Wrap.hsc" #-} - allocaBytes nsub_bytes $ \p_match -> do - nullTest cstr "wrapCount p_match" $ do - let flags' = (execNotBOL .|. flags) - at pos = doMatch regex_ptr (plusPtr cstr pos) 0 p_match flags' - loop acc old (s,e) | acc `seq` old `seq` False = undefined - | s == e = return (Right acc) - | otherwise = do - let pos = old + fromIntegral e - result <- at pos - case result of - Right Nothing -> return (Right acc) - Right (Just (whole:_)) -> loop (succ acc) pos whole - Left err -> return (Left err) - Right (Just []) -> return (Right acc) -- should never happen - result <- doMatch regex_ptr cstr 0 p_match flags - case result of - Right Nothing -> return (Right 0) - Right (Just (whole:_)) -> loop 1 0 whole - Left err -> return (Left err) - Right (Just []) -> return (Right 0) -- should never happen - -{- - --- This is the slower 0.66 version of the code (91s instead of 79s on 10^6 bytes) - -wrapMatchAll regex cstr = do - let regex' = setExecOpts (execNotBOL .|. (getExecOpts regex)) regex - at pos = wrapMatch regex' (plusPtr cstr pos) - loop old (s,e) | s == e = return [] - | otherwise = do - let pos = old + fromIntegral e - result <- at pos - case unwrap result of - Nothing -> return [] - Just [] -> return ((toMA pos []):[]) -- wtf? - Just parts@(whole:_) -> do rest <- loop pos whole - return ((toMA pos parts) : rest) - result <- wrapMatch regex cstr - case unwrap result of - Nothing -> return [] - Just [] -> return ((toMA 0 []):[]) -- wtf? - Just parts@(whole:_) -> do rest <- loop 0 whole - return ((toMA 0 parts) : rest) ---------- --- This was also changed to match wrapMatchAll after 0.66 -wrapCount regex cstr = do - let regex' = setExecOpts (execNotBOL .|. (getExecOpts regex)) regex - at pos = wrapMatch regex' (plusPtr cstr pos) - loop acc old (s,e) | acc `seq` old `seq` False = undefined - | s == e = return acc - | otherwise = do - let pos = old + fromIntegral e - result <- at pos - case unwrap result of - Nothing -> return acc - Just [] -> return (succ acc) -- wtf? - Just (whole:_) -> loop (succ acc) pos whole - result <- wrapMatch regex cstr - case unwrap result of - Nothing -> return 0 - Just [] -> return 1 -- wtf? - Just (whole:_) -> loop 1 0 whole --} diff --git a/Text/Regex/Posix/Wrap.hsc b/Text/Regex/Posix/Wrap.hsc --- a/Text/Regex/Posix/Wrap.hsc +++ b/Text/Regex/Posix/Wrap.hsc @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Text.Regex.Posix.Wrap --- Copyright : (c) Chris Kuklewicz 2006 derived from (c) The University of Glasgow 2002 +-- Copyright : (c) Chris Kuklewicz 2006,2007,2008 derived from (c) The University of Glasgow 2002 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : libraries@haskell.org, textregexlazy@personal.mightyreason.com @@ -25,6 +25,18 @@ -- This module will fail or error only if allocation fails or a nullPtr -- is passed in. -- +-- 2009-January : wrapMatchAll and wrapCount now adjust the execution +-- option execNotBOL after the first result to take into account '\n' +-- in the text immediately before the next matches. (version 0.93.3) +-- +-- 2009-January : wrapMatchAll and wrapCount have been changed to +-- return all non-overlapping matches, including empty matches even if +-- they coincide with the end of the previous non-empty match. The +-- change is that the first non-empty match no longer terminates the +-- search. One can filter the results to obtain the old behavior or +-- to obtain the behavior of "sed", where "sed" eliminates the empty +-- matches which coincide with the end of non-empty matches. (version +-- 0.94.0) ----------------------------------------------------------------------------- module Text.Regex.Posix.Wrap( @@ -102,14 +114,14 @@ {-# CFILES cbits/regfree.c #-} #endif -import Control.Monad(mapM) +import Control.Monad(mapM,liftM) import Data.Array(Array,listArray) import Data.Bits(Bits(..)) -import Data.Int -- need whatever #regoff_t type will be +import Data.Int(Int64) -- need whatever RegeOffset or #regoff_t type will be import Foreign(Ptr, FunPtr, nullPtr, mallocForeignPtrBytes, addForeignPtrFinalizer, Storable(peekByteOff), allocaArray, - allocaBytes, withForeignPtr,ForeignPtr,plusPtr) -import Foreign.C(CSize,CInt) + allocaBytes, withForeignPtr,ForeignPtr,plusPtr,peekElemOff) +import Foreign.C(CSize,CInt,CChar) import Foreign.C.String(peekCAString, CString) import Text.Regex.Base.RegexLike(RegexOptions(..),RegexMaker(..),RegexContext(..),MatchArray) @@ -402,6 +414,12 @@ then return (Left (retOk,"Ptr parameter was nullPtr in Text.Regex.TRE.Wrap."++msg)) else io +isNewline,isNull :: Ptr CChar -> Int -> IO Bool +isNewline cstr pos = liftM (newline ==) (peekElemOff cstr pos) + where newline = toEnum 10 +isNull cstr pos = liftM (nullChar ==) (peekElemOff cstr pos) + where nullChar = toEnum 0 + {- wrapRC :: ReturnCode -> IO (Either WrapError b) {-# INLINE wrapRC #-} @@ -505,17 +523,25 @@ nsub_bytes = ((1 + nsub_int) * (#const sizeof(regmatch_t))) -- add one because index zero covers the whole match allocaBytes nsub_bytes $ \p_match -> do - nullTest cstr "wrapMatchAll p_match" $ do - let flags' = (execNotBOL .|. flags) - at pos = doMatch regex_ptr (plusPtr cstr pos) nsub p_match flags' - loop acc old (s,e) | old `seq` s == e = return (Right (acc [])) + nullTest p_match "wrapMatchAll p_match" $ do + let flagsBOL = (complement execNotBOL) .&. flags + flagsMIDDLE = execNotBOL .|. flags + atBOL pos = doMatch regex_ptr (plusPtr cstr pos) nsub p_match flagsBOL + atMIDDLE pos = doMatch regex_ptr (plusPtr cstr pos) nsub p_match flagsMIDDLE + loop acc old (s,e) | acc `seq` old `seq` False = undefined + | s == e = do + let pos = old + fromIntegral e -- pos may be 0 + atEnd <- isNull cstr pos + if atEnd then return (Right (acc [])) + else loop acc old (s,succ e) | otherwise = do - let pos = old + fromIntegral e - result <- at pos + let pos = old + fromIntegral e -- pos must be greater than 0 (tricky but true) + prev'newline <- isNewline cstr (pred pos) -- safe + result <- if prev'newline then atBOL pos else atMIDDLE pos case result of Right Nothing -> return (Right (acc [])) Right (Just parts@(whole:_)) -> let ma = toMA pos parts - in loop (acc.(ma:)) pos whole + in loop (acc.(ma:)) pos whole Left err -> return (Left err) Right (Just []) -> return (Right (acc [(toMA pos [])])) -- should never happen result <- doMatch regex_ptr cstr nsub p_match flags @@ -546,14 +572,21 @@ withForeignPtr regex_fptr $ \regex_ptr -> do let nsub_bytes = (#size regmatch_t) allocaBytes nsub_bytes $ \p_match -> do - nullTest cstr "wrapCount p_match" $ do - let flags' = (execNotBOL .|. flags) - at pos = doMatch regex_ptr (plusPtr cstr pos) 0 p_match flags' + nullTest p_match "wrapCount p_match" $ do + let flagsBOL = (complement execNotBOL) .&. flags + flagsMIDDLE = execNotBOL .|. flags + atBOL pos = doMatch regex_ptr (plusPtr cstr pos) 0 p_match flagsBOL + atMIDDLE pos = doMatch regex_ptr (plusPtr cstr pos) 0 p_match flagsMIDDLE loop acc old (s,e) | acc `seq` old `seq` False = undefined - | s == e = return (Right acc) + | s == e = do + let pos = old + fromIntegral e -- 0 <= pos + atEnd <- isNull cstr pos + if atEnd then return (Right acc) + else loop acc old (s,succ e) | otherwise = do - let pos = old + fromIntegral e - result <- at pos + let pos = old + fromIntegral e -- 0 < pos + prev'newline <- isNewline cstr (pred pos) -- safe + result <- if prev'newline then atBOL pos else atMIDDLE pos case result of Right Nothing -> return (Right acc) Right (Just (whole:_)) -> loop (succ acc) pos whole diff --git a/regex-posix.cabal b/regex-posix.cabal --- a/regex-posix.cabal +++ b/regex-posix.cabal @@ -1,6 +1,6 @@ Name: regex-posix -- Keep the Version below in sync with ./Text/Regex/Posix.hs value getVersion_Text_Regex_Posix :: Version -Version: 0.93.2 +Version: 0.94.0 Cabal-Version: >=1.2 Build-Type: Custom License: BSD3