[Haskell-cafe] SYB with Existentials

[oleg at okmij.org]

It is quite straightforward to extend the SYB generic programming
framework to existential data types, including existential data types
with type class constraints. After all, an existential is essentially
a variant data type with the infinite, in general, number of variants.

The only, non-fatal, problem is _not_ with writing the instance of
gunfold. Defining gunfold is easy. The problem is that the existing
SYB -- or, the module Data/Data.hs to be precise -- has
non-extensible constructor and datatype descriptions (Constr and
DataType). The problem is not fatal and can be worked around in
various inelegant ways. Alternatively, one can fix the problem once
and for all by making DataType and Constr extensible -- along the
lines of the new Exceptions. The following file

	http://okmij.org/ftp/Haskell/DataEx.hs

demonstrates one such fix. The file DataEx.hs also tries to avoid the
overlap with Data.Typeable. (One doesn't need to carry the name of the
datatype's type constructor in DataType. That name can be obtained
from the result of typeOf). The file DataEx can be used alongside the
original Data.hs. The code below uses DataEx in that way, to
complement Data.hs. The hope is that the maintainers of SYB might
choose to extend Data.hs -- perhaps using some bits or ideas from
DataEx.hs.

The following is a complete literal Haskell code illustrating
gfold/gunfold for existentials.

> {-# LANGUAGE ExistentialQuantification, Rank2Types, ScopedTypeVariables #-}
> {-# LANGUAGE PatternGuards #-}
> {-# LANGUAGE DeriveDataTypeable #-}
>
> module SybExistential where

We import the old Data.Data and complement it with DataEx. We assume
that DataEx.hs present in the -i path.

> import Data.Generics (gnodecount)
> import Data.Data as Old
> import DataEx

-- The following is the sample existential data type suggested by
-- Oscar Finnsson. We use that data type as our running example.

> data DataBox = forall d. (Show d, Eq d, DataEx d) => DataBox d

We make the DataBox itself to be a member of Typeable, Eq and Show.

> instance Typeable DataBox where
>   typeOf _ = mkTyConApp (mkTyCon "DataBox") []
>
> instance Show DataBox where
>     show (DataBox x) = "DataBox[" ++ show x ++ "]"
>
> -- Two databoxes are the same if the types of their enclosed values
> -- are the same, and their values are the same too
> instance Eq DataBox where
>     DataBox x == DataBox y | Just y' <- cast y = x == y'
>     DataBox _ == DataBox _ = False


The file DataEx makes constructor representation extensible. We hereby
add a new variant to constructor representation, so to represent _any_
existential data type.

> data ExConstr = forall a. Typeable a => ExConstr a
>
> instance Show ExConstr where
>     show (ExConstr a) = "ExConstr" ++ show (typeOf a)
>
> instance Typeable ExConstr where
>   typeOf _ = mkTyConApp (mkTyCon "ExConstr") []
>
> instance Eq ExConstr where
>     ExConstr x == ExConstr y = typeOf x == typeOf y


We are now ready to implement gfold/gunfold for DataBox. First is
gfold; gfold is not affected by our extensions of Constr and is not
re-defined in DataEx.

> instance Old.Data DataBox where
>    gfoldl k z (DataBox d) = z DataBox `k` d


As the instance of DataType for DataBox we use a DataBox object
itself. DataBox is already a member of all needed classes (Eq, Show,
Typeable), except for the following.

The file DataEx.hs defines a Read-like type class to de-serialize
constructor representations. We don't need this feature here.

> instance ReadCtor DataBox where
>     readConstr _ str = error "not yet defined"

We come to the main instance, of DataEx:

> instance DataEx DataBox where

As the `description' of DataBox's datatype we take a sample DataBox
value. We only care about typeOf of that value.

>    dataTypeOf _ = DataType (DataBox (undefined::Int))

Since an existential data type is a ``variant data type with,
generally, infinite number of data constructors'', we can use the very
value of the existential as the description of that particular
``constructor.''

>    toConstr = Constr . ExConstr

And finally, the definition of gunfold

>    gunfold k z (Constr c) | Just (ExConstr ec)    <- cast c,
> 			      Just (DataBox (_::a)) <- cast ec =
> 		k (z (DataBox::a -> DataBox))


That is it. Here are a few tests.

> -- sample DataBoxes
> tdb1 = DataBox (42::Int)
> tdb2 = DataBox ("string", tdb1)

> tdb2_show = show tdb2
> -- "DataBox[(\"string\",DataBox[42])]"

The following tests use gfold

> tdb1_gcount = gnodecount tdb1
> -- 2
>
> tdb2_gcount = gnodecount tdb2
> -- 17

whereas the following tests use gunfold.


> -- generic ``minimum''
> -- (I took a liberty to define 0 as the min Int value, since
> -- it prints better)

> genMin :: DataEx a => a
> genMin = r
>  where
>  r = case DataEx.dataTypeOf r of DataType x -> build . min_ctor $ x
>  min_ctor x | Just (AlgDataType (c:_)) <- cast x = Constr c
>  min_ctor x | Just IntDataType  <- cast x  = Constr . DataEx.IntConstr  $ 0
>  min_ctor x | Just CharDataType <- cast x  = Constr . DataEx.CharConstr $ " "
>  min_ctor x | Just (DataBox _)  <- cast x  = Constr . ExConstr $ DataBox False
>  build = DataEx.fromConstrB genMin
>
> min_box = genMin :: DataBox
> -- DataBox[False]
>
> -- rot a term leaving only its skeleton
> rot :: DataEx a => a -> a
> rot = DataEx.fromConstrB genMin . DataEx.toConstr
>
> tdb1_skel = rot tdb1
> -- DataBox[0]
>
> tdb2_skel = rot tdb2
> -- DataBox[("",DataBox[False])]