{- |Test.hs - test program definition for 'RandProc' library module

  $Id: Test.hs 32 2011-06-22 15:43:45Z dbanas $

  David Banas

  6 June 2011

  Copyright (c) 2011 by David Banas; All rights reserved World wide.

  /Revision History:/

  [@Date      SVN #@] Description

  [@2011-06-06    9@] Initial revision created.

  [@2011-06-11   10@] Major re-write to afford automated and structured testing.

  [@2011-06-21   27@] Modified comments for use w/ Haddock and generated docs.

  [@2011-06-22   31@] Moved into 'Data' directory, as per Hackage instructions
                      for libraries.
                      Changed file name from 'Main.hs' to 'Test.hs'.

  /To Do:/

  - Change 'runTest' and 'main', such that final return value is meaningful.

-}

module Main (
    main
) where

import Data.RandProc
import Control.Monad

{- |Custom data structure, used for constructing individual test cases.

/Fields:/

* ps - a pointer to the ProbSpace being tested

* res - the expected result

* name - a label for identifying this test

-}
data ProbSpaceTest = ProbSpaceTest {
    ps    :: ProbSpace
    ,res  :: TestResult -- expected test result
    ,name :: String
}

-- |Takes a test case and returns a string indicating the result of the test.
checkSpace :: ProbSpaceTest -> String
checkSpace pst
    | result == (res pst) = "Ok."
    | otherwise           = "FAILED!: Expected " ++ (show (res pst)) ++ "; Got " ++ (show result)
    where result = checkProbMeas (ps pst)

-- |Runs checkSpace on a test case, outputting useful text to the user.
runTest :: ProbSpaceTest -> IO Bool
runTest pst = do
    putStr ("Checking  " ++ (name pst) ++ "... ")
    putStrLn (checkSpace pst)
    return True

{- |Runs 'runTest' on all test cases listed in 'testList' and returns /True/
if all tests finished as expected; otherwise, returns /False/.

Expected result:

@
Checking  badPointSpace1... Ok.
Checking  badPointSpace2... Ok.
Checking  goodPointSpace... Ok.
Checking  goodDie... FAILED!: Expected Pass; Got Fail {err = MissingUnionEvent}
Checking  badRangeSpace1... Ok.
Checking  badRangeSpace2... Ok.
Checking  goodRangeSpace... Ok.
True
@

-}
main :: IO Bool
main = foldr (liftM2 (&&)) (return True) (map runTest testList)

-- |List of test cases to run
testList :: [ProbSpaceTest]
testList = [
    ProbSpaceTest badSpace1      (Fail MissingNullEvent)     "badPointSpace1"
   ,ProbSpaceTest badSpace2      (Fail MissingCompEvent)     "badPointSpace2"
   ,ProbSpaceTest goodSpace      Pass                        "goodPointSpace"
   ,ProbSpaceTest goodDie        Pass                        "goodDie"
   ,ProbSpaceTest badRangeSpace1 (Fail MissingCompEvent)     "badRangeSpace1"
   ,ProbSpaceTest badRangeSpace2 (Fail EventAndCompNoSumOne) "badRangeSpace2"
   ,ProbSpaceTest goodRangeSpace Pass                        "goodRangeSpace"
    ]

-- |missing null event
badSpace1 :: ProbSpace
badSpace1 = ProbSpace
    [point 0, point 1]
    [Measure ( [point 0]) 0.5, Measure ( [point 1]) 0.5, Measure ( [point 0, point 1]) 1.0]

-- |missing complimentary event
badSpace2 :: ProbSpace
badSpace2 = ProbSpace
    [point 0, point 1]
    [Measure ( [Empty]) 0, Measure ( [point 1]) 0.5, Measure ( [point 0, point 1]) 1]

-- |Satisfies all requirements.
goodSpace :: ProbSpace
goodSpace = ProbSpace
    [point 0.0, point 1.0]
    [Measure ( [Empty]) 0, Measure ( [point 0]) 0.5
    , Measure ( [point 1]) 0.5, Measure ( [point 0, point 1]) 1.0]

-- |Missing some unions of events.
goodDie :: ProbSpace
goodDie = ProbSpace
    [point 1, point 2, point 3, point 4, point 5, point 6]
    [Measure ( [Empty]) 0
    ,Measure ( [point 1]) (fromRational 1/6)
    ,Measure ( [point 2]) (fromRational 1/6)
    ,Measure ( [point 3]) (fromRational 1/6)
    ,Measure ( [point 4]) (fromRational 1/6)
    ,Measure ( [point 5]) (fromRational 1/6)
    ,Measure ( [point 6]) (fromRational 1/6)
    ,Measure ( [point 2, point 3, point 4, point 5, point 6]) (fromRational 5/6)
    ,Measure ( [point 1, point 3, point 4, point 5, point 6]) (fromRational 5/6)
    ,Measure ( [point 1, point 2, point 4, point 5, point 6]) (fromRational 5/6)
    ,Measure ( [point 1, point 2, point 3, point 5, point 6]) (fromRational 5/6)
    ,Measure ( [point 1, point 2, point 3, point 4, point 6]) (fromRational 5/6)
    ,Measure ( [point 1, point 2, point 3, point 4, point 5]) (fromRational 5/6)
    ,Measure ( [point 1, point 2, point 3, point 4, point 5, point 6]) 1
    ]

-- |Missing complimentary event
badRangeSpace1 = ProbSpace
    [range (0.0, 1.0)]
    [Measure ( [Empty]) 0
     ,Measure ( [range (0.1, 0.2)]) 0.1
     ,Measure ( [range (0.2, 1.0)]) 0.8
     ,Measure ( [range (0.0, 1.0)]) 1
     ]

-- |Event and compliment have probabilities, which don't add to 1.
badRangeSpace2 = ProbSpace
    [range (0.0, 1.0)]
    [Measure ( [Empty]) 0
     ,Measure ( [range (0.1, 0.2)]) 0.1
     ,Measure ( [range (0.2, 1.0), point (0.1), point (0.2), range (0.0, 0.1)]) 0.8
     ,Measure ( [range (0.0, 1.0)]) 1
     ]

-- |Satisfies all requirements.
goodRangeSpace = ProbSpace
    [range (0.0, 1.0)]
    [Measure ( [Empty]) 0
     ,Measure ( [range (0.1, 0.2)]) 0.1
     ,Measure ( [range (0.0, 0.1), range (0.2, 1.0), point (0.1), point (0.2)]) 0.9
     ,Measure ( [range (0.0, 1.0)]) 1
     ]