Streams.hs

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE FlexibleInstances, TupleSections #-}

import Prelude hiding (repeat)

class Functor w => Comonad w where
  extract :: w a -> a
  extend :: (w a -> b) -> (w a -> w b)

data Product e a = Product e a

instance Functor (Product e) where
  fmap f (Product x a) = Product x (f a)

instance Comonad (Product e) where
  extract (Product _ a) = a
  extend f whole@(Product x _) = Product x (f whole)

data Stream a = Cons a (Stream a)

instance Functor Stream where
  fmap f (Cons x rest) = Cons (f x) (fmap f rest)

instance Comonad Stream where
  extract (Cons x _) = x
  extend f whole@(Cons _ rest) = Cons (f whole) (extend f rest)

toList :: Stream a -> [a]
toList (Cons x rest) = x : toList rest

instance Show a => Show (Stream a) where
  show = show . take 20 . toList

repeat :: a -> Stream a
repeat x = result
  where result = Cons x result

sumThree :: Num a => Stream a -> a
sumThree (Cons x (Cons y (Cons z _))) = x + y + z

integers :: Integer -> Stream Integer
integers start = Cons start $ integers $ start + 1

streamFold :: (a -> b -> b) -> Stream a -> b -> Stream b
streamFold f (Cons x rest) y = Cons y $ streamFold f rest (f x y)

streamFilter :: (a -> Bool) -> Stream a -> Stream a
streamFilter f (Cons x rest) =
  if f x
  then Cons x $ streamFilter f rest
  else streamFilter f rest

primes1 :: Stream Integer
primes1 = process (integers 2)
  where process (Cons x rest) = Cons x $ streamFilter ((/= 0) . (`mod` x)) $ process rest

hold :: Eq a => a -> (a, Bool) -> (a, Bool)
hold x (y, _) =
  if x == y
  then (x, False)
  else (x, True)

uniq :: Eq a => Stream a -> Stream a
uniq (Cons x rest) = fmap fst $ streamFilter snd $ streamFold hold rest (x, True)

primes2 :: Stream Integer
primes2 = uniq $ fmap head histories
  where histories = streamFold f (integers 3) [2]
        f curr story = if any ((== 0) . (curr `mod`)) story
                       then story
                       else curr : story