[Haskell-cafe] coding a queue with reactive

[sam.roberts.1983 at gmail.com]

Thanks, Ryan. I think I unppderstand the idea behind your function,
which is a lot cleaner then my first queue implementation.
I'm not sure if I could have quite programmed it from scratch
yet, but that will come in time!

I had to fix up a little bit of glue code to get your suggestions
to compile. I've added the resulting code below. I'm sure it can
be improved (eg., the time type constraints I added to the queue
function seem overly restrictive), but for now it works.

> module DraftQueue where

> import Data.Monoid
> import Control.Applicative
> import FRP.Reactive
> import FRP.Reactive.Improving
> import Data.AddBounds
> import FRP.Reactive.Future
> import FRP.Reactive.Internal.Reactive
> import FRP.Reactive.Internal.Future


> stateMachine :: (Ord t, Bounded t) => s -> (a -> s -> s) -> (s -> FutureG  
> t (b, s)) -> EventG ta -> EventG tb

> stateMachineF s0 upd run (Event inp) = do
> x <- mappend (Left <$> run s0) (Right <$> inp)
> case x of
> Left (b,sNext) -> return (Stepper b (stateMachine sNext upd run (Event  
> inp)))
> Right (Stepper a inpNext) -> stateMachineF (upd a s0) upd run inpNext

> stateMachine s0 upd run inp = Event $ stateMachineF s0 upd run inp


> queue :: (Num t, Ord t) => t -> EventG (Improving (AddBounds t)) a ->  
> EventG (Improving (AddBounds t)) a
> queue delay = stateMachine Nothing upd run . withTimeE where
> improve = exactly . NoBound
> run Nothing = mempty
> run (Just (t, a, q)) = future (improve t) (a, sNext) where
> sNext = fmap (\(a', q') -> (t + delay, a', q')) (viewQ q)
> upd (x, time) Nothing = Just (time + delay, x, emptyQ)
> upd (x, time) (Just (t, a, q)) = Just (t, a, pushQ xq)

Thanks for all your help,
Sam
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20110216/7db05333/attachment.htm>