pcre-light-0.4/0000755000175000001440000000000011430103671012271 5ustar donsuserspcre-light-0.4/configure0000644000175000001440000000041111430103671014171 0ustar donsusers#!/bin/sh # # subst standard header path variables if test -n "$CPPFLAGS" ; then echo "Found CPPFLAGS in environment: '$CPPFLAGS'" sed 's,@CPPFLAGS@,'"$CPPFLAGS"',g;s,@LDFLAGS@,'"$LDFLAGS"',g' \ < pcre-light.buildinfo.in > pcre-light.buildinfo fi pcre-light-0.4/LICENSE0000644000175000001440000000270011430103671013275 0ustar donsusersCopyright (c) Don Stewart 2007 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. pcre-light-0.4/Setup.lhs0000644000175000001440000000011411430103671014075 0ustar donsusers#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain pcre-light-0.4/tests/0000755000175000001440000000000011430103671013433 5ustar donsuserspcre-light-0.4/tests/Parse.hs0000644000175000001440000000410511430103671015041 0ustar donsusers-- -- A script to translate the pcre.c testsuite into Haskell -- import System.Environment import System.IO import Data.Char import Data.List import Text.PrettyPrint.HughesPJ data Test = Test String [String] [Maybe [String]] deriving (Eq,Show,Read) main = do [f,g] <- getArgs inf <- readFile f outf <- readFile g let in_str = lines inf out_str = lines outf let loop [] [] = [] loop i_xs o_xs = Test r subj results : loop (dropWhile (=="") i_ys) (dropWhile (=="") o_ys) where ((r:subj), i_ys) = break (== "") i_xs ((_:results'),o_ys) = break (== "") o_xs results= [ if s == "No match" then Nothing else Just [s] | s <- filter (not . all isSpace . take 2) results' ] print . vcat . intersperse (char ',') . map ppr . loop in_str $ out_str breakReg ('/':rest) = let s = reverse . dropWhile (/= '/') . reverse $ rest t = case head (reverse rest) of 'i' -> ["caseless"] '/' -> [] _ -> ["ERROR"] in if s == "" then ("ERROR", []) else (init s, t) breakReg ('"':rest) = let s = reverse . dropWhile (/= '"') . reverse $ rest t = case head (reverse rest) of 'i' -> ["caseless"] '/' -> [] _ -> ["ERROR"] in if s == "" then ("ERROR", []) else (init s, t) breakReg s = ("ERROR", []) ppr :: Test -> Doc ppr (Test r subjs res) = hang (empty <+> text "testRegex" <+> text (show (fst $ breakReg r)) <+> bracket (case snd (breakReg r) of [] -> empty [x] -> text x )) 4 $ (bracket $ vcat $ punctuate (char ',') (map (text.show) subjs)) $+$ (bracket $ vcat $ punctuate (char ',') (map (text.show) res)) bracket x = char '[' <> x <> char ']' pcre-light-0.4/tests/failure1.hs0000644000175000001440000000024611430103671015501 0ustar donsusersimport Text.Regex.PCRE.Light.Char8 main = do let r = compile "(a|)*\\d" [] print (match r "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" []) pcre-light-0.4/tests/Makefile0000644000175000001440000000046411430103671015077 0ustar donsusersall: ghc -Onot -fasm Unit.hs --make && ./Unit # runhaskell Unit.hs && echo $$? test:: ghc -ddump-simpl-stats -lpcre -fhpc --make -i.. -i../dist/build/ Unit.hs -o Unit -O2 -no-recomp rm -f *.tix ./Unit hpc report --decl-list --exclude=Main Unit hpc markup --fun-entry-count --exclude=Main Unit pcre-light-0.4/tests/Unit.hs0000644000175000001440000024512111430103671014713 0ustar donsusers{-# LANGUAGE OverloadedStrings #-} import Text.Regex.PCRE.Light (compile,compileM,match) import qualified Text.Regex.PCRE.Light.Char8 as String (compile,compileM,match) import Text.Regex.PCRE.Light.Base import qualified Data.ByteString.Char8 as S import System.IO import Test.HUnit import System.Exit (exitFailure) import Control.Monad (when) import System.IO import Data.Either import qualified Data.Map as M import System.IO.Unsafe import Control.OldException import Control.Monad.Error assertBool' s = assertBool (S.unpack s) assertEqual' s = assertEqual (S.unpack s) testLabel s = TestLabel (S.unpack s) instance Error S.ByteString where noMsg = S.empty strMsg = S.pack testRegex :: S.ByteString -> [PCREOption] -> [S.ByteString] -> [Maybe [S.ByteString]] -> Test testRegex regex options inputs outputs = testLabel regex $ TestCase $ do assertEqual' "Input/Output Length Check" (length inputs) (length outputs) assertBool' "ByteString regex compile" =<< case compile regex options of r -> return $ and [ match r i [] == o | (i,o) <- zip inputs outputs ] assertBool' "ByteString regex compileM" =<< case compileM regex options of Left s -> do S.hPutStrLn stderr ("ERROR in ByteString in compileM " `S.append` (S.pack s)) return False Right r -> return $ and [ match r i [] == o | (i,o) <- zip inputs outputs ] assertBool' "String regex" =<< case String.compile (S.unpack regex) options of r -> return $ and [ String.match r i [] == o | (i,o) <- zip (map (S.unpack) inputs) (map (fmap (map S.unpack)) outputs) ] assertBool' "String regex" =<< case String.compileM (S.unpack regex) options of Left s -> do S.hPutStrLn stderr ("ERROR in String compileM: " `S.append` (S.pack s)) return False Right r -> return $ and [ String.match r i [] == o | (i,o) <- zip (map (S.unpack) inputs) (map (fmap (map S.unpack)) outputs) ] main = do counts <- runTestTT tests when (errors counts > 0 || failures counts > 0) exitFailure tests = TestList [ testRegex "the quick brown fox" [] [ "the quick brown fox" , "The quick brown FOX" , "What do you know about the quick brown fox?" , "What do you know about THE QUICK BROWN FOX?" ] [ Just ["the quick brown fox"] , Nothing , Just ["the quick brown fox"] , Nothing ] , testLabel "compile failure" $ TestCase $ (assertBool' "compile failure" $ Left ("nothing to repeat" ) == compileM "*" []) , testLabel "compile failure" $ TestCase $ (assertBool' "compile failure" =<< (return $ (Just ("Text.Regex.PCRE.Light: Error in regex: nothing to repeat")) == (unsafePerformIO $ do handle (\e -> return (Just (S.pack $ show e))) (compile "*" [] `seq` return Nothing)))) -- , testRegex "\0*" [] -- the embedded null in the pattern seems to be a problem -- ["\0\0\0\0"] -- [Just ["\0\0\0\0"]] , testRegex "\1*" [] -- the embedded null in the pattern seems to be a problem ["\1\1\1\1"] [Just ["\1\1\1\1"]] , testRegex "The quick brown fox" [caseless] ["the quick brown fox" ,"The quick brown FOX" ,"What do you know about the quick brown fox?" ,"What do you know about THE QUICK BROWN FOX?" ] [ Just ["the quick brown fox"] , Just ["The quick brown FOX"] , Just ["the quick brown fox"] , Just ["THE QUICK BROWN FOX"] ] , testRegex "a*abc?xyz+pqr{3}ab{2,}xy{4,5}pq{0,6}AB{0,}zz" [] ["abxyzpqrrrabbxyyyypqAzz" ,"abxyzpqrrrabbxyyyypqAzz" ,"aabxyzpqrrrabbxyyyypqAzz" ,"aaabxyzpqrrrabbxyyyypqAzz" ,"aaaabxyzpqrrrabbxyyyypqAzz" ,"abcxyzpqrrrabbxyyyypqAzz" ,"aabcxyzpqrrrabbxyyyypqAzz" ,"aaabcxyzpqrrrabbxyyyypAzz" ,"aaabcxyzpqrrrabbxyyyypqAzz" ,"aaabcxyzpqrrrabbxyyyypqqAzz" ,"aaabcxyzpqrrrabbxyyyypqqqAzz" ,"aaabcxyzpqrrrabbxyyyypqqqqAzz" ,"aaabcxyzpqrrrabbxyyyypqqqqqAzz" ,"aaabcxyzpqrrrabbxyyyypqqqqqqAzz" ,"aaaabcxyzpqrrrabbxyyyypqAzz" ,"abxyzzpqrrrabbxyyyypqAzz" ,"aabxyzzzpqrrrabbxyyyypqAzz" ,"aaabxyzzzzpqrrrabbxyyyypqAzz" ,"aaaabxyzzzzpqrrrabbxyyyypqAzz" ,"abcxyzzpqrrrabbxyyyypqAzz" ,"aabcxyzzzpqrrrabbxyyyypqAzz" ,"aaabcxyzzzzpqrrrabbxyyyypqAzz" ,"aaaabcxyzzzzpqrrrabbxyyyypqAzz" ,"aaaabcxyzzzzpqrrrabbbxyyyypqAzz" ,"aaaabcxyzzzzpqrrrabbbxyyyyypqAzz" ,"aaabcxyzpqrrrabbxyyyypABzz" ,"aaabcxyzpqrrrabbxyyyypABBzz" ,">>>aaabxyzpqrrrabbxyyyypqAzz" ,">aaaabxyzpqrrrabbxyyyypqAzz" ,">>>>abcxyzpqrrrabbxyyyypqAzz" ,"abxyzpqrrabbxyyyypqAzz" ,"abxyzpqrrrrabbxyyyypqAzz" ,"abxyzpqrrrabxyyyypqAzz" ,"aaaabcxyzzzzpqrrrabbbxyyyyyypqAzz" ,"aaaabcxyzzzzpqrrrabbbxyyypqAzz" ,"aaabcxyzpqrrrabbxyyyypqqqqqqqAzz" ] [ Just ["abxyzpqrrrabbxyyyypqAzz"] , Just ["abxyzpqrrrabbxyyyypqAzz"] , Just ["aabxyzpqrrrabbxyyyypqAzz"] , Just ["aaabxyzpqrrrabbxyyyypqAzz"] , Just ["aaaabxyzpqrrrabbxyyyypqAzz"] , Just ["abcxyzpqrrrabbxyyyypqAzz"] , Just ["aabcxyzpqrrrabbxyyyypqAzz"] , Just ["aaabcxyzpqrrrabbxyyyypAzz"] , Just ["aaabcxyzpqrrrabbxyyyypqAzz"] , Just ["aaabcxyzpqrrrabbxyyyypqqAzz"] , Just ["aaabcxyzpqrrrabbxyyyypqqqAzz"] , Just ["aaabcxyzpqrrrabbxyyyypqqqqAzz"] , Just ["aaabcxyzpqrrrabbxyyyypqqqqqAzz"] , Just ["aaabcxyzpqrrrabbxyyyypqqqqqqAzz"] , Just ["aaaabcxyzpqrrrabbxyyyypqAzz"] , Just ["abxyzzpqrrrabbxyyyypqAzz"] , Just ["aabxyzzzpqrrrabbxyyyypqAzz"] , Just ["aaabxyzzzzpqrrrabbxyyyypqAzz"] , Just ["aaaabxyzzzzpqrrrabbxyyyypqAzz"] , Just ["abcxyzzpqrrrabbxyyyypqAzz"] , Just ["aabcxyzzzpqrrrabbxyyyypqAzz"] , Just ["aaabcxyzzzzpqrrrabbxyyyypqAzz"] , Just ["aaaabcxyzzzzpqrrrabbxyyyypqAzz"] , Just ["aaaabcxyzzzzpqrrrabbbxyyyypqAzz"] , Just ["aaaabcxyzzzzpqrrrabbbxyyyyypqAzz"] , Just ["aaabcxyzpqrrrabbxyyyypABzz"] , Just ["aaabcxyzpqrrrabbxyyyypABBzz"] , Just ["aaabxyzpqrrrabbxyyyypqAzz"] , Just ["aaaabxyzpqrrrabbxyyyypqAzz"] , Just ["abcxyzpqrrrabbxyyyypqAzz"] , Nothing , Nothing , Nothing , Nothing , Nothing , Nothing ] , testRegex "^(abc){1,2}zz" [] ["abczz" ,"abcabczz" ,"zz" ,"abcabcabczz" ,">>abczz"] [ Just ["abczz","abc"] , Just ["abcabczz", "abc"] , Nothing , Nothing , Nothing ] , testRegex "^(b+?|a){1,2}?c" [] ["bc", "bbc", "bbbc", "bac", "bbac", "aac", "abbbbbbbbbbbc", "bbbbbbbbbbbac", "aaac", "abbbbbbbbbbbac"] [Just ["bc", "b"], Just ["bbc", "b"], Just ["bbbc", "bb"], Just ["bac", "a"], Just ["bbac", "a"], Just ["aac", "a"], Just ["abbbbbbbbbbbc", "bbbbbbbbbbb"], Just ["bbbbbbbbbbbac", "a"], Nothing, Nothing] , testRegex "^(b+|a){1,2}c" [] ["bc", "bbc", "bbbc", "bac", "bbac", "aac", "abbbbbbbbbbbc", "bbbbbbbbbbbac", "aaac", "abbbbbbbbbbbac"] [Just ["bc", "b"], Just ["bbc", "bb"], Just ["bbbc", "bbb"], Just ["bac", "a"], Just ["bbac", "a"], Just ["aac", "a"], Just ["abbbbbbbbbbbc", "bbbbbbbbbbb"], Just ["bbbbbbbbbbbac", "a"], Nothing, Nothing] , testRegex "^(b+|a){1,2}?bc" [] ["bbc"] [Just ["bbc", "b"]] , testRegex "^(b*|ba){1,2}?bc" [] ["babc", "bbabc", "bababc", "bababbc", "babababc"] [Just ["babc","ba"], Just ["bbabc","ba"], Just ["bababc","ba"], Nothing, Nothing] , testRegex "^(ba|b*){1,2}?bc" [] ["babc", "bbabc", "bababc", "bababbc", "babababc"] [Just ["babc","ba"], Just ["bbabc","ba"], Just ["bababc","ba"], Nothing, Nothing] , testRegex "^[ab\\]cde]" [] ["athing", "bthing", "]thing", "cthing", "dthing", "ething", "fthing", "[thing", "\\\\thing"] [Just ["a"], Just ["b"], Just ["]"], Just ["c"], Just ["d"], Just ["e"], Nothing, Nothing, Nothing] , testRegex "^[]cde]" [] ["]thing", "cthing", "dthing", "ething", "athing", "fthing"] [Just ["]"], Just ["c"], Just ["d"], Just ["e"], Nothing, Nothing] , testRegex "^[^ab\\]cde]" [] ["fthing", "[thing", "\\\\thing", "athing", "bthing", "]thing", "cthing", "dthing", "ething"] [Just ["f"], Just ["["], Just ["\\"], Nothing, Nothing, Nothing, Nothing, Nothing, Nothing] , testRegex "^\129" [] ["\129"] [Just ["\x81"]] , testRegex "^\255" [] ["\255"] [Just ["\xff"]] , testRegex "^[0-9]+$" [] ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "100", "abc"] [Just ["0"], Just ["1"], Just ["2"], Just ["3"], Just ["4"], Just ["5"], Just ["6"], Just ["7"], Just ["8"], Just ["9"], Just ["10"], Just ["100"], Nothing] , testRegex "^.*nter" [] ["enter", "inter", "uponter"] [Just ["enter"], Just ["inter"], Just ["uponter"]] , testRegex "^xxx[0-9]+$" [] ["xxx0", "xxx1234", "xxx"] [Just ["xxx0"], Just ["xxx1234"], Nothing] , testRegex "^.+[0-9][0-9][0-9]$" [] ["x123", "xx123", "123456", "123", "x1234"] [Just ["x123"], Just ["xx123"], Just ["123456"], Nothing, Just ["x1234"]] , testRegex "^.+?[0-9][0-9][0-9]$" [] ["x123", "xx123", "123456", "123", "x1234"] [Just ["x123"], Just ["xx123"], Just ["123456"], Nothing, Just ["x1234"]] -- test matching more than 1 subpattern , testRegex "^([^!]+)!(.+)=apquxz\\.ixr\\.zzz\\.ac\\.uk$" [] ["abc!pqr=apquxz.ixr.zzz.ac.uk", "!pqr=apquxz.ixr.zzz.ac.uk", "abc!=apquxz.ixr.zzz.ac.uk", "abc!pqr=apquxz:ixr.zzz.ac.uk", "abc!pqr=apquxz.ixr.zzz.ac.ukk"] [Just ["abc!pqr=apquxz.ixr.zzz.ac.uk", "abc", "pqr"], Nothing, Nothing, Nothing, Nothing] , testRegex ":" [] ["Well, we need a colon: somewhere", "*** Fail if we don't"] [Just [":"], Nothing] , testRegex "([\\da-f:]+)$" [caseless] ["0abc", "abc", "fed", "E", "::", "5f03:12C0::932e", "fed def", "Any old stuff", "*** Failers", "0zzz", "gzzz", "fed\x20", "Any old rubbish"] [Just ["0abc", "0abc"], Just ["abc", "abc"], Just ["fed", "fed"], Just ["E", "E"], Just ["::", "::"], Just ["5f03:12C0::932e", "5f03:12C0::932e"], Just ["def", "def"], Just ["ff", "ff"], Nothing, Nothing, Nothing, Nothing, Nothing] , testRegex "^.*\\.(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})$" [] [".1.2.3", "A.12.123.0", ".1.2.3333", "1.2.3", "1234.2.3"] [Just [".1.2.3", "1", "2", "3"], Just ["A.12.123.0", "12", "123", "0"], Nothing, Nothing, Nothing] , testRegex "^(\\d+)\\s+IN\\s+SOA\\s+(\\S+)\\s+(\\S+)\\s*\\(\\s*$" [] ["1 IN SOA non-sp1 non-sp2(", "1 IN SOA non-sp1 non-sp2 (", "1IN SOA non-sp1 non-sp2("] [Just ["1 IN SOA non-sp1 non-sp2(", "1", "non-sp1", "non-sp2"], Just ["1 IN SOA non-sp1 non-sp2 (", "1", "non-sp1", "non-sp2"], Nothing] , testRegex "^[a-zA-Z\\d][a-zA-Z\\d\\-]*(\\.[a-zA-Z\\d][a-zA-z\\d\\-]*)*\\.$" [] ["a.", "Z.", "2.", "ab-c.pq-r.", "sxk.zzz.ac.uk.", "x-.y-.", "*** Failers", "-abc.peq."] [Just ["a."], Just ["Z."], Just ["2."], Just ["ab-c.pq-r.", ".pq-r"], Just ["sxk.zzz.ac.uk.", ".uk"], Just ["x-.y-.", ".y-"], Nothing, Nothing] , testRegex "^\\*\\.[a-z]([a-z\\-\\d]*[a-z\\d]+)?(\\.[a-z]([a-z\\-\\d]*[a-z\\d]+)?)*$" [] ["*.a", "*.b0-a", "*.c3-b.c", "*.c-a.b-c", "*** Failers", "*.0", "*.a-", "*.a-b.c-", "*.c-a.0-c"] [Just ["*.a"], Just ["*.b0-a", "0-a"], Just ["*.c3-b.c", "3-b", ".c"], Just ["*.c-a.b-c", "-a", ".b-c", "-c"], Nothing, Nothing, Nothing, Nothing, Nothing] , testRegex "^(?=ab(de))(abd)(e)" [] ["abde"] [Just ["abde", "de", "abd", "e"]] , testRegex "^(?!(ab)de|x)(abd)(f)" [] ["abdf"] [Just ["abdf", "", "abd", "f"]] , testRegex "^(?=(ab(cd)))(ab)" [] ["abcd"] [Just ["ab", "abcd", "cd", "ab"]] , testRegex "^[\\da-f](\\.[\\da-f])*$" [caseless] ["a.b.c.d", "A.B.C.D", "a.b.c.1.2.3.C"] [Just ["a.b.c.d", ".d"], Just ["A.B.C.D", ".D"], Just ["a.b.c.1.2.3.C", ".C"]] , testRegex "^\".*\"\\s*(;.*)?$" [] ["\"1234\"", "\"abcd\" ;", "\"\" ; rhubarb", "*** Failers", "\\\"1234\\\" : things"] [Just ["\"1234\""], Just ["\"abcd\" ;", ";"], Just ["\"\" ; rhubarb", "; rhubarb"], Nothing, Nothing] , testRegex "^$" [] ["", "*** Failers"] [Just [""], Nothing] , testRegex " ^ a (?# begins with a) b\\sc (?# then b c) $ (?# then end)" [extended] ["ab c", "*** Failers", "abc", "ab cde"] [Just ["ab c"], Nothing, Nothing, Nothing] , testRegex "(?x) ^ a (?# begins with a) b\\sc (?# then b c) $ (?# then end)" [] ["ab c", "*** Failers", "abc", "ab cde"] [Just ["ab c"], Nothing, Nothing, Nothing] , testRegex "^ a\\ b[c ]d $" [extended] ["a bcd", "a b d", "*** Failers", "abcd", "ab d"] [Just ["a bcd"], Just ["a b d"], Nothing, Nothing, Nothing] , testRegex "^(a(b(c)))(d(e(f)))(h(i(j)))(k(l(m)))$" [] ["abcdefhijklm"] [Just ["abcdefhijklm", "abc", "bc", "c", "def", "ef", "f", "hij", "ij", "j", "klm", "lm", "m"]] , testRegex "^(?:a(b(c)))(?:d(e(f)))(?:h(i(j)))(?:k(l(m)))$" [] ["abcdefhijklm"] [Just ["abcdefhijklm", "bc", "c", "ef", "f", "ij", "j", "lm", "m"]] , testRegex "^[.^$|()*+?{,}]+" [] [".^$(*+)|{?,?}"] [Just [".^$(*+)|{?,?}"]] , testRegex "^a*\\w" [] ["z", "az", "aaaz", "a", "aa", "aaaa", "a+", "aa+"] [Just ["z"], Just ["az"], Just ["aaaz"], Just ["a"], Just ["aa"], Just ["aaaa"], Just ["a"], Just ["aa"]] , testRegex "^a*?\\w" [] ["z", "az", "aaaz", "a", "aa", "aaaa", "a+", "aa+"] [Just ["z"], Just ["a"], Just ["a"], Just ["a"], Just ["a"], Just ["a"], Just ["a"], Just ["a"]] , testRegex "^a+\\w" [] ["az", "aaaz", "aa", "aaaa", "aa+"] [Just ["az"], Just ["aaaz"], Just ["aa"], Just ["aaaa"], Just ["aa"]] , testRegex "^a+?\\w" [] ["az", "aaaz", "aa", "aaaa", "aa+"] [Just ["az"], Just ["aa"], Just ["aa"], Just ["aa"], Just ["aa"]] , testRegex "^\\d{8}\\w{2,}" [] ["1234567890", "12345678ab", "12345678__", "*** Failers", "1234567"] [Just ["1234567890"], Just ["12345678ab"], Just ["12345678__"], Nothing, Nothing] , testRegex "^[aeiou\\d]{4,5}$" [] ["uoie", "1234", "12345", "aaaaa", "*** Failers", "123456"] [Just ["uoie"], Just ["1234"], Just ["12345"], Just ["aaaaa"], Nothing, Nothing] , testRegex "^[aeiou\\d]{4,5}?" [] ["uoie", "1234", "12345", "aaaaa", "123456"] [Just ["uoie"], Just ["1234"], Just ["1234"], Just ["aaaa"], Just ["1234"]] , testRegex "\\A(abc|def)=(\\1){2,3}\\Z" [] ["abc=abcabc", "def=defdefdef", "*** Failers", "abc=defdef"] [Just ["abc=abcabc", "abc", "abc"], Just ["def=defdefdef", "def", "def"], Nothing, Nothing] , testRegex "^(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)\\11*(\\3\\4)\\1(?#)2$" [] ["abcdefghijkcda2", "abcdefghijkkkkcda2"] [Just ["abcdefghijkcda2", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "cd"], Just ["abcdefghijkkkkcda2", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "cd"]] , testRegex "(cat(a(ract|tonic)|erpillar)) \\1()2(3)" [] ["cataract cataract23", "catatonic catatonic23", "caterpillar caterpillar23"] [Just ["cataract cataract23", "cataract", "aract", "ract", "", "3"], Just ["catatonic catatonic23", "catatonic", "atonic", "tonic", "", "3"], Just ["caterpillar caterpillar23", "caterpillar", "erpillar", "", "", "3"]] , testRegex "^From +([^ ]+) +[a-zA-Z][a-zA-Z][a-zA-Z] +[a-zA-Z][a-zA-Z][a-zA-Z] +[0-9]?[0-9] +[0-9][0-9]:[0-9][0-9]" [] ["From abcd Mon Sep 01 12:33:02 1997"] [Just ["From abcd Mon Sep 01 12:33", "abcd"]] , testRegex "^From\\s+\\S+\\s+([a-zA-Z]{3}\\s+){2}\\d{1,2}\\s+\\d\\d:\\d\\d" [] ["From abcd Mon Sep 01 12:33:02 1997", "From abcd Mon Sep 1 12:33:02 1997", "*** Failers", "From abcd Sep 01 12:33:02 1997"] [Just ["From abcd Mon Sep 01 12:33", "Sep "], Just ["From abcd Mon Sep 1 12:33", "Sep "], Nothing, Nothing] , testRegex "\\w+(?=\t)" [] ["the quick brown\t fox"] [Just ["brown"]] , testRegex "foo(?!bar)(.*)" [] ["foobar is foolish see?"] [Just ["foolish see?", "lish see?"]] , testRegex "(?:(?!foo)...|^.{0,2})bar(.*)" [] ["foobar crowbar etc", "barrel", "2barrel", "A barrel"] [Just ["rowbar etc", " etc"], Just ["barrel", "rel"], Just ["2barrel", "rel"], Just ["A barrel", "rel"]] , testRegex "^(\\D*)(?=\\d)(?!123)" [] ["abc456", "*** Failers", "abc123"] [Just ["abc", "abc"], Nothing, Nothing] , testRegex "^(a)\\1{2,3}(.)" [] ["aaab", "aaaab", "aaaaab", "aaaaaab"] [Just ["aaab", "a","b"], Just ["aaaab","a","b"], Just ["aaaaa","a","a"], Just ["aaaaa","a","a"]] , testRegex "(?!^)abc" [] ["the abc", "*** Failers", "abc"] [Just ["abc"], Nothing, Nothing] , testRegex "(?=^)abc" [] ["abc", "*** Failers", "the abc"] [Just ["abc"], Nothing, Nothing] , testRegex "^[ab]{1,3}(ab*|b)" [] ["aabbbbb"] [Just ["aabb", "b"]] , testRegex "^[ab]{1,3}?(ab*|b)" [] ["aabbbbb"] [Just ["aabbbbb", "abbbbb"]] , testRegex "^[ab]{1,3}?(ab*?|b)" [] ["aabbbbb"] [Just ["aa", "a"]] , testRegex "^[ab]{1,3}(ab*?|b)" [] ["aabbbbb"] [Just ["aabb", "b"]] , testRegex "^(cow|)\\1(bell)" [] ["cowcowbell", "bell", "*** Failers", "cowbell"] [Just ["cowcowbell", "cow", "bell"], Just ["bell", "", "bell"], Nothing, Nothing] , testRegex "^\\s" [] ["\o40abc", "\nabc", "\rabc", "\tabc", "abc"] [Just [" "], Just ["\x0a"], Just ["\x0d"], Just ["\x09"], Nothing] , testRegex "^(a|)\\1*b" [] ["ab", "aaaab", "b", "acb"] [Just ["ab", "a"], Just ["aaaab", "a"], Just ["b", ""], Nothing] , testRegex "^(a|)\\1+b" [] ["aab", "aaaab", "b", "*** Failers", "ab"] [Just ["aab", "a"], Just ["aaaab", "a"], Just ["b", ""], Nothing, Nothing] , testRegex "^(a|)\\1?b" [] ["ab", "aab", "b", "acb"] [Just ["ab", "a"], Just ["aab", "a"], Just ["b", ""], Nothing] , testRegex "^(a|)\\1{2}b" [] ["aaab", "b", "ab", "aab", "aaaab"] [Just ["aaab", "a"], Just ["b", ""], Nothing, Nothing, Nothing] , testRegex "^(a|)\\1{2,3}b" [] ["aaab", "aaaab", "b", "ab", "aab", "aaaaab"] [Just ["aaab", "a"], Just ["aaaab", "a"], Just ["b", ""], Nothing, Nothing, Nothing] , testRegex "ab{1,3}bc" [] ["abbbbc", "abbbc", "abbc", "abc", "abbbbbc"] [Just ["abbbbc"], Just ["abbbc"], Just ["abbc"], Nothing, Nothing] , testRegex "([^.]*)\\.([^:]*):[T ]+(.*)" [] ["track1.title:TBlah blah blah"] [Just ["track1.title:TBlah blah blah", "track1", "title", "Blah blah blah"]] , testRegex "([^.]*)\\.([^:]*):[T ]+(.*)" [caseless] ["track1.title:TBlah blah blah"] [Just ["track1.title:TBlah blah blah", "track1", "title", "Blah blah blah"]] , testRegex "([^.]*)\\.([^:]*):[t ]+(.*)" [caseless] ["track1.title:TBlah blah blah"] [Just ["track1.title:TBlah blah blah", "track1", "title", "Blah blah blah"]] , testRegex "^[W-c]+$" [] ["WXY_^abc", "wxy"] [Just ["WXY_^abc"], Nothing] , testRegex "^[W-c]+$" [caseless] ["WXY_^abc", "wxy_^ABC"] [Just ["WXY_^abc"], Just ["wxy_^ABC"]] , testRegex "^[\\x3f-\\x5F]+$" [caseless] ["WXY_^abc", "wxy_^ABC"] [Just ["WXY_^abc"], Just ["wxy_^ABC"]] , testRegex "^abc$" [] ["abc", "qqq\\nabc", "abc\\nzzz", "qqq\\nabc\\nzzz"] [Just ["abc"], Nothing, Nothing, Nothing] , testRegex "(?:b)|(?::+)" [] ["b::c", "c::b"] [Just ["b"], Just ["::"]] , testRegex "[-az]+" [] ["az-", "*** Failers", "b"] [Just ["az-"], Just ["a"], Nothing] , testRegex "[az-]+" [] ["za-", "*** Failers", "b"] [Just ["za-"], Just ["a"], Nothing] , testRegex "[a\\-z]+" [] ["a-z", "*** Failers", "b"] [Just ["a-z"], Just ["a"], Nothing] , testRegex "[a-z]+" [] ["abcdxyz"] [Just ["abcdxyz"]] , testRegex "[\\d-]+" [] ["12-34", "aaa"] [Just ["12-34"], Nothing] , testRegex "[\\d-z]+" [] ["12-34z", "aaa"] [Just ["12-34z"], Nothing] , testRegex "\\x20Z" [] ["the Zoo", "*** Failers", "Zulu"] [Just [" Z"], Nothing, Nothing] , testRegex "(abc)\\1" [caseless] ["abcabc", "ABCabc", "abcABC"] [Just ["abcabc", "abc"], Just ["ABCabc", "ABC"], Just ["abcABC", "abc"]] , testRegex "ab{3cd" [] ["ab{3cd"] [Just ["ab{3cd"]] , testRegex "ab{3,cd" [] ["ab{3,cd"] [Just ["ab{3,cd"]] , testRegex "ab{3,4a}cd" [] ["ab{3,4a}cd"] [Just ["ab{3,4a}cd"]] , testRegex "{4,5a}bc" [] ["{4,5a}bc"] [Just ["{4,5a}bc"]] , testRegex "abc$" [] ["abc", "abc\n", "*** Failers", "abc\ndef"] [Just ["abc"], Just ["abc"], Nothing, Nothing] , testRegex "(abc)\\123" [] ["abc\x53"] [Just ["abcS", "abc"]] , testRegex "(abc)\\223" [] ["abc\x93"] [Just ["abc\x93", "abc"]] , testRegex "(abc)\\323" [] ["abc\xd3"] [Just ["abc\xd3", "abc"]] , testRegex "(abc)\\100" [] ["abc\x40", "abc\o100"] [Just ["abc@", "abc"], Just ["abc@", "abc"]] , testRegex "(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)\\12\\123" [] ["abcdefghijkllS"] [Just ["abcdefghijkllS", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l"]] , testRegex "(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)\\12\\123" [] ["abcdefghijk\o12S"] [Just ["abcdefghijk\x0aS", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k"]] , testRegex "ab\\idef" [] ["abidef"] [Just ["abidef"]] , testRegex "a{0}bc" [] ["bc"] [Just ["bc"]] , testRegex "(a|(bc)){0,0}?xyz" [] ["xyz"] [Just ["xyz"]] , testRegex "(?s)a.b" [] ["a\nb"] [Just ["a\nb"]] , testRegex "^([^a])([^\\b])([^c]*)([^d]{3,4})" [] ["baNOTccccd", "baNOTcccd", "baNOTccd", "bacccd", "anything", "b\bc ", "baccd"] [Just ["baNOTcccc", "b", "a", "NOT", "cccc"], Just ["baNOTccc", "b", "a", "NOT", "ccc"], Just ["baNOTcc", "b", "a", "NO", "Tcc"], Just ["baccc", "b", "a", "", "ccc"], Nothing, Nothing, Nothing] , testRegex "^\\d{8,}\\@.+[^k]$" [] ["12345678@a.b.c.d", "123456789@x.y.z", "*** Failers", "12345678@x.y.uk", "1234567@a.b.c.d "] [Just ["12345678@a.b.c.d"], Just ["123456789@x.y.z"], Nothing, Nothing, Nothing] , testRegex "(a)\\1{8,}" [] ["aaaaaaaaa", "aaaaaaaaaa", "*** Failers", "aaaaaaa "] [Just ["aaaaaaaaa", "a"], Just ["aaaaaaaaaa", "a"], Nothing, Nothing] , testRegex "[^a]" [] ["aaaabcd", "aaAabcd "] [Just ["b"], Just ["A"]] , testRegex "[^a]" [caseless] ["aaaabcd", "aaAabcd "] [Just ["b"], Just ["b"]] , testRegex "[^az]" [] ["aaaabcd", "aaAabcd "] [Just ["b"], Just ["A"]] , testRegex "[^az]" [caseless] ["aaaabcd", "aaAabcd "] [Just ["b"], Just ["b"]] , testRegex "P[^*]TAIRE[^*]{1,6}?LL" [] ["xxxxxxxxxxxPSTAIREISLLxxxxxxxxx"] [Just ["PSTAIREISLL"]] , testRegex "P[^*]TAIRE[^*]{1,}?LL" [] ["xxxxxxxxxxxPSTAIREISLLxxxxxxxxx"] [Just ["PSTAIREISLL"]] , testRegex "(.*?)(\\d+)" [] ["I have 2 numbers: 53147"] [Just ["I have 2", "I have ", "2"]] , testRegex "(.*)(\\d+)$" [] ["I have 2 numbers: 53147"] [Just ["I have 2 numbers: 53147", "I have 2 numbers: 5314", "7"]] , testRegex "(.*?)(\\d+)$" [] ["I have 2 numbers: 53147"] [Just ["I have 2 numbers: 53147", "I have 2 numbers: ", "53147"]] , testRegex "(.*)\\b(\\d+)$" [] ["I have 2 numbers: 53147"] [Just ["I have 2 numbers: 53147", "I have 2 numbers: ", "53147"]] , testRegex "(.*\\D)(\\d+)$" [] ["I have 2 numbers: 53147"] [Just ["I have 2 numbers: 53147", "I have 2 numbers: ", "53147"]] , testRegex "word (?:[a-zA-Z0-9]+ ){0,10}otherword" [] ["word cat dog elephant mussel cow horse canary baboon snake shark otherword", "word cat dog elephant mussel cow horse canary baboon snake shark"] [Just ["word cat dog elephant mussel cow horse canary baboon snake shark otherword"], Nothing] , testRegex "word (?:[a-zA-Z0-9]+ ){0,300}otherword" [] ["word cat dog elephant mussel cow horse canary baboon snake shark the quick brown fox and the lazy dog and several other words getting close to thirty by now I hope"] [Nothing] , testRegex "^(a){0,0}" [] ["bcd", "abc", "aab "] [Just [""], Just [""], Just [""]] , testRegex "^(a){0,1}" [] ["bcd", "abc", "aab "] [Just [""], Just ["a", "a"], Just ["a", "a"]] , testRegex "^(a){0,2}" [] ["bcd", "abc", "aab "] [Just [""], Just ["a", "a"], Just ["aa", "a"]] , testRegex "^(a){0,3}" [] ["bcd", "abc", "aab", "aaa "] [Just [""], Just ["a", "a"], Just ["aa", "a"], Just ["aaa", "a"]] , testRegex "^(a){0,3}" [] ["bcd", "abc", "aab", "aaa "] [Just [""], Just ["a", "a"], Just ["aa", "a"], Just ["aaa", "a"]] , testRegex "^(a){0,}" [] ["bcd", "abc", "aab", "aaa", "aaaaaaaa "] [Just [""], Just ["a", "a"], Just ["aa", "a"], Just ["aaa", "a"], Just ["aaaaaaaa", "a"]] , testRegex "^(a){1,1}" [] ["bcd", "abc", "aab "] [Nothing, Just ["a", "a"], Just ["a", "a"]] , testRegex "^(a){1,2}" [] ["bcd", "abc", "aab "] [Nothing, Just ["a", "a"], Just ["aa", "a"]] , testRegex "^(a){1,3}" [] ["bcd", "abc", "aab", "aaa "] [Nothing, Just ["a", "a"], Just ["aa", "a"], Just ["aaa", "a"]] , testRegex ".*\\.gif" [] ["borfle\nbib.gif\nno"] [Just ["bib.gif"]] , testRegex ".{0,}\\.gif" [] ["borfle\nbib.gif\nno"] [Just ["bib.gif"]] , testRegex ".*\\.gif" [multiline] ["borfle\nbib.gif\nno"] [Just ["bib.gif"]] , testRegex ".*\\.gif" [dotall] ["borfle\nbib.gif\nno"] [Just ["borfle\nbib.gif"]] , testRegex ".*$" [multiline] ["borfle\nbib.gif\nno"] [Just ["borfle"]] , testRegex ".*$" [dotall] ["borfle\nbib.gif\nno"] [Just ["borfle\nbib.gif\nno"]] , testRegex ".*$" [multiline] ["borfle\nbib.gif\nno\\n"] [Just ["borfle"]] , testRegex "(?ms)^B" [] ["abc\nB"] [Just ["B"]] , testRegex "(?s)B$" [] ["B\n"] [Just ["B"]] , testRegex "^[abcdefghijklmnopqrstuvwxy0123456789]" [] ["n", "z "] [Just ["n"], Nothing] , testRegex "abcde{0,0}" [] ["abcd", "abce "] [Just ["abcd"], Nothing] , testRegex "^(b+?|a){1,2}?c" [] ["bac", "bbac", "bbbac", "bbbbac", "bbbbbac "] [Just ["bac","a"], Just ["bbac","a"], Just ["bbbac","a"], Just ["bbbbac","a"], Just ["bbbbbac","a"]] , testRegex "(AB)*?\\1" [] ["ABABAB"] [Just ["ABAB", "AB"]] , testRegex "(.*(.)?)*" [] ["abcd"] [Just ["abcd", ""]] {- , testRegex "(?:a|)*\\d" [] ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa4"] [Nothing, Just ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa4"]] -} , testRegex "^(?:a(?:(?:))+)+" [] ["aaaa"] [Just ["aaaa"]] , testRegex "^(a()+)+" [] ["aaaa"] [Just ["aaaa", "a", ""]] , testRegex "^(?:a(?:(?:))*)*" [] ["aaaa"] [Just ["aaaa"]] , testRegex "^(a()*)*" [] ["aaaa"] [Just ["aaaa", "a", ""]] , testRegex "^(a){1,}" [] ["bcd", "abc", "aab", "aaa", "aaaaaaaa "] [Nothing, Just ["a", "a"], Just ["aa", "a"], Just ["aaa", "a"], Just ["aaaaaaaa", "a"]] , testRegex "(?s)(.*X|^B)" [] ["abcde\n1234Xyz", "BarFoo ", "*** Failers ", "abcde\nBar "] [Just ["abcde\n1234X", "abcde\n1234X"], Just ["B", "B"], Nothing, Nothing] , testRegex "(?s:.*X|^B)" [] ["abcde\n1234Xyz", "BarFoo ", "*** Failers ", "abcde\nBar "] [Just ["abcde\n1234X"], Just ["B"], Nothing, Nothing] , testRegex "\\w{3}(?(\\.\\d\\d[1-9]?))\\d+" [] ["1.230003938", "1.875000282", "1.235 "] [Just [".230003938", ".23"], Just [".875000282", ".875"], Nothing] , testRegex "^((?>\\w+)|(?>\\s+))*$" [] ["now is the time for all good men to come to the aid of the party", "this is not a line with only words and spaces!"] [Just ["now is the time for all good men to come to the aid of the party", "party"], Nothing] , testRegex "((?>\\d+))(\\w)" [] ["12345a", "12345+ "] [Just ["12345a", "12345", "a"], Nothing] , testRegex "(?>a+)b" [] ["aaab"] [Just ["aaab"]] , testRegex "((?>a+)b)" [] ["aaab"] [Just ["aaab", "aaab"]] , testRegex "(?>(a+))b" [] ["aaab"] [Just ["aaab", "aaa"]] , testRegex "(?>b)+" [] ["aaabbbccc"] [Just ["bbb"]] , testRegex "(?>a+|b+|c+)*c" [] ["aaabbbbccccd"] [Just ["aaabbbbc"]] , testRegex "(?:(a)|b)(?(1)A|B)" [] ["aA", "bB", "aB", "bA "] [Just ["aA", "a"], Just ["bB"], Nothing, Nothing] , testRegex "^(a)?(?(1)a|b)+$" [] ["aa", "b", -- "bb ", -- ? "ab "] [Just ["aa", "a"], Just ["b"], -- Just ["bb"], Nothing] , testRegex "^(?(?=abc)\\w{3}:|\\d\\d)$" [] ["abc:", "12", "123", "xyz "] [Just ["abc:"], Just ["12"], Nothing, Nothing] , testRegex "(?(?]&" [] ["<&OUT"] [Just ["<&"]] , testRegex "^(a\\1?){4}$" [] ["aaaaaaaaaa", "*** Failers", "AB", "aaaaaaaaa", "aaaaaaaaaaa"] [Just ["aaaaaaaaaa", "aaaa"], Nothing, Nothing, Nothing, Nothing] , testRegex "^(a(?(1)\\1)){4}$" [] ["aaaaaaaaaa", "*** Failers", "aaaaaaaaa", "aaaaaaaaaaa"] [Just ["aaaaaaaaaa", "aaaa"], Nothing, Nothing, Nothing] , testRegex "(?:(f)(o)(o)|(b)(a)(r))*" [] ["foobar"] [Just ["foobar", "f", "o", "o", "b", "a", "r"]] , testRegex "(?<=a)b" [] ["ab", "*** Failers", "cb", "b"] [Just ["b"], Nothing, Nothing, Nothing] , testRegex "(?a+)ab" [] [] [] , testRegex "(?>a+)b" [] ["aaab"] [Just ["aaab"]] , testRegex "([[:]+)" [] ["a:[b]:"] [Just [":[", ":["]] , testRegex "([[=]+)" [] ["a=[b]="] [Just ["=[", "=["]] , testRegex "([[.]+)" [] ["a.[b]."] [Just [".[", ".["]] , testRegex "((?>a+)b)" [] ["aaab"] [Just ["aaab", "aaab"]] , testRegex "(?>(a+))b" [] ["aaab"] [Just ["aaab", "aaa"]] , testRegex "((?>[^()]+)|\\([^()]*\\))+" [] ["((abc(ade)ufh()()x"] [Just ["abc(ade)ufh()()x", "x"]] , testRegex "a\\Z" [] ["aaab", "a\nb\n"] [Nothing, Nothing] , testRegex "b\\Z" [] ["a\nb\n"] [Just ["b"]] , testRegex "b\\z" [] [] [] , testRegex "b\\Z" [] ["a\\nb"] [Just ["b"]] , testRegex "(?>.*)(?<=(abcd|wxyz))" [] ["alphabetabcd", "endingwxyz", "*** Failers", "a rather long string that doesn't end with one of them"] [Just ["alphabetabcd", "abcd"], Just ["endingwxyz", "wxyz"], Nothing, Nothing] , testRegex "word (?>(?:(?!otherword)[a-zA-Z0-9]+ ){0,30})otherword" [] ["word cat dog elephant mussel cow horse canary baboon snake shark otherword", "word cat dog elephant mussel cow horse canary baboon snake shark" ] [Just ["word cat dog elephant mussel cow horse canary baboon snake shark otherword"], Nothing] , testRegex "((Z)+|A)*" [] ["ZABCDEFG"] [Just ["ZA", "A", "Z"]] , testRegex "(Z()|A)*" [] ["ZABCDEFG"] [Just ["ZA", "A", ""]] , testRegex "(Z(())|A)*" [] ["ZABCDEFG"] [Just ["ZA", "A", "", ""]] , testRegex "((?>Z)+|A)*" [] ["ZABCDEFG"] [Just ["ZA", "A"]] , testRegex "((?>)+|A)*" [] ["ZABCDEFG"] [Just ["", ""]] , testRegex "^[a-\\d]" [] ["abcde", "-things", "0digit", "*** Failers", "bcdef "] [Just ["a"], Just ["-"], Just ["0"], Nothing, Nothing] , testRegex "\\Qabc\\$xyz\\E" [] ["abc\\$xyz"] [Just ["abc\\$xyz"]] , testRegex "\\Qabc\\E\\$\\Qxyz\\E" [] ["abc$xyz"] [Just ["abc$xyz"]] , testRegex "\\Gabc" [] ["abc", "*** Failers", "xyzabc "] [Just ["abc"], Nothing, Nothing] , testRegex "a(?x: b c )d" [] ["XabcdY", "*** Failers ", "Xa b c d Y "] [Just ["abcd"], Nothing, Nothing] , testRegex "((?x)x y z | a b c)" [] ["XabcY", "AxyzB "] [Just ["abc", "abc"], Just ["xyz", "xyz"]] , testRegex "(?i)AB(?-i)C" [] ["XabCY", "*** Failers", "XabcY "] [Just ["abC"], Nothing, Nothing] , testRegex "((?i)AB(?-i)C|D)E" [] ["abCE", "DE", "*** Failers", "abcE", "abCe ", "dE", "De "] [Just ["abCE", "abC"], Just ["DE", "D"], Nothing, Nothing, Nothing, Nothing, Nothing] , testRegex "(.*)\\d+\\1" [] ["abc123abc", "abc123bc "] [Just ["abc123abc", "abc"], Just ["bc123bc", "bc"]] , testRegex "[z\\Qa-d]\\E]" [] ["z", "a", "-", "d", "] ", "*** Failers", "b "] [Just ["z"], Just ["a"], Just ["-"], Just ["d"], Just ["]"], Just ["a"], Nothing] , testRegex "(?<=Z)X." [] ["\\x84XAZXB"] [Just ["XB"]] , testRegex "ab cd (?x) de fg" [] ["ab cd defg"] [Just ["ab cd defg"]] , testRegex "ab cd(?x) de fg" [] ["ab cddefg", "** Failers ", "abcddefg"] [Just ["ab cddefg"], Nothing, Nothing] , testRegex "(?a|)*\\d" [] ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa4"] [Nothing, Just ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa4"]] , testRegex "(?=(\\w+))\\1:" [] ["abcd:"] [Just ["abcd:", "abcd"]] , testRegex "^(?=(\\w+))\\1:" [] ["abcd:"] [Just ["abcd:", "abcd"]] , testRegex "^[a\\E\\E-\\Ec]" [] ["b", "** Failers", "-", "E "] [Just ["b"], Nothing, Nothing, Nothing] , testRegex "(a){0,3}(?(1)b|(c|))*D" [] ["abbD", "ccccD", "D "] [Just ["abbD", "a"], Just ["ccccD", "", ""], Just ["D", "", ""]] , testRegex "(a|)*\\d" [] ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa4"] [Nothing, Just ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa4", ""]] , testRegex "(?>a|)*\\d" [] ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa4"] [Nothing, Just ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa4"]] , testRegex "( (A | (?(1)0|) )* )" [extended] ["abcd"] [Just ["", "", ""]] , testRegex "^[\\w]+" [] ["*** Failers", "\201cole"] [Nothing, Nothing] , testRegex "^[\\w]+" [] ["*** Failers", "\201cole"] [Nothing, Nothing] {- , testRegex "(a.b(?s)c.d|x.y)p.q" [] ["a+bc+dp+q", "a+bc\ndp+q", "x\nyp+q ", "a\nbc\ndp+q", "a+bc\ndp\nq", "x\nyp\nq " ] [Just ["a+bc+dp+q"], Just ["a+bc\ndp+q"], Just ["x\nyp+q"], Nothing, Nothing, Nothing ] -} , testRegex "a\\d\\z" [] ["ba0", "*** Failers", "ba0\n", "ba0\ncd "] [Just ["a0"], Nothing, Nothing, Nothing] , testRegex "a\\d\\Z" [] ["ba0", "ba0\n", "ba0\ncd "] [Just ["a0"], Just ["a0"], Nothing] , testRegex "a\\d$" [] ["ba0", "ba0\n", "*** Failers", "ba0\ncd "] [Just ["a0"], Just ["a0"], Nothing, Nothing] , testRegex "a+" [] ["aaaa"] [Just ["aaaa"]] , testRegex "^\\d{2,3}X" [] ["12X", "123X", "*** Failers", "X", "1X", "1234X "] [Just ["12X"], Just ["123X"], Nothing, Nothing, Nothing, Nothing] , testRegex "^[abcd]\\d" [] ["a45", "b93", "c99z", "d04", "*** Failers", "e45", "abcd ", "abcd1234", "1234 "] [Just ["a4"], Just ["b9"], Just ["c9"], Just ["d0"], Nothing, Nothing, Nothing, Nothing, Nothing] {- , testRegex "^(a*\\w|ab)=(a*\\w|ab)" [] ["ab=ab"] [Just ["ab=ab", "ab"]] -} , testRegex "^(a*\\w|ab)=(?1)" [] ["ab=ab"] [Just ["ab=ab", "ab"]] {- , testRegex "^([^()]|\\((?1)*\\))*$" [] ["abc", "a(b)c", "a(b(c))d ", "*** Failers)", "a(b(c)d "] [Just ["abc"], Just ["a(b)c"], Just ["a(b(c))d"], Nothing, Nothing] , testRegex "^>abc>([^()]|\\((?1)*\\))*abc>123abc>1(2)3abc>(1(2)3)abc>123abc>1(2)3abc>(1(2)3)a*)\\d" [] ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa9876", "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"] [Just ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa9"], Nothing] , testRegex "(?<=abc|xy)123" [] ["abc12345", "wxy123z", "*** Failers", "123abc"] [Just ["123"], Just ["123"], Nothing, Nothing] , testRegex "(?3 ", "defabcxyz"] [Just ["abc"], Just ["abc"], Nothing] -} , testRegex "[\\xFF]" [] [">\xff<"] [Just ["\xff"]] , testRegex "[^\\xFF]" [] ["XYZ"] [Just ["X"]] , testRegex "^\\pN{2,3}X" [] ["12X", "123X", "*** Failers", "X", "1X", "1234X "] [Just ["12X"], Just ["123X"], Nothing, Nothing, Nothing, Nothing] ] pcre-light-0.4/TODO0000644000175000001440000000015311430103671012760 0ustar donsusers* backwards compatibility with older libpcres (e.g. pcre3 on debian) * some tests fail for strange reasons pcre-light-0.4/pcre-light.cabal0000644000175000001440000000271111430103671015314 0ustar donsusersname: pcre-light version: 0.4 homepage: http://code.haskell.org/~dons/code/pcre-light synopsis: A small, efficient and portable regex library for Perl 5 compatible regular expressions description: A small, efficient and portable regex library for Perl 5 compatible regular expressions . The PCRE library is a set of functions that implement regular expression pattern matching using the same syntax and semantics as Perl 5. . Test coverage data for this library is available at: . category: Text license: BSD3 license-file: LICENSE copyright: (c) 2007-2010. Don Stewart author: Don Stewart maintainer: Don Stewart cabal-version: >= 1.2.0 build-type: Configure tested-with: GHC ==6.8.2, GHC ==6.6.1, GHC ==6.12.1, Hugs ==2005 extra-source-files: configure, pcre-light.buildinfo.in extra-tmp-files: pcre-light.buildinfo flag small_base description: Build with new smaller base library default: False library exposed-modules: Text.Regex.PCRE.Light Text.Regex.PCRE.Light.Char8 Text.Regex.PCRE.Light.Base extensions: CPP, ForeignFunctionInterface if flag(small_base) build-depends: base >= 3 && <= 5, bytestring >= 0.9 else build-depends: base < 3 extra-libraries: pcre pcre-light-0.4/pcre-light.buildinfo.in0000644000175000001440000000011411430103671016625 0ustar donsusersghc-options: -optc@CPPFLAGS@ cc-options: @CPPFLAGS@ ld-options: @LDFLAGS@ pcre-light-0.4/Text/0000755000175000001440000000000011430103671013215 5ustar donsuserspcre-light-0.4/Text/Regex/0000755000175000001440000000000011430103671014267 5ustar donsuserspcre-light-0.4/Text/Regex/PCRE/0000755000175000001440000000000011430103671015020 5ustar donsuserspcre-light-0.4/Text/Regex/PCRE/Light/0000755000175000001440000000000011430103671016067 5ustar donsuserspcre-light-0.4/Text/Regex/PCRE/Light/Base.hsc0000644000175000001440000010016011430103671017436 0ustar donsusers{-# LANGUAGE CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving #-} -------------------------------------------------------------------- -- | -- Module : Text.Regex.PCRE.Light.Base -- Copyright: Copyright (c) 2007-2008, Don Stewart -- -- Documentation based on /man pcreapi/, written by Philip Hazel, 2007. -- -- License : BSD3 -- Maintainer: Don Stewart -- Stability : experimental -- Portability: CPP, FFI -- Tested with: GHC 6.8.2 -- -- Raw FFI bindings to PCRE functions and constants. -- module Text.Regex.PCRE.Light.Base ( -- * A PCRE structure PCRE , Regex(..) -- * C exports , c_pcre_compile , c_pcre_exec , c_pcre_fullinfo ------------------------------------------------------------------------ -- * PCRE Options, an abstract newtyped Num wrapper over a CInt , PCREOption , combineOptions , anchored , auto_callout {-, bsr_anycrlf-} {-, bsr_unicode-} , caseless , dollar_endonly , dotall , dupnames , extended , extra , firstline , multiline {-, newline_any-} {-, newline_anycrlf-} , newline_cr , newline_crlf , newline_lf , no_auto_capture , ungreedy , utf8 , no_utf8_check -- * PCRE exec-time options, an abstract, newtyped Num wrapper over CInt , PCREExecOption , combineExecOptions , exec_anchored {-, exec_newline_any , exec_newline_anycrlf-} , exec_newline_cr , exec_newline_crlf , exec_newline_lf , exec_notbol , exec_noteol , exec_notempty , exec_no_utf8_check , exec_partial ------------------------------------------------------------------------ -- * PCRE Errors , PCREError , error_nomatch , error_null , error_badoption , error_badmagic {-, error_unknown_opcode-} , error_unknown_node , error_nomemory , error_nosubstring , error_matchlimit , error_callout , error_badutf8 , error_badutf8_offset , error_partial , error_badpartial , error_internal , error_badcount , error_dfa_uitem , error_dfa_ucond , error_dfa_umlimit , error_dfa_wssize , error_dfa_recurse , error_recursionlimit {-, error_nullwslimit-} {-, error_badnewline-} -- * PCRE Info , PCREInfo , info_options , info_size , info_capturecount , info_backrefmax , info_firstbyte , info_firstchar , info_firsttable , info_lastliteral , info_nameentrysize , info_namecount , info_nametable , info_studysize , info_default_tables {-, info_okpartial-} {-, info_jchanged-} {-, info_hascrorlf-} -- * PCRE Configuration , PCREConfig , config_utf8 , config_newline , config_link_size , config_posix_malloc_threshold , config_match_limit , config_stackrecurse , config_unicode_properties , config_match_limit_recursion {-, config_bsr-} -- * PCRE Extra , PCREExtraFlags , extra_study_data , extra_match_limit , extra_callout_data , extra_tables , extra_match_limit_recursion, ------------------------------------------------------------------------ size_of_cint ) where -- Foreigns import Foreign import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import qualified Data.ByteString.Char8 as S #include -- | Get sizeof CInt from hsc2hs size_of_cint :: Int size_of_cint = #const (sizeof(int)) ------------------------------------------------------------------------ -- Types -- | An abstract pointer to a compiled PCRE Regex structure -- The structure allocated by the PCRE library will be deallocated -- automatically by the Haskell storage manager. -- data Regex = Regex {-# UNPACK #-} !(ForeignPtr PCRE) {-# UNPACK #-} !S.ByteString deriving (Eq, Ord, Show) type PCRE = () ------------------------------------------------------------------------ -- | A type for PCRE compile-time options. These are newtyped CInts, -- which can be bitwise-or'd together, using '(Data.Bits..|.)' -- newtype PCREOption = PCREOption { unPCREOption :: PCREOption_ } #if __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Read) #endif -- | Combine a list of options into a single option, using bitwise (.|.) combineOptions :: [PCREOption] -> PCREOption combineOptions = PCREOption . foldr ((.|.) . unPCREOption) 0 -- Now follows the user-visible options to _exec and _compile. -- To avoid type errors, we newtype the underlying CInts, and -- statically differentiate PCREOptions from non-PCREOptions -- -- The safety can still be defeated using numeric literals though, -- and other Num operations. We could do more to protect against this. -- (a smart constructor for .|.) -- | 'anchored' -- -- If this bit is set, the pattern is forced to be /anchored/, that is, -- it is constrained to match only at the first matching point in the -- string that is being searched (the /subject string/). This effect can -- also be achieved by appropriate constructs in the pattern itself, which -- is the only way to do it in Perl. -- anchored :: PCREOption anchored = PCREOption anchored_cint -- | 'auto_callout' -- -- If this bit is set, "compile" automatically inserts callout -- items, all with number 255, before each pattern item. For discussion -- of the callout facility, see the man pcrecallout documentation -- auto_callout :: PCREOption auto_callout = PCREOption auto_callout_cint -- | 'bsr_anycrlf' and 'bsr_unicode' -- -- These options (which are mutually exclusive) control what the \\R escape -- sequence matches. The choice is either to match only CR, LF, or CRLF, or to -- match any Unicode new- line sequence. The default is specified when PCRE is -- built. It can be overridden from within the pattern, or by setting an option -- when a compiled pattern is matched. -- -- bsr_anycrlf :: PCREOption -- bsr_anycrlf = PCREOption bsr_anycrlf_cint -- | 'bsr_unicode'. See 'bse_anycrlf' -- -- bsr_unicode :: PCREOption -- bsr_unicode = PCREOption bsr_unicode_cint -- | 'caseless' -- -- If this bit is set, letters in the pattern match both upper and lower case -- letters. It is equivalent to Perl's \/i option, and it can be changed within a -- pattern by a (?i) option setting. In UTF-8 mode, PCRE always understands the -- concept of case for characters whose values are less than 128, so caseless -- matching is always possible. For characters with higher values, the concept of -- case is supported if PCRE is compiled with Unicode property sup- port, but not -- otherwise. If you want to use caseless matching for characters 128 and above, -- you must ensure that PCRE is compiled with Unicode property support as well as -- with UTF-8 support. -- caseless :: PCREOption caseless = PCREOption caseless_cint -- | 'dollar_endonly' -- -- If this bit is set, a dollar metacharacter in the pattern matches only at -- the end of the subject string. Without this option, a dollar also matches -- immediately before a newline at the end of the string (but not before any other -- newlines). The 'dollar_endonly' option is ignored if 'multiline' -- is set. There is no equivalent to this option in Perl, and no way to set it -- within a pattern. -- dollar_endonly :: PCREOption dollar_endonly = PCREOption dollar_endonly_cint -- | 'dotall' -- -- If this bit is set, a dot metacharater in the pattern matches all -- characters, including those that indicate newline. Without it, a dot does -- not match when the current position is at a newline. This option is -- equivalent to Perl's \/s option, and it can be changed within a pattern by a -- (?s) option setting. A negative class such as [^a] always matches newline -- characters, independent of the setting of this option. -- dotall :: PCREOption dotall = PCREOption dotall_cint -- | 'dupnames' -- -- If this bit is set, names used to identify capturing subpatterns need not be -- unique. This can be helpful for certain types of pattern when it is known -- that only one instance of the named subpattern can ever be matched. There are -- more details of named subpatterns in the /man pcreapi/ documentation. -- dupnames :: PCREOption dupnames = PCREOption dupnames_cint -- | 'extended' -- -- If this bit is set, whitespace data characters in the pattern are totally -- ignored except when escaped or inside a character class. Whitespace does not -- include the VT character (code 11). In addition, characters between an -- unescaped \# outside a character class and the next newline, inclusive, are -- also ignored. This is equivalent to Perl's \/x option, and it can be changed --within a pattern by a (?x) option setting. -- -- This option makes it possible to include comments inside complicated -- patterns. Note, however, that this applies only to data characters. Whitespace -- characters may never appear within special character sequences in a pattern, -- for example within the sequence (?( which introduces a conditional subpattern. -- extended :: PCREOption extended = PCREOption extended_cint -- | 'extra' -- -- This option was invented in order to turn on additional functionality of -- PCRE that is incompatible with Perl, but it is currently of very little use. -- When set, any backslash in a pattern that is followed by a letter that has no -- special meaning causes an error, thus reserving these combinations for future -- expansion. By default, as in Perl, a backslash followed by a letter with no -- special meaning is treated as a literal. (Perl can, however, be persuaded to -- give a warning for this.) There are at present no other features controlled by -- this option. It can also be set by a (?X) option setting within a pattern. -- extra :: PCREOption extra = PCREOption extra_cint -- | 'firstline' -- -- If this option is set, an unanchored pattern is required to match before or -- at the first newline in the subject string, though the matched text may --continue over the newline. -- firstline :: PCREOption firstline = PCREOption firstline_cint -- | 'multiline' -- -- By default, PCRE treats the subject string as consisting of a single line -- of characters (even if it actually contains newlines). The /start of line/ -- metacharacter (^) matches only at the start of the string, while the /end of line/ -- metacharacter ($) matches only at the end of the string, or before a -- terminating newline (unless 'dollar_endonly' is set). This is the same -- as Perl. -- -- When 'multiline' it is set, the /start of line/ and /end of line/ -- constructs match immediately following or immediately before internal newlines -- in the subject string, respectively, as well as at the very start and end. This -- is equivalent to Perl's \/m option, and it can be changed within a pattern by a -- (?m) option setting. If there are no newlines in a subject string, or no occur- -- rences of ^ or $ in a pattern, setting PCRE_MULTILINE has no effect. -- multiline :: PCREOption multiline = PCREOption multiline_cint -- | newline_cr', 'newline_lf', 'newline_crlf', -- 'newline_anycrlf', 'newline_any' -- -- These options override the default newline definition that -- was chosen when PCRE was built. Setting the first or the -- second specifies that a newline is indicated by a single -- character (CR or LF, respectively). Setting 'newline_crlf' specifies -- that a newline is indicated by the two-character CRLF sequence. -- Setting 'newline_anycrlf' -- specifies that any of the three preceding sequences should -- be recognized. Setting 'newline_any' specifies that any -- Unicode newline sequence should be recognized. The Unicode -- newline sequences are the three just mentioned, plus the -- single characters VT (vertical tab, U+000B), FF (formfeed, -- U+000C), NEL (next line, U+0085), LS (line separator, -- U+2028), and PS (paragraph separator, U+2029). The last -- two are recognized only in UTF-8 mode. -- -- The newline setting in the options word uses three bits -- that are treated as a number, giving eight possibilities. -- Currently only six are used (default plus the five values -- above). This means that if you set more than one newline -- option, the combination may or may not be sensible. For -- example, 'newline_cr' with 'newline_lf' is equivalent to -- 'newline_crlf', but other combinations may yield unused numbers and -- cause an error. -- -- The only time that a line break is specially recognized -- when compiling a pattern is if 'extended' is set, and -- an unescaped \# outside a character class is encountered. -- This indicates a comment that lasts until after the next -- line break sequence. In other circumstances, line break -- sequences are treated as literal data, except that in -- 'extended' mode, both CR and LF are treated as whitespace characters -- and are therefore ignored. -- -- -- The newline option that is set at compile time becomes the -- default that is used for 'exec' but it can be overridden. -- -- newline_any :: PCREOption -- newline_any = PCREOption newline_any_cint -- | 'newline_anycrlf', see 'newline_any' -- newline_anycrlf :: PCREOption -- newline_anycrlf = PCREOption newline_anycrlf_cint -- | 'newline_cr', see 'newline_any' newline_cr :: PCREOption newline_cr = PCREOption newline_cr_cint -- | 'newline_crlf', see 'newline_any' newline_crlf :: PCREOption newline_crlf = PCREOption newline_crlf_cint -- | 'newline_lf', see 'newline_any' newline_lf :: PCREOption newline_lf = PCREOption newline_lf_cint -- | 'no_auto_capture' -- -- If this option is set, it disables the use of numbered -- capturing parentheses in the pattern. Any opening paren- -- thesis that is not followed by ? behaves as if it were -- followed by ?: but named parentheses can still be used for -- capturing (and they acquire numbers in the usual way). -- There is no equivalent of this option in Perl. -- no_auto_capture :: PCREOption no_auto_capture = PCREOption no_auto_capture_cint -- | 'ungreedy' -- -- This option inverts the /greediness/ of the quantifiers so -- that they are not greedy by default, but become greedy if -- followed by /?/. It is not compatible with Perl. It can -- also be set by a (?U) option setting within the pattern. -- ungreedy :: PCREOption ungreedy = PCREOption ungreedy_cint -- | 'utf8' -- -- This option causes PCRE to regard both the pattern and the -- subject as strings of UTF-8 characters instead of single-byte character -- strings. However, it is available only when -- PCRE is built to include UTF-8 support. If not, the use of -- this option provokes an error. Details of how this option -- changes the behaviour of PCRE are given in the section on -- UTF-8 support in the main pcre page. -- utf8 :: PCREOption utf8 = PCREOption utf8_cint -- | 'no_utf8_check' -- -- When PCRE_UTF8 is set, the validity of the pattern as a -- UTF-8 string is automatically checked. There is a discussion -- about the validity of UTF-8 strings in the main pcre -- page. If an invalid UTF-8 sequence of bytes is found, -- compile() returns an error. If you already know that -- your pattern is valid, and you want to skip this check for -- performance reasons, you can set the 'no_utf8_check' -- option. When it is set, the effect of passing an invalid -- UTF-8 string as a pattern is undefined. It may cause your -- program to crash. Note that this option can also be passed -- to 'exec', to suppress the UTF-8 validity checking of subject strings. -- no_utf8_check :: PCREOption no_utf8_check = PCREOption no_utf8_check_cint -- Internal name for hsc2hs to bind to. type PCREOption_ = CInt -- PCRE compile options, as CInts #{enum PCREOption_, , anchored_cint = PCRE_ANCHORED , auto_callout_cint = PCRE_AUTO_CALLOUT , caseless_cint = PCRE_CASELESS , dollar_endonly_cint = PCRE_DOLLAR_ENDONLY , dotall_cint = PCRE_DOTALL , dupnames_cint = PCRE_DUPNAMES , extended_cint = PCRE_EXTENDED , extra_cint = PCRE_EXTRA , firstline_cint = PCRE_FIRSTLINE , multiline_cint = PCRE_MULTILINE , newline_cr_cint = PCRE_NEWLINE_CR , newline_crlf_cint = PCRE_NEWLINE_CRLF , newline_lf_cint = PCRE_NEWLINE_LF , no_auto_capture_cint = PCRE_NO_AUTO_CAPTURE , ungreedy_cint = PCRE_UNGREEDY , utf8_cint = PCRE_UTF8 , no_utf8_check_cint = PCRE_NO_UTF8_CHECK } -- , bsr_anycrlf_cint = PCRE_BSR_ANYCRLF -- , bsr_unicode_cint = PCRE_BSR_UNICODE -- , newline_any_cint = PCRE_NEWLINE_ANY -- , newline_anycrlf_cint = PCRE_NEWLINE_ANYCRLF ------------------------------------------------------------------------ -- | PCRE exec options, to be passed to exec newtype PCREExecOption = PCREExecOption { unPCREExecOption :: PCREExecOption_ } #if __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Read) #endif -- | Combine a list of exec options into a single option, using bitwise (.|.) combineExecOptions :: [PCREExecOption] -> PCREExecOption combineExecOptions = PCREExecOption . foldr ((.|.) . unPCREExecOption) 0 -- | 'anchored'. -- -- The 'anchored' option limits 'exec' to matching at -- the first matching position. If a pattern was compiled -- with 'anchored', or turned out to be anchored by virtue -- of its contents, it cannot be made unachored at matching -- time. exec_anchored :: PCREExecOption exec_anchored = PCREExecOption exec_anchored_cint -- | 'newline_cr', 'newline_lf', -- 'newline_crlf', 'newline_anycrlf', 'newline_any' -- -- These options override the newline definition that was -- chosen or defaulted when the pattern was compiled. For -- details, see the description of 'compile' above. Dur- -- ing matching, the newline choice affects the behaviour of -- the dot, circumflex, and dollar metacharacters. It may -- also alter the way the match position is advanced after a -- match failure for an unanchored pattern. -- -- When 'newline_crlf', 'newline_anycrlf', or 'newline_any' -- is set, and a match attempt for an unanchored -- pattern fails when the current position is at a CRLF -- sequence, and the pattern contains no explicit matches for -- CR or LF characters, the match position is advanced by two -- characters instead of one, in other words, to after the -- CRLF. -- -- The above rule is a compromise that makes the most common -- cases work as expected. For example, if the pattern is .+A -- (and the 'dotall' option is not set), it does not match -- the string /\\r\\nA/ because, after failing at the start, it -- skips both the CR and the LF before retrying. However, the -- pattern /[\\r\\n]A/ does match that string, because it contains -- an explicit CR or LF reference, and so advances only -- by one character after the first failure. -- -- An explicit match for CR of LF is either a literal appear- -- ance of one of those characters, or one of the \\r or \\n -- escape sequences. Implicit matches such as [^X] do not -- count, nor does \\s (which includes CR and LF in the char- -- acters that it matches). -- -- Notwithstanding the above, anomalous effects may still -- occur when CRLF is a valid newline sequence and explicit -- \\r or \\n escapes appear in the pattern. -- -- exec_newline_any :: PCREExecOption -- exec_newline_any = PCREExecOption exec_newline_any_cint -- | 'exec_newline_anycrlf', see 'exec_newline_any' -- exec_newline_anycrlf :: PCREExecOption -- exec_newline_anycrlf = PCREExecOption exec_newline_anycrlf_cint -- | 'exec_newline_cr', see 'exec_newline_any' exec_newline_cr :: PCREExecOption exec_newline_cr = PCREExecOption exec_newline_cr_cint -- | 'exec_newline_crlf', see 'exec_newline_any' exec_newline_crlf :: PCREExecOption exec_newline_crlf = PCREExecOption exec_newline_crlf_cint -- | 'exec_newline_lf', see 'exec_newline_any' exec_newline_lf :: PCREExecOption exec_newline_lf = PCREExecOption exec_newline_lf_cint -- | 'PCRE_NOTBOL' -- -- This option specifies that first character of the subject -- string is not the beginning of a line, so the circumflex -- metacharacter should not match before it. Setting this -- without 'multiline' (at compile time) causes circumflex -- never to match. This option affects only the behaviour of -- the circumflex metacharacter. It does not affect \\A. -- exec_notbol :: PCREExecOption exec_notbol = PCREExecOption exec_notbol_cint -- | 'noteol' -- -- This option specifies that the end of the subject string -- is not the end of a line, so the dollar metacharacter -- should not match it nor (except in multiline mode) a newline -- immediately before it. Setting this without 'multiline' -- (at compile time) causes dollar never to match. -- This option affects only the behaviour of the dollar -- metacharacter. It does not affect \\Z or \\z. -- exec_noteol :: PCREExecOption exec_noteol = PCREExecOption exec_noteol_cint -- | PCRE_NOTEMPTY -- -- An empty string is not considered to be a valid match if -- this option is set. If there are alternatives in the pattern, -- they are tried. If all the alternatives match the -- empty string, the entire match fails. For example, if the -- pattern -- -- > a?b? -- -- is applied to a string not beginning with /a/ or /b/, it -- matches the empty string at the start of the subject. With -- 'notempty' set, this match is not valid, so 'PCRE -- searches further into the string for occurrences of /a/ or -- /b/. -- -- Perl has no direct equivalent of 'notempty', but it -- does make a special case of a pattern match of the empty -- string within its split() function, and when using the \/g -- modifier. It is possible to emulate Perl's behaviour after -- matching a null string by first trying the match again at -- the same offset with PCRE_NOTEMPTY and PCRE_ANCHORED, and -- then if that fails by advancing the starting offset (see -- below) and trying an ordinary match again. There is some -- code that demonstrates how to do this in the pcredemo.c -- sample program. -- exec_notempty :: PCREExecOption exec_notempty = PCREExecOption exec_notempty_cint -- | 'no_utf8_check' -- -- When 'utf8' is set at compile time, the validity of the -- subject as a UTF-8 string is automatically checked when -- exec() is subsequently called. The value of -- startoffset is also checked to ensure that it points to -- the start of a UTF-8 character. There is a discussion -- about the validity of UTF-8 strings in the section on -- UTF-8 support in the main pcre page. If an invalid UTF-8 -- sequence of bytes is found, exec() returns the error -- 'error_badutf8'. If startoffset contains an invalid -- value, 'error_badutf8_offset' is returned. -- -- If you already know that your subject is valid, and you -- want to skip these checks for performance reasons, you can -- set the 'no_utf8_check' option when calling -- 'exec'. You might want to do this for the second and -- subsequent calls to exec() if you are making repeated -- calls to find all the matches in a single subject string. -- However, you should be sure that the value of startoffset -- points to the start of a UTF-8 character. When -- 'no_utf8_check' is set, the effect of passing an -- invalid UTF-8 string as a subject, or a value of startoff- -- set that does not point to the start of a UTF-8 character, -- is undefined. Your program may crash. -- exec_no_utf8_check :: PCREExecOption exec_no_utf8_check = PCREExecOption exec_no_utf8_check_cint -- | 'partial' -- -- This option turns on the partial matching feature. If the -- subject string fails to match the pattern, but at some -- point during the matching process the end of the subject -- was reached (that is, the subject partially matches the -- pattern and the failure to match occurred only because -- there were not enough subject characters), 'exec' -- returns 'error_partial' instead of 'error_nomatch'. -- When 'partial' is used, there are restrictions on what -- may appear in the pattern. These are discussed in the -- pcrepartial documentation. -- exec_partial :: PCREExecOption exec_partial = PCREExecOption exec_partial_cint -- Internal name for hsc2hs to bind to. type PCREExecOption_ = CInt -- PCRE exec options #{enum PCREExecOption_, , exec_anchored_cint = PCRE_ANCHORED , exec_newline_cr_cint = PCRE_NEWLINE_CR , exec_newline_crlf_cint = PCRE_NEWLINE_CRLF , exec_newline_lf_cint = PCRE_NEWLINE_LF , exec_notbol_cint = PCRE_NOTBOL , exec_noteol_cint = PCRE_NOTEOL , exec_notempty_cint = PCRE_NOTEMPTY , exec_no_utf8_check_cint = PCRE_NO_UTF8_CHECK , exec_partial_cint = PCRE_PARTIAL } -- , exec_newline_any_cint = PCRE_NEWLINE_ANY -- , exec_newline_anycrlf_cint = PCRE_NEWLINE_ANYCRLF -- , dfa_shortest = PCRE_DFA_SHORTEST -- , dfa_restart = PCRE_DFA_RESTART ------------------------------------------------------------------------ -- | A type for PCRE Errors: exec-time error codes. type PCREError = CInt #{enum PCREError, , error_nomatch = PCRE_ERROR_NOMATCH , error_null = PCRE_ERROR_NULL , error_badoption = PCRE_ERROR_BADOPTION , error_badmagic = PCRE_ERROR_BADMAGIC , error_unknown_node = PCRE_ERROR_UNKNOWN_NODE , error_nomemory = PCRE_ERROR_NOMEMORY , error_nosubstring = PCRE_ERROR_NOSUBSTRING , error_matchlimit = PCRE_ERROR_MATCHLIMIT , error_callout = PCRE_ERROR_CALLOUT , error_badutf8 = PCRE_ERROR_BADUTF8 , error_badutf8_offset = PCRE_ERROR_BADUTF8_OFFSET , error_partial = PCRE_ERROR_PARTIAL , error_badpartial = PCRE_ERROR_BADPARTIAL , error_internal = PCRE_ERROR_INTERNAL , error_badcount = PCRE_ERROR_BADCOUNT , error_dfa_uitem = PCRE_ERROR_DFA_UITEM , error_dfa_ucond = PCRE_ERROR_DFA_UCOND , error_dfa_umlimit = PCRE_ERROR_DFA_UMLIMIT , error_dfa_wssize = PCRE_ERROR_DFA_WSSIZE , error_dfa_recurse = PCRE_ERROR_DFA_RECURSE , error_recursionlimit = PCRE_ERROR_RECURSIONLIMIT } -- , error_unknown_opcode = PCRE_ERROR_UNKNOWN_OPCODE -- , error_nullwslimit = PCRE_ERROR_NULLWSLIMIT -- , error_badnewline = PCRE_ERROR_BADNEWLINE ------------------------------------------------------------------------ -- Request types for fullinfo() */ -- | PCRE Info requests -- provides information about the compiled pattern. type PCREInfo = CInt #{enum PCREInfo, , info_options = PCRE_INFO_OPTIONS , info_size = PCRE_INFO_SIZE , info_capturecount = PCRE_INFO_CAPTURECOUNT , info_backrefmax = PCRE_INFO_BACKREFMAX , info_firstbyte = PCRE_INFO_FIRSTBYTE , info_firstchar = PCRE_INFO_FIRSTCHAR , info_firsttable = PCRE_INFO_FIRSTTABLE , info_lastliteral = PCRE_INFO_LASTLITERAL , info_nameentrysize = PCRE_INFO_NAMEENTRYSIZE , info_namecount = PCRE_INFO_NAMECOUNT , info_nametable = PCRE_INFO_NAMETABLE , info_studysize = PCRE_INFO_STUDYSIZE , info_default_tables = PCRE_INFO_DEFAULT_TABLES } -- , info_okpartial = PCRE_INFO_OKPARTIAL -- , info_jchanged = PCRE_INFO_JCHANGED -- , info_hascrorlf = PCRE_INFO_HASCRORLF ------------------------------------------------------------------------ -- | Request types for config() type PCREConfig = CInt #{enum PCREConfig, , config_utf8 = PCRE_CONFIG_UTF8 , config_newline = PCRE_CONFIG_NEWLINE , config_link_size = PCRE_CONFIG_LINK_SIZE , config_posix_malloc_threshold = PCRE_CONFIG_POSIX_MALLOC_THRESHOLD , config_match_limit = PCRE_CONFIG_MATCH_LIMIT , config_stackrecurse = PCRE_CONFIG_STACKRECURSE , config_unicode_properties = PCRE_CONFIG_UNICODE_PROPERTIES , config_match_limit_recursion = PCRE_CONFIG_MATCH_LIMIT_RECURSION } -- Not portable -- , config_bsr = PCRE_CONFIG_BSR ------------------------------------------------------------------------ -- | PCREExtra. -- A extra structure contains the following fields: -- -- * flags Bits indicating which fields are set -- * study_data Opaque data from study() -- * match_limit Limit on internal resource use -- * match_limit_recursion Limit on internal recursion depth -- * callout_data Opaque data passed back to callouts -- * tables Points to character tables or is NULL -- type PCREExtra = () -- | PCREExtraFlags. bit flags for extra structure. type PCREExtraFlags = CInt -- Bit flags for the extra structure. Do not re-arrange or redefine -- these bits, just add new ones on the end, in order to remain compatible. */ #{enum PCREExtraFlags, , extra_study_data = PCRE_EXTRA_STUDY_DATA , extra_match_limit = PCRE_EXTRA_MATCH_LIMIT , extra_callout_data = PCRE_EXTRA_CALLOUT_DATA , extra_tables = PCRE_EXTRA_TABLES , extra_match_limit_recursion = PCRE_EXTRA_MATCH_LIMIT_RECURSION } -- PCRE_EXP_DECL pcre *compile(const char *, int, const char **, int *, const unsigned char *); -- PCRE_EXP_DECL int config(int, void *); -- PCRE_EXP_DECL int exec(const pcre *, const extra *, PCRE_SPTR, int, int, int, int *, int); ------------------------------------------------------------------------ -- C api {- pcre *pcre_compile(const char *pattern, int options, const char **errptr, int *erroffset, const unsigned char *tableptr); -} -- | Compile a pattern to an internal form. The pattern is a C string -- terminated by a binary zero. A pointer to a single block of memory that is -- obtained via pcre_malloc is returned. It is up to the caller to free -- the memory (via pcre_free) when it is no longer required -- -- The options argument contains various bit settings that affect the -- compilation. It should be zero if no options are required. -- -- If errptr is NULL, pcre_compile() returns NULL immediately. -- Otherwise, if compilation of a pattern fails, pcre_compile() returns NULL, -- and sets the variable pointed to by errptr to point to a textual error -- message. -- -- The offset from the start of the pattern to the character where the error -- was discovered is placed in the variable pointed to by erroffset, which must -- not be NULL. -- foreign import ccall unsafe "pcre.h pcre_compile" c_pcre_compile :: CString -> PCREOption -> Ptr CString -> Ptr CInt -> Ptr Word8 -> IO (Ptr PCRE) -- Additional fields to c_pcre_compile: -- -- errptr Where to put an error message -- erroffset Offset in pattern where error was found -- tableptr Pointer to character tables, or NULL to to use built in {- int pcre_exec(const pcre *code, const pcre_extra *extra, const char *subject, int length, int startoffset, int options, int *ovector, int ovecsize); -} -- | This function matches a compiled regular expression -- against a given subject string, using a matching algorithm -- that is similar to Perl's. It returns offsets to captured -- substrings. -- -- Its arguments are, in order: -- -- * 'code' Points to the compiled pattern (result of pcre_compile) -- -- * 'extra' Points to an associated pcre_extra structure (result of pcre_study), or is NULL -- -- * 'subject' Points to the subject string -- -- * 'length' Length of the subject string, in bytes -- -- * 'startoffset' Offset in bytes in the subject at which to start matching -- -- * 'options' Option bits -- -- * 'ovector' Points to a vector of ints for result substrings -- -- * 'ovecsize' Number of elements in the vector (a multiple of 3) -- -- Note, subject not required to be null terminated. -- foreign import ccall unsafe "pcre.h pcre_exec" c_pcre_exec :: Ptr PCRE -> Ptr PCREExtra -> Ptr Word8 -> CInt -> CInt -> PCREExecOption -> Ptr CInt -> CInt -> IO CInt -- | Return information about a compiled pattern foreign import ccall unsafe "pcre.h pcre_fullinfo" c_pcre_fullinfo :: Ptr PCRE -> Ptr PCREExtra -> PCREInfo -> Ptr a -> IO CInt pcre-light-0.4/Text/Regex/PCRE/Light/Char8.hs0000644000175000001440000001402311430103671017370 0ustar donsusers-------------------------------------------------------------------- -- | -- Module : Text.Regex.PCRE.Light.Char8 -- Copyright: Copyright (c) 2007-2008, Don Stewart -- License : BSD3 -- -- Maintainer: Don Stewart -- Stability : experimental -- Portability: H98 + FFI -- -------------------------------------------------------------------- -- -- A simple, portable binding to perl-compatible regular expressions -- (PCRE) via 8-bit latin1 Strings. -- module Text.Regex.PCRE.Light.Char8 ( -- * The abstract PCRE Regex type Regex -- * String interface , compile, compileM , match -- * Regex types and constructors externally visible -- ** PCRE compile-time bit flags , PCREOption , anchored , auto_callout {-, bsr_anycrlf-} {-, bsr_unicode-} , caseless , dollar_endonly , dotall , dupnames , extended , extra , firstline , multiline {-, newline_any-} {-, newline_anycrlf-} , newline_cr , newline_crlf , newline_lf , no_auto_capture , ungreedy , utf8 , no_utf8_check -- ** PCRE exec-time bit flags , PCREExecOption , exec_anchored {-, exec_newline_any -} {-, exec_newline_anycrlf -} , exec_newline_cr , exec_newline_crlf , exec_newline_lf , exec_notbol , exec_noteol , exec_notempty , exec_no_utf8_check , exec_partial ) where import qualified Data.ByteString.Char8 as S import qualified Text.Regex.PCRE.Light as S import Text.Regex.PCRE.Light hiding (match, compile, compileM) -- | 'compile' -- -- Compile a perl-compatible regular expression, in a strict bytestring. -- The arguments are: -- -- * 'pat': A ByteString, which may or may not be zero-terminated, -- containing the regular expression to be compiled. -- -- * 'flags', optional bit flags. If 'Nothing' is provided, defaults are used. -- -- Valid compile-time flags are: -- -- * 'anchored' - Force pattern anchoring -- -- * 'auto_callout' - Compile automatic callouts -- -- * 'bsr_anycrlf' - \\R matches only CR, LF, or CRLF -- -- * 'bsr_unicode' - \\R matches all Unicode line endings -- -- * 'caseless' - Do caseless matching -- -- * 'dollar_endonly' - '$' not to match newline at end -- -- * 'dotall' - matches anything including NL -- -- * 'dupnames' - Allow duplicate names for subpatterns -- -- * 'extended' - Ignore whitespace and # comments -- -- * 'extra' - PCRE extra features (not much use currently) -- -- * 'firstline' - Force matching to be before newline -- -- * 'multiline' - '^' and '$' match newlines within data -- -- * 'newline_any' - Recognize any Unicode newline sequence -- -- * 'newline_anycrlf' - Recognize CR, LF, and CRLF as newline sequences -- -- * 'newline_cr' - Set CR as the newline sequence -- -- * 'newline_crlf' - Set CRLF as the newline sequence -- -- * 'newline_lf' - Set LF as the newline sequence -- -- * 'no_auto_capture' - Disable numbered capturing parentheses (named ones available) -- -- * 'ungreedy' - Invert greediness of quantifiers -- -- * 'utf8' - Run in UTF-8 mode -- -- * 'no_utf8_check' - Do not check the pattern for UTF-8 validity -- -- If compilation of the pattern fails, the 'Left' constructor is -- returned with the error string. Otherwise an abstract type -- representing the compiled regular expression is returned. -- The regex is allocated via malloc on the C side, and will be -- deallocated by the runtime when the Haskell value representing it -- goes out of scope. -- -- As regexes are often defined statically, GHC will compile them -- to null-terminated, strict C strings, enabling compilation of the -- pattern without copying. This may be useful for very large patterns. -- -- See man pcreapi for more details. -- compile :: String -> [PCREOption] -> Regex compile str os = S.compile (S.pack str) os {-# INLINE compile #-} -- | 'compileM' -- A safe version of 'compile' with failure lifted into an Either compileM :: String -> [PCREOption] -> Either String Regex compileM str os = S.compileM (S.pack str) os {-# INLINE compileM #-} -- | 'match' -- -- Matches a compiled regular expression against a given subject string, -- using a matching algorithm that is similar to Perl's. If the subject -- string doesn't match the regular expression, 'Nothing' is returned, -- otherwise the portion of the string that matched is returned, along -- with any captured subpatterns. -- -- The arguments are: -- -- * 'regex', a PCRE regular expression value produced by compile -- -- * 'subject', the subject string to match against -- -- * 'options', an optional set of exec-time flags to exec. -- -- Available runtime options are: -- -- * 'anchored' - Match only at the first position -- -- * 'bsr_anycrlf' - '\\R' matches only CR, LF, or CRLF -- -- * 'bsr_unicode' - '\\R' matches all Unicode line endings -- -- * 'newline_any' - Recognize any Unicode newline sequence -- -- * 'newline_anycrlf' - Recognize CR, LF, and CRLF as newline sequences -- -- * 'newline_cr' - Set CR as the newline sequence -- -- * 'newline_crlf' - Set CRLF as the newline sequence -- -- * 'newline_lf' - Set LF as the newline sequence -- -- * 'notbol' - Subject is not the beginning of a line -- -- * 'noteol' - Subject is not the end of a line -- -- * 'notempty' - An empty string is not a valid match -- -- * 'no_utf8_check' - Do not check the subject for UTF-8 -- -- * 'partial' - Return PCRE_ERROR_PARTIAL for a partial match -- -- The result value, and any captured subpatterns, are returned. -- If the regex is invalid, or the subject string is empty, Nothing -- is returned. -- match :: Regex -> String -> [PCREExecOption] -> Maybe [String] match r subject os = case S.match r (S.pack subject) os of Nothing -> Nothing Just x -> Just (map S.unpack x) {-# INLINE match #-} pcre-light-0.4/Text/Regex/PCRE/Light.hs0000644000175000001440000002502011430103671016422 0ustar donsusers{-# LANGUAGE CPP #-} -------------------------------------------------------------------- -- | -- Module : Text.Regex.PCRE.Light -- Copyright: Copyright (c) 2007-2008, Don Stewart -- License : BSD3 -- -- Maintainer: Don Stewart -- Stability : experimental -- Portability: H98 + CPP -- -------------------------------------------------------------------- -- -- A simple, portable binding to perl-compatible regular expressions -- (PCRE) via strict ByteStrings. -- module Text.Regex.PCRE.Light ( -- * The abstract PCRE Regex type Regex -- * ByteString interface , compile, compileM , match , captureCount -- * Regex types and constructors externally visible -- ** PCRE compile-time bit flags , PCREOption , anchored , auto_callout {-, bsr_anycrlf-} {-, bsr_unicode-} , caseless , dollar_endonly , dotall , dupnames , extended , extra , firstline , multiline {-, newline_any-} {-, newline_anycrlf-} , newline_cr , newline_crlf , newline_lf , no_auto_capture , ungreedy , utf8 , no_utf8_check -- ** PCRE exec-time bit flags , PCREExecOption , exec_anchored {-, exec_newline_any -} {-, exec_newline_anycrlf -} , exec_newline_cr , exec_newline_crlf , exec_newline_lf , exec_notbol , exec_noteol , exec_notempty , exec_no_utf8_check , exec_partial ) where import Text.Regex.PCRE.Light.Base -- Strings import qualified Data.ByteString as S #if __GLASGOW_HASKELL__ >= 608 import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Unsafe as S #else import qualified Data.ByteString.Base as S #endif -- Foreigns import Foreign import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Foreign.Storable import Foreign.Marshal.Alloc -- | 'compile' -- -- Compile a perl-compatible regular expression stored in a strict bytestring. -- -- An example -- -- > let r = compile (pack "^(b+|a){1,2}?bc") [] -- -- Or using GHC's -XOverloadedStrings flag, and importing -- Data.ByteString.Char8, we can avoid the pack: -- -- > let r = compile "^(b+|a){1,2}?bc" [] -- -- If the regular expression is invalid, an exception is thrown. -- If this is unsuitable, 'compileM' is availlable, which returns failure -- in a monad. -- -- To do case insentive matching, -- -- > compile "^(b+|a){1,2}?bc" [caseless] -- -- Other flags are documented below. -- -- The resulting abstract regular expression can be passed to 'match' -- for matching against a subject string. -- -- The arguments are: -- -- * 'pat': A ByteString containing the regular expression to be compiled. -- -- * 'flags', optional bit flags. If 'Nothing' is provided, defaults are used. -- -- Valid compile-time flags are: -- -- * 'anchored' - Force pattern anchoring -- -- * 'auto_callout' - Compile automatic callouts -- -- * 'bsr_anycrlf' - \\R matches only CR, LF, or CRLF -- -- * 'bsr_unicode' - \\R matches all Unicode line endings -- -- * 'caseless' - Do caseless matching -- -- * 'dollar_endonly' - '$' not to match newline at end -- -- * 'dotall' - matches anything including NL -- -- * 'dupnames' - Allow duplicate names for subpatterns -- -- * 'extended' - Ignore whitespace and # comments -- -- * 'extra' - PCRE extra features (not much use currently) -- -- * 'firstline' - Force matching to be before newline -- -- * 'multiline' - '^' and '$' match newlines within data -- -- * 'newline_any' - Recognize any Unicode newline sequence -- -- * 'newline_anycrlf' - Recognize CR, LF, and CRLF as newline sequences -- -- * 'newline_cr' - Set CR as the newline sequence -- -- * 'newline_crlf' - Set CRLF as the newline sequence -- -- * 'newline_lf' - Set LF as the newline sequence -- -- * 'no_auto_capture' - Disable numbered capturing parentheses (named ones available) -- -- * 'ungreedy' - Invert greediness of quantifiers -- -- * 'utf8' - Run in UTF-8 mode -- -- * 'no_utf8_check' - Do not check the pattern for UTF-8 validity -- -- The regex is allocated via malloc on the C side, and will be -- deallocated by the runtime when the Haskell value representing it -- goes out of scope. -- -- See 'man pcreapi for more details. -- -- Caveats: patterns with embedded nulls, such as "\0*" seem to be -- mishandled, as this won't currently match the subject "\0\0\0". -- compile :: S.ByteString -> [PCREOption] -> Regex compile s o = case compileM s o of Right r -> r Left e -> error ("Text.Regex.PCRE.Light: Error in regex: " ++ e) ------------------------------------------------------------------------ -- | 'compileM' -- A safe version of 'compile' with failure wrapped in an Either. -- -- Examples, -- -- > > compileM ".*" [] :: Either String Regex -- > Right (Regex 0x000000004bb5b980 ".*") -- -- > > compileM "*" [] :: Either String Regex -- > Left "nothing to repeat" -- compileM :: S.ByteString -> [PCREOption] -> Either String Regex compileM str os = unsafePerformIO $ S.useAsCString str $ \pattern -> do alloca $ \errptr -> do alloca $ \erroffset -> do pcre_ptr <- c_pcre_compile pattern (combineOptions os) errptr erroffset nullPtr if pcre_ptr == nullPtr then do err <- peekCString =<< peek errptr return (Left err) else do reg <- newForeignPtr finalizerFree pcre_ptr -- release with free() return (Right (Regex reg str)) -- Possible improvements: an 'IsString' instance could be defined -- for 'Regex', which would allow the compiler to insert calls to -- 'compile' based on the type: -- -- The following would be valid: -- -- > match "a.*b" "abcdef" [] -- -- and equivalent to: -- -- > match (either error id (compile "a.*b")) "abcdef" [] -- | 'match' -- -- Matches a compiled regular expression against a given subject string, -- using a matching algorithm that is similar to Perl's. If the subject -- string doesn't match the regular expression, 'Nothing' is returned, -- otherwise the portion of the string that matched is returned, along -- with any captured subpatterns. -- -- The arguments are: -- -- * 'regex', a PCRE regular expression value produced by compile -- -- * 'subject', the subject string to match against -- -- * 'options', an optional set of exec-time flags to exec. -- -- Available runtime options are: -- -- * 'exec_anchored' - Match only at the first position -- -- * 'exec_newline_any' - Recognize any Unicode newline sequence -- -- * 'exec_newline_anycrlf' - Recognize CR, LF, and CRLF as newline sequences -- -- * 'exec_newline_cr' - Set CR as the newline sequence -- -- * 'exec_newline_crlf' - Set CRLF as the newline sequence -- -- * 'exec_newline_lf' - Set LF as the newline sequence -- -- * 'exec_notbol' - Subject is not the beginning of a line -- -- * 'exec_noteol' - Subject is not the end of a line -- -- * 'exec_notempty' - An empty string is not a valid match -- -- * 'exec_no_utf8_check' - Do not check the subject for UTF-8 -- -- * 'exec_partial' - Return PCRE_ERROR_PARTIAL for a partial match -- -- The result value, and any captured subpatterns, are returned. -- If the regex is invalid, or the subject string is empty, Nothing -- is returned. -- match :: Regex -> S.ByteString -> [PCREExecOption] -> Maybe [S.ByteString] match (Regex pcre_fp _) subject os = unsafePerformIO $ do withForeignPtr pcre_fp $ \pcre_ptr -> do n_capt <- captureCount' pcre_ptr -- The smallest size for ovector that will allow for n captured -- substrings, in addition to the offsets of the substring -- matched by the whole pattern, is (n+1)*3. (man pcreapi) let ovec_size = (n_capt + 1) * 3 ovec_bytes = ovec_size * size_of_cint allocaBytes ovec_bytes $ \ovec -> do let (str_fp, off, len) = S.toForeignPtr subject withForeignPtr str_fp $ \cstr -> do r <- c_pcre_exec pcre_ptr nullPtr (cstr `plusPtr` off) -- may contain binary zero bytes. (fromIntegral len) 0 (combineExecOptions os) ovec (fromIntegral ovec_size) if r < 0 -- errors, or error_no_match then return Nothing else let loop n o acc = if n == r then return (Just (reverse acc)) else do i <- peekElemOff ovec $! o j <- peekElemOff ovec (o+1) let s = substring i j subject s `seq` loop (n+1) (o+2) (s : acc) in loop 0 0 [] -- The first two-thirds of ovec is used to pass back captured -- substrings When a match is successful, information about captured -- substrings is returned in pairs of integers, starting at the -- beginning of ovector, and continuing up to two-thirds of its length at -- the most. The first pair, ovector[0] and ovector[1], identify the -- portion of the subject string matched by the entire pattern. The next -- pair is used for the first capturing subpattern, and so on. The -- value returned by pcre_exec() is one more than the highest num- bered -- pair that has been set. For example, if two sub- strings have been -- captured, the returned value is 3. where -- The first element of a pair is set to the offset of the first -- character in a substring, and the second is set to the offset of the -- first character after the end of a substring. substring :: CInt -> CInt -> S.ByteString -> S.ByteString substring x y _ | x == y = S.empty -- XXX an unset subpattern substring a b s = end -- note that we're not checking... where start = S.unsafeDrop (fromIntegral a) s end = S.unsafeTake (fromIntegral (b-a)) start captureCount :: Regex -> Int captureCount (Regex pcre_fp _) = unsafePerformIO $ do withForeignPtr pcre_fp $ \pcre_ptr -> do captureCount' pcre_ptr captureCount' pcre_fp = alloca $ \n_ptr -> do -- (st :: Ptr CInt) c_pcre_fullinfo pcre_fp nullPtr info_capturecount n_ptr return . fromIntegral =<< peek (n_ptr :: Ptr CInt)