{- |
Module      :  $Id: testwrap.hs 18342 2013-11-29 02:57:59Z sternk $
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")
