Question

我一直在玩“freer monads” and extensible effects，在freer-effects包中实现，我遇到了一个似乎可行的问题，但我遇到了解决问题。

我写了一个代表与文件系统简单交互的类型：

data FileSystem v where
  ReadFile :: FilePath -> FileSystem String
  WriteFile :: FilePath -> String -> FileSystem ()

在IO中为此编写解释器很容易，但很无聊。我真正感兴趣的是编写一个内部使用State的纯解释器。我可以有效地将runState的实现内联到FileSystem的解释器中，但这似乎有点打败了目的。我真正希望能够做的就是在这两种类型之间编写转换，然后重用State解释器。

编写这样的转换很简单：

fsAsState :: forall v r. FileSystem v -> Eff (State [(FilePath, String)] ': r) v fsAsState (ReadFile a) = (lookup a <$> get) >>= maybe (fail "readFile: file does not exist") return fsAsState (WriteFile a b) = modify $ \fs -> (a, b) : filter ((/= a) . fst) fs

现在我想要一个通用的reencode函数，它可以接受我的fsAsState转换，并通过重用FileSystem解释器来使用它来解释我的State。有了这样的功能，我就可以编写以下解释器了：

runInMemoryFS :: forall r w. [(FilePath, String)] -> Eff (FileSystem ': r) w -> Eff r (w, [(FilePath, String)]) runInMemoryFS fs m = runState (reencode fsAsState m) fs

棘手的是实际实施reencode。我已经得到了几乎 typechecks的东西：

reencode :: forall r w f g. (forall v. f v -> Eff (g ': r) v) -> Eff (f ': r) w -> Eff (g ': r) w reencode f m = loop m where loop :: Eff (f ': r) w -> Eff (g ': r) w loop (Val x) = return x loop (E u q) = case decomp u of Right x -> qComp q loop =<< f x Left u' -> E (weaken u') undefined

不幸的是，在E的最后一个案例中，我无法弄清楚如何向loop提供第二个参数。我不认为我理解优化FTCQueue类型如何工作的实现细节，以便了解我在这里需要做的事情是否简单，或者我正在做什么是不可能的。

这可能吗？如果答案是否定的，事实证明我正在做的事情，实际上是不可能的，我会感兴趣的是一个解释来帮助我理解原因。

Answer 1

免责声明：下面的类型检查，但我还没试过运行它。

您需要走q（来自E u q模式匹配），并将其所有步骤从Eff (f ': r)转移到Eff (g ': r)。我们可以多态地编写这种遍历：

shiftQ :: forall m n a b. (forall a. m a -> n a) -> FTCQueue m a b -> FTCQueue n a b
shiftQ shift q = case tviewl q of
    TOne act -> tsingleton (shift . act)
    act :| q -> go (tsingleton (shift . act)) q
  where
    go :: forall a b c. FTCQueue n a b -> FTCQueue m b c -> FTCQueue n a c
    go q' q = case tviewl q of
        TOne act -> q' |> (shift . act)
        act :| q -> go (q' |> (shift . act)) q

（它有点尴尬，因为我们只能snoc而且只能解开FTCQueue s。

然后我们可以将reencode本身作为reencode f传递给shift使用它：

reencode :: forall r w f g. (forall v. f v -> Eff (g ': r) v) -> Eff (f ': r) w -> Eff (g ': r) w
reencode f m = loop m
  where
    loop :: Eff (f ': r) w -> Eff (g ': r) w
    loop (Val x) = return x
    loop (E u q) = case decomp u of
      Right x -> qComp q loop =<< f x
      Left u' -> E (weaken u') (shiftQ (reencode f) q)

使用更自由的可扩展效果对另一个进行编码效果

1 个答案: