testwrap.hs revision 9890f5274aa35d7b8c073cd5bbc3c4028b18dc7d
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannModule : $Header$
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannCopyright : (c) Andy Gimblett and Markus Roggenbach and Uni Bremen 2004
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannMaintainer : a.m.gimblett@swan.ac.uk
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannStability : provisional
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannPortability : portable
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannTest case wrapper for CspCASL specs and fragments.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannThis is a standalone `main' wrapper for CspCASL-related tests
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmannperformed locally to the CspCASL codebase. It's probably only of
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmanninterest to the CspCASL maintainers.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann testwrap [options] targets
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann -t Don't parse any .cspcasl files; useful for just running tests.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann -c Don't run any tests; useful for just parsing .cspcasl files.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann Obviously, specifying both of these options stops this program from
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann doing anything useful.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann targets - a list of targets, where each target can be:
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann - a .cspcasl file; parse the file as a Core-CspCASL specification,
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann unparse the parse tree, and print out the result of the unparse.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann In case of parse error, report the error.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann - a .testcase file; execute the test and report the outcome. A
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann testcase file specifies one test case, whose source is contained
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann in another file, and whose output we will check against expected
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann contents. See below for the file format.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann - a .testcases file; execute the tests and report their outcomes.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann A testcases file specifies multiple test cases, with source
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann integrated with each test case, and outputs we will check
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann against expected contents. See below for the file format.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann - a directory; find all .cspcasl, .testcase and .testcases files
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann in the directory (recursively) and operate on them as described
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannPostive & negative tests:
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann A positive test is one where we expect the parse to succeed; here
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann the expected output is the result of unparsing the resultant parse
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann tree. The test can fail with a parse error, or with unexpected
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann A negative test is one where we expect the parse to fail; here the
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann expected output is the error message produced. The test can fail
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann with a successful parse, or with unexpected output.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannFormat of .testcase files:
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann A .testcase file contains a single test case. The first line is the
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann path to the file containing the source to be parsed/tested, relative
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann to the .testcase file; it also acts as the name of the test case.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann The second line identifies the test sense ("++" is positive, "--" is
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann negative). The third line is the name of the parser to be used. The
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann remaining lines contain the expected output of the test.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannFormat of .testcases files:
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann A .testcases file contains multiple test cases including their
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann source. Individual test cases are separated by lines containing
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann twenty '-' characters and nothing else. The format of an individual
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann test case is similar but not identical to the format of a standalone
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann test case (above). The first line is the name of the test (used for
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann reporting). The second line identifies the test sense ("++" is
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann positive, "--" is negative). The third line is the name of the
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann parser to be used. This is followed by the expected outcome of the
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann test and the source (input) of the test, in that order, both of
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann which may span multiple lines; they are separated by a line
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann containing ten '-' characters and nothing else.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmannmodule Main where
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmannimport Common.AnnoState (emptyAnnos)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmannimport CspCASL.Parse_CspCASL(basicCspCaslSpec)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmannimport CspCASL.Parse_CspCASL_Process(csp_casl_process)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmannmain = do args <- getArgs
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann dirs <- filterM doesDirectoryExist args
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann dir_contents <- (liftM concat) (mapM listFilesR dirs)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann files <- filterM doesFileExist (sort $ nub (args ++ dir_contents))
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann doIf ("-t" `notElem` args) (parseCspCASLs (filter isCspCASL files))
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann doIf ("-c" `notElem` args) (performTests (filter isTest files))
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann where isCspCASL = (".cspcasl" `isSuffixOf`)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann isTest f = (isSuffixOf ".testcase" f) || (isSuffixOf ".testcases" f)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann doIf c f = if c then f else putStr ""
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Given a list of paths to .cspcasl files, parse each in turn,
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- printing results as you go.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannparseCspCASLs :: [FilePath] -> IO ()
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannparseCspCASLs [] = do putStr ""
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannparseCspCASLs (f:fs) = do putStrLn dash20
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann prettyCspCASLFromFile f
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann parseCspCASLs fs
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Parse one .cspcasl file; print error or pretty print parse tree.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannprettyCspCASLFromFile :: FilePath -> IO ()
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannprettyCspCASLFromFile fname
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann = do putStrLn ("Parsing " ++ fname)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann input <- readFile fname
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann case (runParser basicCspCaslSpec (emptyAnnos ()) fname input) of
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann Left err -> do putStr "parse error at "
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann Right x -> do putStrLn $ showDoc x ""
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Test sense: do we expect parse success or failure? What is the
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- nature of the expected output?
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmanndata TestSense = Positive | Negative
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann deriving (Eq, Ord)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmanninstance Show TestSense where
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann show Positive = "++"
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann show Negative = "--"
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Test case details: where is source, what is it, which parser, etc.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmanndata TestCase = TestCase {
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann -- | @name@ - test name
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann name :: String,
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann -- | @parser@ - name of parser to apply
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann parser :: String,
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann -- | @sense@ - sense of test (positive or negative)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann sense :: TestSense,
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann -- | @src@ - source to be parsed
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann src :: String,
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann -- | @expected@ - expected output of test
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann expected :: String
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann} deriving (Eq, Ord)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmanninstance Show TestCase where
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann show a = (name a) ++ " (" ++ (show (sense a)) ++ (parser a) ++ ")"
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmanndata TestOutcome = TestPass TestCase
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann | TestFail TestCase String
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Given a list of paths of test case files, read & perform them.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannperformTests :: [FilePath] -> IO ()
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannperformTests tcs = do putStrLn "Performing tests"
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann tests <- (liftM concat) (mapM readTestFile tcs)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann doThoseTests tests
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Turn a .testcase or .testcases file into list of test cases therein.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannreadTestFile :: FilePath -> IO [TestCase]
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannreadTestFile f
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann | ".testcase" `isSuffixOf` f = readTestCaseFile f
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann | ".testcases" `isSuffixOf` f = readTestCasesFile f
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann | otherwise = do return []
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Turn a .testcase file into the test case therein.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannreadTestCaseFile :: FilePath -> IO [TestCase]
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannreadTestCaseFile f =
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann do hdl <- openFile f ReadMode
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann contents <- hGetContents hdl
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann let (a, b, c, d) = (testCaseParts contents)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann hdl_s <- openFile (joinPaths (dirName f) a) ReadMode
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann e <- hGetContents hdl_s
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann return [TestCase { name=a, parser=b, sense=c, expected=d, src=e }]
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Turn a .testcases file into the test cases therein.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannreadTestCasesFile :: FilePath -> IO [TestCase]
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannreadTestCasesFile f =
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann do hdl <- openFile f ReadMode
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann s <- hGetContents hdl
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann let tests = map interpretTestCasesOne (map strip (split dash20 s))
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Turn test case string from a .testcases file into its test case.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmanninterpretTestCasesOne :: String -> TestCase
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmanninterpretTestCasesOne s
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann | (length parts) == 2 = TestCase { name=a, parser=b, sense=c,
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann expected=d, src=e }
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann | otherwise = error s
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann where parts = map strip (split dash10 s)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann (a, b, c, d) = testCaseParts (parts !! 0)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann e = parts !! 1
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Turn test case string into its constituent parts (except source).
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmanntestCaseParts :: String -> (String, String, TestSense, String)
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmanntestCaseParts s = (head ls,
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann head (tail ls),
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann interpretSense (head (tail (tail ls))),
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann unlines (tail (tail (tail ls))))
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann where ls = lines s
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Interpret a test case sense (++ or --, positive or negative)
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmanninterpretSense :: String -> TestSense
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmanninterpretSense s = case s of
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann "++" -> Positive
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann "--" -> Negative
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann _ -> error ("Bad test sense " ++ s)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Given a list of test cases, perform the tests in turn, printing
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- results as you go.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmanndoThoseTests :: [TestCase] -> IO ()
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmanndoThoseTests [] = do putStr ""
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmanndoThoseTests (t:ts) = do putStrLn dash20
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann print (show t)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann doThoseTests ts
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannprintResults :: [TestOutcome] -> IO ()
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannprintResults [] = do putStr ""
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannprintResults ((TestPass tc):xs) = do putStrLn ((show tc) ++ " passed")
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann printResults xs
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannprintResults ((TestFail tc o):xs) = do putStrLn ((show tc) ++ " failed")
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann putStrLn (o ++ "\nvs\n" ++ (expected tc))
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann putStrLn "--"
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann printResults xs
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Perform a test and record its outcome. There are six
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- possibilities: 1) positive test succeeds; 2) postive test
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- fail/non-parse (parse fails); 3) positive test error (unparse not
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- as expected); 4) negative test succeeds; 5) negative test
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- fail/parse (parse succeeds); 6) negative test error (error not as
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannperformTest :: TestCase -> TestOutcome
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannperformTest tc =
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann case (sense tc, (parseTestCase tc)) of
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann (Positive, Right o) -> if (trim o) == (trim (expected tc))
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann then TestPass tc -- case 1
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann else TestFail tc o -- case 3
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann (Positive, Left err) -> TestFail tc (show err) -- case 2
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann (Negative, Right o) -> TestFail tc o -- case 5
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann (Negative, Left err) -> if (trim es) == (trim (expected tc))
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann then TestPass tc -- case 4
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann else TestFail tc es -- case 6
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann where es = (show err)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann where trim = applyTwice (reverse . trim1)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann trim1 = dropWhile (`elem` delim)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann delim = [' ', '\t', '\n', '\r']
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann applyTwice f = f . f
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Run a test case.
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannparseTestCase :: TestCase -> Either ParseError String
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannparseTestCase t =
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann case (parser t) of
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann "CoreCspCASL" -> case (runParser basicCspCaslSpec es fn s) of
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann Left err -> Left err
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann Right x -> Right (showDoc x "")
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann "Process" -> case (runParser csp_casl_process es fn s) of
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann Left err -> Left err
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann Right x -> Right (showDoc x "")
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann _ -> error "Parser name"
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann where es = emptyAnnos ()
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- The above implemenation is horrible. There must be a nice way to
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- abstract the parser out from the code to run it and collect/unparse
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- the result. Alas, I don't know it, or don't know that I know it.
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmanndash20, dash10 :: String
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmanndash10 = "----------"
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmanndash20 = dash10 ++ dash10
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- Utility functions which really should be in the standard library!
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | Recursive file lister adapted from
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannlistFilesR :: FilePath -> IO [FilePath]
304d15b2ffa9376d78bddcfc63569824381714abDaniel HausmannlistFilesR path =
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann do allfiles <- getDirectoryContents path
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann nodots <- filterM (return . isDODD) (map (joinPaths path) allfiles)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann dirs <- filterM doesDirectoryExist nodots
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann subdirfiles <- (mapM listFilesR dirs >>= return . concat)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann files <- filterM doesFileExist nodots
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann return $ files ++ subdirfiles
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann isDODD f = not $ ("/." `isSuffixOf` f) || ("/.." `isSuffixOf` f)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | String split in style of python string.split()
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmannsplit :: String -> String -> [String]
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmannsplit tok splitme = unfoldr (sp1 tok) splitme
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann where sp1 _ "" = Nothing
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann sp1 t s = case find (t `isSuffixOf`) (inits s) of
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann Nothing -> Just (s, "")
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann Just p -> Just (take ((length p) - (length t)) p,
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann drop (length p) s)
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann-- | String strip in style of python string.strip()
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmannstrip :: String -> String
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmannstrip s = dropWhile ws (reverse (dropWhile ws (reverse s)))
304d15b2ffa9376d78bddcfc63569824381714abDaniel Hausmann where ws = (`elem` [' ', '\n', '\t', '\r'])