是否有基于 Monad 类型类的 van Laarhoven 光学器件？

Question

据我了解，每个 van Laarhoven 光学类型都可以通过类型构造函数的约束来定义：

type Lens      s t a b = forall f. Functor f     => (a -> f b) -> s -> f t
type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
-- etc.

如果我们选择Monad作为约束，它是否以有意义的方式形成某种“光学”？

type Something s t a b = forall f. Monad f => (a -> f b) -> s -> f t

我的直觉是，Monad约束可能过于严格，无法从这样的结构中获取任何值：由于Const函子不是 a Monad，我们无法通过专门化ftoConst来派生view类似函数。尽管如此，我们仍然可以用这种类型做一些Something事情；我只是不清楚我们是否可以用它做任何特别有用的事情。

我很好奇的原因是 van Laarhoven 光学器件的类型与修改“可变引用”类型（如 ）的函数类型非常相似IORef。例如，我们可以轻松实现

modifyIORefM :: MonadIO m => IORef a -> (a -> m a) -> () -> m ()

当部分应用于 时IORef，其形状为

type SomethingIO s t a b = forall f. MonadIO f => (a -> f b) -> s -> f t

哪里a = b和s = t = (). 我不确定这是一个有意义的巧合还是毫无意义的巧合。

Answer 1

实际上，这样的光学器件有点不方便Traversal。

这是因为，实际上，我们使用Traversal：

type Traversal s t a b = forall f. (Applicative f) => (a -> f b) -> (s -> f t)

为了两件事。a从 an获取 s 的列表s，我们可以使用Const函子来实现：

toListOf :: Traversal s t a b -> s -> [a]
toListOf t = getConst . t (Const . (:[]))

并将 s 替换a为bs 将 变成sa t。一种方法是使用仿函数，并忽略s 和sState的计数匹配问题，我们有：ab

setListOf :: Traversal s t a b -> [b] -> s -> t
setListOf t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs

如果我们有一个使用Monad约束的光学器件：

type TraversalM s t a b = forall f. (Monad f) => (a -> f b) -> (s -> f t)

我们仍然可以执行这两个操作。由于State是一个 monad，setListOf操作可以使用相同的实现：

setListOfM :: Traversal s t a b -> [b] -> s -> t
setListOfM t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs

对于toListOf，没有 的Monad实例Const [a]，但我们可以使用Writermonad 来提取a值，只要我们有一个虚拟b值以使类型检查器满意：

toListOfM :: TraversalM s t a b -> b -> s -> [a]
toListOfM t dummy_b s = execWriter (t (\a -> tell [a] >> pure dummy_b) s)

或者，因为 Haskell 有底部：

toListOfM' :: TraversalM s t a b -> s -> [a]
toListOfM' t s = execWriter (t (\a -> tell [a] >> pure undefined) s)

独立代码：

import Data.Functor.Const
import Control.Monad.State
import Control.Monad.Writer

type Traversal s t a b = forall f. (Applicative f) => (a -> f b) -> (s -> f t)

toListOf :: Traversal s t a b -> s -> [a]
toListOf t = getConst . t (Const . (:[]))

setListOf :: Traversal s t a b -> [b] -> s -> t
setListOf t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs

type TraversalM s t a b = forall f. (Monad f) => (a -> f b) -> (s -> f t)

toListOfM :: TraversalM s t a b -> b -> s -> [a]
toListOfM t dummy_b s = execWriter (t (\a -> tell [a] >> pure dummy_b) s)

toListOfM' :: TraversalM s t a b -> s -> [a]
toListOfM' t s = execWriter (t (\a -> tell [a] >> pure undefined) s)

setListOfM :: TraversalM s t a b -> [b] -> s -> t
setListOfM t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs

listItems :: Traversal [a] [b] a b
listItems = traverse

listItemsM :: TraversalM [a] [b] a b
listItemsM = mapM

main = do
  -- as a getter
  print $ toListOf listItems [1,2,3]
  print $ toListOfM listItemsM 99 [1,2,3]  -- dummy value
  print $ toListOfM' listItemsM [1,2,3]    -- use undefined
  -- as a setter
  print $ setListOf listItems [4,5,6] [1,2,3]
  print $ setListOfM listItemsM [4,5,6] [1,2,3]