haskell - 用于构建测试数据的monad

Question

好的，所以我试图编写一个monad来构建测试数据，但是我不能完全按照我的要求来运行它。看起来像这样:

runBuildM :: [i] -> BuildM i o x -> [o]
-- Given a list of i, build a list of o.

source :: BuildM i o i
-- Fetch unique i.

yield :: o -> BuildM i o ()
-- Return a new o to the caller.

gather :: BuildM i o x -> BuildM i o o
-- Fetch every possible o from sub-computation.

local :: BuildM i o x -> BuildM i o x
-- Isolate any source invocations from the rest of the code.

换句话说，它是供应单子(monad)，作家单子(monad)和列表单子(monad)。我的想法是，我可以这样写:

build_tests depth = do
  local $ do
    v <- source
    yield v
    yield (map toLower v)
  yield "[]"
  yield "()"
  when (depth > 2) $ do
    t1 <- gather $ build_tests (depth-1)
    yield $ "(" ++ t1 ++ ")"
    yield $ "[" ++ t1 ++ "]"
    t2 <- gather $ build_tests (depth-1)
    yield $ "(" ++ t1 ++ "," ++ t2 ++ ")"

这个想法是生成所有可能的数据组合。您可以仅使用列表推导来完成此操作，但是结果在语法上会令人生畏。这更具可读性。不幸的是，它实际上是行不通的...

问题似乎归结为 local函数的行为不正确。目的是使子计算中的任何 source调用在其外部均无效。 (即，从 source块外部对 local的后续调用再次获得了第一个 token 。)但是，我对 local的实现实际上所做的是为所有内容(即，包括子计算的内容)重置了下一个 token 。这显然是不正确的，但我一生都无法专心于如何使其正常工作。

我在使代码无法按要求工作时遇到了很多麻烦，这可能意味着我的monad的实际内部表示是错误的。有人可以刺痛地正确实现此方法吗？

编辑:我也许应该已经意识到这一点，但是我实际上并没有指定我想要获得的预期结果。上面的代码应该产生以下结果:

["A", "a", "[]", "()", "(A)", "(a)", "[A]", "[a]", "(A, B)", "(A, b)", "(a, B)", "(a, b)"]

结果按此顺序出现并不是 super 关键。我希望单个案例出现在复合案例之前，但是我不太在意这些案例出现的顺序。规则是，同一变量在任何单个表达式中都不会出现两次。

如果我们允许深度更深一些，我们还会得到诸如

"((A))", "([A])", "[(A)]", "((A, B), C)", "(A, (B, C))"

等等。

它显然已经坏了，但是到目前为止，这是我得到的:

newtype BuildM i o x = BuildM ([i] -> SEQ.Seq ([i], SEQ.Seq o, x))

instance Functor (BuildM i o) where
  fmap uf (BuildM sf) =
    BuildM $ \ is0 -> do
      (is1, os, x) <- sf is0
      return (is1, os, uf x)

instance Applicative (BuildM i o) where
  pure x = BuildM $ \ is0 -> return (is0, SEQ.empty, x)

  BuildM sf1 <*> BuildM sf2 =
    BuildM $ \ is1 -> do
      (is2, os2, f) <- sf1 is1
      (is3, os3, x) <- sf2 is2
      return (is3, os2 >< os3, f x)

instance Monad (BuildM i o) where
  return = pure

  BuildM sf1 >>= uf =
    BuildM $ \ is1 -> do
      (is2, os2, x) <- sf1 is1
      let BuildM sf2 = uf x
      (is3, os3, y) <- sf2 is2
      return (is3, os2 >< os3, y)

runBuildM :: [i] -> BuildM i o x -> [o]
runBuildM is0 (BuildM sf) =
  toList $ do
    (is, os, x) <- sf is0
    os

source :: BuildM i o i
source =
  BuildM $ \ is ->
    if null is
      then error "AHC.Tests.TestBuilder.source: end of input"
      else return (tail is, SEQ.empty, head is)

yield :: o -> BuildM i o ()
yield o = BuildM $ \ is -> return (is, SEQ.singleton o, () )

gather :: BuildM i o x -> BuildM i o' o
gather (BuildM sf1) =
  BuildM $ \ is1 -> do
    (is2, os2, _) <- sf1 is1
    o <- os2
    return (is2, SEQ.empty, o)

local :: BuildM i o x -> BuildM i o ()
local (BuildM sf1) =
  BuildM $ \ is1 ->
    let os = do (is2, os2, x) <- sf1 is1; os2
    in  return (is1, os, () )

Answer 1

您正在尝试重塑pipes和一些nice syntax for building lists。这个问题比您的特征要简单得多。字符串的来源可以与构建结构完全分开。

您想要生成从某些来源绘制符号的结构。不用担心源代码，让我们构建结构。每个结构都是一个Pipe，它将从某些源字符串和yield字符串中提取出来以连接在一起以构建表达式。

import Data.Char

import Data.Functor.Identity

import Pipes.Core
import Pipes ((>->))
import qualified Pipes as P
import qualified Pipes.Prelude as P

build_structures :: Int -> [Pipe String String Identity ()]
build_structures depth = gather $ do
    yield $ P.take 1
    yield $ P.map (map toLower) >-> P.take 1
    when (depth > 2) $ do
        t1 <- lift $ build_structures (depth - 1)
        yield $ P.yield "(" >> t1 >> P.yield ")"
        yield $ P.yield "[" >> t1 >> P.yield "]"
        t2 <- lift $ build_structures (depth - 1)
        yield $ P.yield "(" >> t1 >> P.yield "," >> t2 >> P.yield ")"

这段代码使用了接续答案中的 ContT yield trick。

我们通过向其中提供符号并连接结果来运行这些结构之一。

run :: Pipe String String Identity () -> String
run p = concat . P.toList $ P.each symbols >-> p

-- an infinite source of unique symbols
symbols :: [String]
symbols = drop 1 symbols'
    where
        symbols' = [""] ++ do
            tail <- symbols'
            first <- ['A'..'Z']
            return (first : tail)

这些示例将生成所需的字符串。作为练习，我将剩下的两个特殊情况 "[]"和 "()"都以递归形式出现。

import Data.Functor

main = do
    putStrLn "Depth 2"
    print $ run <$> build_structures 2
    putStrLn "Depth 3"
    print $ run <$> build_structures 3
    putStrLn "Depth 4"
    print $ run <$> build_structures 4

这导致

Depth 2
["A","a"]
Depth 3
["A","a","(A)","[A]","(A,B)","(A,b)","(a)","[a]","(a,B)","(a,b)"]
Depth 4
["A","a","(A)","[A]","(A,B)","(A,b)","(A,(B))","(A,[B])","(A,(B,C))","(A,(B,c))","(A,(b))","(A,[b])","(A,(b,C))","(A,(b,c))","(a)","[a]","(a,B)","(a,b)","(a,(B))","(a,[B])","(a,(B,C))","(a,(B,c))","(a,(b))","(a,[b])",...