Combining Free types

Question

I\'ve been recently teaching myself about the Free monad from the free package, but I\'ve come across a problem with it. I would like to have different free mo

Answer 1

Gabriel's answer is spot on, but I think it pays to highlight a bit more the thing that makes it all work, which is that the sum of two Functors is also a Functor:

-- | Data type to encode the sum of two 'Functor's @f@ and @g@.
data Sum f g a = InL (f a) | InR (g a)

-- | The 'Sum' of two 'Functor's is also a 'Functor'.
instance (Functor f, Functor g) => Functor (Sum f g) where
    fmap f (InL fa) = InL (fmap f fa)
    fmap f (InR ga) = InR (fmap f ga)

-- | Elimination rule for the 'Sum' type.
elimSum :: (f a -> r) -> (g a -> r) -> Sum f g a -> r
elimSum f _ (InL fa) = f fa
elimSum _ g (InR ga) = g ga

(Edward Kmett's libraries have this as Data.Functor.Coproduct.)

So if Functors are the "instruction sets" for Free monads, then:

1. Sum functors give you the unions of such instruction sets, and thus the corresponding combined free monads
2. The elimSum function is the basic rule that allows you to build a Sum f g interpreter out of an interpreter for f and one for g.

The "Data types à la carte" techniques are just what you get when you develop this insight—it's well worth your while to just work it out by hand.

This kind of Functor algebra is a valuable thing to learn. For example:

data Product f g a = Product (f a) (g a)

-- | The 'Product' of two 'Functor's is also a 'Functor'.
instance (Functor f, Functor g) => Functor (Product f g) where
   fmap f (Product fa ga) = Product (fmap f fa) (fmap f ga)

-- | The 'Product' of two 'Applicative's is also an 'Applicative'.
instance (Applicative f, Applicative g) => Applicative (Product f g) where
   pure x = Product (pure x) (pure x)
   Product ff gf <*> Product fa ga = Product (ff <*> fa) (gf <*> ga)


-- | 'Compose' is to 'Applicative' what monad transformers are to 'Monad'.
-- If your problem domain doesn't need the full power of the 'Monad' class, 
-- then applicative composition might be a good alternative on how to combine
-- effects.
data Compose f g a = Compose (f (g a))

-- | The composition of two 'Functor's is also a 'Functor'.
instance (Functor f, Functor g) => Functor (Compose f g) where
   fmap f (Compose fga) = Compose (fmap (fmap f) fga)

-- | The composition of two 'Applicative's is also an 'Applicative'.
instance (Applicative f, Applicative g) => Applicative (Compose f g) where
   pure = Compose . pure . pure
   Compose fgf <*> Compose fga = Compose ((<*>) <$> fgf <*> fga)

Gershom Bazerman's blog entry "Abstracting with Applicatives" expands on these points about Applicatives, and is very well worth reading.

---

EDIT: One final thing I'll note is that when people design their custom Functors for their free monads, in fact, implicitly they're using precisely these techniques. I'll take two examples from Gabriel's "Why free monads matter":

data Toy b next =
    Output b next
  | Bell next
  | Done

data Interaction next =
    Look Direction (Image -> next)
  | Fire Direction next
  | ReadLine (String -> next)
  | WriteLine String (Bool -> next)

All of these can be analyzed into some combination of the Product, Sum, Compose, (->) functors and the following three:

-- | Provided by "Control.Applicative"
newtype Const b a = Const b

instance Functor (Const b) where
    fmap _ (Const b) = Const b


-- | Provided by "Data.Functor.Identity"
newtype Identity a = Identity a

instance Functor Identity where
    fmap f (Identity a) = Identity (f a)


-- | Near-isomorphic to @Const ()@
data VoidF a = VoidF

instance Functor VoidF where
    fmap _ VoidF = VoidF

So using the following type synonyms for brevity:

{-# LANGUAGE TypeOperators #-}

type f :+: g = Sum f g
type f :*: g = Product f g
type f :.: g = Compose f g

infixr 6 :+:
infixr 7 :*:
infixr 9 :.:

...we can rewrite those functors like this:

type Toy b = Const b :*: Identity :+: Identity :+: VoidF

type Interaction = Const Direction :*: ((->) Image :.: Identity)
               :+: Const Direction :*: Identity
               :+: (->) String :.: Identity
               :+: Const String :*: ((->) Bool :.: Identity)