public
Last active

Simple example of monadic IO with QuickCheck in Haskell

  • Download Gist
io_quickcheck_example.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
#!/usr/bin/env runhaskell
 
-- Synopsis:
-- $ cabal install QuickCheck
-- $ runhaskell io_quickcheck_example.hs
--
-- Author: Issac Trotts <issac.trotts@gmail.com>
 
import Directory
import System.Environment
import System.Process
import System.Exit
import Test.QuickCheck (Property, quickCheck, (==>))
import Test.QuickCheck.Monadic (assert, monadicIO, run)
 
main = do
putStrLn "addThenClearMakesClear"
quickCheck addThenClearMakesClear
 
putStrLn "addNewIsIdempotent"
quickCheck addNewIsIdempotent
 
-- Add some strings to /tmp/foo
add :: [String] -> IO ()
add strings = do
-- Have to write then rename to work around lazy IO.
oldStrings <- get
writeFile "/tmp/foo2" $ unlines $ oldStrings ++ strings
renameFile "/tmp/foo2" "/tmp/foo"
 
-- Add some strings to /tmp/foo that were not already there
addNew :: [String] -> IO ()
addNew strings = do
oldStrings <- get
add [s | s <- strings, s `notElem` oldStrings && s /= ""]
 
-- Get all the strings in /tmp/foo
get :: IO [String]
get = readProcessOrDie "cat" ["/tmp/foo"] "" >>= return . lines
 
-- Clear /tmp/foo
clear :: IO ()
clear = writeFile "/tmp/foo" ""
 
readProcessOrDie :: String -> [String] -> String -> IO String
readProcessOrDie cmd args input = do
(code, stdout, _) <- readProcessWithExitCode cmd args input
case code of
ExitFailure i -> error $ ("Command failed with status " ++ show i ++
": " ++ cmd ++ show args)
ExitSuccess -> return stdout
 
addThenClearMakesClear :: [String] -> Property
addThenClearMakesClear strings = monadicIO $ do
run $ add strings
run $ clear
contents <- run $ get
assert $ contents == []
 
addNewIsIdempotent :: [String] -> Property
addNewIsIdempotent strings = (and $ map ('\n' `notElem`) strings) ==> monadicIO $ do
run $ clear
run $ addNew strings
contents1 <- run $ get
run $ addNew strings
contents2 <- run $ get
assert $ contents1 == contents2

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.