Combining Free types
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 monads for different libraries, essentially I would like to build DSLs for different contexts, but I would also like to be able to combine them together. As an example:
{-# LANGUAGE DeriveFunctor #-}
module TestingFree where
import Control.Monad.Free
data BellsF x
= Ring x
| Chime x
deriving (Functor, Show)
type Bells = Free BellsF
data WhistlesF x
= PeaWhistle x
| SteamWhistle x
deriving (Functor, Show)
type Whistles = Free WhistlesF
ring :: Bells ()
ring = liftF $ Ring ()
chime :: Bells ()
chime = liftF $ Chime ()
peaWhistle :: Whistles ()
peaWhistle = liftF $ PeaWhistle ()
steamWhistle :: Whistles ()
steamWhistle = liftF $ SteamWhistle ()
playBells :: Bells r -> IO r
playBells (Pure r) = return r
playBells (Free (Ring x)) = putStrLn "RingRing!" >> playBells x
playBells (Free (Chime x)) = putStr "Ding-dong!" >> playBells x
playWhistles :: Whistles () -> IO ()
playWhistles (Pure _) = return ()
playWhistles (Free (PeaWhistle x)) = putStrLn "Preeeet!" >> playWhistles x
playWhistles (Free (SteamWhistle x)) = putStrLn "Choo-choo!" >> playWhistles x
Now, I would like to be able to create a type BellsAndWhistles that allows me to combine the functionality of both Bells and Whistles without much effort.
Since the problem is combining monads, my first thought was to look at the Control.Monad.Trans.Free module for a quick and easy solution. Unfortunately, there are sparse examples and none showing what I want to do. Also, it seems that stacking two or more free monads doesn't work, since MonadFree has a functional dependency of m -> f . Essentially, I'd like the ability to write code like:
newtype BellsAndWhistles m a = BellsAndWhistles
{ unBellsAndWhistles :: ???
} deriving
( Functor
, Monad
-- Whatever else needed
)
noisy :: Monad m => BellsAndWhistles m ()
noisy = do
lift ring
lift peaWhistle
lift chime
lift steamWhistle
play :: BellsAndWhistles IO () -> IO ()
play bellsNwhistles = undefined
But in such a way that Bells and Whistles can exist in separate modules and don't have to know about each others implementations. The idea is that I can write stand alone modules for different tasks, each implementing its own DSL, and then having a way to combine them into a "larger" DSL as needed. Is there an easy way to do this?
As a bonus it'd be great to be able to leverage the different play* functions that are already written, in such a way that I can swap them out. I want to be able to use one free interpreter for debug and another in production, and it'd obviously be useful to be able to choose which DSL was being debugged individually.
This is an answer based off of the paper Data types à la carte, except without type classes. I recommend reading that paper.
The trick is that instead of writing interpreters for Bells and Whistles , you define interpreters for their single functor steps, BellsF and WhistlesF , like this:
playBellsF :: BellsF (IO a) -> IO a
playBellsF (Ring io) = putStrLn "RingRing!" >> io
playBellsF (Chime io) = putStr "Ding-dong!" >> io
playWhistlesF :: WhistelsF (IO a) -> IO a
playWhistlesF (PeaWhistle io) = putStrLn "Preeeet!" >> io
playWhistlesF (SteamWhistle io) = putStrLn "choo-choo!" >> io
If you choose not to combine them, you can just pass them to Control.Monad.Free.iterM to get back your original play functions:
playBells :: Bells a -> IO a
playBells = iterM playBell
playWhistles :: Whistles a -> IO a
playWhistles = iterM playWhistlesF
... however because they deal with single steps they can be combined more easily. You can define a new combined free monad like this:
data BellsAndWhistlesF a = L (BellsF a) | R (WhistlesF a)
Then turn that into a free monad:
type BellsAndWhistles = Free BellsAndWhistlesF
Then you write an interpreter for a single step of BellsAndWhistlesF in terms of the two sub-interpreters:
playBellsAndWhistlesF :: BellsAndWhistlesF (IO a) -> IO a
playBellsAndWhistlesF (L bs) = playBellsF bs
playBellsAndWhistlesF (R ws) = playWhistlesF ws
... and then you get the interpreter for the free monad by just passing that to iterM :
playBellsAndWhistles :: BellsAndWhistles a -> IO a
playBellsAndWhistles = iterM playBellsAndWhistlesF
So the answer to your question is that the trick to combining free monads is to preserve more information by defining intermediate interpreters for individual functor steps ("algebras"). These "algebras" are much more amenable to combination than interpreters for free monads.
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 Functor s 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 Functor s are the "instruction sets" for Free monads, then:
elimSum function is the basic rule that allows you to build a Sum fg 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 Applicative s" expands on these points about Applicative s, and is very well worth reading.
EDIT: One final thing I'll note is that when people design their custom Functor s 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)
下一篇: 结合Free类型