{-----------------------------------------------------------------------------
Reactive Banana
Linking any implementation to an event-based framework
------------------------------------------------------------------------------}moduleReactive.Banana.Implementation(-- * Synopsis-- | Run event networks and hook them up to existing event-based frameworks.-- * ImplementationPushIO,run,-- * Using existing event-based frameworks-- $PreparePrepare,prepareEvents,reactimate,AddHandler,fromAddHandler,liftIO,moduleData.Dynamic,)whereimportReactive.Banana.PushIOasImplementation-- import Reactive.Banana.Model hiding (Event, Behavior, run)importqualifiedReactive.Banana.ModelasModelimportData.DynamicimportData.List(nub)importControl.ApplicativeimportControl.Monad.RWSimportData.IORef-- debug = putStrLn{-----------------------------------------------------------------------------
PushIO specific functions
------------------------------------------------------------------------------}typeFlavor=PushIOinput::Typeablea=>Channel->Model.EventPushIOainput=event.InputcompileHandlers::Model.EventFlavor(IO())->IO[(Channel,Universe->IO())]compileHandlersnetwork=do-- compile networkletnetwork'=Implementation.unEventnetwork(paths,cache)<-Implementation.compile(invalidRef,Reactimatenetwork')-- reduce to one path per channelletpaths1=groupChannelsBy(\pqx->px>>qx)paths-- prepare threading the cache as statercache<-newIORefemptyCachewriteIORefrcachecacheletrunm=docache<-readIORefrcache(_,cache')<-runRunmcachewriteIORefrcachecache'paths2=map(\(i,p)->(i,run.p))$paths1returnpaths2-- FIXME: make this fastergroupChannelsBy::(a->a->a)->[(Channel,a)]->[(Channel,a)]groupChannelsByfxs=[(i,foldr1f[x|(j,x)<-xs,i==j])|i<-channels]wherechannels=nub.mapfst$xs{-----------------------------------------------------------------------------
Setting up an event network
------------------------------------------------------------------------------}{-$Prepare
After having read all about 'Event's and 'Behavior's,
you want to hook things up to an existing event-based framework,
like @wxHaskell@ or @Gtk2Hs@.
How do you do that?
To do that, you have to use the 'Prepare' monad.
The typical setup looks like this:
> main = do
> ... -- other initialization
>
> -- initialize event network
> prepareEvents $ do
> -- obtain Event from functions that register event handlers
> emouse <- fromAddHandler (registerMouseEvent window)
> ekeyboard <- fromAddHandler (registerKeyEvent window)
>
> -- build event network
> let
> behavior1 = accumB ...
> ...
> event15 = union event13 event14
>
> -- animate relevant event occurences
> reactimate $ fmap print event15
> reactimate $ fmap drawCircle eventCircle
>
> ... -- start the GUI framework here
In short, you use 'fromAddHandler' to obtain /input events/;
the library will register corresponding event handlers
with your event-based framework.
To animate /output events/, you use the 'reactimate' function.
The whole setup has to be wrapped into a call to 'prepareEvents'.
The 'Prepare' monad is an instance of 'MonadIO',
so 'IO' is allowed inside. However, you can't pass anything
of type @Event@ or @Behavior@ outside the 'prepareEvents' call;
this is intentional.
(You can probably circumvent this with mutable variables,
but there is a 99,8% chance that earth will be suspended
by time-traveling zygohistomorphisms
if you do that; you have been warned.)
-}typeAddHandler'=(Channel,(Universe->IO())->IO())typePreparations=([Model.EventFlavor(IO())],[AddHandler'])newtypePreparea=Prepare{unPrepare::RWST()PreparationsChannelIOa}instanceMonad(Prepare)wherereturn=Prepare.returnm>>=k=Prepare$unPreparem>>=unPrepare.kinstanceMonadIOPreparewhereliftIO=Prepare.liftIO-- | Animate an output event.-- Executes the 'IO' action whenever the event occurs.reactimate::Model.EventPushIO(IO())->Prepare()reactimatee=Prepare$tell([e],[])-- | Wrap around the 'Prepare' monad to set up an event network.prepareEvents::Prepare()->IO()prepareEvents(Preparem)=do(_,_,(outputs,inputs))<-runRWSTm()0let-- union of all reactimatesnetwork=mconcatoutputs::Model.EventPushIO(IO())-- compile networkpaths<-compileHandlersnetwork-- register event handlerssequence_.mapsnd.applyChannelsinputs$paths-- FIXME: make this fasterapplyChannels::[(Channel,a->b)]->[(Channel,a)]->[(Channel,b)]applyChannelsfsxs=[(i,fx)|(i,f)<-fs,(j,x)<-xs,i==j]-- | A value of type @AddHandler a@ is just an IO function that registers-- callback functions, also known as event handlers. typeAddHandlera=(a->IO())->IO()-- | Obtain an 'Event' from an 'AddHandler'.-- This will register a callback function such that-- an event will occur whenever the callback function is called.fromAddHandler::Typeablea=>AddHandlera->Prepare(Model.EventPushIOa)fromAddHandleraddHandler=Prepare$dochannel<-newChannelletaddHandler'k=addHandler$k.toUniversechanneltell([],[(channel,addHandler')])return$inputchannelwherenewChannel=doc<-get;put$!c+1;returnc{-----------------------------------------------------------------------------
Run function for testing
------------------------------------------------------------------------------}-- | Running an event network for the purpose of easy testing.run::Typeablea=>(Model.EventPushIOa->Model.EventPushIOb)->[a]->IO[[b]]runfxs=dooref<-newIORef[]href<-newIORef[]letaddHandlerk=modifyIORefhref(++[k])prepareEvents$doe<-fromAddHandleraddHandlerreactimate$fmap(\b->modifyIOReforef(++[b]))(fe)handler<-(\ksx->mapM($x)ks)<$>readIORefhrefforMxs$\x->dohandlerxbs<-readIOReforefwriteIOReforef[]returnbs