在已经是 Functor 的数据类型上使用“Fix”的递归方案？

Question

仍在使用我的文本编辑器 Rasa。

目前我正在构建用于跟踪 viewports/splits 的系统（类似于 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 存储在树中，然后我可以 traverse/fmap 对它们进行修改，它也与镜头包非常吻合！

我最近一直在学习 Recursion Schemes，这似乎是适合他们的用例，因为树是递归数据结构。

我设法弄清楚了足以构建 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)

是否仍然可以定义 fmap/traverse 而不是 a？或者我是否需要使用 recursion-schemes 基元来执行这些操作？我要实现 Bifunctor 吗？实例实现会是什么样子？

其余类型为 here，项目无法编译，因为我没有 Window...

的正确 Functor 实例

谢谢！！

Answer 1

是的，您想使用 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

Answer 2

经过一番折腾，我得出的结论是，更好的选择是定义两种数据类型；具有所需属性的标准数据类型（在本例中为 Bifunctor）和递归函子数据类型，您可以为其定义 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

请注意，如果您最终重建一组 windows，您仍将使用 = 右侧的非 F 版本。

我已经为我的场景定义了以下内容并且效果很好； Functor 和 Bifunctor 都满足了 Window 的要求，甚至没有使用新类型：

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

在已经是 Functor 的数据类型上使用“Fix”的递归方案？

Recursion schemes using `Fix` on a data-type that's already a Functor?

haskell

functor

recursive-datastructures

recursion-schemes

fixpoint-combinators