1

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.
Community
  • 1
  • 1
fho
  • 6,787
  • 26
  • 71
  • There was [a similar question](http://stackoverflow.com/questions/21395407/combining-free-types/21395655#21395655) about how to merge functors of a free monad together. Check out the answers to that question (I wrote one of them, but the others are good, too) and let me know if that is what you are looking for. – Gabriella Gonzalez Apr 24 '14 at 14:07
  • @GabrielGonzalez Thats more or less the same solution that was given in my first/linked question. I am looking for the *other way around*, that is, constructing the structure from parsed input. – fho Apr 24 '14 at 14:22
  • You want to parse into `Free FooF` instead of parsing into `FooF x`? I presume you can parse into `FooF x` for all `x` that you can parse? – Cirdec Apr 24 '14 at 14:59
  • Do you mean to parse some other junk before and after each occurrence of free (like the junk that was written in the linked question)? Since the parser libraries are based on type classes, the easiest thing might be to make a type that represents what you surround your data with. `data Surrounded a b f x = Surrounded a (f x) b`. Then, if you are adding, say a `String` before and an `Int` after, you would be parsing into `Free (Surrounded String Int FooF)`. – Cirdec Apr 24 '14 at 15:21
  • @Cirdec yep ... I recognised on the way home that this is probably the way to go. I'll try to implement that, maybe you can rephrase this into a short answer? – fho Apr 24 '14 at 16:53
  • Based on one of your comments on the other question, are you looking for a way to write `getMacroF :: Get b -> MacroF (Get b)`, where `MacroF` is your `FooF` and somehow find the inverse of `iterM` such that `reverseIterM :: (Monad m, Functor f) => (m a -> f (m a)) -> m a -> Free f a` can be applied to `getMacroF` to do the opposite of what you were doing in the other question? so `reverseIterM getMacroF` is the parser for what `iterM putMacroF` pretty prints? – Cirdec Apr 24 '14 at 21:21
  • If that's what you want, `getMacroF` is the `get` method of `FooF`'s `Serialize` instance in my answer, and the `Get b` is passed as the `Serialize x` constraint. The `Serialize a => Serialize (Free FooF a)` instance from my answer has `get :: Get (Free FooF a)` where the `Get a` was passed in by the `Serialize a` constraint. Note that you can't get closer to the ideal type for `reverseIterM` than that, unless you have a way to get the `a` out of the monad `m`. – Cirdec Apr 24 '14 at 21:31
  • @Cirdec sorry ... won't be able to work on this this week ... I'll just mark your answer as accepted for now. – fho Apr 28 '14 at 14:37

1 Answers1

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
Cirdec
  • 24,019
  • 2
  • 50
  • 100
  • uff ... that's a lot to chew on. I honestly can't tell if this is useful to me yet. – fho Apr 24 '14 at 19:49
  • `Compose` and `Surrounded` just add something like what you were doing in your other question. If you just want something that works along the lines of `Serialize a` => `Serialize (Free FooF a)`, you don't need them. You still need `SerializeByF` and `Serialize1` for the `Serialize (Free f a)` instance. The same code could be written more easily without the extra types and type classes, slightly similar to what was done with `iterM` in the other question, but then we can't (remotely easily) use the type class based cereal library. – Cirdec Apr 24 '14 at 20:41
  • Actually that was what I was hoping for ... but I could not make up something like a "reverse iterM". Something like "run this `Get (Surround x y (Foo()))` n times and combine the results in one big `Surround x y (Foo())`". – fho Apr 24 '14 at 20:46
  • iterM goes from a tree (Free) to a list by traversing the tree. "reverse iterM" wouldn't go back to a single big flat list from the serialized list; the inverse operation would build the Free tree from the list, with the extra stuff wrapped around each step. Imagine if we inverted `doFooFExtra :: before -> after -> FooF (M a) -> M a`. It'd look something like `M a -> (before, after, FooF (M a))`. – Cirdec Apr 24 '14 at 21:02