-- Communicating Haskell Processes.
-- Copyright (c) 2009, University of Kent.
-- All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
-- met:
--
--  * Redistributions of source code must retain the above copyright
--    notice, this list of conditions and the following disclaimer.
--  * Redistributions in binary form must reproduce the above copyright
--    notice, this list of conditions and the following disclaimer in the
--    documentation and/or other materials provided with the distribution.
--  * Neither the name of the University of Kent nor the names of its
--    contributors may be used to endorse or promote products derived from
--    this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-- | A module containing some useful functions for testing CHP programs, both in
-- the QuickCheck 2 framework and using HUnit.
--
-- This whole module was added in version 1.4.0.
module Control.Concurrent.CHP.Test where

import Control.Monad
import Data.Maybe
import Test.HUnit (assertBool, Test(..))
import Test.QuickCheck (Gen, Property)
import Test.QuickCheck.Monadic (assert, forAllM, monadicIO, run)

import Control.Concurrent.CHP

-- | Takes a CHP program that returns a Bool (True = test passed, False = test
-- failed) and forms it into a Property that QuickCheck can test.
--
-- Note that if the program exits with poison, this is counted as a test failure.
propCHP :: CHP Bool -> Property
propCHP = monadicIO . (>>= assert . fromMaybe False) . run . runCHP

-- | Tests a process that takes a single input and produces a single output, using
-- QuickCheck.
--
-- The first parameter is a pure function that takes the input to the process,
-- the output the process gave back, and indicates whether this is okay (True =
-- test pass, False = test fail).  The second parameter is the process to test,
-- and the third parameter is the thing to use to generate the inputs (passing 'arbitrary'
-- is the simplest thing to do).
--
-- Here are a couple of example uses:
-- 
-- > propCHPInOut (==) Common.id (arbitrary :: Gen Int)
-- 
-- > propCHPInOut (const $ (< 0)) (Common.map (negate . abs)) (arbitrary :: Gen Int)
--
-- The test starts the process afresh each time, and shuts it down after the single
-- output has been produced (by poisoning both its channels).  Any poison from
-- the process being tested after it has produced its output is consequently ignored,
-- but poison instead of producing an output will cause a test failure.
-- If the process does not produce an output or poison (for example if you test
-- something like the Common.filter process), the test will deadlock.
propCHPInOut :: Show a => (a -> b -> Bool) -> (Chanin a -> Chanout b -> CHP ()) -> Gen a -> Property
propCHPInOut f p gen
  = monadicIO $ forAllM gen $ \x -> run (runCHP $
              do c <- oneToOneChannel
                 d <- oneToOneChannel
                 (_,r) <- (p (reader c) (writer d)
                            `onPoisonTrap` (poison (reader c) >> poison (writer d)))
                   <||> ((do writeChannel (writer c) x
                             y <- readChannel (reader d)
                             poison (writer c) >> poison (reader d)
                             return $ f x y
                         ) `onPoisonTrap` return False)
                 return r) >>= assert . fromMaybe False

-- | Takes a CHP program that returns a Bool (True = test passed, False = test
-- failed) and forms it into an HUnit test.
--
-- Note that if the program exits with poison, this is counted as a test failure.
testCHP :: CHP Bool -> Test
testCHP = TestCase . (>>= assertBool "testCHP failure" . fromMaybe False) . runCHP

-- | Tests a process that takes a single input and produces a single output, using
-- HUnit.
--
-- The first parameter is a pure function that takes the input to the process,
-- the output the process gave back, and indicates whether this is okay (True =
-- test pass, False = test fail).  The second parameter is the process to test,
-- and the third parameter is the input to send to the process.
--
-- The intention is that you will either create several tests with the same first
-- two parameters or use a const function as the first parameter.  So for example,
-- here is how you might test the identity process with several tests:
-- 
-- > let check = testCHPInOut (==) Common.id
-- > in TestList [check 0, check 3, check undefined]
--
-- Whereas here is how you could test a slightly different process:
--
-- > let check = testCHPInOut (const $ (< 0)) (Common.map (negate . abs))
-- > in TestList $ map check [-5..5]
--
-- The test starts the process afresh each time, and shuts it down after the single
-- output has been produced (by poisoning both its channels).  Any poison from
-- the process being tested after it has produced its output is consequently ignored,
-- but poison instead of producing an output will cause a test failure.
-- If the process does not produce an output or poison (for example if you test
-- something like the Common.filter process), the test will deadlock.
testCHPInOut :: (a -> b -> Bool) -> (Chanin a -> Chanout b -> CHP ()) -> a -> Test
testCHPInOut f p x
  = testCHP $ do c <- oneToOneChannel
                 d <- oneToOneChannel
                 liftM snd $ (p (reader c) (writer d)
                            `onPoisonTrap` (poison (reader c) >> poison (writer d)))
                   <||> ((do writeChannel (writer c) x
                             y <- readChannel (reader d)
                             poison (writer c) >> poison (reader d)
                             return $ f x y
                         ) `onPoisonTrap` return False)

-- TODO add some better HUnit facilities