Non-ugly average in Haskell

Submitted by Greg Buchholz
on November 7, 2008 - 9:01pm

data E a b = L (E a b) | R b deriving (Show)

fold f acc [] = R acc                      
fold f acc (x:xs) = let x' = f acc x 
                    in x' `seq` (L $ fold f x' xs)

lift2 f = \x y -> par_eval x y
    where par_eval   (L x)   (L y) = par_eval x y
          par_eval x@(R _)   (L y) = par_eval x y
          par_eval   (L x) y@(R _) = par_eval x y
          par_eval   (R x)   (R y) = R $ f x y

lift1 f (L x) = lift1 f x
lift1 f (R x) = R (f x)

sum' xs = fold (+) 0 xs
len' xs = fold (\x y->succ x) 0 xs
avg  xs =  (sum' xs) / (len' xs)

main = print $ avg [1..1e7]

instance Eq b => Eq (E a b) where
    a == b = case (lift2 (==) a b) of (R x) -> x

instance Num b => Num (E a b) where
   (+) = lift2 (+)
   (*) = lift2 (*)
   fromInteger = R . fromInteger
   abs = lift1 abs 
   signum = lift1 signum

instance Fractional b => Fractional (E a b) where
   (/) = lift2 (/)
   fromRational = R . fromRational