"Overloaded" value constructors

Question

In "Making Our Own Types and Typeclasses" they give the following piece of code :

data Point = Point Float Float deriving (Show)  
data Shape = Circle Point Float | Rectangle Point Point deriving (Show)

surface :: Shape -> Float  
surface (Circle _ r) = pi * r ^ 2  
surface (Rectangle (Point x1 y1) (Point x2 y2)) = (abs $ x2 - x1) * (abs $ y2 - y1)  

nudge :: Shape -> Float -> Float -> Shape
nudge (Circle (Point x y) r) a b = Circle (Point (x+a) (y+b)) r  
nudge (Rectangle (Point x1 y1) (Point x2 y2)) a b = Rectangle (Point (x1+a) (y1+b)) (Point (x2+a) (y2+b))

main = do
    print (surface (Circle (Point 0 0) 24))
    print (nudge (Circle (Point 34 34) 10) 5 10)

As it stands the pattern matching against constructors is getting quite cluttered at the point

nudge (Rectangle (Point x1 y1) (Point x2 y2)) a b = ....

Had we defined the Shape type as :

data Shape = Circle Point Float | Rectangle Float Float Float Float deriving (Show)

Then even though we lose a bit of clarity into the nature of the type, the patten matching looks less cluttered, as can be seen below :

data Point = Point Float Float deriving (Show)  
data Shape = Circle Point Float | Rectangle Float Float Float Float deriving (Show)

surface :: Shape -> Float  
surface (Circle _ r) = pi * r ^ 2  
surface (Rectangle x1 y1 x2 y2) = (abs $ x2 - x1) * (abs $ y2 - y1)  

nudge :: Shape -> Float -> Float -> Shape
nudge (Circle (Point x y) r) a b = Circle (Point (x+a) (y+b)) r  
nudge (Rectangle x1 y1 x2 y2) a b = Rectangle (x1+a) (y1+b) (x2+a) (y2+b)

main = do
    print (surface (Circle (Point 0 0) 24))
    print (nudge (Circle (Point 34 34) 10) 5 10)

My question is whether it is possible to have both

Rectangle Point Point

and

Rectangle Float Float Float Float

in the same piece of code (i.e. a sort of "overloading" of value constructors), so that we can do something like :

...
surface (Rectangle (Point x1 y1) (Point x2 y2)) = (abs $ x2 - x1) * (abs $ y2 - y1)  

...
nudge (Rectangle x1 y1 x2 y2) a b = Rectangle (x1+a) (y1+b) (x2+a) (y2+b)

where the "..." denotes the same as in the code above. Also are there any other tricks to make the notation a bit more compact at the "nudge (Rectangle...." point? Thanks

Answer 1

One option would be to use view patterns. Let me give you a short example:

