对已经是Functor的数据类型使用“Fix”的递归方案?

时间:2017-01-07 18:27:14

标签: haskell functor recursion-schemes

仍然使用我的文字编辑器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存储在树中,然后我可以遍历它们来改变它们,它也很好地与镜头包相吻合!

我最近一直在学习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

但是因为窗口是类型的同义词而窒息。

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吗?实例的实现是什么样的?
  2. 其余类型为here,项目无法编译,因为我没有适合Window的Functor实例...

    谢谢!

2 个答案:

答案 0 :(得分:3)

经过大量的摔跤之后,我得出的结论是,更好的选择是定义两种数据类型;标准数据类型,包含您需要的属性(在本例中为Bifunctor)和Recursive Functor数据类型,您可以为其定义BaseRecursiveCorecursive个实例。

这是它的样子:

{-# 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

请注意,如果您最终重建一组窗口,您仍然会使用=右侧的NON-F版本。​​

我为我的场景定义了以下内容并且效果很好;正如我所希望的那样FunctorBifunctor我都没有使用新类型:

Window

答案 1 :(得分:2)

是的,您想使用Fix中的Data.Bifunctor.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

不幸的是,为newtype-wrapped版本定义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