content: {- |
  Module      :  $Id$
  Copyright   :  (c) Andy Gimblett and Markus Roggenbach and Uni Bremen 2004
  License     :  GPLv2 or higher, see LICENSE.txt
  
  Maintainer  :  a.m.gimblett@swan.ac.uk
  Stability   :  provisional
  Portability :  portable
  
  Test case wrapper for CspCASL specs and fragments.
  
  This is a standalone `main' wrapper for CspCASL-related tests
  performed locally to the CspCASL codebase.  It's probably only of
  interest to the CspCASL maintainers.
  
  Usage:
  
    testwrap [options] targets
  
  Options:
  
    -t    Don't parse any .cspcasl files; useful for just running tests.
  
    -c    Don't run any tests; useful for just parsing .cspcasl files.
  
    Obviously, specifying both of these options stops this program from
    doing anything useful.
  
  Parameters:
  
    targets - a list of targets, where each target can be:
  
      - a .cspcasl file; parse the file as a Core-CspCASL specification,
        unparse the parse tree, and print out the result of the unparse.
        In case of parse error, report the error.
  
      - a .testcase file; execute the test and report the outcome.  A
        testcase file specifies one test case, whose source is contained
        in another file, and whose output we will check against expected
        contents.  See below for the file format.
  
      - a .testcases file; execute the tests and report their outcomes.
        A testcases file specifies multiple test cases, with source
        integrated with each test case, and outputs we will check
        against expected contents.  See below for the file format.
  
      - a directory; find all .cspcasl, .testcase and .testcases files
        in the directory (recursively) and operate on them as described
        above.
  
  Postive and negative tests:
  
    A positive test is one where we expect the parse to succeed; here
    the expected output is the result of unparsing the resultant parse
    tree.  The test can fail with a parse error, or with unexpected
    output.
  
    A negative test is one where we expect the parse to fail; here the
    expected output is the error message produced.  The test can fail
    with a successful parse, or with unexpected output.
  
  Format of .testcase files:
  
    A .testcase file contains a single test case.  The first line is the
    path to the file containing the source to be parsed/tested, relative
    to the .testcase file; it also acts as the name of the test case.
    The second line identifies the test sense ("++" is positive, "--" is
    negative). The third line is the name of the parser to be used.  The
    remaining lines contain the expected output of the test.
  
  Format of .testcases files:
  
    A .testcases file contains multiple test cases including their
    source.  Individual test cases are separated by lines containing
    twenty '-' characters and nothing else.  The format of an individual
    test case is similar but not identical to the format of a standalone
    test case (above).  The first line is the name of the test (used for
    reporting).  The second line identifies the test sense ("++" is
    positive, "--" is negative). The third line is the name of the
    parser to be used.  This is followed by the expected outcome of the
    test and the source (input) of the test, in that order, both of
    which may span multiple lines; they are separated by a line
    containing ten '-' characters and nothing else.
  
  -}
  
  module Main where
  
  import Data.List
  import Control.Monad
  import System.Directory
  import System.Environment (getArgs)
  import System.FilePath (combine, dropFileName)
  import System.IO
  import Text.ParserCombinators.Parsec
  
  import Common.AnnoState (emptyAnnos)
  import Common.DocUtils
  
  import CspCASL.Parse_CspCASL (cspBasicExt)
  import CspCASL.Parse_CspCASL_Process (csp_casl_process)
  import CspCASL.Print_CspCASL ()
  
  main :: IO ()
  main = do args <- getArgs
            dirs <- filterM doesDirectoryExist args
            dir_contents <- liftM concat (mapM listFilesR dirs)
            files <- filterM doesFileExist (sort $ nub (args ++ dir_contents))
            doIf ("-t" `notElem` args) (parseCspCASLs (filter isCspCASL files))
            doIf ("-c" `notElem` args) (performTests (filter isTest files))
      where isCspCASL = (".cspcasl" `isSuffixOf`)
            isTest f = isSuffixOf ".testcase" f || isSuffixOf ".testcases" f
            doIf c f = if c then f else putStr ""
  
  {- | Given a list of paths to .cspcasl files, parse each in turn,
  printing results as you go. -}
  parseCspCASLs :: [FilePath] -> IO ()
  parseCspCASLs [] = putStr ""
  parseCspCASLs (f : fs) = do putStrLn dash20
                              prettyCspCASLFromFile f
                              parseCspCASLs fs
  
  -- | Parse one .cspcasl file; print error or pretty print parse tree.
  prettyCspCASLFromFile :: FilePath -> IO ()
  prettyCspCASLFromFile fname
    = do putStrLn ("Parsing " ++ fname)
         input <- readFile fname
         case runParser cspBasicExt (emptyAnnos ()) fname input of
             Left err -> do putStr "parse error at "
                            print err
             Right x -> do putStrLn $ showDoc x ""
                           print x
  
  {- | Test sense: do we expect parse success or failure?  What is the
  nature of the expected output? -}
  data TestSense = Positive | Negative
                   deriving (Eq, Ord)
  instance Show TestSense where
    show Positive = "++"
    show Negative = "--"
  
  -- | Test case details: where is source, what is it, which parser, etc.
  data TestCase = TestCase {
        -- | @name@ - test name
        name :: String,
        -- | @parser@ - name of parser to apply
        parser :: String,
        -- | @sense@ - sense of test (positive or negative)
        sense :: TestSense,
        -- | @src@ - source to be parsed
        src :: String,
        -- | @expected@ - expected output of test
        expected :: String
  } deriving (Eq, Ord)
  instance Show TestCase where
    show a = name a ++ " (" ++ show (sense a) ++ parser a ++ ")"
  
  -- | Given a list of paths of test case files, read & perform them.
  performTests :: [FilePath] -> IO ()
  performTests tcs = do putStrLn "Performing tests"
                        tests <- liftM concat (mapM readTestFile tcs)
                        doTests tests
  
  -- | Turn a .testcase or .testcases file into list of test cases therein.
  readTestFile :: FilePath -> IO [TestCase]
  readTestFile f
      | ".testcase" `isSuffixOf` f = readTestCaseFile f
      | ".testcases" `isSuffixOf` f = readTestCasesFile f
      | otherwise = return []
  
  -- | Turn a .testcase file into the test case therein.
  readTestCaseFile :: FilePath -> IO [TestCase]
  readTestCaseFile f =
      do hdl <- openFile f ReadMode
         contents <- hGetContents hdl
         let (a, b, c, d) = testCaseParts contents
         hdl_s <- openFile (combine (dropFileName f) a) ReadMode
         e <- hGetContents hdl_s
         return [TestCase { name = a, parser = b, sense = c, expected = d, src = e }]
  
  -- | Turn a .testcases file into the test cases therein.
  readTestCasesFile :: FilePath -> IO [TestCase]
  readTestCasesFile f =
      do hdl <- openFile f ReadMode
         s <- hGetContents hdl
         let tests = map (interpretTestCasesOne . strip) (split dash20 s)
         return tests
  
  -- | Turn test case string from a .testcases file into its test case.
  interpretTestCasesOne :: String -> TestCase
  interpretTestCasesOne s
      | length parts == 2 = TestCase { name = a, parser = b, sense = c,
                                         expected = d, src = e }
      | otherwise = error s
      where parts = map strip (split dash10 s)
            (a, b, c, d) = testCaseParts (head parts)
            e = parts !! 1
  
  -- | Turn test case string into its constituent parts (except source).
  testCaseParts :: String -> (String, String, TestSense, String)
  testCaseParts s = (head ls,
                     head (tail ls),
                     interpretSense (head (tail (tail ls))),
                     unlines (tail (tail (tail ls))))
      where ls = lines s
  
  -- | Interpret a test case sense (++ or --, positive or negative)
  interpretSense :: String -> TestSense
  interpretSense s = case s of
                       "++" -> Positive
                       "--" -> Negative
                       _ -> error ("Bad test sense " ++ s)
  
  {- | Given a list of test cases, perform the tests in turn, printing
  results as you go. -}
  doTests :: [TestCase] -> IO ()
  doTests [] = putStr ""
  doTests (tc : ts) = do -- putStrLn dash20
                       let output = parseTestCase tc
                       putStr (show tc ++ " ")
                       printOutcome tc output
                       doTests ts
  
  {- | Perform a test and report its outcome.  There are six
  possibilities: 1) positive test succeeds; 2) postive test
  fail/non-parse (parse fails); 3) positive test error (unparse not
  as expected); 4) negative test succeeds; 5) negative test
  fail/parse (parse succeeds); 6) negative test error (error not as
  expected). -}
  printOutcome :: TestCase -> Either ParseError (String, String) -> IO ()
  printOutcome tc out =
      case (sense tc, out) of
        (Positive, Right (o, tree)) ->
            if strip o == strip (expected tc)
            then testPass                                    -- case 1
            else do testFail "unparse" (expected tc) o       -- case 3
                    putStrLn ("-> tree:\n" ++ tree)
        (Positive, Left err) ->
            testFail "parse failure" "" (show err)        -- case 2
        (Negative, Right (o, _)) ->
            testFail "parse success" (expected tc) o         -- case 5
        (Negative, Left err) ->
            if strip (show err) == strip (expected tc)
            then testPass                                    -- case 4
            else testFail "error" (expected tc) (show err)   -- case 6
  
  -- Report on a test pass
  testPass :: IO ()
  testPass = putStrLn "passed"
  
  -- Report on a test failure
  testFail :: String -> String -> String -> IO ()
  testFail nature expect got =
      do putStrLn ("failed - unexpected " ++ nature)
         if expect /= ""
            then putStrLn ("-> expected:\n" ++ strip expect)
            else putStr ""
         putStrLn "-> got:"
         putStrLn $ strip got
  
  
  -- | Run a test case through its parser.
  parseTestCase :: TestCase -> Either ParseError (String, String)
  parseTestCase t =
      case parser t of
        "CoreCspCASL" -> case runWithEof cspBasicExt of
                           Left err -> Left err
                           Right x -> Right (showDoc x "", show x)
        "Process" -> case runWithEof csp_casl_process of
                       Left err -> Left err
                       Right x -> Right (showDoc x "", show x)
        _ -> error "Parser name"
      where runWithEof p = runParser p' (emptyAnnos ()) (name t) (src t)
                where p' = do n <- p
                              eof
                              return n
  
  {- The above implemenation is horrible.  There must be a nice way to
  abstract the parser out from the code to run it and collect/unparse
  the result.  Alas, I don't know it, or don't know that I know it. -}
  
  dash20, dash10 :: String
  dash10 = "----------"
  dash20 = dash10 ++ dash10
  
  -- Utility functions which really should be in the standard library!
  
  {- | Recursive file lister adapted from
  http://therning.org/magnus/archives/228 -}
  listFilesR :: FilePath -> IO [FilePath]
  listFilesR path =
      do allfiles <- getDirectoryContents path
         nodots <- filterM (return . isDODD) (map (combine path) allfiles)
         dirs <- filterM doesDirectoryExist nodots
         subdirfiles <- liftM concat $ mapM listFilesR dirs
         files <- filterM doesFileExist nodots
         return $ files ++ subdirfiles
      where
        isDODD f = not $ ("/." `isSuffixOf` f) || ("/.." `isSuffixOf` f)
  
  {- | A function inspired by python's string.split().  A list is split
  on a separator which is itself a list (not a single element). -}
  split :: Eq a => [a] -> [a] -> [[a]]
  split tok = unfoldr (sp1 tok)
      where sp1 _ [] = Nothing
            sp1 t s = case find (t `isSuffixOf`) (inits s) of
                        Nothing -> Just (s, [])
                        Just p -> Just (take (length p - length t) p,
                                        drop (length p) s)
  
  -- | String strip in style of python string.strip()
  strip :: String -> String
  strip s = dropWhile ws $ reverse $ dropWhile ws $ reverse s
      where ws = (`elem` " \n\t\r")
  