% Extensible product types
% [Public domain]
\input birdstyle
\birdleftrule=1pt
\emergencystretch=1em
\def\hugebreak{\penalty-600\vskip 30pt plus 8pt minus 4pt\relax}
\newcount\chapno
\def\: #1.{\advance\chapno by 1\relax\hugebreak{\bf\S\the\chapno. #1. }}
\: Introduction. This module implements extensible product types, which
means you can have like a record, and add fields to this record even in
different modules. Dependent defaults are supported.
>
>
> module Data.Extensible.Product (
> ExtProd, ExtProdC(..), ProdConstructor(..), emptyExtProd, getExtProd,
> putExtProd, lensExtProd, constructExtProd
> ) where {
> import Control.Applicative;
> import Data.Hashable;
> import Data.HashMap.Lazy (HashMap);
> import qualified Data.HashMap.Lazy as H;
> import Data.Lens.Common;
> import Data.Typeable;
> import GHC.Exts (Any);
> import Unsafe.Coerce;
\: Implementation. It is implemented using a hash map, with types as keys.
For it to be extensible there has to be default values. It allows default
values to be based on a single value of the type that indexes the {\tt
ExtProd} type, which is used to tell what kind of record it is.
> data ExtProd p where {
> ExtProd :: p -> HashMap TypeRep Any -> ExtProd p;
> } deriving Typeable;
Instances should ignore the value of the first parameter of the {\tt
defaultExtProd} method; it is used only for knowing the type (so it will
be OK to pass {\tt undefined} as the first parameter).
The second parameter should be used to set default values.
> class Typeable x => ExtProdC p x | x -> p where {
> type ExtProdF x :: *;
> defaultExtProd :: x -> p -> ExtProdF x;
> };
In addition, we will have a constructor-like datatype for extensible
products, which is similar to an extensible sum type, and can be used in
a list to construct a value of the type.
> data ProdConstructor p where {
> (:*=) :: ExtProdC p x => x -> ExtProdF x -> ProdConstructor p;
> };
> infix 0 :*=;
\: Functions.
{\tt emptyExtProd}: Make a value of extensible product type with all
values set to the defaults.
> emptyExtProd :: p -> ExtProd p;
> emptyExtProd = flip ExtProd H.empty;
{\tt getExtProd}: Get the value of a field.
> getExtProd :: ExtProdC p x => ExtProd p -> x -> ExtProdF x;
> getExtProd (ExtProd p m) f = unsafeCoerce $ H.lookupDefault
> (unsafeCoerce $ defaultExtProd f p) (typeOf f) m;
{\tt putExtProd}: Set the value of a field.
> putExtProd :: ExtProdC p x => ExtProd p -> x -> ExtProdF x -> ExtProd p;
> putExtProd (ExtProd p m) f v = ExtProd p $ H.insert (typeOf f)
> (unsafeCoerce v) m;
{\tt lensExtProd}: Make a lens of an extensible product type.
> lensExtProd :: ExtProdC p x => x -> Lens (ExtProd p) (ExtProdF x);
> lensExtProd f = lens (flip getExtProd f) (\v x -> putExtProd x f v);
{\tt constructExtProd}: Construct a value of an extensible product type.
> constructExtProd :: p -> [ProdConstructor p] -> ExtProd p;
> constructExtProd p l = ExtProd p $ H.fromList (constructorToKV <$> l);
> constructorToKV :: ProdConstructor p -> (TypeRep, Any);
> constructorToKV (k :*= v) = (typeOf k, unsafeCoerce v);
% End of document (final "}" is suppressed from printout)
\medskip\centerline{The End}
\toks0={{
> }