shelltestrunner 0.6 → 0.7
raw patch · 2 files changed
+259/−208 lines, 2 filesdep +cmdargsdep +pcre-lightdep −parseargsdep −regexprdep ~test-framework-hunit
Dependencies added: cmdargs, pcre-light
Dependencies removed: parseargs, regexpr
Dependency ranges changed: test-framework-hunit
Files
- shelltestrunner.cabal +47/−41
- shelltestrunner.hs +212/−167
shelltestrunner.cabal view
@@ -1,69 +1,71 @@ name: shelltestrunner-version: 0.6+version: 0.7 category: Testing synopsis: A tool for testing command-line programs. description: .- Run a given program through \"shell\" tests specifed by one or more test- files, where each test can specify: command-line arguments, input, expected- output, expected stderr output, and/or expected exit code. This was- extracted from the hledger project, inspired by the tests in John- Wiegley's ledger project, and uses test-framework's test runner.+ Run a command-line program through \"shell tests\" defined in one or+ more test files. Each test specifies command-line arguments, some input,+ and expected output, stderr output and/or exit status.+ We use test-framework's test runner, so can run tests in parallel.+ shelltestrunner was inspired by the tests in John Wiegley's ledger project. . Usage: .- > shelltestrunner [opts] executable testfile1 [testfile2 ...] [-- <test-framework runner opts>]- .- You can pass options through to test-framework's runner; they must go- after -- at the end. You may be able to get a big speedup by running- tests in parallel: try -- -j8.+ > shelltestrunner [FLAGS] EXECUTABLE [TESTFILES ...]+ > + > -? --help[=FORMAT] Show usage information (optional format)+ > -V --version Show version information+ > -v --verbose Higher verbosity+ > -q --quiet Lower verbosity+ > -d --debug show debug messages+ > --debug-parse show parsing debug messages and stop+ > -i --implicit=none|exit|all provide implicit tests (default=exit) .- Test file format:+ Any unrecognised options will be passed through to test-framework's runner.+ You may be able to get a big speedup by running tests in parallel: try -j16. .- A test file contains 0 or more shell tests, each of which looks like this: + A test file contains one or more shell tests, each of which looks like this: .- > # 0 or more comment lines beginning with #+ > # optional comment lines beginning with # > -opt1 -opt2 arg1 arg2 # one line of command line args, executable will be prepended > <<< > 0 or more lines of input- > >>> [/regexp/]+ > >>> [/regexp/] [optional comment beginning with #] > [..or 0 or more lines of expected output]- > >>>2 [/regexp/]+ > >>>2 [/regexp/] [optional comment] > [..or 0 or more lines of expected error output]- > >>>= [expected numeric exit code or /regexp/]- .- Each expected field can have either a regular expression match- expression, in which case the test passes if the output is matched, or 0- or more data lines, in which case the output must match these exactly. A- ! preceding a \/regexp\/ negates the match. The regular expression syntax- is that supported by the regexpr library.- .- Apart from the command line, all fields are optional. Only the fields you- specify will be tested, unless you use the -i/--implicit-tests flag,- which adds default tests (empty stdout, empty stderr, and 0 exit code)- for omitted fields.- .- Issues:+ > >>>= [expected exit status or /regexp/] [optional comment]+ > # optional comment lines .- - can't test input/output which does not end with newline+ The expected output and expected error output fields can have either a+ regular expression match expression, in which case the test passes if the+ output is matched, or 0 or more following data lines, in which case the+ output must match these exactly. The expected exit status field can have+ either a numeric exit code or a regular expression match expression. A !+ preceding a an exit code or \/regexp\/ negates the match. The regular+ expression syntax is that of the pcre-light library with the dotall flag. .- - can't use / in regexps+ The command line args field is required, all others are optional. By+ default there is an implicit test for exit status = 0, but no implicit+ test for stdout or stderr. You can change this with the+ -i/--implicit-tests flag. .- - option processing and --help output could be better+ Some issues to be aware of: .- Wishlist:+ - uncompiled haskell scripts can't be tested due to http://hackage.haskell.org/trac/ghc/ticket/3890 .- - configurable delimiters+ - unparseable test files and uncompilable regexps are counted as test failures . license: GPL license-file: LICENSE author: Simon Michael <simon@joyful.com> maintainer: Simon Michael <simon@joyful.com> homepage: http://joyful.com/darcsweb/darcsweb.cgi?r=shelltestrunner--- bug-reports: -stability: experimental+bug-reports: mailto:simon@joyful.com+stability: beta tested-with: GHC==6.10-cabal-version: >= 1.2+cabal-version: >= 1.6 build-type: Simple extra-tmp-files:@@ -78,6 +80,10 @@ ,process ,HUnit ,test-framework- ,test-framework-hunit >= 0.2 && < 0.3- ,parseargs >= 0.1 && < 0.2- ,regexpr >= 0.5.1+ ,test-framework-hunit >= 0.2+ ,cmdargs >= 0.1+ ,pcre-light >= 0.3.1++source-repository head+ type: darcs+ location: http://joyful.com/repos/hledger
shelltestrunner.hs view
@@ -1,7 +1,8 @@ #!/usr/bin/env runhaskell+{-# LANGUAGE DeriveDataTypeable #-} {- -shelltestrunner - a handy tool for testing command-line programs.+shelltestrunner - a tool for testing command-line programs. See shelltestrunner.cabal. @@ -13,70 +14,64 @@ where import Control.Concurrent (forkIO) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)-import Control.Monad (liftM,when)-import Data.List (partition, intercalate)-import Data.Maybe (fromJust,isJust,maybe,isNothing,catMaybes)+import Control.Monad (liftM,when,unless)+import Data.List (intercalate)+import Data.Maybe (isNothing,isJust,fromJust,maybe,catMaybes) import qualified Test.HUnit (Test)-import System.Console.ParseArgs hiding (args)-import System.Environment (withArgs)-import System.Exit (ExitCode(..),exitWith)+import System.Console.CmdArgs hiding (args)+import qualified System.Console.CmdArgs as CmdArgs (args)+import System.Exit (ExitCode(..), exitWith) import System.IO (Handle, hGetContents, hPutStr) import System.Process (runInteractiveCommand, waitForProcess)-import Test.Framework (defaultMain)+import Test.Framework (defaultMainWithArgs) import Test.Framework.Providers.HUnit (hUnitTestToTests) import Test.HUnit hiding (Test) import Text.ParserCombinators.Parsec import Text.Printf (printf)-import Text.RegexPR+import Text.Regex.PCRE.Light.Char8 import Debug.Trace strace :: Show a => a -> a strace a = trace (show a) a -version :: String-version = "0.6" -- keep synced with .cabal+version = "0.6.98" -- keep synced with shelltestrunner.cabal+progname = "shelltestrunner"+progversion = progname ++ " " ++ version+version, progname, progversion :: String -data ArgId = HelpFlag- | VersionFlag- | DebugFlag- | ImplicitTestsFlag- | ExecutableArg- deriving (Ord, Eq, Show)+data Args = Args {+ debug :: Bool+ ,debugparse :: Bool+ ,implicit :: String+ ,executable :: String+ ,testfiles :: [String]+ ,otheropts :: [String]+ } deriving (Show, Data, Typeable) -argspec :: [Arg ArgId]-argspec = [- Arg {argIndex = HelpFlag,- argName = Just "help",- argAbbr = Just 'h',- argData = Nothing,- argDesc = "show help"- }- ,Arg {argIndex = VersionFlag,- argName = Just "version",- argAbbr = Just 'V',- argData = Nothing,- argDesc = "show version"- }- ,Arg {argIndex = DebugFlag,- argName = Just "debug",- argAbbr = Just 'd',- argData = Nothing,- argDesc = "show verbose debugging output"- }- ,Arg {argIndex = ImplicitTestsFlag,- argName = Just "implicit-tests",- argAbbr = Just 'i',- argData = Nothing,- argDesc = "provide implicit tests for all omitted fields"- }- ,Arg {argIndex = ExecutableArg,- argName = Nothing,- argAbbr = Nothing,- argData = argDataRequired "executable" ArgtypeString,- argDesc = "executable program or shell command to test"- }+nullargs :: Args+nullargs = Args False False "" "" [] []++argmodes :: [Mode Args]+argmodes = [+ mode $ Args{+ debug = def &= flag "debug" & text "show debug messages"+ ,debugparse = def &= flag "debug-parse" & explicit & text "show parsing debug messages and stop"+ ,implicit = "exit" &= typ "none|exit|all" & text "provide implicit tests"+ ,executable = def &= argPos 0 & typ "EXECUTABLE" & text "executable under test"+ ,testfiles = def &= CmdArgs.args & typ "TESTFILES" & text "test files"+ ,otheropts = def &= unknownFlags & explicit & typ "FLAGS" & text "other flags are passed to test runner"+ } ] +checkArgs :: Args -> IO Args+checkArgs args = do+ when (not $ i `elem` ["none","exit","all"]) $+ warn $ printf "Bad -i/--implicit value %s, valid choices are: none, exit or all" $ show i+ return args+ where+ i = implicit args+ warn s = cmdArgsHelp s argmodes Text >>= putStrLn >> exitWith (ExitFailure 1)+ data ShellTest = ShellTest { testname :: String ,commandargs :: String@@ -84,146 +79,189 @@ ,stdoutExpected :: Maybe Matcher ,stderrExpected :: Maybe Matcher ,exitCodeExpected :: Maybe Matcher- } deriving (Show)+ } -type Regex = String+type Regexp = String data Matcher = Lines String | Numeric String- | PositiveRegex Regex- | NegativeRegex Regex- deriving (Show)+ | NegativeNumeric String+ | PositiveRegex Regexp+ | NegativeRegex Regexp main :: IO () main = do- args <- parseArgsIO ArgsTrailing argspec- -- parseargs issue: exits at first gotArg if there's no exe argument- when (args `gotArg` VersionFlag) printVersion- when (args `gotArg` HelpFlag) $ printHelp args- let (unprocessedopts, testfiles) = partition ((=="-").take 1) $ argsRest args- when (args `gotArg` DebugFlag) $ do- putStrLn $ "testing executable: " ++ (show $ fromJust $ getArgString args ExecutableArg)- putStrLn $ "unprocessed options: " ++ show unprocessedopts- putStrLn $ "test files: " ++ show testfiles- shelltests <- liftM concat $ mapM (parseShellTestFile args) testfiles- withArgs unprocessedopts $ defaultMain $ concatMap (hUnitTestToTests.shellTestToHUnitTest args) shelltests--printVersion :: IO ()-printVersion = putStrLn version >> exitWith ExitSuccess--printHelp :: Args ArgId -> IO ()-printHelp args = putStrLn (argsUsage args) >> exitWith ExitSuccess+ args <- cmdArgs progversion argmodes >>= checkArgs+ when (debug args) $ printf "args: %s\n" (show args)+ loud <- isLoud+ when loud $ do+ printf "executable: %s\n" (executable args)+ printf "test files: %s\n" (intercalate ", " $ testfiles args)+ parseresults <- mapM (parseShellTestFile args) $ testfiles args+ unless (debugparse args) $+ defaultMainWithArgs (concatMap (hUnitTestToTests.testFileParseToHUnitTest args) parseresults) (otheropts args) -- parsing -parseShellTestFile :: Args ArgId -> FilePath -> IO [ShellTest]+parseShellTestFile :: Args -> FilePath -> IO (Either ParseError [ShellTest]) parseShellTestFile args f = do- when (args `gotArg` DebugFlag) $ putStrLn $ "parsing file: " ++ f- ts <- liftM (either (error.show) id) $ parseFromFile (many shelltestp) f- let ts' | length ts > 1 = [t{testname=testname t++":"++show n} | (n,t) <- zip ([1..]::[Int]) ts]- | otherwise = ts- when (args `gotArg` DebugFlag) $ putStrLn $ "parsed tests: " ++ show ts'- return ts'+ p <- parseFromFile shelltestfilep f+ case p of+ Right ts -> do+ let ts' | length ts > 1 = [t{testname=testname t++":"++show n} | (n,t) <- zip ([1..]::[Int]) ts]+ | otherwise = ts+ when (debug args || debugparse args) $ do+ printf "parsed %s:\n" f+ mapM_ (putStrLn.(' ':).show) ts'+ return $ Right ts'+ Left _ -> return p +shelltestfilep :: Parser [ShellTest]+shelltestfilep = do+ ts <- many (try shelltestp)+ many commentlinep+ eof+ return ts+ shelltestp :: Parser ShellTest shelltestp = do st <- getParserState let f = sourceName $ statePos st many commentlinep- c <- commandargsp- i <- optionMaybe inputp- o <- optionMaybe expectedoutputp- e <- optionMaybe expectederrorp- x <- optionMaybe expectedexitcodep- when (null c && (isNothing i) && (null $ catMaybes [o,e,x])) $ fail "empty test file"- return ShellTest{testname=f,commandargs=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x}--linep,commentlinep,commandargsp,delimiterp,inputp,whitespacep :: Parser String--linep = anyChar `manyTill` newline+ c <- commandargsp <?> "command arguments"+ i <- optionMaybe inputp <?> "input"+ o <- optionMaybe expectedoutputp <?> "expected output"+ e <- optionMaybe expectederrorp <?> "expected error output"+ x <- optionMaybe expectedexitcodep <?> "expected exit status"+ when (null c && (isNothing i) && (null $ catMaybes [o,e,x])) $ fail ""+ return $ ShellTest{testname=f,commandargs=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} -commentlinep = char '#' >> anyChar `manyTill` newline+newlineoreofp, whitespacecharp :: Parser Char+linep,lineoreofp,whitespacep,whitespacelinep,commentlinep,whitespaceorcommentlinep,whitespaceorcommentlineoreofp,commandargsp,delimiterp,inputp :: Parser String+linep = (anyChar `manyTill` newline) <?> "rest of line"+newlineoreofp = newline <|> (eof >> return '\n') <?> "newline or end of file"+lineoreofp = (anyChar `manyTill` newlineoreofp)+whitespacecharp = oneOf " \t"+whitespacep = many whitespacecharp+whitespacelinep = try (newline >> return "") <|> (whitespacecharp >> whitespacecharp `manyTill` newlineoreofp)+commentlinep = whitespacep >> char '#' >> lineoreofp <?> "comments"+whitespaceorcommentlinep = choice [try commentlinep, whitespacelinep]+whitespaceorcommentlineoreofp = choice [(eof >> return ""), try commentlinep, whitespacelinep]+delimiterp = choice [try $ string "<<<", try $ string ">>>", try commentlinep >> return "", eof >> return ""] commandargsp = linep -delimiterp = choice [try $ string "<<<", try $ string ">>>", (eof >> return "")]--inputp = string "<<<" >> newline >> (liftM unlines) (linep `manyTill` (lookAhead delimiterp))+inputp = string "<<<" >> whitespaceorcommentlinep >> (liftM unlines) (linep `manyTill` (lookAhead delimiterp)) expectedoutputp :: Parser Matcher-expectedoutputp = try $ do+expectedoutputp = (try $ do string ">>>" >> optional (char '1') whitespacep- choice [positiveregexmatcherp, negativeregexmatcherp, linesmatcherp]+ choice [positiveregexmatcherp, negativeregexmatcherp, whitespaceorcommentlineoreofp >> linesmatcherp]+ ) <?> "expected output" expectederrorp :: Parser Matcher-expectederrorp = try $ do+expectederrorp = (try $ do string ">>>2" whitespacep- choice [positiveregexmatcherp, negativeregexmatcherp, linesmatcherp]+ choice [positiveregexmatcherp, negativeregexmatcherp, (whitespaceorcommentlineoreofp >> linesmatcherp)]+ ) <?> "expected error output" expectedexitcodep :: Parser Matcher-expectedexitcodep = do+expectedexitcodep = (try $ do string ">>>=" whitespacep- choice [positiveregexmatcherp, negativeregexmatcherp, numericmatcherp]+ choice [positiveregexmatcherp, try negativeregexmatcherp, numericmatcherp, negativenumericmatcherp]+ ) <?> "expected exit status" +linesmatcherp :: Parser Matcher+linesmatcherp = do+ (liftM $ Lines . unlines) (linep `manyTill` (lookAhead delimiterp)) <?> "lines of output"+ negativeregexmatcherp :: Parser Matcher-negativeregexmatcherp = do+negativeregexmatcherp = (do char '!' PositiveRegex r <- positiveregexmatcherp- return $ NegativeRegex r+ return $ NegativeRegex r) <?> "non-matched regexp pattern" positiveregexmatcherp :: Parser Matcher-positiveregexmatcherp = do- char '/'- r <- many $ noneOf "/"+positiveregexmatcherp = (do char '/'- whitespacep- newline- return $ PositiveRegex r+ r <- (try escapedslashp <|> noneOf "/") `manyTill` (char '/')+ whitespaceorcommentlineoreofp+ return $ PositiveRegex r) <?> "regexp pattern" -linesmatcherp :: Parser Matcher-linesmatcherp = do- whitespacep- newline- (liftM $ Lines . unlines) (linep `manyTill` (lookAhead delimiterp))+negativenumericmatcherp :: Parser Matcher+negativenumericmatcherp = (do+ char '!'+ Numeric s <- numericmatcherp+ return $ NegativeNumeric s+ ) <?> "non-matched number" numericmatcherp :: Parser Matcher-numericmatcherp = do+numericmatcherp = (do s <- many1 $ oneOf "0123456789"- whitespacep- newline+ whitespaceorcommentlineoreofp return $ Numeric s+ ) <?> "number" -whitespacep = many $ oneOf " \t"+escapedslashp :: Parser Char+escapedslashp = char '\\' >> char '/' -- running -shellTestToHUnitTest :: Args ArgId -> ShellTest -> Test.HUnit.Test+testFileParseToHUnitTest :: Args -> Either ParseError [ShellTest] -> Test.HUnit.Test+testFileParseToHUnitTest args (Right ts) = TestList $ map (shellTestToHUnitTest args) ts+testFileParseToHUnitTest _ (Left e) = ("parse error in " ++ (sourceName $ errorPos e)) ~: assertFailure $ show e++shellTestToHUnitTest :: Args -> ShellTest -> Test.HUnit.Test shellTestToHUnitTest args ShellTest{testname=n,commandargs=c,stdin=i,stdoutExpected=o_expected, stderrExpected=e_expected,exitCodeExpected=x_expected} = n ~: do- let exe = fromJust $ getArgString args ExecutableArg+ let exe = executable args cmd = unwords [exe,c] (o_expected',e_expected',x_expected') =- case (args `gotArg` ImplicitTestsFlag) of- True -> (case o_expected of- Just m -> Just m- _ -> Just $ Lines ""- ,case e_expected of Just m -> Just m- _ -> Just $ Lines ""- ,case x_expected of Just m -> Just m- _ -> Just $ Numeric "0")- False -> (o_expected,e_expected,x_expected)- when (args `gotArg` DebugFlag) $ do- putStrLn $ "running test: " ++ n- putStrLn $ "running command: " ++ cmd+ case (implicit args) of+ "all" -> (case o_expected of+ Just m -> Just m+ _ -> Just $ Lines ""+ ,case e_expected of Just m -> Just m+ _ -> Just $ Lines ""+ ,case x_expected of Just m -> Just m+ _ -> Just $ Numeric "0")+ "exit" -> (o_expected,e_expected+ ,case x_expected of Just m -> Just m+ _ -> Just $ Numeric "0")+ _ -> (o_expected,e_expected,x_expected)+ when (debug args) $ printf "command: %s\n" (show cmd)+ (o_actual, e_actual, x_actual) <- runCommandWithInput cmd i+ when (debug args) $ do+ printf "stdout: %s\n" (show $ trim o_actual)+ printf "stderr: %s\n" (show $ trim e_actual)+ printf "exit: %s\n" (show $ trim $ show x_actual)+ if (x_actual == 127) -- catch bad executable - should work on posix systems at least+ then ioError $ userError e_actual -- XXX still a test failure; should be an error+ else assertString $ addnewline $ intercalate "\n" $ filter (not . null) [+ if (maybe True (o_actual `matches`) o_expected')+ then ""+ else showExpectedActual "stdout" (fromJust o_expected') o_actual+ ,if (maybe True (e_actual `matches`) e_expected')+ then ""+ else showExpectedActual "stderr" (fromJust e_expected') e_actual+ ,if (maybe True (show x_actual `matches`) x_expected')+ then ""+ else showExpectedActual "exit code" (fromJust x_expected') (show x_actual)+ ]+ where addnewline "" = ""+ addnewline s = "\n"++s - -- run the command, passing it the stdin if any, and reading the- -- stdout/stderr/exit code. This has to be done carefully.+-- | Run a shell command line, passing it standard input if provided,+-- and return the standard output, standard error output and exit code.+runCommandWithInput :: String -> Maybe String -> IO (String, String, Int)+runCommandWithInput cmd input = do+ -- this has to be done carefully (ih,oh,eh,ph) <- runInteractiveCommand cmd- when (isJust i) $ forkIO (hPutStr ih $ fromJust i) >> return ()+ when (isJust input) $ forkIO (hPutStr ih $ fromJust input) >> return () o <- newEmptyMVar e <- newEmptyMVar forkIO $ oh `hGetContentsStrictlyAnd` putMVar o@@ -231,49 +269,50 @@ x_actual <- waitForProcess ph >>= return.fromExitCode o_actual <- takeMVar o e_actual <- takeMVar e-- let failuremsg- -- when a bad exe is provided, we don't want to show all the test- -- failures. This should work on all posix systems at least.- -- Really we should report a test error here, not a failure.- | x_actual == 127 = cmd ++ ": command not found"- | otherwise = addnewline $ intercalate "\n" $ filter (not . null) [- if (maybe True (o_actual `matches`) o_expected')- then "" - else showExpectedActual "stdout" (fromJust o_expected') o_actual- ,if (maybe True (e_actual `matches`) e_expected')- then "" - else showExpectedActual "stderr" (fromJust e_expected') e_actual- ,if (maybe True (show x_actual `matches`) x_expected')- then ""- else showExpectedActual "exit code" (fromJust x_expected') (show x_actual)- ]- assertString failuremsg- where addnewline "" = ""- addnewline s = "\n"++s+ return (o_actual, e_actual, x_actual) hGetContentsStrictlyAnd :: Handle -> (String -> IO b) -> IO b-hGetContentsStrictlyAnd h f = hGetContents h >>= \c -> length c `seq` f c+hGetContentsStrictlyAnd h f = hGetContents h >>= \s -> length s `seq` f s matches :: String -> Matcher -> Bool-matches s (PositiveRegex r) = s `containsRegex` r-matches s (NegativeRegex r) = not $ s `containsRegex` r-matches s (Numeric p) = s == p-matches s (Lines p) = s == p+matches s (PositiveRegex r) = s `containsRegex` r+matches s (NegativeRegex r) = not $ s `containsRegex` r+matches s (Numeric p) = s == p+matches s (NegativeNumeric p) = not $ s == p+matches s (Lines p) = s == p showExpectedActual :: String -> Matcher -> String -> String showExpectedActual field e a =- printf "**Expected %s:%s**Got %s:\n%s" field (showMatcher e) field a+ printf "**Expected %s: %s\n**Got %s: %s" field (show e) field (show $ trim a) -showMatcher :: Matcher -> String-showMatcher (PositiveRegex r) = " /"++r++"/\n"-showMatcher (NegativeRegex r) = " !/"++r++"/\n"-showMatcher (Numeric s) = "\n"++s++"\n"-showMatcher (Lines s) = "\n"++s+instance Show Matcher where+ show (PositiveRegex r) = "/"++(trim r)++"/"+ show (NegativeRegex r) = "!/"++(trim r)++"/"+ show (Numeric s) = show $ trim s+ show (NegativeNumeric s) = "!"++ show (trim s)+ show (Lines s) = show $ trim s +instance Show ShellTest where+ show ShellTest{testname=n,commandargs=a,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} = + printf "ShellTest {testname = %s, commandargs = %s, stdin = %s, stdoutExpected = %s, stderrExpected = %s, exitCodeExpected = %s}"+ (show $ trim n)+ (show $ trim a)+ (maybe "Nothing" (show.trim) i)+ (show o)+ (show e)+ (show x) + -- utils +trim :: String -> String+trim s | l <= limit = s+ | otherwise = take limit s ++ suffix+ where+ limit = 500+ l = length s+ suffix = printf "...(%d more)" (l-limit)+ -- toExitCode :: Int -> ExitCode -- toExitCode 0 = ExitSuccess -- toExitCode n = ExitFailure n@@ -288,7 +327,13 @@ rstrip = reverse . dropws . reverse dropws = dropWhile (`elem` " \t") +-- | Does string contain this regular expression ?+-- A malformed regexp will cause a runtime error. containsRegex :: String -> String -> Bool-containsRegex s r = case matchRegexPR (""++r) s of- Just _ -> True- _ -> False+containsRegex s r =+ case compileM r [+ dotall+ -- ,utf8 -- shows no obvious benefit with 6.10, review situation with 6.12+ ] of+ Right regex -> isJust $ match regex s []+ Left e -> error $ printf "bad regexp, %s: %s" e (trim $ r)