Skip to content

Instantly share code, notes, and snippets.

@kazu-yamamoto
Created November 16, 2012 05:33
Embed
What would you like to do?
Testing typeclass with QuickCheck
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Main where
import Control.Monad
import Control.Monad.Error
import Control.Monad.Trans.RWS.Strict
import Prelude hiding (putChar, getChar)
import qualified System.IO as IO
import Test.QuickCheck
class Monad m => CharIO m where
getChar :: m Char
putChar :: Char -> m ()
instance CharIO IO where
getChar = IO.getChar
putChar = IO.putChar
----------------------------------------------------------------
-- Example code
echo :: CharIO m => m ()
echo = do
getChar >>= putChar
echo
echo1 :: CharIO m => m Int
echo1 = do
getChar >>= putChar
return 1
----------------------------------------------------------------
-- IO
main :: IO ()
main = echo
----------------------------------------------------------------
-- Testing pure
data Output = Read
| Print Char
deriving (Eq, Show)
type EOFError = String
type PureIO = ErrorT EOFError (RWS () [Output] String)
instance CharIO PureIO where
getChar = do
cs <- lift get
case cs of
[] -> throwError "EOF"
x:xs -> do
lift $ put xs
lift $ tell [Read]
return x
putChar c = lift $ tell [Print c]
toOutput :: PureIO a -> String -> (Either EOFError a, [Output])
toOutput act str = evalRWS (runErrorT act) () str
copy :: String -> [Output]
copy [] = []
copy (c:cs) = [Read, Print c] ++ copy cs
prop_echo :: String -> Bool
prop_echo xs = toOutput echo xs == (Left "EOF", copy xs)
test :: IO ()
test = quickCheck prop_echo
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment