length.hs

-- Performing calculations on measurements of length using Haskell types.  The
-- winning solution created collaboratively at @pdxfunc.
--
-- August 10, 2009
--
-- When arithmetic is performed on mixed length units, the result will be
-- measured with the smallest unit in the expression.
--
-- Usage:
--
--     L 3 Feet + L 4 Meters            => L 16.119999999999997 Feet
--     L 1000 Kilometers - L 500 Meters => L 500.0 Meters
--     L 1 Miles + L 1 Feet             => L 5281.0 Feet

-- Order matters: the smallest length units come first!
data LengthUnit = Feet | Meters | Furlongs | Kilometers | Miles deriving (Ord, Eq, Show)
data Length = L Double LengthUnit deriving Show

instance Eq Length where
  L a l1 == L b l2 = if l1 == l2
                     then a == b 
                     else (L a l1) == toUnit l1 (L b l2)

instance Ord Length where
  compare (L a u1) (L b u2) = if u1 == u2
                              then compare a b
                              else compare (L a u1) (toUnit u1 (L b u2))

instance Num Length where
  L a l1 + L b l2 | l1 == l2 = L (a + b) l1
                  | l1 <  l2 = L a l1 + toUnit l1 (L b l2)
                  | l1 >  l2 = toUnit l2 (L a l1) + L b l2

  L a l1 - L b l2 | l1 == l2 = L (a - b) l1
                  | l1 <  l2 = L a l1 - toUnit l1 (L b l2)
                  | l1 >  l2 = toUnit l2 (L a l1) - L b l2

  L a l1 * L b l2 = error "Non-linear measurements are not yet defined."
  abs (L a l1)    = L (abs a) l1
  
  -- either
  signum (L a l1) = error "Lengths cannot be negative."
  fromInteger n   = error "Length units cannot be determined for integer argument."
  -- or
  -- signum (L a l1)      = L (signum a) Unitless
  -- fromInteger n        = L (floor n)  Unitless

lengthConv :: LengthUnit -> LengthUnit -> (Double -> Double)
lengthConv Meters Kilometers = (/1000)
lengthConv Meters Feet       = (*3.28)
lengthConv Meters Miles      = lengthConv Feet Miles    . lengthConv Meters Feet
lengthConv Meters Furlongs   = lengthConv Feet Furlongs . lengthConv Meters Feet

-- Some units are better expressed in terms of Feet than Meters.
lengthConv Feet Miles    = (/5280)
lengthConv Feet Furlongs = (/660)

-- The composition in this case avoids a division by zero when converting
-- certain length measurements with a magnitude of zero.
lengthConv u Meters | u /= Meters = (*) (((1/) . lengthConv Meters u) 1) 

lengthConv u1 u2 | u1 == u2 = id
                 | u1 /= u2 = lengthConv Meters u2 . lengthConv u1 Meters

toUnit :: LengthUnit -> Length -> Length
toUnit u1 (L b u2) = L (lengthConv u2 u1 b) u1

-- hlists - Lists of elements with different types.
--
-- TODO: Postpone actual arithmetic with thunks. A length can be a list of
-- length measurements and arithmetic operators. Thanks to Markus for this
-- idea, of course.