{-# OPTIONS_HADDOCK prune #-}
module ForSyDe.Atom.MoC.Stream where
infixr 3 :-
data Stream e = NullS
| e :- Stream e
instance Functor Stream where
fmap :: (a -> b) -> Stream a -> Stream b
fmap _ NullS = Stream b
forall e. Stream e
NullS
fmap f :: a -> b
f (x :: a
x:-xs :: Stream a
xs) = a -> b
f a
x b -> Stream b -> Stream b
forall e. e -> Stream e -> Stream e
:- (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
instance Applicative Stream where
pure :: a -> Stream a
pure x :: a
x = a
x a -> Stream a -> Stream a
forall e. e -> Stream e -> Stream e
:- Stream a
forall e. Stream e
NullS
_ <*> :: Stream (a -> b) -> Stream a -> Stream b
<*> NullS = Stream b
forall e. Stream e
NullS
NullS <*> _ = Stream b
forall e. Stream e
NullS
(f :: a -> b
f:-fs :: Stream (a -> b)
fs) <*> (x :: a
x:-xs :: Stream a
xs) = a -> b
f a
x b -> Stream b -> Stream b
forall e. e -> Stream e -> Stream e
:- Stream (a -> b)
fs Stream (a -> b) -> Stream a -> Stream b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Stream a
xs
instance Foldable Stream where
foldr :: (a -> b -> b) -> b -> Stream a -> b
foldr k :: a -> b -> b
k z :: b
z = Stream a -> b
go
where
go :: Stream a -> b
go NullS = b
z
go (y :: a
y:-ys :: Stream a
ys) = a
y a -> b -> b
`k` Stream a -> b
go Stream a
ys
instance (Show a) => Show (Stream a) where
showsPrec :: Int -> Stream a -> ShowS
showsPrec p :: Int
p = Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>1) (ShowS -> ShowS) -> (Stream a -> ShowS) -> Stream a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> ShowS
forall a. Show a => Stream a -> ShowS
showStream
where
showStream :: Stream a -> ShowS
showStream (x :: a
x :- xs :: Stream a
xs) = Char -> ShowS
showChar '{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
showEvent a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> ShowS
forall a. Show a => Stream a -> ShowS
showStream' Stream a
xs
showStream (Stream a
NullS) = Char -> ShowS
showChar '{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '}'
showStream' :: Stream a -> ShowS
showStream' (x :: a
x :- xs :: Stream a
xs) = Char -> ShowS
showChar ',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
showEvent a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> ShowS
showStream' Stream a
xs
showStream' (Stream a
NullS) = Char -> ShowS
showChar '}'
showEvent :: a -> ShowS
showEvent x :: a
x = a -> ShowS
forall a. Show a => a -> ShowS
shows a
x
instance (Read a) => Read (Stream a) where
readsPrec :: Int -> ReadS (Stream a)
readsPrec d :: Int
d = Bool -> ReadS (Stream a) -> ReadS (Stream a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
dInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>1) ReadS (Stream a)
readStreamStart
where
readStreamStart :: ReadS (Stream a)
readStreamStart = (\ a :: String
a -> [(Stream a
xs,String
c) | ("{",b :: String
b) <- ReadS String
lex String
a , (xs :: Stream a
xs,c :: String
c) <- ReadS (Stream a)
forall e. Read e => String -> [(Stream e, String)]
readStream (',' Char -> ShowS
forall a. a -> [a] -> [a]
: String
b) [(Stream a, String)]
-> [(Stream a, String)] -> [(Stream a, String)]
forall a. [a] -> [a] -> [a]
++ ReadS (Stream a)
forall e. String -> [(Stream e, String)]
readNull String
b])
readStream :: String -> [(Stream e, String)]
readStream r :: String
r = String -> [(Stream e, String)]
readEvent String
r [(Stream e, String)]
-> [(Stream e, String)] -> [(Stream e, String)]
forall a. [a] -> [a] -> [a]
++ String -> [(Stream e, String)]
forall e. String -> [(Stream e, String)]
readNull String
r
readEvent :: String -> [(Stream e, String)]
readEvent a :: String
a = [(e
x e -> Stream e -> Stream e
forall e. e -> Stream e -> Stream e
:- Stream e
xs,String
d) | (",",b :: String
b) <- ReadS String
lex String
a , (x :: e
x,c :: String
c) <- ReadS e
forall a. Read a => ReadS a
reads String
b , (xs :: Stream e
xs,d :: String
d) <- String -> [(Stream e, String)]
readStream String
c]
readNull :: String -> [(Stream e, String)]
readNull a :: String
a = [(Stream e
forall e. Stream e
NullS,String
b) | ("}",b :: String
b) <- ReadS String
lex String
a]
stream :: [a] -> Stream a
stream :: [a] -> Stream a
stream [] = Stream a
forall e. Stream e
NullS
stream (x :: a
x:xs :: [a]
xs) = a
x a -> Stream a -> Stream a
forall e. e -> Stream e -> Stream e
:- ([a] -> Stream a
forall a. [a] -> Stream a
stream [a]
xs)
fromStream :: Stream a -> [a]
fromStream :: Stream a -> [a]
fromStream NullS = []
fromStream (x :: a
x:-xs :: Stream a
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Stream a -> [a]
forall a. Stream a -> [a]
fromStream Stream a
xs
headS :: Stream a -> a
headS :: Stream a -> a
headS NullS = String -> a
forall a. HasCallStack => String -> a
error "Empty signal"
headS (x :: a
x :- _) = a
x
tailS :: Stream e -> Stream e
tailS NullS = Stream e
forall e. Stream e
NullS
tailS (_ :- a :: Stream e
a) = Stream e
a
lastS :: Stream p -> p
lastS NullS = String -> p
forall a. HasCallStack => String -> a
error "Empty signal"
lastS (x :: p
x:-NullS) = p
x
lastS (_:- xs :: Stream p
xs) = Stream p -> p
lastS Stream p
xs
repeatS :: a -> Stream a
repeatS :: a -> Stream a
repeatS a :: a
a = a
a a -> Stream a -> Stream a
forall e. e -> Stream e -> Stream e
:- a -> Stream a
forall a. a -> Stream a
repeatS a
a
takeS :: t -> Stream e -> Stream e
takeS 0 _ = Stream e
forall e. Stream e
NullS
takeS _ NullS = Stream e
forall e. Stream e
NullS
takeS n :: t
n (x :: e
x:-xs :: Stream e
xs)
| t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Stream e
forall e. Stream e
NullS
| Bool
otherwise = e
x e -> Stream e -> Stream e
forall e. e -> Stream e -> Stream e
:- t -> Stream e -> Stream e
takeS (t
nt -> t -> t
forall a. Num a => a -> a -> a
-1) Stream e
xs
dropS :: t -> Stream e -> Stream e
dropS 0 NullS = Stream e
forall e. Stream e
NullS
dropS _ NullS = Stream e
forall e. Stream e
NullS
dropS n :: t
n (x :: e
x:-xs :: Stream e
xs)
| t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = e
xe -> Stream e -> Stream e
forall e. e -> Stream e -> Stream e
:-Stream e
xs
| Bool
otherwise = t -> Stream e -> Stream e
dropS (t
nt -> t -> t
forall a. Num a => a -> a -> a
-1) Stream e
xs
takeWhileS :: (a -> Bool) -> Stream a -> Stream a
takeWhileS :: (a -> Bool) -> Stream a -> Stream a
takeWhileS _ NullS = Stream a
forall e. Stream e
NullS
takeWhileS p :: a -> Bool
p (x :: a
x:-xs :: Stream a
xs)
| a -> Bool
p a
x = a
x a -> Stream a -> Stream a
forall e. e -> Stream e -> Stream e
:- (a -> Bool) -> Stream a -> Stream a
forall a. (a -> Bool) -> Stream a -> Stream a
takeWhileS a -> Bool
p Stream a
xs
| Bool
otherwise = Stream a
forall e. Stream e
NullS
+-+ :: Stream e -> Stream e -> Stream e
(+-+) NullS ys :: Stream e
ys = Stream e
ys
(+-+) (x :: e
x:-xs :: Stream e
xs) ys :: Stream e
ys = e
x e -> Stream e -> Stream e
forall e. e -> Stream e -> Stream e
:- (Stream e
xs Stream e -> Stream e -> Stream e
+-+ Stream e
ys)
(-$-) :: Functor e => (a -> b) -> Stream (e a) -> Stream (e b)
-$- :: (a -> b) -> Stream (e a) -> Stream (e b)
(-$-) = (e a -> e b) -> Stream (e a) -> Stream (e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e a -> e b) -> Stream (e a) -> Stream (e b))
-> ((a -> b) -> e a -> e b)
-> (a -> b)
-> Stream (e a)
-> Stream (e b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> e a -> e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap