On 11/20/12 6:21 PM, Steve Severance wrote:

class (ReflectDescriptor a, Typeable a, Wire a) => ProtoBuf a

data Expression a b where

OpenTable :: (ProtoBuf b) => Int -> Table -> Expression () b

OpenFile :: (ProtoBuf b) => Int -> String -> Expression () b

WriteFile :: (Typeable a, ProtoBuf b) => Int -> String -> Expression a b -> Expression b ()

WriteTable :: (Typeable a, ProtoBuf b) => Int -> Table -> Expression a b -> Expression b ()

Map :: (ProtoBuf a, ProtoBuf b, ProtoBuf c) => Int -> (a -> b) -> Expression c a -> Expression a b

LocalMerge :: (ProtoBuf a) => Int -> [Expression c a] -> Expression c a

We can implement a version of the compos operator like so:

compos :: forall m c d. (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)
           -> (forall e f. Expression e f -> m (Expression e f)) -> Expression c d -> m (Expression c d)
compos ret app f v =
        case v of
          OpenTable i t -> ret (OpenTable i t)
          OpenFile i s -> ret (OpenFile i s)
          Map i g e -> ret (Map i g) `app` f e
          WriteFile i s e -> ret (WriteFile i s) `app` f e
          WriteTable i t e -> ret (WriteTable i t) `app` f e
          LocalMerge i es -> ret (LocalMerge i) `app` mapm f es
    where
        mapm :: forall g h. (Expression g h -> m (Expression g h)) -> [Expression g h] -> m [Expression g h]
        mapm g = foldr (app . app (ret (:)) . g) (ret [])

Then, with this in hand, we get all the usual compos variants:

composOp :: (forall a b. Expression a b -> Expression a b) -> Expression c d -> Expression c d
composOp f = runIdentity . composOpM (Identity . f)

composOpM :: (Monad m) => (forall a b. Expression a b -> m (Expression a b)) -> Expression c d -> m (Expression c d)
composOpM = compos return ap

composOpM_ :: (Monad m) => (forall a b. Expression a b -> m ()) -> Expression c d -> m ()
composOpM_ = composOpFold (return ()) (>>)

composOpFold :: b -> (b -> b -> b) -> (forall c d. Expression c d -> b) -> Expression e f -> b
composOpFold z c f = unC . compos (\_ -> C z) (\(C x) (C y) -> C (c x y)) (C . f)
newtype C b a = C { unC :: b }

See Bringert and Ranta's "A Pattern for Almost Compositional Functions" for more details: http://publications.lib.chalmers.se/records/fulltext/local_75172.pdf

In my experience, compos requires a little work, but it can handle just about any data type or family of data types you throw at it.

(note the twist on compos is just an extra rank 2 type to quantify over the "a" and "b" in "Expression a b". The same rank 2 type lets you write the recursive code almost directly as well [using polymorphic recursion] -- compos is just a nice generic way to avoid writing the boilerplate traversal repeatedly).

Cheers,
Gershom