[Haskell-cafe] Unit Testing with Control.Proxy
Renzo Carbonara
gnuk0001 at gmail.com
Fri Apr 19 06:34:28 CEST 2013
On Tue, Apr 16, 2013 at 2:45 PM, Dan <wilsonhardrock at gmail.com> wrote:
> I've discovered the excellent proxy library recently and one thing strikes
> me. How do you unit test a proxy? Are there any specific methods or
> workflows for doing this cleanly and consistently?
I don't think it's different from testing other normal Haskell
code. And as such, you will need to consider the particulars of the
base monad you are using for your proxies. For example, if your base
monad is 'IO', then you should reason about your unit tests and
properties the same way you would for any other non-pipes 'IO' code you
test.
Below is a simple working example that tests a simple proxy using both
HUnit and QuickCheck. I find the 'toListD' Proxy particularly useful in
cases like these.
module Main where
import Control.Proxy ((>->))
import qualified Control.Proxy as P
import Test.HUnit
import Test.QuickCheck
-- | This Proxy doubles Int values flowing downstream.
doublerD :: (Monad m, P.Proxy p) => a' -> p a' Int a' Int m r
doublerD = P.mapD (*2)
-- | A unit test about 'doublerD'
test_doublerD :: Test
test_doublerD = [2,4,6] ~=? actual where
actual = let session = P.fromListS [1,2,3] >-> doublerD >-> P.toListD
in head . P.execWriterT . P.runProxy $ session
-- | A property we can test about 'doublerD' using QuickCheck
prop_doublerD :: [Int] -> Bool
prop_doublerD xs = expected == actual where
expected = fmap (*2) xs
actual = let session = P.fromListS xs >-> doublerD >-> P.toListD
in head . P.execWriterT . P.runProxy $ session
main :: IO ()
main = do
putStrLn "HUnit tests:" >> runTestTT test_doublerD
putStrLn "QuickCheck tests:" >> quickCheck prop_doublerD
And the output, after running the code:
HUnit tests:
Cases: 1 Tried: 1 Errors: 0 Failures: 0
QuickCheck tests:
+++ OK, passed 100 tests.
Regards,
Renzo Carbonara.
More information about the Haskell-Cafe
mailing list