module Data.Stream.Future
( Future(..)
, cons, (<|)
, head
, tail
, length
, tails
, map
, index
) where
import Prelude hiding (head, tail, map, length)
import Control.Applicative
import Control.Comonad
import Data.Foldable
import Data.Functor.Alt
import Data.Traversable
import Data.Semigroup hiding (Last)
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
#ifdef LANGUAGE_DeriveDataTypeable
import Data.Data
#endif
infixr 5 :<, <|
data Future a = Last a | a :< Future a deriving
( Eq, Ord, Show, Read
#ifdef LANGUAGE_DeriveDataTypeable
, Data, Typeable
#endif
)
(<|) :: a -> Future a -> Future a
(<|) = (:<)
cons :: a -> Future a -> Future a
cons = (:<)
head :: Future a -> a
head (Last a) = a
head (a :< _) = a
length :: Future a -> Int
length = go 1
where
go !n (Last _) = n
go !n (_ :< as) = go (n + 1) as
tail :: Future a -> Maybe (Future a)
tail (Last _) = Nothing
tail (_ :< as) = Just as
tails :: Future a -> Future (Future a)
tails w@(_ :< as) = w :< tails as
tails w@(Last _) = Last w
map :: (a -> b) -> Future a -> Future b
map f (a :< as) = f a :< map f as
map f (Last a) = Last (f a)
index :: Int -> Future a -> a
index n aas
| n < 0 = error "index: negative index"
| n == 0 = extract aas
| otherwise = case aas of
Last _ -> error "index: out of range"
_ :< as -> index (n 1) as
instance Functor Future where
fmap = map
b <$ (_ :< as) = b :< (b <$ as)
b <$ _ = Last b
instance Foldable Future where
foldMap = foldMapDefault
instance Traversable Future where
traverse f (Last a) = Last <$> f a
traverse f (a :< as) = (:<) <$> f a <*> traverse f as
instance Foldable1 Future
instance Traversable1 Future where
traverse1 f (Last a) = Last <$> f a
traverse1 f (a :< as) = (:<) <$> f a <.> traverse1 f as
instance Extend Future where
duplicate = tails
extend f w@(_ :< as) = f w :< extend f as
extend f w@(Last _) = Last (f w)
instance Comonad Future where
extract = head
instance Apply Future where
Last f <.> Last a = Last (f a)
(f :< _) <.> Last a = Last (f a)
Last f <.> (a :< _ ) = Last (f a)
(f :< fs) <.> (a :< as) = f a :< (fs <.> as)
Last a <. _ = Last a
(a :< _ ) <. Last _ = Last a
(a :< as) <. (_ :< bs) = a :< (as <. bs)
_ .> Last b = Last b
Last _ .> (b :< _) = Last b
(_ :< as) .> (b :< bs) = b :< (as .> bs)
instance Alt Future where
Last a <!> bs = a :< bs
(a :< as) <!> bs = a :< (as <!> bs)
instance Semigroup (Future a) where
(<>) = (<!>)
instance Applicative Future where
pure = Last
(<*>) = (<.>)
(<* ) = (<. )
( *>) = ( .>)