Atze,
I have a question about Streams.
In the Paper Impl the following code:
newtype Stream a = S { next :: B (E a) }
catMaybesStream :: Stream (Maybe a) -> Stream a
catMaybesStream (S s) = S loop where
loop = do e <- s
join <$> plan (nxt <$> e)
-- nxt :: Maybe a -> B (E a)
nxt (Just a) = return (return a)
nxt Nothing = loop
Which I understand.
And in the library the following code:
newtype EvStream a = S { getEs :: Behavior (Event [a]) }
catMaybesEs :: EvStream (Maybe a) -> EvStream a
catMaybesEs s = S $ loop where
-- loop :: Behavior (Event [a])
loop = do e <- getEs s
join <$> plan (nxt <$> e)
nxt l = case catMaybes l of
[] -> loop
l -> return (return l)
I assume the new type EvStream the intent is for the stream of ‘a’ to be an array rather than a recursive data structure, based on the name ‘getEs’.
But, catMaybeEs is written like the paper version, suggesting it is a recursive data structure arrays.
My goal is to write an integrator for a stream, such that the type signature is:
EvStream (Double,Double) -> EvStream (Double)
where the tuple is (data, time) and the result is (integratedData)
and I modeled the function catMaybeEs, but it is not working. So I want to understand the general way to handle the stream in catMaybesEs.
Mike
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.orghttp://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe