module Control.Comonad.Trans.Stream
(
Stream
, stream
, runStream
, unfolds
, StreamT(..)
, tails
, unfoldsW
) where
import Control.Applicative
import Control.Comonad
import Control.Comonad.Apply
import Control.Comonad.Hoist.Class
import Control.Comonad.Trans.Class
import Data.Functor.Apply
import Data.Functor.Identity
import Data.Foldable
import Data.Traversable
import Data.Monoid
#ifdef GHC_TYPEABLE
import Data.Data
#endif
type Stream f = StreamT f Identity
stream :: a -> f (Stream f a) -> Stream f a
stream a as = StreamT (Identity (a, as))
runStream :: Stream f a -> (a, f (Stream f a))
runStream = runIdentity . runStreamT
unfolds :: Functor f => (a -> (b, f a)) -> a -> Stream f b
unfolds f a = let (h, t) = f a in stream h (unfolds f <$> t)
data StreamT f w a = StreamT { runStreamT :: w (a, f (StreamT f w a)) }
instance (Functor w, Functor f) => Functor (StreamT f w) where
fmap f = StreamT . fmap (\(a, as) -> (f a, fmap f <$> as)) . runStreamT
instance (Comonad w, Functor f) => Comonad (StreamT f w) where
extract = fst . extract . runStreamT
duplicate = StreamT . extend (\w -> (StreamT w, duplicate <$> snd (extract w))) . runStreamT
extend f = StreamT . extend (\w -> (f (StreamT w), extend f <$> snd (extract w))) . runStreamT
instance (ComonadApply w, FunctorApply f) => FunctorApply (StreamT f w) where
StreamT ffs <.> StreamT aas = StreamT (liftW2 wfa ffs aas) where
wfa (f,fs) (a,as) = (f a, (<.>) <$> fs <.> as)
instance (ComonadApply w, FunctorApply f) => ComonadApply (StreamT f w)
instance Functor f => ComonadTrans (StreamT f) where
lower = fmap fst . runStreamT
instance Functor f => ComonadHoist (StreamT f) where
cohoist (StreamT wa) = stream a (cohoist <$> as) where
(a,as) = extract wa
instance (Foldable w, Foldable f) => Foldable (StreamT f w) where
foldMap f = foldMap (\(a, as) -> f a `mappend` foldMap (foldMap f) as) . runStreamT
instance (Traversable w, Traversable f) => Traversable (StreamT f w) where
traverse f (StreamT w) = StreamT <$> traverse (\(a, as) -> (,) <$> f a <*> traverse (traverse f) as) w
tails :: Comonad w => StreamT f w a -> f (StreamT f w a)
tails = snd . extract . runStreamT
unfoldsW :: (Comonad w, Functor f) => (w a -> (b, f a)) -> w a -> StreamT f w b
unfoldsW f = StreamT . extend (\s -> let (h, t) = f s in (h, fmap (\a -> unfoldsW f (a <$ s)) t))
#ifdef GHC_TYPEABLE
instance (Typeable1 f, Typeable1 w) => Typeable1 (StreamT f w) where
typeOf1 dfwa = mkTyConApp streamTTyCon [typeOf1 (f dfwa), typeOf1 (w dfwa)]
where
f :: StreamT f w a -> f a
f = undefined
w :: StreamT f w a -> w a
w = undefined
instance (Typeable1 f, Typeable1 w, Typeable a) => Typeable (StreamT f w a) where
typeOf = typeOfDefault
streamTTyCon :: TyCon
streamTTyCon = mkTyCon "Control.Comonad.Trans.Stream.StreamT"
instance
( Typeable1 f
, Typeable1 w
, Data (w (a, f (StreamT f w a)))
, Data (a, f (StreamT f w a))
, Data (f (StreamT f w a))
, Data a
) => Data (StreamT f w a) where
gfoldl f z (StreamT a) = z StreamT `f` a
toConstr _ = streamTConstr
gunfold k z c = case constrIndex c of
1 -> k (z StreamT)
_ -> error "gunfold"
dataTypeOf _ = streamTDataType
dataCast1 f = gcast1 f
streamTConstr :: Constr
streamTConstr = mkConstr streamTDataType "StreamT" [] Prefix
streamTDataType :: DataType
streamTDataType = mkDataType "Control.Comonad.Trans.Stream.StreamT" [streamTConstr]
#endif