在 Haskell 中构建组合自参照透镜

Posted 2023-02-19

【中文标题】在 Haskell 中构建组合自参照透镜

【英文标题】：Constructing compositional self-referential lenses in Haskell

【发布时间】：2021-09-22 23:50:21

【问题描述】：

包含自引用的数据并不少见。这肯定会出现在命令式编程中，但它也可以出现在 Haskell 中。例如，可以将IORefs 或STRefs 作为指向数据类型本身的数据类型中的字段（并且可以使用RecursiveDo 语法或mfix 在构造上“打结”） .

我想知道是否可以使用镜头做类似的事情。

假设我有一些 s 类型的状态和一个从 s 到包含在该状态中的一些数据的镜头。我希望包含的数据本身可以访问这个镜头，或者换句话说，我希望状态中的数据类似于：

import Data.Lens

data Foo s = Foo
   self :: Lens' s (Foo s)
  , fooData :: Int
  

-- A silly `Show` instance so that we can print a few things
instance Show (Foo s) where
  show Foo.. = "Foo <lens> "<>show fooData

这使用起来有点困难，但可以使用 Fix 类型，例如：

newtype Fix f = Fix  unFix :: f (Fix f) 

fixIso :: Iso' (Fix f) (f (Fix f))
fixIso = iso unFix Fix

现在，我可以设置以下值：

myFoo :: Foo (Fix Foo)
myFoo = Foo fixIso 2

这里，我们有一个类型为 Foo (Fix Foo) 的值，带有一个从其状态到自身的镜头。

我还可以创建一对Foos（通过使用:*: 来自Generics）：

import GHC.Generics ((:*:)(..))

pairOfFoo :: (Foo :*: Foo) (Fix (Foo :*: Foo))
pairOfFoo = Foo (fixIso . _1) 2 :*: Foo (fixIso . _2) 4

这基本上是可行的，如下所示：

> pairOfFoo ^. _1
Foo <lens> 2
> pairOfFoo ^. _2
Foo <lens> 4
> Fix pairOfFoo ^. (self $ pairOfFoo ^. _1)
Foo <lens> 2

更大的问题是感觉我应该能够从myFoocompositionally创建pairOfFoo，但我不知道该怎么做。也就是说，我想写这样的东西：

pairOf :: (Extendable x, Extendable y) => x (Fix x) -> y (Fix y) -> (x :*: y) (Fix (x :*: y))
pairOf x y = extend x _1 :*: extend y _2

pairOfFoo = pairOf (Foo fixIso 2) (Foo fixIso 4)

class Extendable x where
  extend :: Lens' s' s -> x (Fix s) -> x (Fix s')

但这就是我卡住的地方。我不知道如何创建实例Extendable Foo（或者即使这是正确的签名）。我也认为应该有(Extendable x, Extendable y) => Extendable (x :*: y)（或类似的）的实例。或者，也许还有另一种策略？

---

问题扩展

现在，假设我们定义了第二种数据类型：

data Bar s = Bar
   barSelf :: Lens' s (Bar s)
  , barFoo  :: Lens' s (Foo s)
  , barData :: String
  

不可能有Bar (Fix Bar) 类型的值，因为Bar 实际上不包含Foo。但是，可以制作如下内容：

fooBar :: (Foo :*: Bar) (Fix (Foo :*: Bar))
fooBar = Foo (fixIso . _1) 2 :*: Bar (fixIso . _2) (fixIso . _1) "bar"

另外，感觉应该可以有一个实例Extendable Bar，这样我们就可以在pairOf中使用fooBar作为参数。这种情况可能吗？

【问题讨论】：

我发现很难理解您的目标是什么。我也看不出这些嵌入式镜头与您在介绍中提到的IORefs 有何关系。

我有 Foo 和 Bar 之类的数据类型，但它们使用 STRefs 而不是镜头，并且我有各种其他功能可以读取/写入这些参考。这可以满足我的需要，但构造需要使用newSTRef，这是一个单子操作。我认为如果我可以使用镜头而不是使用STRefs，那就太好了。然后构造将是构建数据类型的过程（使用像pairOf 这样的函数），读/写将通过一个简单的State monad 工作。但是，我无法让它工作，所以我想知道这是否可能，或者如果没有，为什么不呢。

【参考方案1】：

我猜你可能想要：

class Extendable a where
  extend :: Lens' (s' (Fix s')) (a (Fix s')) -> a (Fix s) -> a (Fix s')
instance Extendable Foo where
  extend l (Foo self x) = Foo (fixIso . l) x

pairOf :: (Extendable x, Extendable y)
  => x (Fix x) -> y (Fix y) -> (x :*: y) (Fix (x :*: y))
pairOf foo1 foo2 = extend _1 foo1 :*: extend _2 foo2

pairOfFoo = pairOf (Foo fixIso 2) (Foo fixIso 4)

它似乎有效，并扩展到更复杂的组合：

instance (Extendable x, Extendable y) => Extendable (x :*: y) where
  extend l (x :*: y) = extend (l . _1) x :*: extend (l . _2) y

example2 = pairOf (pairOf (Foo fixIso 2) (Foo fixIso 3)) (Foo fixIso 4)

完整代码：

-# LANGUAGE RecordWildCards #-
-# LANGUAGE RankNTypes #-
-# LANGUAGE TypeOperators #-

import GHC.Generics ((:*:)(..))
import Control.Lens

data Foo s = Foo
   self :: Lens' s (Foo s)
  , fooData :: Int
  

instance Show (Foo s) where
  show Foo.. = "Foo <lens> " <> show fooData

newtype Fix f = Fix  unFix :: f (Fix f) 

fixIso :: Iso' (Fix f) (f (Fix f))
fixIso = iso unFix Fix

class Extendable a where
  extend :: Lens' (s' (Fix s')) (a (Fix s')) -> a (Fix s) -> a (Fix s')
instance Extendable Foo where
  extend l (Foo self x) = Foo (fixIso . l) x
instance (Extendable x, Extendable y) => Extendable (x :*: y) where
  extend l (x :*: y) = extend (l . _1) x :*: extend (l . _2) y

pairOf :: (Extendable x, Extendable y)
  => x (Fix x) -> y (Fix y) -> (x :*: y) (Fix (x :*: y))
pairOf foo1 foo2 = extend _1 foo1 :*: extend _2 foo2

pairOfFoo = pairOf (Foo fixIso 2) (Foo fixIso 4)
example2 = pairOf (pairOf (Foo fixIso 2) (Foo fixIso 3)) (Foo fixIso 4)

【讨论】：

这真的很棒，我非常感谢您的努力。但是，我认为我在发布时可能过于简化了问题。具体来说，您没有在extend 的定义中使用self 来代表Foo，这对我的更大问题来说似乎是有问题的。我将用一个稍微复杂的例子来更新我的问题。