用于构建测试数据的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.

换句话说,它是一个供应单子,作家单子和列表单子.我的想法是我可以这样写:

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块再次拿到的第一个标记.)然而,什么我执行local 实际上做的是将下一令牌一切(即包括子计算的内容).这显然是不正确的,但我不能为我的生活弯曲我的思想如何使其正常工作.

事实上,我在使代码按要求工作时遇到这个问题可能意味着我的monad的实际内部表示是错误的.任何人都可以正确地实施这个吗？

---

编辑:我或许应该意识到这一点,但我实际上没有指定我想要的预期结果.上面的代码应该产生这个:

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

结果恰好按此顺序出现并不是至关重要的.我希望单个案例出现在复合案例之前,但我并不太确定化合物出现的顺序.规则是相同的变量在任何单个表达式中都不会出现两次.

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

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

您正在尝试重新发明管道和一些用于构建列表的好语法。这个问题比你如何描述它要简单得多。弦的来源可以与结构的构建完全分开。

您想要生成从某些来源绘制符号的结构。不用担心来源，让我们构建结构。每个结构都是一个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 ")"

这段代码使用了后续答案中的ContTyield技巧。

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

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