module Control.Monad.Trans.Fresh.Stream where
import Control.Applicative
import Control.Arrow (first)
import Control.Comonad.Cofree
import Control.Monad.Trans.Class
import Data.Fresh
import Data.Functor.Identity
newtype FreshT v m a = FreshT
{ runFreshT :: Cofree Identity v -> m (a, Cofree Identity v) }
seedStream
:: v
-> (v -> v)
-> Cofree Identity v
seedStream seed sukk = go seed
where
go tt = tt `seq` (mm :< Identity (go mm))
where
mm = sukk tt
integerStream :: Integer -> Cofree Identity Integer
integerStream n = seedStream n succ
listStream :: [v] -> Cofree Identity v
listStream (x:xs) = x :< Identity (listStream xs)
listStream [] = error "Can't create a stream from a finite list."
instance Functor m => Functor (FreshT v m) where
fmap f (FreshT xx) = FreshT $ \s -> fmap (first f) (xx s)
instance (Functor m, Monad m) => Applicative (FreshT v m) where
pure = return
FreshT ff <*> FreshT xx = FreshT $ \s -> do
(fv, s1) <- ff s
(xv, s2) <- xx s1
return (fv xv, s2)
instance Monad m => Monad (FreshT v m) where
return x = FreshT $ \s -> return (x, s)
FreshT aa >>= f = FreshT $ \s -> do
(a, s1) <- aa s
let FreshT ff = f a
ff s1
instance MonadTrans (FreshT v) where
lift m = FreshT $ \s -> do
r <- m
return (r, s)
instance Applicative m => Fresh v (FreshT v m) where
fresh = FreshT $ \(s :< Identity s') -> pure (s, s')