Skip to content

Instantly share code, notes, and snippets.

@radix
Created September 20, 2015 21:07
Show Gist options
  • Save radix/44bbeb2e472f119b1c69 to your computer and use it in GitHub Desktop.
Save radix/44bbeb2e472f119b1c69 to your computer and use it in GitHub Desktop.
Testing effectful programs in Haskell, take 2
-- With much thanks to Cirdec of Stack Overflow: http://stackoverflow.com/questions/32673144/how-do-i-compare-a-program-specified-as-a-free-monad-against-a-description-of-ex
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ViewPatterns #-}
import Text.Show.Functions
import Control.Monad.Operational
-- Core effect definition
data Intent result where
Prompt :: String -> Intent String
Display :: String -> Intent ()
deriving instance Show (Intent result)
type MyEffect a = Program Intent a
prompt p = singleton (Prompt p)
display o = singleton (Display o)
-- |run programs in the real world
runIO :: MyEffect a -> IO a
runIO (view -> (Return x)) = return x
runIO (view -> (Prompt p :>>= cont)) = do
putStr p
line <- getLine
runIO (cont line)
runIO (view -> (Display o :>>= cont)) = do putStrLn o; runIO (cont ())
-- |A sample program
greet :: MyEffect String
greet = do
name <- prompt "Enter your name: "
let greeting = "Why hello there, " ++ name ++ "."
display greeting
friendName <- prompt "And what is your friend's name? "
display ("It's good to meet you too, " ++ friendName ++ ".")
return "blacrg"
-- Testing API
-- |Check if the next instruction is a Prompt with the given parameter,
-- and simulate returning a value.
checkPrompt :: String -> String -> MyEffect a -> Either String (MyEffect a)
checkPrompt expected response prog =
case view prog of
(Prompt p :>>= cont)
| p == expected -> Right (cont response)
(intent :>>= cont) -> Left $ "Expected (Prompt " ++ show expected ++ ") Got (" ++ show intent ++ ")"
-- |Check if the next instruction is a Display with the given parameter
checkDisplay :: String -> MyEffect a -> Either String (MyEffect a)
checkDisplay expected prog =
case view prog of
(Display o :>>= cont)
| o == expected -> Right (cont ())
(intent :>>= cont) -> Left $ "Expected (Display " ++ show expected ++ ") Got (" ++ show intent ++ ")"
-- |Check if the next instruction is a Return with the given parameter
checkReturn :: (Eq a, Show a) => a -> MyEffect a -> Either String ()
checkReturn expected prog =
case view prog of
Return x | x == expected -> Right ()
| otherwise -> Left $ "Expected (Return " ++ show expected ++ ") Got (Return " ++ show x ++ ")"
-- Finally, the test case for the `greet` program.
testGreet prog =
Right prog >>=
checkPrompt "Enter your name: " "radix" >>=
checkDisplay "Why hello there, radix." >>=
checkPrompt "And what is your friend's name? " "Bob" >>=
checkDisplay "It's good to meet you too, Bob." >>=
checkReturn "blacrg"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment