length.hs

-- Defines a data type, `Length a`, with different constructors to represent
-- different units of length.  Comparisons and arithmetic can be performed with
-- this type and mismatched units are converted automatically.
--
-- For example,
--     
--     Feet 3 + Meters 1  =>  Meters 1.9146341463414633

data Length = Meters Double | Kilometers Double | Feet Double | Miles Double

instance Show Length where
  show (Meters a)      =  show a ++ " meters"
  show (Kilometers a)  =  show a ++ " kilometers"
  show (Feet a)        =  show a ++ " feet"
  show (Miles a)       =  show a ++ " miles"

instance Eq Length where
  Meters x == Meters y  =  x == y
  x        == y         =  inMeters x == inMeters y

instance Ord Length where
  Meters x < Meters y  =  x < y
  x < y                =  inMeters x < inMeters y

  Meters x > Meters y  =  x > y
  x > y                =  inMeters x > inMeters y

instance Num Length where
  Meters x + Meters y  =  Meters (x + y)
  x + y                =  inMeters x + inMeters y

  Meters x - Meters y  =  Meters (x - y)
  x - y                =  inMeters x - inMeters y

  Meters x * Meters y  =  Meters (x * y)
  x * y                =  inMeters x * inMeters y

  abs (Meters a)       =  Meters (abs a)
  abs x                =  abs (inMeters x)

  signum (Meters a)    =  Meters (signum a)
  signum x             =  signum (inMeters x)

  fromInteger n        =  error "Integer argument given with no units of measurement."

instance Fractional Length where
  Meters x / Meters y  =  Meters (x / y)
  x / y                =  inMeters x / inMeters y

  fromRational q       =  error "Rational argument given with no units of measurement."

inMeters :: Length -> Length
inMeters (Meters x)     = Meters x
inMeters (Kilometers x) = Meters (x * 1000)
inMeters (Feet x)       = Meters (x / 3.28)
inMeters (Miles x)      = inMeters (Feet (x * 5280))

length_pdxfunc.hs

-- 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.

length_phantom_type.hs

-- Defines a data type, `Length a`, with different constructors to represent
-- different units of length.  Arithmetic and arithmetic can be performed with
-- this type and mismatched units are converted automatically.
--
-- For example,
--     
--     (mkMeters 1 `lplus` mkFeet 3) :: Length Meters  =>  1.9146341463414633 meters
--
-- This version uses a 'phantom type' for `a` in the definition of the `Length
-- a` type.
--
-- To Compile this version of length you will need to pass these options to ghc or to ghci:
--
--     -XFlexibleInstances -XFlexibleContexts -XIncoherentInstances

data Length a = L Double

data Meters = Meters
data Kilometers = Kilometers
data Feet = Feet
data Miles = Miles

mkMeters :: Double -> Length Meters
mkMeters = L

mkKilometers :: Double -> Length Kilometers
mkKilometers = L

mkFeet :: Double -> Length Feet
mkFeet = L

mkMiles :: Double -> Length Miles
mkMiles = L

instance Num (Length a) where
  (L a) + (L b) = L (a + b)
  (L a) * (L b) = L (a * b)
  abs (L a)     = L (abs a)
  signum (L a)  = L (signum a)
  fromInteger   = error "Integer argument given with no units of measurement."

instance Eq (Length a) where
  (L a) == (L b) = a == b

instance Show (Length Meters) where
  show (L a) = show a ++ " meters"
instance Show (Length Kilometers) where
  show (L a) = show a ++ " kilometers"
instance Show (Length Feet) where
  show (L a) = show a ++ " feet"
instance Show (Length Miles) where
  show (L a) = show a ++ " miles"
instance Show (Length a) where
  show (L a) = show a ++ " of some units"

class LengthType a where
  fromMeters :: Length Meters -> a
  toMeters :: a -> Length Meters

instance LengthType (Length Meters) where
  fromMeters = id
  toMeters   = id

instance LengthType (Length Kilometers) where
  fromMeters (L m)  = L (m  / 1000)
  toMeters   (L km) = L (km * 1000)

instance LengthType (Length Feet) where
  fromMeters (L m)  = L (m  * 3.28)
  toMeters   (L ft) = L (ft / 3.28)

instance LengthType (Length Miles) where
  fromMeters (L m)  = L (m  / 1609.344)
  toMeters   (L mi) = L (mi * 1609.344)

lplus :: (LengthType (Length a), LengthType (Length b), LengthType (Length c)) =>  Length a -> Length b -> Length c
a `lplus` b = fromMeters (toMeters a + toMeters b)