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