[Hs-Generics] MultiRec generic producer.
Sebastiaan Visser
sfvisser at cs.uu.nl
Mon May 25 09:33:39 EDT 2009
Thanks, this should probably be enough for me to go on.
Pattern matching on the type-equality proof is just the trick that I
needed.
On May 25, 2009, at 3:23 PM, José Pedro Magalhães wrote:
> Hey Sebastiaan,
>
> Generation of a single value (the leftmost), for instance, can be
> done as follows:
>
> {-# OPTIONS_GHC -fglasgow-exts #-}
>
> module Left where
>
> import Generics.MultiRec.Base
>
>
> class Left (phi :: * -> *) (f :: (* -> *) -> * -> *) where
> leftf :: phi ix -> (forall ix'. El phi ix' => phi ix' -> r ix') -
> > [f r ix]
>
> instance (Left phi a, Left phi b) => Left phi (a :+: b) where
> leftf w f = map L (leftf w f) ++ map R (leftf w f)
>
> instance (Constructor c, Left phi f) => Left phi (C c f) where
> leftf w f = map C (leftf w f)
>
> instance (Left phi a, Left phi b) => Left phi (a :*: b) where
> leftf w f = zipWith (:*:) (leftf w f) (leftf w f)
>
> instance (El phi xi) => Left phi (I xi) where
> leftf _ f = [I (f index)]
>
> instance Left phi U where
> leftf _ _ = [U]
>
> instance (EqS phi, El phi ix, Left phi f) => Left phi (f :>: ix) where
> leftf w f =
> case eqS (proof :: phi ix) w of
> Nothing -> []
> Just Refl -> map Tag (leftf w f)
>
> instance LeftA a => Left phi (K a) where
> leftf _ _ = [K lefta]
>
> class LeftA a where
> lefta :: a
>
> instance LeftA Char where
> lefta = 'L'
>
> instance LeftA () where
> lefta = ()
>
> left :: (El phi ix, Fam phi, Left phi (PF phi)) => phi ix -> ix
> left w = to w $ head $ leftf w (I0 . left)
>
>
> I also have an arbitrary, but that's slightly more complex. Generic
> read should be available soon.
>
> Cheers,
> Pedro
>
> On Mon, May 25, 2009 at 15:11, Sebastiaan Visser <sfvisser at cs.uu.nl>
> wrote:
> Hey guys,
>
> While playing around with MultiRec most things are pretty
> straightforward and most usage can be derived from the examples. The
> only thing that seems tricky to do, and of which I cannot find any
> examples, are generic producers.
>
> Any examples of generic producers that take no values as input but
> do produce values as output? E.g. generic parsers (read), binary
> get, arbitrary?
>
> I have some `SingleRec' producers that are fairly trivial to port
> except for the `Tag' case. Any clues?
>
> Thanks,
>
> --
> Sebastiaan Visser
More information about the Generics
mailing list