% Extensible sum 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 sum types, which means you can do something like a datatype where you can add additional constructors even in other modules.
> {-# LANGUAGE FunctionalDependencies, GADTs, RankNTypes, TypeFamilies #-}
> {-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-}
> module Data.Extensible.Sum (
>   ExtSum(..), ExtSumC(..), SumSelector(..), callExtSum, nextExtSum,
>   castExtSum, selectExtSum, lensExtSum
> ) where {
> import Control.Applicative;
> import Control.Monad;
> import Data.Lens.Common;
> import Data.Typeable;
> import GHC.Exts (Any);
> import Unsafe.Coerce;
\: Implementation. This implementation is based on a constrained dependent sum type; there is a tag and then the value it corresponds to which is set up by the instances of that class.
> data ExtSum s where {
>   ExtSum :: forall s x. ExtSumC s x => x -> ExtSumF x -> ExtSum s;
> } deriving Typeable;
There are no special laws that need to be satisfied with instances of this class.
> class (Eq x, Typeable x) => ExtSumC s x | x -> s where {
>   type ExtSumF x :: *;
>   accessExtSum :: x -> ExtSumF x -> (s, s -> x);
> };
This type is used for selectors. A selector is used to convert a value of one of the choices for an extensible sum into a value of a single type.
> data SumSelector s v where {
>   (:+?) :: forall s x v. ExtSumC s x =>
>    x -> (ExtSumF x -> v) -> SumSelector s v;
> };
> infix 0 :+?;
\: Functions. {\tt callExtSum}: Can access the value of the single type which it corresponds to. This type might even be an extensible product type.
> callExtSum :: ExtSum s -> s;
> callExtSum (ExtSum x y) = fst (accessExtSum x y);
{\tt nextExtSum}: Make a change in the selector. This is not generally a functor.
> nextExtSum :: (s -> s) -> ExtSum s -> ExtSum s;
> nextExtSum f (ExtSum x y) = let { (a, b) = accessExtSum x y; } in
>  ExtSum (b $ f a) y;
{\tt castExtSum}: Ask the constructor, and will make the value if that is the one which is active.
> castExtSum :: ExtSumC s x => ExtSum s -> x -> Maybe (ExtSumF x);
> castExtSum (ExtSum x y) t = unsafeCoerce y
>  <$ guard (typeOf x == typeOf t && x == unsafeCoerce t);
{\tt selectExtSum}: Given a list of selectors, take the value selected from the extensible sum value, and apply the selector.
> selectExtSum :: [SumSelector s v] -> ExtSum s -> Maybe v;
> selectExtSum [] _ = Nothing;
> selectExtSum ((n :+? f) : t) x = (f <$> castExtSum x n)
>  <|> selectExtSum t x;
{\tt lensExtSum}: Make a lens of an extensible sum type.
> lensExtSum :: Lens (ExtSum s) s;
> lensExtSum = lens callExtSum $ nextExtSum . const;
% End of document (final "}" is suppressed from printout) \medskip\centerline{The End} \toks0={{
> } -- }\bye