所以我正在尝试做一些小说（我想），但我不是
经验丰富的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
这是“核心”代码。这是一个示例程序：
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，这应该采取一个程序和“预期效果”的一些规范模糊地像这样：
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 名单。然后应该将相关值（每对中的第二项）作为该效果的结果返回给程序。如果所有效果都匹配，则程序的最终结果应作为a返回 Just。如果有什么不匹配， Nothing 应该返回（稍后我将展开它，以便它返回一条信息性的错误消息）。
当然这个 expect 元组是没用的，因为它的类型是一个巨大的东西，我不能写一个泛型 runTest 功能结束。我遇到的主要问题是我应该如何表达这个预期意图序列，我可以编写一个函数，可以对任何程序使用任何序列 Free DSL a。
- 我隐约知道Haskell中的各种高级类型级功能，但我还没有经验知道应该尝试使用哪些东西。
- 我应该使用HList还是其他东西
expected 序列？
我们非常感谢任何有关事物的提示。
对程序的测试 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