Is it possible to extend free monad parsers?

Question

This is a follow up to Is it possible to extend free monad interpreters? or better the reverse.

I recently revisited the project that the previous question stemmed from. This time I try to parse the file into the data structure.

Problem is that I have no clue on how to achieve this. While writing he (cereal based) parsers is unproblematic and it is working as long as I only parse into the FooF type, I have no idea on how to how to create the interleaved Functor (correct terminology?).

Note:

• At this point I am looking only for clues on how to achieve this.
• There is no code yet that I can provide.
• Please refer to the code in the linked question and the accepted answer for datatypes.

Answer 1

Types

It sounds like you might be looking for the composition of functors, which lives in the transformers package in Data.Functor.Compose:

newtype Compose f g a = Compose { getCompose :: f (g a) }

If I understand your two questions correctly, you want to add things before and after something else, and then parse the added data back out. We'll make a type for adding things before and after something else

data Surrounded a b c = Surrounded a c b
  deriving (Functor)

surround :: a -> b -> c -> Surrounded a b c
surround a b c = Surrounded a c b

Now, supposing the data before something else is a String and the data after something else is an Int, you're looking for the type:

Free (Compose (Surrounded String Int) FooF) :: * -> *

Instances

All that remains is to make Serialize instances for FooF x, Surrounded a b c, Compose f g x, and Free f a. The first three of these are easy and can be derived by the cereal package:

deriving instance Generic (FooF x)
instance Serialize x => Serialize (FooF x)

deriving instance Generic (Surrounded a b c)
instance (Serialize a, Serialize b, Serialize c) => Serialize (Surrounded a b c)

deriving instance Generic (Compose f g a)
instance (Serialize (f (g a))) => Serialize (Compose f g a)

If we try to do the same for Free, we would write instance (Serialize a, Serialize (f (Free f a))) => Serialize (Free f a). We'd run into UndecidableInstances territory; to make a Serialize instance for Free, we first must have a Serialize instance for Free. We'd like to prove by induction that the instance already exists, but to do so, we'd need to be able to check that f a has a Serialize instance for all as that have a Serialize instance.

Serialize1

To check that a functor has a Serialize instance as long as it's argument has a Serialize instance, we introduce a new type class, Serialize1. For those functors whose Serialize instance was already defined based on a Serialize instance for the argument, we can generate the new serialize instance by default.

class Serialize1 f where
    put1 :: Serialize a => Putter (f a)
    get1 :: Serialize a => Get (f a)

    default put1 :: (Serialize a, Serialize (f a)) => Putter (f a)
    put1 = put

    default get1 :: (Serialize a, Serialize (f a)) => Get (f a)
    get1 = get

The first two functors, FooF and Surround a b, can use the default instances for the new class:

instance Serialize1 FooF

instance (Serialize a, Serialize b) => Serialize1 (Surrounded a b)

Compose f g needs a bit of help.

-- Type to help defining Compose's Serialise1 instance
newtype SerializeByF f a = SerializeByF { unSerialiseByF :: f a }

instance (Serialize1 f, Serialize a) => Serialize (SerializeByF f a) where
    put = put1 . unSerialiseByF
    get = fmap SerializeByF get1

instance (Serialize1 f) => Serialize1 (SerializeByF f)

Now we can define a Serialize1 instance for Compose f g in terms of serializing by the other two Serialize1 instances. fmap SerializeByF tags f's inner data to be serialized by g's Serialize1 instance.:

instance (Functor f, Serialize1 f, Serialize1 g) => Serialize1 (Compose f g) where
    put1 = put . SerializeByF . fmap SerializeByF . getCompose
    get1 = fmap (Compose . fmap unSerializeByF . unSerializeByF ) get

Serialize Free

Now we should be equipped to make a Serialize instance for Free f a. We will borrow the serialization of Either a (SerializeByF f (Free f a)).

toEitherRep :: Free f a => Either a (SerializeByF f (Free f a))
toEitherRep (Pure a) = Left a
toEitherRep (Free x) = Right (SerializeByF x)

fromEitherRep :: Either a (SerializeByF f (Free f a)) => Free f a
fromEitherRep = either Pure (Free . unSerializeByF)

instance (Serialize a, Serialize1 f) => Serialize (Free f a) where
    put = put . toEitherRep    
    get = fmap fromEitherRep get

instance (Serialize1 f) => Serialize1 (Free f)

Example

Now we can serialize and deserialize things like:

example :: Free (Compose (Surrounded String Int) FooF) ()
example = Free . Compose . surround "First" 1 . Foo "FirstFoo" . Free . Compose . surround "Second" 2 . Bar 22 . Pure $ ()

Boilerplate

The above requires the following extensions

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}

and the following libraries:

import Control.Monad.Free
import Data.Functor.Compose
import Data.Serialize
import GHC.Generics