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
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
