{-# LANGUAGE DeriveDataTypeable #-}
module Language.KansasLava.Stream where
import Data.Traversable
import qualified Data.Foldable as F
import Control.Applicative
import Control.Monad
import Data.Monoid
import Prelude hiding (zipWith,zipWith3, repeat)
import qualified Data.List as List
import Data.Dynamic
import Debug.Trace
infixr 5 `Cons`
data Stream a = Cons !a (Maybe (Stream a))
deriving (Typeable)
instance Show a => Show (Stream a) where
show (Cons a opt_as) = show a ++ " " ++ maybe "" show opt_as
instance Applicative Stream where
pure a = a `Cons` Nothing
(h1 `Cons` t1) <*> (h2 `Cons` t2) = h1 h2 `Cons` (t1 `opt_ap` t2)
where
Nothing `opt_ap` Nothing = Nothing
Nothing `opt_ap` (Just x) = Just (pure h1 <*> x)
(Just f) `opt_ap` Nothing = Just (f <*> pure h2)
(Just f) `opt_ap` (Just x) = Just (f <*> x)
instance Functor Stream where
fmap f (a `Cons` opt_as) = f a `Cons` maybe Nothing (Just . fmap f) opt_as
zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c
zipWith f xs ys = f <$> xs <*> ys
zipWith3 :: (a -> b -> c -> d) -> Stream a -> Stream b -> Stream c -> Stream d
zipWith3 f xs ys zs = f <$> xs <*> ys <*> zs
fromFiniteList :: [a] -> a -> Stream a
fromFiniteList (x : xs) end = x `Cons` (Just (fromFiniteList xs end))
fromFiniteList [] end = end `Cons` Nothing
fromList :: [a] -> Stream a
fromList xs = fromFiniteList xs (error "found end of infinite list")
toList :: Stream a -> [a]
toList (x `Cons` opt_xs) = x : maybe (List.repeat x) toList opt_xs
instance F.Foldable Stream where
foldMap f (a `Cons` opt_as) = f a `mappend` maybe (F.foldMap f (a `Cons` opt_as))
(F.foldMap f)
opt_as
instance Traversable Stream where
traverse f (a `Cons` opt_as) = Cons <$> f a <*> maybe (pure Nothing) (\ as -> Just <$> traverse f as) opt_as
observeStream :: (Show a) => String -> Stream a -> Stream a
observeStream nm (Cons a rest) = trace (show (nm,a)) $ Cons a $
case rest of
Nothing -> trace (show (nm,".")) $ Nothing
Just xs -> Just $ observeStream nm xs