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

Question

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!!

Answer 1

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

Answer 2

Yes, you want to use the version of Fix from 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)

You'll have to change your WindowF type to match:

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

It's possible to use recursion-schemes with this, along with an auxiliary type:

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

Unfortunately, defining Recursive for the newtype-wrapped version is a little trickier:

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