我可以使用Monad约束制作镜头吗？

Question

上下文:这个问题具体参考Control.Lens(撰写本文时的版本3.9.1)

我一直在使用镜头库,能够读取和写入结构的一块(或遍历的碎片)是非常好的.然后我讨论了是否可以使用镜头来对抗外部数据库.当然,我需要在执行中执行IO Monad.所以概括:

题:

鉴于一个吸气剂(s -> m a)和一个定位器(b -> s -> m t)在哪里m是Monad,是否可以构造Lens s t a b镜头的Functor现在也包含在Monad中？是否仍然可以(.)与其他"纯功能"镜头组合使用？

例:

我可以让Lens (MVar a) (MVar b) a b 使用readMVar和withMVar？

替代方案:

对于IOmonad中的容器是否有等效的Control.Lens,如MVar或IORef(或STDIN)？

Answer 1

我一直在考虑这个想法,我称之为可变镜头.到目前为止,如果你从中受益,我还没有把它变成一个包,让我知道.

首先让我们回顾一下通用的van Laarhoven镜头(在我们稍后需要进行一些进口之后):

{-# LANGUAGE RankNTypes #-}
import qualified Data.ByteString as BS
import           Data.Functor.Constant
import           Data.Functor.Identity
import           Data.Traversable (Traversable)
import qualified Data.Traversable as T
import           Control.Monad
import           Control.Monad.STM
import           Control.Concurrent.STM.TVar

type Lens s t a b = forall f . (Functor f) => (a -> f b) -> (s -> f t)
type Lens' s a = Lens s s a a

我们可以用"吸气剂"和"定型器"来制造这样的镜头

mkLens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
mkLens g s  f x = fmap (s x) (f (g x))

然后从镜头中取出"吸气剂"/"定型器"

get :: Lens s t a b -> (s -> a)
get l = getConstant . l Constant

set :: Lens s t a b -> (s -> b -> t)
set l x v = runIdentity $ l (const $ Identity v) x

例如,以下镜头访问一对中的第一个元素:

_1 :: Lens' (a, b) a
_1 = mkLens fst (\(x, y) x' -> (x', y))
-- or directly: _1 f (a,c) = (\b -> (b,c)) `fmap` f a

现在可变透镜应该如何工作？获取某些容器的内容涉及一个monadic动作.设置一个值不会改变容器,它保持不变,就像一块可变的内存一样.因此,可变镜头的结果必须是monadic,而不是t我们将拥有的返回型容器().而且,Functor约束是不够的,因为我们需要将它与monadic计算交织.因此,我们需要Traversable:

type MutableLensM  m s  a b
    = forall f . (Traversable f) => (a -> f b) -> (s -> m (f ()))
type MutableLensM' m s  a
    = MutableLensM m s a a

(Traversable是monadic计算什么Functor是纯计算).

我们再次创建辅助函数

mkLensM :: (Monad m) => (s -> m a) -> (s -> b -> m ())
        -> MutableLensM m s a b
mkLensM g s  f x = g x >>= T.mapM (s x) . f


mget :: (Monad m) => MutableLensM m s a b -> s -> m a
mget l s = liftM getConstant $ l Constant s

mset :: (Monad m) => MutableLensM m s a b -> s -> b -> m ()
mset l s v = liftM runIdentity $ l (const $ Identity v) s

举个例子,让我们从TVar内部创建一个可变镜头STM:

alterTVar :: MutableLensM' STM (TVar a) a
alterTVar = mkLensM readTVar writeTVar

这些透镜片面直接与组合的Lens,例如

alterTVar . _1 :: MutableLensM' STM (TVar (a, b)) a

笔记:

• 如果我们允许修改功能包括效果,可变透镜可以变得更强大:

  type MutableLensM2  m s  a b
      = (Traversable f) => (a -> m (f b)) -> (s -> m (f ()))
  type MutableLensM2' m s  a
      = MutableLensM2 m s a a
  
  mkLensM2 :: (Monad m) => (s -> m a) -> (s -> b -> m ())
           -> MutableLensM2 m s a b
  mkLensM2 g s  f x = g x >>= f >>= T.mapM (s x)
  

  但是,它有两个主要缺点:

  1. 它不能与纯粹组合Lens.
  2. 由于内部动作是任意的,它允许你通过在变异操作本身期间改变这个(或其他)镜头来拍摄自己的脚.

• monadic镜片还有其他可能性.例如,我们可以创建一个monadic copy-on-write镜头来保留原始容器(就像那样Lens),但是操作涉及一些monadic动作:

  type LensCOW m s t a b
      = forall f . (Traversable f) => (a -> f b) -> (s -> m (f t))
  

• 我已经制作了jLens - 一个用于可变镜头的Java库,但API当然远不如Haskell镜头那么好.

Answer 2

不，您不能将“镜头功能”限制为Monad。a的类型Lens要求它与所有Functors 兼容：

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

这在英语中类似于：A Lens是一个函数，对于所有类型f，其中fa是a Functor，取a (a -> f b)并返回an s -> f t。关键在于它必须为每个函数提供这种功能Functor f，而不仅仅是它们中某些恰好是Monads的子集。

编辑：

您可以制作一个Lens (MVar a) (MVar b) a b，因为都不存在s t a或b受限制。那么，构造它的getter和setter上的类型是什么？(MVar a -> a)我相信只能将getter的类型实现为该类型\_ -> undefined，因为除了as之外，没有其他东西可以从MVar中提取值IO a。设置器将是(MVar a -> b -> MVar b)，我们也无法定义它，因为没有任何东西可以使MVaras 成为除外IO (MVar b)。

