如何将指定为自由 monad 的程序与预期指令的描述进行比较？

Question

所以我正在尝试做一些新颖的事情（我认为），但我不是对 Haskell 类型级编程有足够的经验，可以自己解决。

我有一个免费的 monad 描述了一些要执行的效果（一个 AST，如果那是你滚动的方式），我想根据一些描述来解释它预期效果。

到目前为止，这是我的代码::

{-# 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

那是 "core" 代码。这是一个示例程序：

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 ++ ".")

为了测试这个程序，我想使用一个函数 runTest :: Free DSL a -> _ -> Maybe a，它应该包含一个程序和一些 "expected effects" 的规范，大致如下：

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.", ()))

并通过将程序执行的每个效果与 expect 列表中的下一项相匹配来解释程序。然后关联值（每对中的第二项）应作为该效果的结果返回给程序。如果所有效果都匹配，则程序的最终结果应作为 Just 返回。如果不匹配，应该返回 Nothing（稍后我将扩展它以便它 returns 一条信息性错误消息）。

当然这个 expect 元组是无用的，因为它的类型是一个巨大的东西，我不能写一个通用的 runTest 函数。我遇到的主要问题是我应该如何以一种我可以编写一个函数来表示这个预期意图序列的方式，该函数可以针对任何程序使用任何序列 Free DSL a.

我隐约知道 Haskell 中的各种高级类型级功能，但我还没有经验知道我应该尝试使用哪些东西。
我应该为我的 expected 序列使用 HList 或其他东西吗？

非常感谢任何关于需要调查的提示。

Answer 1

程序Free f a的测试只是程序Free f a -> r的解释器，产生一些结果r

您正在寻找的是一种简单的方法来为程序构建解释器，断言程序的结果符合您的预期。解释器的每一步都会从程序中解包一个 Free f 指令，或者描述一些错误。他们的类型是

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

我们将对 DSL 中的每个构造函数进行测试。 prompt' 需要具有特定值的 Prompt 并将响应值提供给函数以查找下一个内容。

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' 需要具有特定值的 Display。

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' 期望 Pure 具有特定值

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

使用 prompt' 和 display' 我们可以很容易地构建一个 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."

运行本次测试

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

结果失败

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

一旦我们将测试更改为期望提示末尾有空格

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."

运行结果是

Passed

如何将指定为自由 monad 的程序与预期指令的描述进行比较？

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

interpreter

haskell

types

free-monad