haskellfunctorrecursive-datastructuresrecursion-schemesfixpoint-combinators

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


Still working on my text editor Rasa.

At the moment I'm building out the system for tracking viewports/splits (similar to vim splits). It seemed natural to me to represent this structure as a tree:

data Dir = Hor
         | Vert
         deriving (Show)

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

This works great, I store my Views in the tree, and then I can traverse/fmap over them to alter them, it also dovetails with the lens package pretty well!

I've been learning about Recursion Schemes lately and it seems like this is a suitable use-case for them since the tree is a recursive data-structure.

I managed to figure it out well enough to build out the Fixpoint version:

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

type Window a = Fix (WindowF a)

However, now the Functor instance is used up by the r;

I've tried a few variations of

deriving instance Functor Window

But it chokes because window is a type synonym.

And:

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

And that fails too;

• Couldn't match kind ‘* -> *’ with ‘*’
    arising from the first field of ‘Window’ (type ‘Fix (WindowF a)’)
• When deriving the instance for (Functor Window)
  1. Is it still possible to define fmap/traverse over a? Or do I need to do these operations using recursion-schemes primitives? Do I implement Bifunctor? What would the instance implementation look like?

Rest of the types are here, the project doesn't compile because I don't have the proper Functor instance for Window...

Thanks!!


Solution

  • After a lot of wrestling I've come to the conclusion that a better choice is to define two data-types; a standard datatype that has the properties you want (in this case Bifunctor) and a Recursive Functor data-type for which you can define Base, Recursive and Corecursive instances for.

    Here's what it looks like:

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

    You can now use your base type (BiTree) throughout your code like normal; and when you decide to use a recursion scheme you simply need to remember that when unpacking you use the 'F' versions of the constructors:

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

    Note that if you end up rebuilding a set of windows you'll still use the NON-F versions on the right-hand side of the =.

    I've defined the following for my scenario and it works great; I've got both Functor and Bifunctor for Window as I wanted without even using a 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