这表明，相反，我们可以改成类型Lens (MVar a) (IO (MVar b)) (IO a) b。这将是一条有趣的途径，可以进一步使用一些我现在没有的实际代码和编译器。要将其与其他“纯功能性”镜头结合使用，我们可能需要某种举升机构将其举升为monad，例如liftLM :: (Monad m) => Lens s t a b -> Lens s (m t) (m a) b。

编译的代码（第二次编辑）：

为了能够使用Lens s t a bas，Getter s a我们必须有s ~ tand a ~ b。这限制了我们的有用的镜片类型解除对一些Monad以最广泛的类型s，并t与最广泛的类型a和b。如果我们用b ~ a可能的类型代替，我们会拥有Lens (MVar a) (IO (MVar a)) (IO a) a，但是我们仍然需要MVar a ~ IO (MVar a)和IO a ~ a。我们将每种类型的类型进行选择Lens (IO (MVar a)) (IO (MVar a)) (IO a) (IO a)，然后选择Control.Lens.Lens让我们编写为Lens' (IO (MVar a)) (IO a)。按照这一思路，我们可以制作一个完整的系统，将“纯功能性”镜片与单价镜片组合在一起。提起“纯功能”镜头的操作，liftLensM其类型为(Monad m) => Lens' s a -> LensF' m s a，其中LensF' f s a ~ Lens' (f s) (f a)。

{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}

module Main (
    main
) where

import Control.Lens
import Control.Concurrent.MVar

main = do
    -- Using MVar
    putStrLn "Ordinary MVar"
    var <- newMVar 1
    output var
    swapMVar var 2
    output var

    -- Using mvarLens
    putStrLn ""
    putStrLn "MVar accessed through a LensF' IO"
    value <- (return var) ^. mvarLens
    putStrLn $ show value 
    set mvarLens (return 3) (return var)
    output var

    -- Debugging lens
    putStrLn ""
    putStrLn "MVar accessed through a LensF' IO that also debugs"
    value <- readM (debug mvarLens) var
    putStrLn $ show value 
    setM (debug mvarLens) 4 var
    output var 

    -- Debugging crazy box lens
    putStrLn ""
    putStrLn "MVar accessed through a LensF' IO that also debugs through a Box that's been lifted to LensF' IO that also debugs"
    value <- readM ((debug mvarLens) . (debug (liftLensM boxLens))) var
    putStrLn $ show value 
    setM ((debug mvarLens) . (debug (liftLensM boxLens))) (Box 5) var
    output var 

    where
        output = \v -> (readMVar v) >>= (putStrLn . show)

-- Types to write higher lenses easily

type LensF f s t a b = Lens (f s) (f t) (f a) (f b)

type LensF' f s a = Lens' (f s) (f a)

type GetterF f s a = Getter (f s) (f a)

type SetterF f s t a b = Setter (f s) (f t) (f a) (f b) 

-- Lenses for MVars

setMVar :: IO (MVar a) -> IO a -> IO (MVar a)
setMVar ioVar ioValue = do
    var <- ioVar
    value <- ioValue
    swapMVar var value
    return var

getMVar :: IO (MVar a) -> IO a
getMVar ioVar = do
    var <- ioVar
    readMVar var
-- (flip (>>=)) readMVar 

mvarLens :: LensF' IO (MVar a) a
mvarLens = lens getMVar setMVar       

-- Lift a Lens' to a Lens' on monadic values           

liftLensM :: (Monad m) => Lens' s a -> LensF' m s a
liftLensM pureLens = lens getM setM
    where
        getM mS = do
            s <- mS
            return (s^.pureLens)
        setM mS mValue = do
            s <- mS
            value <- mValue
            return (set pureLens value s)


-- Output when a Lens' is used in IO 

debug :: (Show a) => LensF' IO s a -> LensF' IO s a 
debug l = lens debugGet debugSet
    where
        debugGet ioS = do
            value <- ioS^.l
            putStrLn $ show $ "Getting " ++ (show value)
            return value
        debugSet ioS ioValue = do
            value <- ioValue
            putStrLn $ show $ "Setting " ++ (show value)
            set l (return value) ioS

-- Easier way to use lenses in a monad (if you don't like writing return for each argument)

readM :: (Monad m) => GetterF m s a -> s -> m a
readM l s = (return s) ^. l

setM :: (Monad m) => SetterF m s t a b -> b -> s -> m t
setM l b s = set l (return b) (return s)

-- Another example lens

newtype Boxed a = Box {
    unBox :: a
} deriving Show

boxLens :: Lens' a (Boxed a) 
boxLens = lens Box (\_ -> unBox)

此代码产生以下输出：

Ordinary MVar
1
2

MVar accessed through a LensF' IO
2
3

MVar accessed through a LensF' IO that also debugs
"Getting 3"
3
"Setting 4"
4

MVar accessed through a LensF' IO that also debugs through a Box that's been lifted to LensF' IO that also debugs
"Getting 4"
"Getting Box {unBox = 4}"
Box {unBox = 4}
"Setting Box {unBox = 5}"
"Getting 4"
"Setting 5"
5

有可能是一个更好的方式来写liftLensM，而不诉诸使用lens，(^.)，set和do符号。通过提取getter和setter并调用lens新的getter和setter来构建镜头似乎有些错误。

我无法弄清楚如何将镜头既用作吸气剂又用作吸气剂。readM (debug mvarLens)并且setM (debug mvarLens)都工作得很好，但像任何结构“让debugMVarLens =调试mvarLens”失去要么它可以作为一个事实Getter，它可以作为一个事实Setter，或者说知识Int是一个实例show，因此我可以使用debug。我希望看到一种编写此部分的更好方法。