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

Итак, я пытаюсь сделать что-то такое роман (я думаю), но я не достаточно опытный с программированием уровня Haskell для самостоятельной работы.

У меня есть свободная монада, описывающая некоторые эффекты для выполнения (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 name? "
    display ("It 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 name?", "Bob"),
    (Display' "It good to meet you too, Bob.", ()))

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

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

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

Любые подсказки для вещей, которые нужно изучить, очень ценятся.

Ответы

Ответ 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' ожидает a 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' ожидает a 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 name?" "Bob" >>=
           display' "It 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 name? " "Bob" >>=
           display' "It good to meet you too, Bob."

Выполнение этого результата приводит к

Passed