使用`Fix`的递归方案在一个已经是Functor的数据类型上实现？

Question

我正在努力开发一个文本编辑器Rasa。

目前，我正在构建跟踪视口/分割区域的系统（类似于vim分割区域）。对我来说，将这个结构表示为树形结构是很自然的：

data Dir = Hor
         | Vert
         deriving (Show)

data Window a =
  Split Dir SplitInfo (Window a) (Window a)
    | Single ViewInfo a
    deriving (Show, Functor, Traversable, Foldable)

这很好用，我将我的View存储在树中，然后可以遍历/映射它们以改变它们，它也很好地与lens包结合使用！

最近我一直在学习递归方案，似乎这是一个适合使用它们的场景，因为该树是一个递归数据结构。

我设法弄清楚了如何构建出Fixpoint版本：

data WindowF a r =
  Split Dir SplitInfo r r
    | Single ViewInfo a
    deriving (Show, Functor)

type Window a = Fix (WindowF a)

然而，现在Functor实例已被r使用；

我尝试了几种变化：

deriving instance Functor Window

但它卡住了，因为window是一个类型同义词。

以及：

newtype Window a = Window (Fix (WindowF a)) deriving Functor

那也失败了；

• Couldn't match kind ‘* -> *’ with ‘*’
    arising from the first field of ‘Window’ (type ‘Fix (WindowF a)’)
• When deriving the instance for (Functor Window)

1. 是否仍然可以在 a 上定义 fmap/traverse？还是我需要使用 recursion-schemes 原语执行这些操作？我应该实现 Bifunctor 吗？实例实现会是什么样子？

其余类型在 这里，项目无法编译，因为我没有 Window 的适当 Functor 实例...

谢谢！

- Chris Penner

---

是的，这实际上是两个问题。请不要这样做。 - dfeuer

不确定我当时在想什么哈哈，既然你回答了第一个问题，我会把第二个问题单独列出来。顺便说一句，谢谢！ - Chris Penner

Answer 1

经过许多探讨，我得出的结论是定义两个数据类型更好；一个标准的数据类型具有所需的属性（在这种情况下为 Bifunctor），而另一个递归 Functor 数据类型则可以定义 Base、Recursive 和 Corecursive 实例。

下面是它的样子：

{-# language DeriveFunctor, DeriveTraversable, TypeFamilies  #-}

import Data.Typeable
import Data.Bifunctor
import Data.Functor.Foldable

data BiTree b l =
  Branch b (BiTree b l) (BiTree b l)
    | Leaf l
    deriving (Show, Typeable, Functor, Traversable, Foldable)

instance Bifunctor BiTree where
  bimap _ g (Leaf x) = Leaf (g x)
  bimap f g (Branch b l r) = Branch (f b) (bimap f g l) (bimap f g r)

data BiTreeF b l r =
  BranchF b r r
    | LeafF l
    deriving (Show, Functor, Typeable)

type instance Base (BiTree a b) = BiTreeF a b
instance Recursive (BiTree a b) where
  project (Leaf x) = LeafF x
  project (Branch s l r) = BranchF s l r

instance Corecursive (BiTree a b) where
  embed (BranchF sp x xs) = Branch sp x xs
  embed (LeafF x) = Leaf x

您现在可以像使用普通类型一样在代码中使用基本类型（BiTree）；当您决定使用递归方案时，只需要记住在解包时使用构造函数的“F”版本：

anyActiveWindows :: Window -> Bool
anyActiveWindows = cata alg
  where alg (LeafF vw) = vw^.active
        alg (BranchF _ l r) = l || r

请注意，如果您最终重建了一组窗口，则仍将在等号右侧使用非F版本。

我已经针对我的场景定义了以下内容，并且它运行良好；我已经成功地获得了Window的Functor和Bifunctor，而不需要使用newtype。

type Window = BiTree Split View

data SplitRule =
  Percentage Double
  | FromStart Int
  | FromEnd Int
  deriving (Show)

data Dir = Hor
        | Vert
        deriving (Show)

data Split = Split
  { _dir :: Dir
  , _splitRule :: SplitRule
  } deriving (Show)

makeLenses ''Split

data View = View
  { _active :: Bool
  , _bufIndex :: Int
  } deriving (Show)

makeLenses ''View

- Chris Penner

Answer 2

是的，你需要使用来自 Data.Bifunctor.Fix 的 Fix 版本：

newtype Fix p a = In { out :: p (Fix p a) a }

instance Bifunctor p => Functor (Fix p) where
  fmap f (In x) = In (bimap (fmap f) f x)

您需要更改WindowF类型以匹配：

data WindowF r a =
  Split Dir SplitInfo r r
    | Single ViewInfo a
    deriving (Show, Functor)

instance Bifunctor WindowF where
  bimap f _g (Split dir si x y) = Split dir si (f x) (f y)
  bimap _f g (Single vi a) = Single vi (g a)

newtype Window a = Window (Fix WindowF a) deriving Functor

可以使用recursion-schemes和一个辅助类型来实现这个功能：

import Data.Functor.Foldable hiding (Fix (..))
import Data.Profunctor.Unsafe
import Data.Coerce

newtype Flip p a b = Flip {unFlip :: p b a}

instance Bifunctor p => Bifunctor (Flip p) where
  bimap f g (Flip x) = Flip (bimap g f x)

instance Bifunctor p => Functor (Flip p a) where
  fmap = coerce (first :: (x -> y) -> p x a -> p y a)
    :: forall x y . (x -> y) -> Flip p a x -> Flip p a y

type instance Base (Fix p a) = Flip p a
instance Bifunctor p => Recursive (Fix p a) where
  project = Flip #. out
  cata f = f . Flip . first (cata f) . out

不幸的是，为新类型包装版本定义 Recursive 稍微麻烦一些：

newtype Window a = Window {getWindow :: Fix WindowF a} deriving (Functor)
type instance Base (Window a) = Flip WindowF a

instance Recursive (Window a) where
  project = coerce #. project .# getWindow
  cata = (. getWindow) #. cata

- dfeuer

---

我们需要newtype吗？在这种情况下它提供了什么？对于Functor实例来说是必需的吗？我现在使用它有点困难，例如以下（微不足道的）示例适用于常规Fix，但不适用于新的Bifunctor Fix，请查看此处的allTree：https://gist.github.com/ChrisPenner/aa6083478d2d1100f62a974860aae529非常抱歉给您带来麻烦，我对所有这些Fix的东西都很陌生，现在有两个不同版本的它并没有使它变得更容易哈哈。 - Chris Penner

@ChrisPenner，这有帮助吗？ - dfeuer

@ChrisPenner，你肯定可以使用“递归方案”方法并手写“Functor”实例。我猜最漂亮的方式可能涉及编写“recursion-schemes”的双函子克隆，但那肯定是过度设计了。 - dfeuer

哦，有趣；我刚重新发现了镜头库中的Plated部分；它有para，而你可以像cata一样使用transformOf，它可能有些不同，但具有类似的功能，而不需要破坏你的基础数据结构，这很好。到目前为止，它对我的需求很有效。 - Chris Penner

遇到了一些问题，因为像 transform 这样的函数具有 (a -> a) -> a -> a 的签名，这不允许在类似于 cata 的折叠操作中更改类型... 叹气。不过还是谢谢你的尝试！ - Chris Penner