How do I compare a program specified as a free monad against a description of expected instructions?

Question

So I'm trying to do something that's kind of novel (I think), but I'm not experienced enough with Haskell type-level programming to work it out myself.

I've got a free monad describing some effects to perform (an AST, if that's the way you roll), and I want to interpret it against some description of the effects that are expected.

Here's my code so far::

{-# LANGUAGE DeriveFunctor, FlexibleInstances, GADTs, FlexibleContexts #-}
import Control.Monad.Free -- from package 'free'

data DSL next
    = Prompt String (String -> next)
    | Display String next
    deriving (Show, Functor)

prompt p = liftF (Prompt p id)
display o = liftF (Display o ())

-- |Just to make sure my stuff works interactively
runIO :: (Free DSL a) -> IO a
runIO (Free (Prompt p cont)) = do
    putStr p
    line <- getLine
    runIO (cont line)
runIO (Free (Display o cont)) = do putStrLn o; runIO cont
runIO (Pure x) = return x

That's the "core" code. Here's an example program:

greet :: (Free DSL ())
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 ++ ".")

To test this program, I want to use a function runTest :: Free DSL a -> _ -> Maybe a, which should take a program and some specification of "expected effects" vaguely like this:

expect = (
    (Prompt' "Enter your name:", "radix"),
    (Display' "Why hello there, radix.", ()),
    (Prompt' "And what is your friend's name?", "Bob"),
    (Display' "It's good to meet you too, Bob.", ()))

and interpret the program by matching each effect that it performs against the next item in the expect list. Then the associated value (the second item in each pair) should be returned as the result of that effect to the program. If all the effects match, the final result of the program should be returned as a Just. If something doesn't match, Nothing should be returned (later I'll expand this so that it returns an informative error message).

Of course this expect tuple is useless, since its type is a big giant thing that I can't write a generic runTest function over. The main problem I'm having is how I should represent this sequence of expected intents in a way that I can write a function that works with any sequence against any program Free DSL a.

1. I'm vaguely aware of various advanced type-level features in Haskell, but I'm not yet experienced to know which things I should try to use.
2. Should I be using an HList or something for my expected sequence?

Any hints for things to look into are greatly appreciated.

Answer 1

A test for a program Free f a is just an interpreter for the program Free f a -> r producing some result r

What you are looking for is an easy way to build interpreters for the program that assert that the outcome of the program is what you expected. Each step of the interpreter will either unwrap a Free f instruction from the program or describe some error. They'll have the type

Free DSL a -> Either String (Free DSL a)
|                    |       ^ the remaining program after this step
|                    ^ a descriptive error
^ the remaining program before this step

We'll make a test for each of the constructors in the DSL. prompt' expects a Prompt with a specific value and provides the response value to the function to find what's next.

prompt' :: String -> String -> Free DSL a -> Either String (Free DSL a)
prompt' expected response f =
    case f of
        Free (Prompt p cont) | p == expected -> return (cont response)
        otherwise                            -> Left $ "Expected (Prompt " ++ show expected ++ " ...) but got " ++ abbreviate f

abbreviate :: Free DSL a -> String
abbreviate (Free (Prompt  p _)) = "(Free (Prompt "  ++ show p ++ " ...))"
abbreviate (Free (Display p _)) = "(Free (Display " ++ show p ++ " ...))"
abbreviate (Pure _)             = "(Pure ...)"

display' expects a Display with a specific value.

display' :: String -> Free DSL a -> Either String (Free DSL a)
display' expected f =
    case f of
        Free (Display p next) | p == expected -> return next
        otherwise                             -> Left $ "Expected (Display " ++ show expected ++ " ...) but got " ++ abbreviate f

pure' expects a Pure with a specific value

pure' :: (Eq a, Show a) => a -> Free DSL a -> Either String ()
pure' expected f = 
    case f of
        Pure a | a == expected -> return ()
        otherwise              -> Left $ "Expected " ++ abbreviate' (Pure expected) ++ " but got " ++ abbreviate' f

abbreviate' :: Show a => Free DSL a -> String
abbreviate' (Pure a) = "(Pure " ++ showsPrec 10 a ")"
abbreviate' f        = abbreviate f

With prompt' and display' we can easily build an interpreter in the style of expect.

expect :: Free DSL a -> Either String (Free DSL a)
expect f = return f >>=
           prompt' "Enter your name:" "radix" >>=
           display' "Why hello there, radix." >>=
           prompt' "And what is your friend's name?" "Bob" >>=
           display' "It's good to meet you too, Bob."

Running this test

main = either putStrLn (putStrLn . const "Passed") $ expect greet

Results in a failure

Expected (Prompt "Enter your name:" ...) but got (Free (Prompt "Enter your name: " ...))

Once we change the test to expect spaces at the end of the prompts

expect :: Free DSL a -> Either String (Free DSL a)
expect f = return f >>=
           prompt' "Enter your name: " "radix" >>=
           display' "Why hello there, radix." >>=
           prompt' "And what is your friend's name? " "Bob" >>=
           display' "It's good to meet you too, Bob."

Running it results in

Passed