{-# LANGUAGE ViewPatterns #-}

data Point = Point Float Float
data Shape = Circle Point Float | Rectangle Point Point

rectangleAsPoints :: Shape -> Maybe (Point,Point)
rectangleAsPoints (Rectangle a b) = Just (a,b)
rectangleAsPoints _               = Nothing

rectangleFromPoints :: Point -> Point -> Shape
rectangleFromPoints = Rectangle

rectangleAsCoords :: Shape -> Maybe (Float,Float,Float,Float)
rectangleAsCoords (Rectangle (Point x y) (Point a b)) = Just (x,y,a,b)
rectangleAsCoords _                                   = Nothing

rectangleFromCoords :: Float -> Float -> Float -> Float -> Shape
rectangleFromCoords a b c d = Rectangle (Point a b) (Point c d)

surface (rectangleAsPoints -> Just (Point x1 y1, Point x2 y2)) =
  (abs $ x2 - x1) * (abs $ y2 - y1)
surface (Circle _ r) = pi * r ^ 2

nudge (rectangleAsCoords -> Just (x1,y1,x2,y2)) a b =
  rectangleFromCoords (x1+a) (y1+b) (x2+a) (y2+b)
nudge (Circle (Point x y) r) a b = Circle (Point (x+a) (y+b)) r

For consistency's sake I implemented both views of rectangles as functions. This way the actual implementation of the Rectangle type can remain hidden.

Note how you can mix normal pattern matching and view patterns.

Answer 2

You could possibly use type classes to make a function behave as both Point -> Point -> Rectangle and Float -> Float -> Float -> Float -> Rectangle, but I wouldn't advocate it. It will be to much trouble for the gain. I don't think there's anyway you could make such an overloaded name usable in pattern matching anyway.

The way I see it, if you're only ever going to be using Point values by deconstructing them and operating on the raw Float values, then you're not really getting that much out of it, so you could resolve your problem by getting rid of it entirely.

But you're missing a golden opportunity to implement a function to adjust a point directly!

For starters I would make an Offset type to hold your a and b values. Then you make a function adjust :: Offset -> Point -> Point to do the combining. And then your nudge doesn't even need to understand the internal structure of a Point to do its job!

For example (Disclaimer: I haven't actually compiled this)¹:

data Point = Point Float Float deriving (Show)
data Offset = Offset Float Float deriving (Show)
data Shape = Circle Point Float | Rectangle Point Point deriving (Show)

adjust :: Point -> Offset -> Point
adjust (Point x y) (Offset ox oy) = Point (x + ox) (y + oy)

nudge :: Shape -> Offset -> Shape
nudge (Circle c r) o = Circle (adjust c o) r  
nudge (Rectangle p1 p2) o = Rectangle (adjust p1 o) (adjust p2 o)

And similarly there could be a whole family of operations on Point and Offset. For example offsetFrom :: Point -> Point -> Offset could be useful in your surface function. I once went overboard and used type classes to implement a family of operators (|+|, |*|, etc IIRC) which allowed various things to be combined (for example, you can add a Point and an Offset in either order to get a Point, you can add and subtract Offsets but not Points, you can multiply Offsets by scalars but not Points, etc). Not sure whether it was worth it in the end, but it made my code look like my maths a little more!

With your current code you're effectively implementing all operations on Point again every time you need them (including the same adjustment operation twice in the same equation in nudge, which is my take on why it looks quite so bad).

---

¹ There's a certain argument to be made for making functions like adjust and nudge have signatures where the "main" thing being operated on comes last, so adjust :: Offset -> Point -> Point and nudge :: Offset -> Shape -> Shape. This can come in handy because then partially applying adjust gives you a "point transformer" with type Point -> Point, and similarly you can partially apply nudge to get a "shape transformer" with type Shape -> Shape.

This helps when you have a collection of points or shapes and you want to apply the same transformation to all of them, for example:

data Shape = Polygon [Point]

adjust :: Offset -> Point -> Point
adjust (Offset ox oy) (Point x y) = Point (x + ox) (y + oy)

nudge :: Offset -> Shape -> Shape
nudge o (Polygon ps) = Polygon (map (adjust o) ps)

And generally "transformers" with type Something -> Something are just useful things to have on your main data structures. So whenever you have a function that combines some auxiliary data with a Something to produce a new Something, it'll often turn out to be useful to put the Something as the last argument, so you have another easy source of transformer functions.

Answer 3

What you want is't possibile. For the purposes of pattern matching you could use ViewPatterns as a poor-mans replacement for multiple constructors and make a single function to ease construction:

{-# LANGUAGE ViewPatterns #-}

-- Your pattern match aid
unRectangle :: Shape -> Maybe (Float, Float, Float, Float)
unRectangle (Rectangle (Point x1 y1) (Point x2 y2)) = Just (x1,y1,x2,y2)
unRectangle _ = Nothing

-- your construction aid
rectangle :: Float -> Float -> Float -> Float -> Shape
rectangle x y u v = Rectangle (Point x y) (Point u v)

surface (unRectangle -> Just (x1,y1,x2,y2)) = (abs $ x2 - x1) * (abs $ y2 - y1)
...
nudge (unRectangle -> Just (x1,y1,x2,y2)) = rectangle (x1+a) (y1+b) (x2+a) (y2+b)