[Haskell-cafe] Restrict values in type

[oleg at okmij.org]

The problem you have posed calls for so-called open unions. Open
unions come up all the time, and lots of solutions exists. Alas, they
are all a bit ad hoc. At Haskell Symposium I was advocating designing
a good solution once and for all. 

The paper that introduced monad transformers showed one implementation
of open unions (of effects). The paper `data types a la carte' showed
another (essentially the same, trying to deemphasize its use of
overlapping instances). The Extensible effects paper has two more
solutions, one with Typeable and one without. You can use OpenUnions
from that paper if you install extensible-effects package. Using
singletons is yet another, quite heavy-weight solution. 

I'd like to stress a much simpler solution, which requires no type
equality or GADTs or bleeding edge. It is a tagless-final solution. In
fact, it has been demonstrated already by Jake McArthur. I elaborate
and show the whole code.

Your original code defined PenShape as a data structure

> data PenShape = Circle Float
>     | Rectangle Float Float
>     | ArbitraryPen -- Stuff (not relevant)

I will define it as an expression in a very simple domain-specific
language of pen shapes.

> class CirclePen repr where
>     circle :: Float -> repr
>     -- other ways of constructing circles go here
>
> class RectPen repr where
>     rectangle :: Float -> Float -> repr
>
> class ArbitraryPen repr where
>     arbitrary :: () -> repr -- () stands for irrelevant stuff

Here repr is the meaning of a pan shape in a particular
interpretation. The same term can be interpreted in many ways
(compare: a Haskell code can be loaded into GHCi, compiled with GHC or
processed with Haddoc). One interpretation of pen shapes is to print
them out nicely:

data S = S{unS :: String}

instance CirclePen S where
  circle x = S $ "circle pen of radius " ++ show x

instance RectPen S where
  rectangle x y = S $ "rect pen " ++ show (x,y)
  
instance ArbitraryPen S where
  arbitrary () = S $ "arbitrary pen"

There probably will be other representations: defined only for
specific sets of pens (rather than all of them), see below for an example.

You ask how can you pattern-match on pen shapes. The answer is that in
taggless-final style, you don't pattern-match. You interpret. Quite
often the code becomes clearer. Enclosed is the complete code. For
(far) more explanation of tagless-final, please see the first part of

        http://okmij.org/ftp/tagless-final/course/lecture.pdf

{-# LANGUAGE RankNTypes #-}

module Im where

data Image = Image [Stroke]


-- As a data structure
{-
data PenShape = Circle Float
    | Rectangle Float Float
    | ArbitraryPen -- Stuff (not relevant)
-}

-- As a term in a simple language of shapes

class CirclePen repr where
    circle :: Float -> repr
    -- other ways of constructing circles go here

class RectPen repr where
    rectangle :: Float -> Float -> repr

class ArbitraryPen repr where
    arbitrary :: () -> repr -- () stands for irrelevant stuff

-- Let's define a few interpretations of pens

-- the Show interpretation, to print them
-- All pens support this interpretation
data S = S{unS :: String}

instance CirclePen S where
  circle x = S $ "circle pen of radius " ++ show x

instance RectPen S where
  rectangle x y = S $ "rect pen " ++ show (x,y)
  
instance ArbitraryPen S where
  arbitrary () = S $ "arbitrary pen"



-- Another interpretation: finite-dim pens. Only CirclePen and RectPen
-- support it
data FiniteDim = FiniteDim{unFD:: Float}

instance CirclePen FiniteDim where
  circle x = FiniteDim x
  
instance RectPen FiniteDim where
  rectangle x y = FiniteDim $ max x y


{-
data Stroke = Line Point Point PenShape
    | Arc Point Point Point PenShape
    | Spot Point PenShape
-}

type Point = (Float,Float)
p0 = (0,0)
p1 = (1,1)

data Stroke =
    Line Point Point (forall repr. (CirclePen repr, RectPen repr) => repr)
  | Arc Point Point (forall repr. (CirclePen repr) => repr)
  | Spot Point (forall repr.
                (CirclePen repr, RectPen repr, ArbitraryPen repr) => repr)


-- Let's make a an image

im1 = Image [
  Line p0 p1 (circle 10),
  Line p0 p1 (rectangle 1 2),
  -- The following will be a type error, as expected
  -- Arc p0 p1 (rectangle 1 2),
  Arc p0 p1 (circle 3),
  Spot p0 (rectangle 1 2),
  Spot p0 (arbitrary ())
  ]

-- If we add
--   Line p0 p1 (arbitrary ())
-- we get a type error with an informative message
{-
    Could not deduce (ArbitraryPen repr)
      arising from a use of `arbitrary'
    from the context (CirclePen repr, RectPen repr)
      bound by a type expected by the context:
                 (CirclePen repr, RectPen repr) => repr
-}

-- Let's print the list of strokes

show_strokes :: Image -> [String]
show_strokes (Image l) = map f l
 where
 f (Line p1 p2 pensh) = unwords ["Line", show (p1,p2), unS pensh]
 f (Arc p1 p2 pensh) = unwords ["Arc", show (p1,p2), unS pensh]
 f (Spot p1 pensh) = unwords ["Spot", show p1, unS pensh]

tshow = show_strokes im1
{-
["Line ((0.0,0.0),(1.0,1.0)) circle pen of radius 10.0",
 "Line ((0.0,0.0),(1.0,1.0)) rect pen (1.0,2.0)",
 "Arc ((0.0,0.0),(1.0,1.0)) circle pen of radius 3.0",
 "Spot (0.0,0.0) rect pen (1.0,2.0)","Spot (0.0,0.0) arbitrary pen"]
-}