notes/folds.hs

   1 {-# LANGUAGE ExistentialQuantification #-}
   2
   3 -- | Thanks to Gabriel Gonzales and his beautiful folds
   4
   5 import Data.Monoid
   6 import Prelude hiding (head, last, all, any, sum, product, length)
   7
   8 import qualified Data.Foldable
   9
  10 data Fold i o = forall m . Monoid m => Fold (i -> m) (m -> o)
  11
  12 fold :: Fold i o -> [i] -> o
  13 fold (Fold tally summarize) is = summarize (reduce (map tally is))
  14     where
  15         reduce = Data.Foldable.foldl' (<>) mempty
  16
  17 --
  18 head :: Fold a (Maybe a)
  19 head = Fold (First . Just) getFirst
  20
  21 last :: Fold a (Maybe a)
  22 last = Fold (Last . Just) getLast
  23 --
  24 all :: (a -> Bool) -> Fold a Bool
  25 all predicate = Fold (All . predicate) getAll
  26
  27 any :: (a -> Bool) -> Fold a Bool
  28 any predicate = Fold (Any . predicate) getAny
  29 --
  30 sum :: Num n => Fold n n
  31 sum = Fold Sum getSum
  32
  33 product :: Num n => Fold n n
  34 product = Fold Product getProduct
  35
  36 length :: Num n => Fold i n
  37 length = Fold (\_ -> Sum 1) getSum
  38
  39 --
  40 {-# LANGUAGE BangPatterns #-}
  41
  42 data Average a = Average { numerator :: !a, denominator :: !Int }
  43
  44 instance Num a => Monoid (Average a) where
  45     mempty = Average 0 0
  46     mappend (Average xL nL) (Average xR nR) = Average (xL + xR) (nL + nR)
  47
  48 average :: Fractional a => Fold a a
  49 average = Fold tally summarize
  50     where
  51         tally x = Average x 1
  52         summarize (Average numerator denominator) =
  53             numerator / fromIntegral denominator
  54
  55
  56