{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor  #-}

module Kanren.Stream (Stream (..), maybeToStream, interleave) where

import           Prelude hiding (take)

data Stream a
  = Done
  | Only a
  | Yield a (Stream a)
  | Await (Stream a)
  deriving ((forall a b. (a -> b) -> Stream a -> Stream b)
-> (forall a b. a -> Stream b -> Stream a) -> Functor Stream
forall a b. a -> Stream b -> Stream a
forall a b. (a -> b) -> Stream a -> Stream b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Stream a -> Stream b
fmap :: forall a b. (a -> b) -> Stream a -> Stream b
$c<$ :: forall a b. a -> Stream b -> Stream a
<$ :: forall a b. a -> Stream b -> Stream a
Functor, (forall m. Monoid m => Stream m -> m)
-> (forall m a. Monoid m => (a -> m) -> Stream a -> m)
-> (forall m a. Monoid m => (a -> m) -> Stream a -> m)
-> (forall a b. (a -> b -> b) -> b -> Stream a -> b)
-> (forall a b. (a -> b -> b) -> b -> Stream a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stream a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stream a -> b)
-> (forall a. (a -> a -> a) -> Stream a -> a)
-> (forall a. (a -> a -> a) -> Stream a -> a)
-> (forall a. Stream a -> [a])
-> (forall a. Stream a -> Bool)
-> (forall a. Stream a -> Int)
-> (forall a. Eq a => a -> Stream a -> Bool)
-> (forall a. Ord a => Stream a -> a)
-> (forall a. Ord a => Stream a -> a)
-> (forall a. Num a => Stream a -> a)
-> (forall a. Num a => Stream a -> a)
-> Foldable Stream
forall a. Eq a => a -> Stream a -> Bool
forall a. Num a => Stream a -> a
forall a. Ord a => Stream a -> a
forall m. Monoid m => Stream m -> m
forall a. Stream a -> Bool
forall a. Stream a -> Int
forall a. Stream a -> [a]
forall a. (a -> a -> a) -> Stream a -> a
forall m a. Monoid m => (a -> m) -> Stream a -> m
forall b a. (b -> a -> b) -> b -> Stream a -> b
forall a b. (a -> b -> b) -> b -> Stream a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Stream m -> m
fold :: forall m. Monoid m => Stream m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Stream a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Stream a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Stream a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Stream a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Stream a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Stream a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Stream a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Stream a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Stream a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Stream a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Stream a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Stream a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Stream a -> a
foldr1 :: forall a. (a -> a -> a) -> Stream a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Stream a -> a
foldl1 :: forall a. (a -> a -> a) -> Stream a -> a
$ctoList :: forall a. Stream a -> [a]
toList :: forall a. Stream a -> [a]
$cnull :: forall a. Stream a -> Bool
null :: forall a. Stream a -> Bool
$clength :: forall a. Stream a -> Int
length :: forall a. Stream a -> Int
$celem :: forall a. Eq a => a -> Stream a -> Bool
elem :: forall a. Eq a => a -> Stream a -> Bool
$cmaximum :: forall a. Ord a => Stream a -> a
maximum :: forall a. Ord a => Stream a -> a
$cminimum :: forall a. Ord a => Stream a -> a
minimum :: forall a. Ord a => Stream a -> a
$csum :: forall a. Num a => Stream a -> a
sum :: forall a. Num a => Stream a -> a
$cproduct :: forall a. Num a => Stream a -> a
product :: forall a. Num a => Stream a -> a
Foldable)

instance (Show a) => Show (Stream a) where
  show :: Stream a -> String
show Stream a
ys = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Stream a -> String
forall a. Show a => Stream a -> String
show' Stream a
ys
   where
    show' :: Stream a -> String
show' Stream a
Done                     = String
"]"
    show' (Only a
x)                 = a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    show' (Yield a
x xs :: Stream a
xs@(Yield a
_ Stream a
_)) = a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Stream a -> String
show' Stream a
xs
    show' (Yield a
x Stream a
xs)             = a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ Stream a -> String
show' Stream a
xs
    show' (Await Stream a
xs)               = Stream a -> String
forall a. Show a => a -> String
show Stream a
xs    -- FIXME: demonstrate the use of Await

instance Applicative Stream where
  pure :: forall a. a -> Stream a
pure = a -> Stream a
forall a. a -> Stream a
Only

  Stream (a -> b)
Done <*> :: forall a b. Stream (a -> b) -> Stream a -> Stream b
<*> Stream a
_        = Stream b
forall a. Stream a
Done
  Only a -> b
f <*> Stream a
xs     = (a -> b) -> Stream a -> Stream b
forall a b. (a -> b) -> Stream a -> Stream b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Stream a
xs
  Yield a -> b
f Stream (a -> b)
fs <*> Stream a
xs = Stream b -> Stream b -> Stream b
forall a. Stream a -> Stream a -> Stream a
interleave ((a -> b) -> Stream a -> Stream b
forall a b. (a -> b) -> Stream a -> Stream b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Stream a
xs) (Stream (a -> b)
fs Stream (a -> b) -> Stream a -> Stream b
forall a b. Stream (a -> b) -> Stream a -> Stream b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Stream a
xs)
  Await Stream (a -> b)
fs <*> Stream a
xs   = Stream b -> Stream b
forall a. Stream a -> Stream a
Await (Stream (a -> b)
fs Stream (a -> b) -> Stream a -> Stream b
forall a b. Stream (a -> b) -> Stream a -> Stream b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Stream a
xs)

instance Monad Stream where
  Stream a
Done >>= :: forall a b. Stream a -> (a -> Stream b) -> Stream b
>>= a -> Stream b
_       = Stream b
forall a. Stream a
Done
  Only a
x >>= a -> Stream b
f     = a -> Stream b
f a
x
  Yield a
x Stream a
xs >>= a -> Stream b
f = Stream b -> Stream b -> Stream b
forall a. Stream a -> Stream a -> Stream a
interleave (a -> Stream b
f a
x) (Stream a
xs Stream a -> (a -> Stream b) -> Stream b
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Stream b
f)
  Await Stream a
xs >>= a -> Stream b
f   = Stream b -> Stream b
forall a. Stream a -> Stream a
Await (Stream a
xs Stream a -> (a -> Stream b) -> Stream b
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Stream b
f)

maybeToStream :: Maybe a -> Stream a
maybeToStream :: forall a. Maybe a -> Stream a
maybeToStream Maybe a
Nothing  = Stream a
forall a. Stream a
Done
maybeToStream (Just a
x) = a -> Stream a
forall a. a -> Stream a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

interleave :: Stream a -> Stream a -> Stream a
interleave :: forall a. Stream a -> Stream a -> Stream a
interleave Stream a
Done Stream a
ys         = Stream a
ys
interleave (Only a
x) Stream a
ys     = a -> Stream a -> Stream a
forall a. a -> Stream a -> Stream a
Yield a
x Stream a
ys
interleave (Yield a
x Stream a
xs) Stream a
ys = a -> Stream a -> Stream a
forall a. a -> Stream a -> Stream a
Yield a
x (Stream a -> Stream a -> Stream a
forall a. Stream a -> Stream a -> Stream a
interleave Stream a
ys Stream a
xs)
interleave (Await Stream a
xs) Stream a
ys   = Stream a -> Stream a
forall a. Stream a -> Stream a
Await (Stream a -> Stream a -> Stream a
forall a. Stream a -> Stream a -> Stream a
interleave Stream a
ys Stream a
xs)