1{-# OPTIONS_GHC -Wall -fno-warn-unused-imports #-} 2 3----------------------------------------------------------------------------- 4-- | 5-- Module : Text.Regex.Posix.Wrap 6-- Copyright : (c) Chris Kuklewicz 2006,2007,2008 derived from (c) The University of Glasgow 2002 7-- SPDX-License-Identifier: BSD-3-Clause 8-- 9-- Maintainer : hvr@gnu.org 10-- Stability : experimental 11-- Portability : non-portable (regex-base needs MPTC+FD) 12-- 13-- WrapPosix.hsc exports a wrapped version of the ffi imports. To 14-- increase type safety, the flags are newtype'd. The other important 15-- export is a 'Regex' type that is specific to the Posix library 16-- backend. The flags are documented in "Text.Regex.Posix". The 17-- 'defaultCompOpt' is @(compExtended .|. compNewline)@. 18-- 19-- The 'Regex', 'CompOption', and 'ExecOption' types and their 'RegexOptions' 20-- instance is declared. The '=~' and '=~~' convenience functions are 21-- defined. 22-- 23-- This module will fail or error only if allocation fails or a nullPtr 24-- is passed in. 25-- 26-- 2009-January : wrapMatchAll and wrapCount now adjust the execution 27-- option execNotBOL after the first result to take into account '\n' 28-- in the text immediately before the next matches. (version 0.93.3) 29-- 30-- 2009-January : wrapMatchAll and wrapCount have been changed to 31-- return all non-overlapping matches, including empty matches even if 32-- they coincide with the end of the previous non-empty match. The 33-- change is that the first non-empty match no longer terminates the 34-- search. One can filter the results to obtain the old behavior or 35-- to obtain the behavior of "sed", where "sed" eliminates the empty 36-- matches which coincide with the end of non-empty matches. (version 37-- 0.94.0) 38----------------------------------------------------------------------------- 39 40module Text.Regex.Posix.Wrap( 41 -- ** High-level API 42 Regex, 43 RegOffset, 44 RegOffsetT, 45 (=~), 46 (=~~), 47 48 -- ** Low-level API 49 WrapError, 50 wrapCompile, 51 wrapTest, 52 wrapMatch, 53 wrapMatchAll, 54 wrapCount, 55 56 -- ** Miscellaneous 57 unusedRegOffset, 58 59 -- ** Compilation options 60 CompOption(CompOption), 61 compBlank, 62 compExtended, -- use extended regex syntax 63 compIgnoreCase, -- ignore case when matching 64 compNoSub, -- no substring matching needed 65 compNewline, -- '.' doesn't match newline 66 67 -- ** Execution options 68 ExecOption(ExecOption), 69 execBlank, 70 execNotBOL, -- not at begining of line 71 execNotEOL, -- not at end of line 72 73 -- ** Return codes 74 ReturnCode(ReturnCode), 75 retBadbr, 76 retBadpat, 77 retBadrpt, 78 retEcollate, 79 retEctype, 80 retEescape, 81 retEsubreg, 82 retEbrack, 83 retEparen, 84 retEbrace, 85 retErange, 86 retEspace 87 ) where 88 89#include <sys/types.h> 90#include <string.h> 91 92#ifndef _POSIX_C_SOURCE 93#define _POSIX_C_SOURCE 1 94#endif 95 96#include <regex.h> 97 98#include "myfree.h" 99 100import Prelude hiding (fail) 101import Control.Monad.Fail (MonadFail) 102 103import Control.Monad(liftM) 104import Data.Array(Array,listArray) 105import Data.Bits(Bits(..)) 106import Data.Int(Int32,Int64) -- need whatever RegeOffset or #regoff_t type will be 107import Data.Word(Word32,Word64) -- need whatever RegeOffset or #regoff_t type will be 108import Foreign(Ptr, FunPtr, nullPtr, newForeignPtr, 109 addForeignPtrFinalizer, Storable(peekByteOff), allocaArray, 110 allocaBytes, withForeignPtr,ForeignPtr,plusPtr,peekElemOff) 111import Foreign.Marshal.Alloc(mallocBytes) 112import Foreign.C(CChar) 113#if __GLASGOW_HASKELL__ >= 703 114import Foreign.C(CSize(CSize),CInt(CInt)) 115#else 116import Foreign.C(CSize,CInt) 117#endif 118import Foreign.C.String(peekCAString, CString) 119import Text.Regex.Base.RegexLike(RegexOptions(..),RegexMaker(..),RegexContext(..),MatchArray) 120-- deprecated: import qualified System.IO.Error as IOERROR(try) 121import qualified Control.Exception(try,IOException) 122 123try :: IO a -> IO (Either Control.Exception.IOException a) 124try = Control.Exception.try 125 126data CRegex -- pointer tag for regex_t C type 127 128-- | RegOffset is "typedef int regoff_t" on Linux and ultimately "typedef 129-- long long __int64_t" on Max OS X. So rather than saying 130-- 2,147,483,647 is all the length you need, I'll take the larger: 131-- 9,223,372,036,854,775,807 should be enough bytes for anyone, no 132-- need for Integer. The alternative is to compile to different sizes 133-- in a platform dependent manner with "type RegOffset = (#type 134-- regoff_t)", which I do not want to do. 135-- 136-- There is also a special value 'unusedRegOffset' :: 'RegOffset' which is 137-- (-1) and as a starting index means that the subgroup capture was 138-- unused. Otherwise the RegOffset indicates a character boundary that 139-- is before the character at that index offset, with the first 140-- character at index offset 0. So starting at 1 and ending at 2 means 141-- to take only the second character. 142type RegOffset = Int64 143--debugging 64-bit ubuntu 144type RegOffsetT = (#type regoff_t) 145 146-- | A bitmapped 'CInt' containing options for compilation of regular 147-- expressions. Option values (and their man 3 regcomp names) are 148-- 149-- * 'compBlank' which is a completely zero value for all the flags. 150-- This is also the 'blankCompOpt' value. 151-- 152-- * 'compExtended' (REG_EXTENDED) which can be set to use extended instead 153-- of basic regular expressions. 154-- This is set in the 'defaultCompOpt' value. 155-- 156-- * 'compNewline' (REG_NEWLINE) turns on newline sensitivity: The dot (.) 157-- and inverted set @[^ ]@ never match newline, and ^ and $ anchors do 158-- match after and before newlines. 159-- This is set in the 'defaultCompOpt' value. 160-- 161-- * 'compIgnoreCase' (REG_ICASE) which can be set to match ignoring upper 162-- and lower distinctions. 163-- 164-- * 'compNoSub' (REG_NOSUB) which turns off all information from matching 165-- except whether a match exists. 166 167newtype CompOption = CompOption CInt deriving (Eq,Show,Num,Bits) 168 169-- | A bitmapped 'CInt' containing options for execution of compiled 170-- regular expressions. Option values (and their man 3 regexec names) are 171-- 172-- * 'execBlank' which is a complete zero value for all the flags. This is 173-- the blankExecOpt value. 174-- 175-- * 'execNotBOL' (REG_NOTBOL) can be set to prevent ^ from matching at the 176-- start of the input. 177-- 178-- * 'execNotEOL' (REG_NOTEOL) can be set to prevent $ from matching at the 179-- end of the input (before the terminating NUL). 180newtype ExecOption = ExecOption CInt deriving (Eq,Show,Num,Bits) 181 182-- | ReturnCode is an enumerated 'CInt', corresponding to the error codes 183-- from @man 3 regex@: 184-- 185-- * 'retBadbr' (@REG_BADBR@) invalid repetition count(s) in @{ }@ 186-- 187-- * 'retBadpat' (@REG_BADPAT@) invalid regular expression 188-- 189-- * 'retBadrpt' (@REG_BADRPT@) @?@, @*@, or @+@ operand invalid 190-- 191-- * 'retEcollate' (@REG_ECOLLATE@) invalid collating element 192-- 193-- * 'retEctype' (@REG_ECTYPE@) invalid character class 194-- 195-- * 'retEescape' (@REG_EESCAPE@) @\\@ applied to unescapable character 196-- 197-- * 'retEsubreg' (@REG_ESUBREG@) invalid backreference number 198-- 199-- * 'retEbrack' (@REG_EBRACK@) brackets @[ ]@ not balanced 200-- 201-- * 'retEparen' (@REG_EPAREN@) parentheses @( )@ not balanced 202-- 203-- * 'retEbrace' (@REG_EBRACE@) braces @{ }@ not balanced 204-- 205-- * 'retErange' (@REG_ERANGE@) invalid character range in @[ ]@ 206-- 207-- * 'retEspace' (@REG_ESPACE@) ran out of memory 208-- 209-- * 'retNoMatch' (@REG_NOMATCH@) The regexec() function failed to match 210-- 211newtype ReturnCode = ReturnCode CInt deriving (Eq,Show) 212 213-- | A compiled regular expression. 214data Regex = Regex (ForeignPtr CRegex) CompOption ExecOption 215 216-- | A completely zero value for all the flags. 217-- This is also the 'blankCompOpt' value. 218compBlank :: CompOption 219compBlank = CompOption 0 220 221-- | A completely zero value for all the flags. 222-- This is also the 'blankExecOpt' value. 223execBlank :: ExecOption 224execBlank = ExecOption 0 225 226unusedRegOffset :: RegOffset 227unusedRegOffset = (-1) 228 229-- | The return code will be retOk when it is the Haskell wrapper and 230-- not the underlying library generating the error message. 231type WrapError = (ReturnCode,String) 232 233wrapCompile :: CompOption -- ^ Flags (bitmapped) 234 -> ExecOption -- ^ Flags (bitmapped) 235 -> CString -- ^ The regular expression to compile (ASCII only, no null bytes) 236 -> IO (Either WrapError Regex) -- ^ Returns: the compiled regular expression 237 238wrapTest :: Regex -> CString 239 -> IO (Either WrapError Bool) 240 241-- | wrapMatch returns offsets for the begin and end of each capture. 242-- Unused captures have offsets of unusedRegOffset which is (-1) 243wrapMatch :: Regex -> CString 244 -> IO (Either WrapError (Maybe [(RegOffset,RegOffset)])) 245 246-- | wrapMatchAll returns the offset and length of each capture. 247-- Unused captures have an offset of unusedRegOffset which is (-1) and 248-- length of 0. 249wrapMatchAll :: Regex -> CString 250 -> IO (Either WrapError [MatchArray]) 251 252wrapCount :: Regex -> CString 253 -> IO (Either WrapError Int) 254 255(=~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target) 256 => source1 -> source -> target 257(=~~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target,MonadFail m) 258 => source1 -> source -> m target 259 260instance RegexOptions Regex CompOption ExecOption where 261 blankCompOpt = compBlank 262 blankExecOpt = execBlank 263 defaultCompOpt = compExtended .|. compNewline 264 defaultExecOpt = execBlank 265 setExecOpts e' (Regex r c _) = Regex r c e' 266 getExecOpts (Regex _ _ e) = e 267 268-- (=~) ::(RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target) => source1 -> source -> target 269(=~) x r = let make :: RegexMaker Regex CompOption ExecOption a => a -> Regex 270 make = makeRegex 271 in match (make r) x 272 273-- (=~~) ::(RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target,MonadFail m) => source1 -> source -> m target 274(=~~) x r = let make :: RegexMaker Regex CompOption ExecOption a => a -> Regex 275 make = makeRegex 276 in matchM (make r) x 277 278type CRegMatch = () -- dummy regmatch_t used below to read out so and eo values 279 280-- ----------------------------------------------------------------------------- 281-- The POSIX regex C interface 282 283-- string.h 284foreign import ccall unsafe "memset" 285 c_memset :: Ptr CRegex -> CInt -> CSize -> IO (Ptr CRegex) 286 287-- cbits/myfree.h and cbits/myfree.c 288foreign import ccall unsafe "&hs_regex_regfree" 289 c_myregfree :: FunPtr (Ptr CRegex -> IO ()) 290 291foreign import ccall unsafe "regex.h regcomp" 292 c_regcomp :: Ptr CRegex -> CString -> CompOption -> IO ReturnCode 293 294{- currently unused 295foreign import ccall unsafe "regex.h ®free" 296 c_regfree :: FunPtr (Ptr CRegex -> IO ()) 297-} 298 299foreign import ccall unsafe "regex.h regexec" 300 c_regexec :: Ptr CRegex -> CString -> CSize 301 -> Ptr CRegMatch -> ExecOption -> IO ReturnCode 302 303foreign import ccall unsafe "regex.h regerror" 304 c_regerror :: ReturnCode -> Ptr CRegex 305 -> CString -> CSize -> IO CSize 306 307retOk :: ReturnCode 308retOk = ReturnCode 0 309 310-- Flags for regexec 311#enum ExecOption,ExecOption, \ 312 execNotBOL = REG_NOTBOL, \ 313 execNotEOL = REG_NOTEOL 314 315-- Flags for regcomp 316#enum CompOption,CompOption, \ 317 compExtended = REG_EXTENDED, \ 318 compIgnoreCase = REG_ICASE, \ 319 compNoSub = REG_NOSUB, \ 320 compNewline = REG_NEWLINE 321 322-- Return values from regexec (REG_NOMATCH, REG_ESPACE,...) 323-- Error codes from regcomp (not REG_NOMATCH) 324-- Though calling retNoMatch an error is rather missing the point... 325#enum ReturnCode,ReturnCode, \ 326 retNoMatch = REG_NOMATCH, \ 327 retBadbr = REG_BADBR, \ 328 retBadpat = REG_BADPAT, \ 329 retBadrpt = REG_BADRPT, \ 330 retEcollate = REG_ECOLLATE, \ 331 retEctype = REG_ECTYPE, \ 332 retEescape = REG_EESCAPE, \ 333 retEsubreg = REG_ESUBREG, \ 334 retEbrack = REG_EBRACK, \ 335 retEparen = REG_EPAREN, \ 336 retEbrace = REG_EBRACE, \ 337 retErange = REG_ERANGE, \ 338 retEspace = REG_ESPACE 339---- 340-- error helpers 341 342nullTest :: Ptr a -> String -> IO (Either WrapError b) -> IO (Either WrapError b) 343{-# INLINE nullTest #-} 344nullTest ptr msg io = do 345 if nullPtr == ptr 346 then return (Left (retOk,"Ptr parameter was nullPtr in Text.Regex.TRE.Wrap."++msg)) 347 else io 348 349isNewline,isNull :: Ptr CChar -> Int -> IO Bool 350isNewline cstr pos = liftM (newline ==) (peekElemOff cstr pos) 351 where newline = toEnum 10 352isNull cstr pos = liftM (nullChar ==) (peekElemOff cstr pos) 353 where nullChar = toEnum 0 354 355{- 356wrapRC :: ReturnCode -> IO (Either WrapError b) 357{-# INLINE wrapRC #-} 358wrapRC r = return (Left (r,"Error in Text.Regex.Posix.Wrap: "++show r)) 359-} 360wrapError :: ReturnCode -> Ptr CRegex -> IO (Either WrapError b) 361wrapError errCode regex_ptr = do 362 -- Call once to compute the error message buffer size 363 errBufSize <- c_regerror errCode regex_ptr nullPtr 0 364 -- Allocate a temporary buffer to hold the error message 365 allocaArray (fromIntegral errBufSize) $ \errBuf -> do 366 nullTest errBuf "wrapError errBuf" $ do 367 _ <- c_regerror errCode regex_ptr errBuf errBufSize 368 msg <- peekCAString errBuf :: IO String 369 return (Left (errCode, msg)) 370 371---------- 372wrapCompile flags e pattern = do 373 nullTest pattern "wrapCompile pattern" $ do 374 e_regex_ptr <- try $ mallocBytes (#const sizeof(regex_t)) -- ioError called if nullPtr 375 case e_regex_ptr of 376 Left ioerror -> return (Left (retOk,"Text.Regex.Posix.Wrap.wrapCompile: IOError from mallocBytes(regex_t) : "++show ioerror)) 377 Right raw_regex_ptr -> do 378 zero_regex_ptr <- c_memset raw_regex_ptr 0 (#const sizeof(regex_t)) -- no calloc, so clear the new area to zero 379 regex_fptr <- newForeignPtr c_myregfree zero_regex_ptr -- once pointed-to area is clear it should be safe to add finalizer 380 withForeignPtr regex_fptr $ \regex_ptr -> do -- withForeignPtr is best hygiene here 381 errCode <- c_regcomp regex_ptr pattern flags 382 if (errCode == retOk) 383 then return . Right $ Regex regex_fptr flags e 384 else wrapError errCode regex_ptr 385 386--------- 387wrapTest (Regex regex_fptr _ flags) cstr = do 388 nullTest cstr "wrapTest" $ do 389 withForeignPtr regex_fptr $ \regex_ptr -> do 390 r <- c_regexec regex_ptr cstr 0 nullPtr flags 391 if r == retOk 392 then return (Right True) 393 else if r == retNoMatch 394 then return (Right False) 395 else wrapError r regex_ptr 396 397--------- 398wrapMatch regex@(Regex regex_fptr compileOptions flags) cstr = do 399 nullTest cstr "wrapMatch cstr" $ do 400 if (0 /= compNoSub .&. compileOptions) 401 then do 402 r <- wrapTest regex cstr 403 case r of 404 Right True -> return (Right (Just [])) -- Source of much "wtf?" crap 405 Right False -> return (Right Nothing) 406 Left err -> return (Left err) 407 else do 408 withForeignPtr regex_fptr $ \regex_ptr -> do 409 nsub <- (#peek regex_t, re_nsub) regex_ptr :: IO CSize 410 let nsub_int,nsub_bytes :: Int 411 nsub_int = fromIntegral nsub 412 nsub_bytes = ((1 + nsub_int) * (#const sizeof(regmatch_t))) 413 -- add one because index zero covers the whole match 414 allocaBytes nsub_bytes $ \p_match -> do 415 nullTest p_match "wrapMatch allocaBytes" $ do 416 doMatch regex_ptr cstr nsub p_match flags 417 418-- Very very thin wrapper 419-- Requires, but does not check, that nsub>=0 420-- Cannot return (Right (Just [])) 421doMatch :: Ptr CRegex -> CString -> CSize -> Ptr CRegMatch -> ExecOption 422 -> IO (Either WrapError (Maybe [(RegOffset,RegOffset)])) 423{-# INLINE doMatch #-} 424doMatch regex_ptr cstr nsub p_match flags = do 425 r <- c_regexec regex_ptr cstr (1 + nsub) p_match flags 426 if r == retOk 427 then do 428 regions <- mapM getOffsets . take (1+fromIntegral nsub) 429 . iterate (`plusPtr` (#const sizeof(regmatch_t))) $ p_match 430 return (Right (Just regions)) -- regions will not be [] 431 else if r == retNoMatch 432 then return (Right Nothing) 433 else wrapError r regex_ptr 434 where 435 getOffsets :: Ptr CRegMatch -> IO (RegOffset,RegOffset) 436 {-# INLINE getOffsets #-} 437 getOffsets pmatch' = do 438 start <- (#peek regmatch_t, rm_so) pmatch' :: IO (#type regoff_t) 439 end <- (#peek regmatch_t, rm_eo) pmatch' :: IO (#type regoff_t) 440 return (fromIntegral start,fromIntegral end) 441 442wrapMatchAll regex@(Regex regex_fptr compileOptions flags) cstr = do 443 nullTest cstr "wrapMatchAll cstr" $ do 444 if (0 /= compNoSub .&. compileOptions) 445 then do 446 r <- wrapTest regex cstr 447 case r of 448 Right True -> return (Right [(toMA 0 [])]) -- Source of much "wtf?" crap 449 Right False -> return (Right []) 450 Left err -> return (Left err) 451 else do 452 withForeignPtr regex_fptr $ \regex_ptr -> do 453 nsub <- (#peek regex_t, re_nsub) regex_ptr :: IO CSize 454 let nsub_int,nsub_bytes :: Int 455 nsub_int = fromIntegral nsub 456 nsub_bytes = ((1 + nsub_int) * (#const sizeof(regmatch_t))) 457 -- add one because index zero covers the whole match 458 allocaBytes nsub_bytes $ \p_match -> do 459 nullTest p_match "wrapMatchAll p_match" $ do 460 let flagsBOL = (complement execNotBOL) .&. flags 461 flagsMIDDLE = execNotBOL .|. flags 462 atBOL pos = doMatch regex_ptr (plusPtr cstr pos) nsub p_match flagsBOL 463 atMIDDLE pos = doMatch regex_ptr (plusPtr cstr pos) nsub p_match flagsMIDDLE 464 loop acc old (s,e) | acc `seq` old `seq` False = undefined 465 | s == e = do 466 let pos = old + fromIntegral e -- pos may be 0 467 atEnd <- isNull cstr pos 468 if atEnd then return (Right (acc [])) 469 else loop acc old (s,succ e) 470 | otherwise = do 471 let pos = old + fromIntegral e -- pos must be greater than 0 (tricky but true) 472 prev'newline <- isNewline cstr (pred pos) -- safe 473 result <- if prev'newline then atBOL pos else atMIDDLE pos 474 case result of 475 Right Nothing -> return (Right (acc [])) 476 Right (Just parts@(whole:_)) -> let ma = toMA pos parts 477 in loop (acc.(ma:)) pos whole 478 Left err -> return (Left err) 479 Right (Just []) -> return (Right (acc [(toMA pos [])])) -- should never happen 480 result <- doMatch regex_ptr cstr nsub p_match flags 481 case result of 482 Right Nothing -> return (Right []) 483 Right (Just parts@(whole:_)) -> let ma = toMA 0 parts 484 in loop (ma:) 0 whole 485 Left err -> return (Left err) 486 Right (Just []) -> return (Right [(toMA 0 [])]) -- should never happen 487 where 488 toMA :: Int -> [(RegOffset,RegOffset)] -> Array Int (Int,Int) 489 toMA pos [] = listArray (0,0) [(pos,0)] -- wtf? 490 toMA pos parts = listArray (0,pred (length parts)) 491 . map (\(s,e)-> if s>=0 then (pos+fromIntegral s, fromIntegral (e-s)) else (-1,0)) 492 $ parts 493 494--------- 495wrapCount regex@(Regex regex_fptr compileOptions flags) cstr = do 496 nullTest cstr "wrapCount cstr" $ do 497 if (0 /= compNoSub .&. compileOptions) 498 then do 499 r <- wrapTest regex cstr 500 case r of 501 Right True -> return (Right 1) 502 Right False -> return (Right 0) 503 Left err -> return (Left err) 504 else do 505 withForeignPtr regex_fptr $ \regex_ptr -> do 506 let nsub_bytes = (#size regmatch_t) 507 allocaBytes nsub_bytes $ \p_match -> do 508 nullTest p_match "wrapCount p_match" $ do 509 let flagsBOL = (complement execNotBOL) .&. flags 510 flagsMIDDLE = execNotBOL .|. flags 511 atBOL pos = doMatch regex_ptr (plusPtr cstr pos) 0 p_match flagsBOL 512 atMIDDLE pos = doMatch regex_ptr (plusPtr cstr pos) 0 p_match flagsMIDDLE 513 loop acc old (s,e) | acc `seq` old `seq` False = undefined 514 | s == e = do 515 let pos = old + fromIntegral e -- 0 <= pos 516 atEnd <- isNull cstr pos 517 if atEnd then return (Right acc) 518 else loop acc old (s,succ e) 519 | otherwise = do 520 let pos = old + fromIntegral e -- 0 < pos 521 prev'newline <- isNewline cstr (pred pos) -- safe 522 result <- if prev'newline then atBOL pos else atMIDDLE pos 523 case result of 524 Right Nothing -> return (Right acc) 525 Right (Just (whole:_)) -> loop (succ acc) pos whole 526 Left err -> return (Left err) 527 Right (Just []) -> return (Right acc) -- should never happen 528 result <- doMatch regex_ptr cstr 0 p_match flags 529 case result of 530 Right Nothing -> return (Right 0) 531 Right (Just (whole:_)) -> loop 1 0 whole 532 Left err -> return (Left err) 533 Right (Just []) -> return (Right 0) -- should never happen 534 535{- 536 537-- This is the slower 0.66 version of the code (91s instead of 79s on 10^6 bytes) 538 539wrapMatchAll regex cstr = do 540 let regex' = setExecOpts (execNotBOL .|. (getExecOpts regex)) regex 541 at pos = wrapMatch regex' (plusPtr cstr pos) 542 loop old (s,e) | s == e = return [] 543 | otherwise = do 544 let pos = old + fromIntegral e 545 result <- at pos 546 case unwrap result of 547 Nothing -> return [] 548 Just [] -> return ((toMA pos []):[]) -- wtf? 549 Just parts@(whole:_) -> do rest <- loop pos whole 550 return ((toMA pos parts) : rest) 551 result <- wrapMatch regex cstr 552 case unwrap result of 553 Nothing -> return [] 554 Just [] -> return ((toMA 0 []):[]) -- wtf? 555 Just parts@(whole:_) -> do rest <- loop 0 whole 556 return ((toMA 0 parts) : rest) 557--------- 558-- This was also changed to match wrapMatchAll after 0.66 559wrapCount regex cstr = do 560 let regex' = setExecOpts (execNotBOL .|. (getExecOpts regex)) regex 561 at pos = wrapMatch regex' (plusPtr cstr pos) 562 loop acc old (s,e) | acc `seq` old `seq` False = undefined 563 | s == e = return acc 564 | otherwise = do 565 let pos = old + fromIntegral e 566 result <- at pos 567 case unwrap result of 568 Nothing -> return acc 569 Just [] -> return (succ acc) -- wtf? 570 Just (whole:_) -> loop (succ acc) pos whole 571 result <- wrapMatch regex cstr 572 case unwrap result of 573 Nothing -> return 0 574 Just [] -> return 1 -- wtf? 575 Just (whole:_) -> loop 1 0 whole 576-} 577