使用镜头初始化嵌套字段的便捷方法

Convenient ways to initialize nested fields with lenses

我有一些数据类型与普通树非常相似,只是一些特殊形式。

data NestedTree = NT
    { _dummy :: Int
    , _tree  :: HashMap String NestedTree
    } deriving (Show)

makeLenses ''NestedTree

我想使用镜头命令式地初始化我的数据类型的实例。这是我现在得到的:

example :: NestedTree
example = flip execState (NT 0 mempty) $ do
    dummy .= 3
    tree.at "foo" ?= flip execState (NT 0 mempty) (dummy .= 10)

你可以在这个例子中观察到我可以用 (NT 3 mempty) 替换第一个 (NT 0 mempty) 但这不是重点。我想要的是也能够使用这种漂亮的命令式样式来初始化嵌套的 HashMap。更准确地说,我希望能够这样写:

example :: NestedTree
example = flip execState (NT 0 mempty) $ do
    dummy .= 3
    tree.at "foo" ?= flip execState (NT 0 mempty) $ do
        dummy .= 10
        tree.at "foo nested" ?= NT 5 mempty
    tree.at "bar" ?= flip execState (NT 0 mempty) $ do
        dummy .= 15
        tree.at "bar nested" ?= NT (-3) mempty

我的真实数据结构更复杂,仅使用简单的记录来初始化它很快就会变得非常难看。因此我想使用某种 DSL,镜头非常适合我的需要。但是您会注意到上面的代码无法编译。

因为($)的优先级最低,不能只写tree.at "foo" ?= flip execState (NT 0 mempty) $ do。但我真的不想在嵌套的 do 周围添加 ()

是否有任何好的方法可以将任意运算符与 $do 混合使用以编写此类函数?我真的不想引入一些像 wordsAssign = (?=) 这样的助手并调用像

这样的函数

wordsAssign (tree.at "foo") $ flip execState (NT 0 mempty) $ do

因为我喜欢?=运算符。也许我做错了,而我想做的这种事情可以在没有镜头的情况下通过一些手写运算符来完成?

您可以定义自己的 ?=,其优先级与 $ 相同,使它们可以更好地协同工作:

import Control.Lens hiding ((?=))
import qualified Control.Lens as L

(?=)
  :: MonadState s m
  => ASetter s s a (Maybe b) -> b -> m ()
(?=) = (L.?=)

infixr 0 ?=

有了这个你的例子就可以了。

zoom 是 tailor-made 用于处理嵌套状态更新。不幸的是,在你的情况下,Maybe-ness 使它的使用有点尴尬:

example :: NestedTree
example = flip execState (NT 0 mempty) $ do
    dummy .= 3
    zoom (tree.at "foo") $ do
        put (Just (NT 0 mempty))
        _Just.dummy .= 10
        _Just.tree.at "foo nested" ?= NT 5 mempty
    -- Or, using zoom one more time:
    zoom (tree.at "bar") $ do
        put (Just (NT 0 mempty))
        zoom _Just $ do
            dummy .= 15
            tree.at "bar nested" ?= NT (-3) mempty

为了比较,如果不需要在外层插入新键,可以使用ix而不是at并删除所有Maybe-相关样板:

    zoom (tree.ix "foo") $ do
        dummy .= 10
        tree.at "foo nested" ?= NT 5 mempty