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 (e.g.., 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 t a -> EventG t b
>
> 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 x q)
Thanks for all your help,
Sam