Как сравнить программу, указанную в качестве свободной монады, с описанием ожидаемых инструкций?

Question

Так что я пытаюсь сделать что-то вроде романа (я думаю), но я не достаточно опытен в программировании на уровне типов на Хаскелле, чтобы решить это сам.

У меня есть бесплатная монада, описывающая некоторые эффекты, которые нужно выполнить (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 список. Затем соответствующее значение (второй элемент в каждой паре) должно быть возвращено в результате этого эффекта в программу. Если все эффекты совпадают, конечный результат программы должен быть возвращен как Just, Если что-то не совпадает, Nothing должен быть возвращен (позже я расширю это так, чтобы он возвращал информативное сообщение об ошибке).

Конечно это expect кортеж бесполезен, так как его тип - гигантская вещь, которую я не могу написать runTest функция закончена. Основная проблема, с которой я столкнулся, заключается в том, как мне представить эту последовательность ожидаемых намерений таким образом, чтобы я мог написать функцию, которая работает с любой последовательностью для любой программы. Free DSL a,

1. Я смутно знаю о различных продвинутых функциях на уровне типов в Haskell, но у меня пока нет опыта, чтобы знать, какие вещи я должен попытаться использовать.
2. Должен ли я использовать HList или что-то для моего expected последовательность?

Любые намеки на вещи, чтобы посмотреть в с благодарностью.

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