Since sodium has been deprecated by the author I'm trying to port my code to reactive-banana. However, there seem to be some incongruencies between the two that I'm having a hard time overcomming.
For example, in sodium it was easy to retrieve the current value of a behaviour:
retrieve :: Behaviour a -> IO a
retrieve b = sync $ sample b
I don't see how to do this in reactive-banana
(The reason I want this is because I'm trying to export the behaviour as a dbus property. Properties can be queried from other dbus clients)
Edit: Replaced the word "poll" as it was misleading
If you have a Behaviour modelling the value of your property, and you have an Event modelling the incoming requests for the property's value, then you can just use (<#) :: Behavior b -> Event a -> Event b1 to get a new event occurring at the times of your incoming requests with the value the property has at that time). Then you can transform that into the actual IO actions you need to take to reply to the request and use reactimate as usual.
1 https://hackage.haskell.org/package/reactive-banana-1.1.0.0/docs/Reactive-Banana-Combinators.html#v:-60--64-
For conceptual/architectural reasons, Reactive Banana has functions from Event to Behavior, but not vice versa, and it makes sense too, given th nature and meaning of FRP. I'm quite sure you can write a polling function, but instead you should consider changing the underlying code to expose events instead.
Is there a reason you can't change your Behavior into an Event? If not, that would be a good way to go about resolving your issue. (It might in theory even reveal a design shortcoming you have been overlooking so far.)
The answer seems to be "it's sort of possible".
sample corresponds to valueB, but there is no direct equivalent to sync.
However, it can be re-implemented with the help of execute:
module Sync where
import Control.Monad.Trans
import Data.IORef
import Reactive.Banana
import Reactive.Banana.Frameworks
data Network = Network { eventNetwork :: EventNetwork
, run :: MomentIO () -> IO ()
}
newNet :: IO Network
newNet = do
-- Create a new Event to handle MomentIO actions to be executed
(ah, call) <- newAddHandler
network <- compile $ do
globalExecuteEV <- fromAddHandler ah
-- Set it up so it executes MomentIO actions passed to it
_ <- execute globalExecuteEV
return ()
actuate network
return $ Network { eventNetwork = network
, run = call -- IO Action to fire the event
}
-- To run a MomentIO action within the context of the network, pass it to the
-- event.
sync :: Network -> MomentIO a -> IO a
sync Network{run = call} f = do
-- To retrieve the result of the action we set up an IORef
ref <- newIORef (error "Network hasn't written result to ref")
-- (`call' passes the do-block to the event)
call $ do
res <- f
-- Put the result into the IORef
liftIO $ writeIORef ref res
-- and read it back once the event has finished firing
readIORef ref
-- Example
main :: IO ()
main = do
net <- newNet -- Create an empty network
(bhv1, set1) <- sync net $ newBehavior (0 :: Integer)
(bhv2, set2) <- sync net $ newBehavior (0 :: Integer)
set1 3
set2 7
let sumB = (liftA2 (+) bhv1 bhv2)
print =<< sync net (valueB sumB)
set1 5
print =<< sync net (valueB sumB)
return ()
Starting from a previous question here:
Reactive Banana: how to use values from a remote API and merge them in the event stream
I have a bit different problem now: How can I use the Behaviour output as input for an IO operation and finally display the IO operation's result?
Below is the code from the previous answer changed with a second output:
import System.Random
type RemoteValue = Int
-- generate a random value within [0, 10)
getRemoteApiValue :: IO RemoteValue
getRemoteApiValue = (`mod` 10) <$> randomIO
getAnotherRemoteApiValue :: AppState -> IO RemoteValue
getAnotherRemoteApiValue state = (`mod` 10) <$> randomIO + count state
data AppState = AppState { count :: Int } deriving Show
transformState :: RemoteValue -> AppState -> AppState
transformState v (AppState x) = AppState $ x + v
main :: IO ()
main = start $ do
f <- frame [text := "AppState"]
myButton <- button f [text := "Go"]
output <- staticText f []
output2 <- staticText f []
set f [layout := minsize (sz 300 200)
$ margin 10
$ column 5 [widget myButton, widget output, widget output2]]
let networkDescription :: forall t. Frameworks t => Moment t ()
networkDescription = do
ebt <- event0 myButton command
remoteValueB <- fromPoll getRemoteApiValue
myRemoteValue <- changes remoteValueB
let
events = transformState <$> remoteValueB <# ebt
coreOfTheApp :: Behavior t AppState
coreOfTheApp = accumB (AppState 0) events
sink output [text :== show <$> coreOfTheApp]
sink output2 [text :== show <$> reactimate ( getAnotherRemoteApiValue <#> coreOfTheApp)]
network <- compile networkDescription
actuate network
As you can see what I am trying to do it is using the new state of the application -> getAnotherRemoteApiValue -> show. But it doesn't work.
Is actually possible doing that?
UPDATE
Based on the Erik Allik and Heinrich Apfelmus below answers I have the current code situation - that works :) :
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import System.Random
import Graphics.UI.WX hiding (Event, newEvent)
import Reactive.Banana
import Reactive.Banana.WX
data AppState = AppState { count :: Int } deriving Show
initialState :: AppState
initialState = AppState 0
transformState :: RemoteValue -> AppState -> AppState
transformState v (AppState x) = AppState $ x + v
type RemoteValue = Int
main :: IO ()
main = start $ do
f <- frame [text := "AppState"]
myButton <- button f [text := "Go"]
output1 <- staticText f []
output2 <- staticText f []
set f [layout := minsize (sz 300 200)
$ margin 10
$ column 5 [widget myButton, widget output1, widget output2]]
let networkDescription :: forall t. Frameworks t => Moment t ()
networkDescription = do
ebt <- event0 myButton command
remoteValue1B <- fromPoll getRemoteApiValue
let remoteValue1E = remoteValue1B <# ebt
appStateE = accumE initialState $ transformState <$> remoteValue1E
appStateB = stepper initialState appStateE
mapIO' :: (a -> IO b) -> Event t a -> Moment t (Event t b)
mapIO' ioFunc e1 = do
(e2, handler) <- newEvent
reactimate $ (\a -> ioFunc a >>= handler) <$> e1
return e2
remoteValue2E <- mapIO' getAnotherRemoteApiValue appStateE
let remoteValue2B = stepper Nothing $ Just <$> remoteValue2E
sink output1 [text :== show <$> appStateB]
sink output2 [text :== show <$> remoteValue2B]
network <- compile networkDescription
actuate network
getRemoteApiValue :: IO RemoteValue
getRemoteApiValue = do
putStrLn "getRemoteApiValue"
(`mod` 10) <$> randomIO
getAnotherRemoteApiValue :: AppState -> IO RemoteValue
getAnotherRemoteApiValue state = do
putStrLn $ "getAnotherRemoteApiValue: state = " ++ show state
return $ count state
The fundamental problem is a conceptual one: FRP Events and Behaviors can only be combined in a pure way. In principle, it is not possible to have a function of type, say
mapIO' :: (a -> IO b) -> Event a -> Event b
because the order in which the corresponding IO actions are to be executed is undefined.
In practice, it may sometimes be useful to perform IO while combining Events and Behaviors. The execute combinator can do this, as #ErikAllik indicates. Depending on the nature of getAnotherRemoteApiValue, this may be the right thing to do, in particular if this is function is idempotent, or does a quick lookup from location in RAM.
However, if the computation is more involved, then it is probably better to use reactimate to perform the IO computation. Using newEvent to create an AddHandler, we can give an implementation of the mapIO' function:
mapIO' :: (a -> IO b) -> Event a -> MomentIO (Event b)
mapIO' f e1 = do
(e2, handler) <- newEvent
reactimate $ (\a -> f a >>= handler) <$> e1
return e2
The key difference to the pure combinator
fmap :: (a -> b) -> Event a -> Event b
is that the latter guarantees that the input and result events occur simultaneously, while the former gives absolutely no guarantee about when the result event occurs in relation to other events in the network.
Note that execute also guarantees that input and result are have simultaneous occurrences, but places informal restrictions on the IO allowed.
With this trick of combining reactimate with newEvent a similar combinator can be written for Behaviors in a similar fashion. Keep in mind that the toolbox from Reactive.Banana.Frameworks is only appropriate if you are dealing with IO actions whose precise order will necessarily be undefined.
(To keep this answer current, I have used the type signatures from the upcoming reactive-banana 1.0. In version 0.9, the type signature for mapIO' is
mapIO' :: Frameworks t => (a -> IO b) -> Event t a -> Moment t (Event t b)
)
TL;DR: scroll down to the ANSWER: section for a solution along with an explanation.
First of all
getAnotherRemoteApiValue state = (`mod` 10) <$> randomIO + count state
is invalid (i.e. does not typecheck) for reasons completely unrelated to FRP or reactive-banana: you cannot add an Int to an IO Int — just as you can't apply mod 10 to an IO Int directly, which is exactly why, in the answer to your original question, I used <$> (which is another name for fmap from Functor).
I strongly recommend you look up and understand the purpose/meaning of <$>, along with <*> and some other Functor and Applicative type class methods — FRP (at least the way it is designed in reactive-banana) builds heavily upon Functors and Applicatives (and sometimes Monads, Arrows and possibly some other more novel foundation), hence if you don't completely understand those, you won't ever become proficient with FRP.
Secondly, I'm not sure why you're using coreOfTheApp for sink output2 ... — the coreOfTheApp value is related to the other API value.
Thirdly, how should the other API value be displayed? Or, more specifically, when should it be displayed? Your first API value is displayed when the button is clicked but there's no button for the second one — do you want the same button to trigger the API call and display update? Do you want another button? Or do you want it to be polled every n unit of time and simply auto-updated in the UI?
Lastly, reactimate is meant for converting a Behavior into an IO action, which is not what you want, because you already have the show helper and don't need to setText or smth on the static label. In other words, what you need for the second API value is the same as before, except you need to pass something from the app state along with the request to the external API, but aside from that difference, you can still just keep showing the (other) API value using show as normal.
ANSWER:
As to how to convert getAnotherRemoteApiValue :: AppState -> IO RemoteValue into an Event t Int similar to the original remoteValueE:
I first tried to go via IORefs and using changes+reactimate', but that quickly turned out to a dead end (besides being ugly and overly complicated): output2 was always updated one FRP "cycle" too late, so it was always one "version" behind in the UI.
I then, with the help of Oliver Charles (ocharles) on #haskell-game on FreeNode, turned to execute:
execute :: Event t (FrameworksMoment a) -> Moment t (Event t a)
which I still don't fully grasp yet, but it works:
let x = fmap (\s -> FrameworksMoment $ liftIO $ getAnotherRemoteApiValue s)
(appStateB <# ebt)
remoteValue2E <- execute x
so the same button would trigger both actions. But the problem with that quickly turned out to be the same as with the IORef based solution — since the same button would trigger a pair of events, and one event inside that pair depended on the other, the contents of output2 was still one version behind.
I then realised the events relatede to output2 need to be triggered after any events related to output1. However, it's impossible to go from Behavior t a -> Event t a; in other words, once you have a behavior, you can't (easily?) obtain an event from that (except with changes, but changes is tied to reactimate/reactimate', which is not useful here).
I finally noticed that I was essentially "throwing away" an intermediate Event at this line:
appStateB = accumB initialState $ transformState <$> remoteValue1E
by replacing it with
appStateE = accumE initialState $ transformState <$> remoteValue1E
appStateB = stepper initialState -- there seems to be no way to eliminate the initialState duplication but that's fine
so I still had the exact same appStateB, which is used as previously, but I could then also rely on appStateE to reliably trigger further events that rely on the AppState:
let x = fmap (\s -> FrameworksMoment $ liftIO $ getAnotherRemoteApiValue s)
appStateE
remoteValue2E <- execute x
The final sink output2 line looks like:
sink output2 [text :== show <$> remoteValue2B]
All of the code can be seen at http://lpaste.net/142202, with debug output still enabled.
Note that the (\s -> FrameworkMoment $ liftIO $ getAnotherRemoteApiValue s) lambda cannot be converted to point-free style for reasons related to RankN types. I was told this problem will go away in reactive-banana 1.0 because there will be no FrameworkMoment helper type.
I am reading a button's state (whether being pressed or not) every moment:
readButton :: IO Boolean
readButton = ...
main = do
(add, fire) <- newAddHandler
network <- compile (desc add)
actuate network
forever $ do
buttonState <- readButton
fire buttonState
desc addButtonEvent = do
eButtonState <- fromAddHandler addButtonEvent
...
All the read states are stored into eButtonState in the network description desc.
The button is considered to be newly pressed when the current moment's state is 1 with the previous moment's being 0. So, if the event sequence was a list, the function would be written like this:
f :: [Bool] -> Bool
f (True:False:_) = True
f _ = False
I want to apply this function to eButtonState so I would know whether the button is newly pressed or not in the moment.
Is it ever possible? How would you do it? I would appreciate if there is a better or more common idea or method to achieve this goal.
Here is one way (this is a runnable demo):
import Reactive.Banana
import Reactive.Banana.Frameworks
import Control.Monad
import Control.Applicative -- Needed if you aren't on GHC 7.10.
desc addDriver = do
-- Refreshes the button state. Presumably fired by external IO.
eButtonDriver <- fromAddHandler addDriver
let -- Canonical repersentation of the button state.
bButtonState = stepper False eButtonDriver
-- Observes the button just before changing its state.
ePreviousState = bButtonState <# eButtonDriver
-- Performs the test your f function would do.
newlyPressed :: Bool -> Bool -> Bool
newlyPressed previous current = not previous && current
-- Applies the test. This works because eButtonDriver and
-- ePreviousState are fired simultaneously.
eNewlyPressed = unionWith newlyPressed
ePreviousState eButtonDriver
-- The same but more compactly, without needing ePreviousState.
{-
eNewlyPressed = newlyPressed <$> bButtonState <#> eButtonDriver
-}
reactimate (print <$> eNewlyPressed)
main = do
(addDriver, fireDriver) <- newAddHandler
network <- compile (desc addDriver)
actuate network
-- Demo: enter y to turn the button on, and any other string to
-- turn it off.
forever $ do
buttonState <- (== "y") <$> getLine
fireDriver buttonState
Notes:
Events are transient, behaviors are permanent is a good general rule to decide whether you need a behavior or an event stream. In this case, you need to look at what the button state was before the update in order to decide whether it was newly updated. The natural thing to do, then, is to represent the button state with a behavior (bButtonState), which is updated by an event fired externally (eButtonDriver).
For details about what the combinators are doing, see Reactive.Banana.Combinators.
For the fine print on the timing of events and behavior updates in reactive-banana, see this question.
Depending on what you are trying to do, the changes function might be useful. Be aware of the caveats related to it mentioned by the documentation.
I'm learning Haskell, and trying to write some event-driven programs.
The following code is from the tutorial: http://www.haskell.org/haskellwiki/OpenGLTutorial2
main = do
(progname,_) <- getArgsAndInitialize
initialDisplayMode $= [DoubleBuffered]
createWindow "Hello World"
reshapeCallback $= Just reshape
angle <- newIORef (0.0::GLfloat) -- 1
delta <- newIORef (0.1::GLfloat) -- 2
position <- newIORef (0.0::GLfloat, 0.0) -- 3
keyboardMouseCallback $= Just (keyboardMouse delta position)
idleCallback $= Just (idle angle delta)
displayCallback $= (display angle position)
mainLoop
The states are stored in IORefs, which makes it looks just like imperative language.
I'v heard that there are APIs other than this Graphics.UI.GLUT, (e.g. Reactive), but it looks very complicated.
My approach is that the lib provide a function runEventHandler, and the user writes a handler that accepts list of Events and convert them to IO ().
handler :: [Event] -> IO ()
runEventHandler :: ( [Event] -> IO () ) -> IO ()
And the main function should look like:
main = runEventHandler handler
Is there such libs?
I am currently implementing one using multi-threading, but I'm worrying that it might be poor in performance ...
reactive-banana is a mature library very similar to reactive. We won't try to reinvent an frp library; instead we'll explore how to integrate reactive-banana into a project for ourselves.
The big picture
To use a functional reactive programming library like reactive-banana with OpenGL we will divide the work into 4 parts, 2 of which already exist. We will use the existing GLUT library to interact with OpenGL, and the existing reactive-banana library for an implementation of functional reactive programming. We will provide 2 parts of our own. The first part we will provide is a framework that will connect GLUT to reactive-banana. The second part we will provide is the program that will be written in terms of the frp implementation (reactive-banana) and framework and GLUT types.
Both of the parts that we provide will be written in terms of the reactive-banana frp library. The library has two big ideas, Event t a and Behavior t a. Event t a represents events carrying data of type a that occur at different points in time. Behavior t a represents a time varying value of type a that is defined at all points in time. The t type argument we are required by the type system to preserve but otherwise ignore.
Most of the interface to Event and Behavior are hidden in their instances. Event is a Functor - we can fmap or <$> a function over the values of any Event.
fmap :: (a -> b) -> Event t a -> Event t b
Behavior is both Applicative and a Functor. We can fmap or <$> a function over all the values a Behavior takes on, can provide new constant unchanging values with pure, and calculate new Behaviors with <*>.
fmap :: (a -> b) -> Behavior t a -> Behavior t b
pure :: a -> Behavior t a
<*> :: Behavior t (a -> b) -> Behavior t a -> Behavior t b
There are a few other functions provided by reactive-banana that provide functionality that can't be represented in terms of base typeclasses. These introduce statefulness, combine Events together, and convert between Events and Behaviors.
State is introduced by accumE which takes an initial value and an Event of changes from the previous value to a new value and produces an Event of the new values. accumB produces a Behavior instead
accumE :: a -> Event t (a -> a) -> Event t a
accumB :: a -> Event t (a -> a) -> Behavior t a
union combines two event streams together
union :: Event t a -> Event t a -> Event t a
stepper can convert an Event to a Behavior holding the most recent value if we provide an initial value so that it is defined at all points in time. apply or <#> can convert a Behavior into an Event if we provide a series of Events at which to poll the current value of the Behavior.
stepper :: a -> Event t a -> Behavior t a
<#> :: Behavior t (a -> b) -> Event t a -> Event t b
The instances for Event and Behavior and the 19 functions in Reactive.Banana.Combinators make up the entire interface for functional reactive programming.
Overall, we will need the GLUT library and libraries used by the OpenGL example we are implementing, the reactive-banana library, the reactive-banana exports for making frameworks and the RankNTypes extension, a couple mechanisms for interthread communication, and the ability to read the system clock.
{-# LANGUAGE RankNTypes #-}
import Graphics.UI.GLUT
import Control.Monad
import Reactive.Banana
import Reactive.Banana.Frameworks
import Data.IORef
import Control.Concurrent.MVar
import Data.Time
The framework interface
Our framework will map the IO events from GLUT to reactive-banana Events and Behaviors. There are four GLUT events that the example uses - reshapeCallback, keyboardMouseCallback, idleCallback, and displayCallback. We will map these to Events and Behaviors.
reshapeCallback is run when the user resizes the window. As a callback, it required something of the type type ReshapeCallback = Size -> IO (). We will represent this as an Event t Size.
keyboardMouseCallback is run when the user provides keyboard input, moves the mouse, or clicks a mouse button. As a callback, it required something of the type type KeyboardMouseCallback = Key -> KeyState -> Modifiers -> Position -> IO (). We will represent this as an input with type Event t KeyboardMouse, where KeyboardMouse bundles together all of the arguments passed to the callback.
data KeyboardMouse = KeyboardMouse {
key :: Key,
keyState :: KeyState,
modifiers :: Modifiers,
pos :: Position
}
idleCallback is run when time passes. We will represent this as a behavior that tracks the amount of time that has passed, Behavior t DiffTime. Because it is a Behavior instead of an Event, our program won't be able to directly observe time passing. If this isn't desired, we could use an Event instead.
Bundling all of the inputs together we get
data Inputs t = Inputs {
keyboardMouse :: Event t KeyboardMouse,
time :: Behavior t DiffTime,
reshape :: Event t Size
}
displayCallback is different from the other callbacks; it isn't for the input to the program, but instead is for outputting what needs to be displayed. Since GLUT could run this at any time to try to display something on the screen, it makes sense for it to be defined at all points in time. We will represent this output with a Behavior t DisplayCallback.
There is one more output we will need - in response to events the example program occasionally produces other IO actions. We will allow the program to raise events to execute arbitrary IO with an Event t (IO ()).
Bundling both outputs together we get
data Outputs t = Outputs {
display :: Behavior t DisplayCallback,
whenIdle :: Event t (IO ())
}
Our framework will be invoked by passing it a program with the type forall t. Inputs t -> Outputs t. We will define program and reactiveGLUT in the next two sections.
main :: IO ()
main = do
(progname,_) <- getArgsAndInitialize
initialDisplayMode $= [DoubleBuffered]
createWindow "Hello World"
reactiveGLUT program
The program
The program will use reactive-banana to map the Inputs to the Outputs. To get started porting the tutorial code, we'll remove the IORefs from cubes and rename reshape to onReshape since it conflicts with a name from our framework interface.
cubes :: GLfloat -> (GLfloat, GLfloat) -> DisplayCallback
cubes a (x',y') = do
clear [ColorBuffer]
loadIdentity
translate $ Vector3 x' y' 0
preservingMatrix $ do
rotate a $ Vector3 0 0 1
scale 0.7 0.7 (0.7::GLfloat)
forM_ (points 7) $ \(x,y,z) -> preservingMatrix $ do
color $ Color3 ((x+1)/2) ((y+1)/2) ((z+1)/2)
translate $ Vector3 x y z
cube 0.1
swapBuffers
onReshape :: ReshapeCallback
onReshape size = do
viewport $= (Position 0 0, size)
keyboardMouse will be completely replaced by positionChange and angleSpeedChange. These convert a KeyboardMouse event into a change to make to either the position or the speed the cubes are rotating. When no change is needed for an event, they return Nothing.
positionChange :: Fractional a => KeyboardMouse -> Maybe ((a, a) -> (a, a))
positionChange (KeyboardMouse (SpecialKey k) Down _ _) = case k of
KeyLeft -> Just $ \(x,y) -> (x-0.1,y)
KeyRight -> Just $ \(x,y) -> (x+0.1,y)
KeyUp -> Just $ \(x,y) -> (x,y+0.1)
KeyDown -> Just $ \(x,y) -> (x,y-0.1)
_ -> Nothing
positionChange _ = Nothing
angleSpeedChange :: Num a => KeyboardMouse -> Maybe (a -> a)
angleSpeedChange (KeyboardMouse (Char c) Down _ _) = case c of
' ' -> Just negate
'+' -> Just (+1)
'-' -> Just (subtract 1)
_ -> Nothing
angleSpeedChange _ = Nothing
Calculating the position is fairly easy, we accumulate the changes from the keyboard inputs. filterJust :: Event t (Maybe a) -> Event t a throws out the events that we weren't interested in.
positionB :: Fractional a => Inputs t -> Behavior t (a, a)
positionB = accumB (0.0, 0.0) . filterJust . fmap positionChange . keyboardMouse
We'll calculate the angle of the rotating cubes a bit differently. We'll remember the time and angle when the speed changes, apply a function that calculates the difference in angle to the difference in times, and add that to the initial angle.
angleCalculation :: (Num a, Num b) => a -> b -> (a -> b) -> a -> b
angleCalculation a0 b0 f a1 = f (a1 - a0) + b0
Calculating the angle is a bit more difficult. First we compute an event, angleF :: Event t (DiffTime -> GLfloat), holding a function from a difference between times to a difference between angles. We lift and apply our angleCalculation to the current time and angle, and poll that at each occurrence of the angleF event. We convert the polled function into a Behavior with stepper and apply it to the current time.
angleB :: Fractional a => Inputs t -> Behavior t a
angleB inputs = angle
where
initialSpeed = 2
angleSpeed = accumE initialSpeed . filterJust . fmap angleSpeedChange . keyboardMouse $ inputs
scaleSpeed x y = 10 * x * realToFrac y
angleF = scaleSpeed <$> angleSpeed
angleSteps = (angleCalculation <$> time inputs <*> angle) <#> angleF
angle = stepper (scaleSpeed initialSpeed) angleSteps <*> time inputs
The whole program maps Inputs to Outputs. It says that the behavior for what to display is cubes lifted and applied to the angle and position. The Event for other IO side effects is onReshape every time the reshape event happens.
program :: Inputs t -> Outputs t
program inputs = outputs
where
outputs = Outputs {
display = cubes <$> angleB inputs <*> positionB inputs,
whenIdle = onReshape <$> reshape inputs
}
The framework
Our framework accepts a program with the type forall t. Inputs t -> Outputs t and runs it. To implement the framework, we use the functions in Reactive.Banana.Frameworks. These functions allow us to raise Events from IO and run IO actions in response to Events. We can make Behaviors from Events and poll Behaviors when Events occur using the functions from Reactive.Banana.Combinators.
reactiveGLUT :: (forall t. Inputs t -> Outputs t) -> IO ()
reactiveGLUT program = do
-- Initial values
initialTime <- getCurrentTime
-- Events
(addKeyboardMouse, raiseKeyboardMouse) <- newAddHandler
(addTime, raiseTime) <- newAddHandler
(addReshape, raiseReshape) <- newAddHandler
(addDisplay, raiseDisplay) <- newAddHandler
newAddHandler creates a handle with which to talk about an Event t a, and a function to raise the event of type a -> IO (). We make the obvious events for keyboard and mouse input, idle time passing, and the window shape changing. We also make an event that we will use to poll the display Behavior when we need to run it in the displayCallback.
We have one tricky problem to overcome - OpenGL requires all the UI interaction to happen in a specific thread, but we aren't sure what thread the actions we bind to reactive-banana events will happen in. We'll use a couple of variables shared across threads to make sure the Output IO is run in the OpenGL thread. For display output, we'll use an MVar to store the polled display action. For IO actions that are queued in whenIdle we'll accumulate them in an IORef,
-- output variables and how to write to them
displayVar <- newEmptyMVar
whenIdleRef <- newIORef (return ())
let
setDisplay = putMVar displayVar
runDisplay = takeMVar displayVar >>= id
addWhenIdle y = atomicModifyIORef' whenIdleRef (\x -> (x >> y, ()))
runWhenIdle = atomicModifyIORef' whenIdleRef (\x -> (return (), x)) >>= id
Our whole network consists of the following parts. First we create Events (using fromAddHandler) or Behaviors (using fromChanges) for each of the Inputs and an Event for polling the output display. We perform a small amount of processing to simplify the clock. We apply the program to the inputs we prepared to get the program's Outputs. Using <#, we poll the display whenever our display event happens. Finally, reactimate tells reactive-banana to run setDisplay or addWhenIdle whenever the corresponsonding Event occurs. Once we have described the network we compile and actuate it.
-- Reactive network for GLUT programs
let networkDescription :: forall t. Frameworks t => Moment t ()
networkDescription = do
keyboardMouseEvent <- fromAddHandler addKeyboardMouse
clock <- fromChanges initialTime addTime
reshapeEvent <- fromAddHandler addReshape
displayEvent <- fromAddHandler addDisplay
let
diffTime = realToFrac . (flip diffUTCTime) initialTime <$> clock
inputs = Inputs keyboardMouseEvent diffTime reshapeEvent
outputs = program inputs
displayPoll = display outputs <# displayEvent
reactimate $ fmap setDisplay displayPoll
reactimate $ fmap addWhenIdle (whenIdle outputs)
network <- compile networkDescription
actuate network
For each of the GLUT callbacks we are interested in we raise the corresponding reactive-banana Event. For the idle callback we also run any queued events. For the display callback, we run the polled DisplayCallback.
-- Handle GLUT events
keyboardMouseCallback $= Just (\k ks m p -> raiseKeyboardMouse (KeyboardMouse k ks m p))
idleCallback $= Just (do
getCurrentTime >>= raiseTime
runWhenIdle
postRedisplay Nothing)
reshapeCallback $= Just raiseReshape
displayCallback $= do
raiseDisplay ()
runDisplay
mainLoop
The rest of the example
The rest of the tutorial code can be repeated verbatim
vertex3f :: (GLfloat, GLfloat, GLfloat) -> IO ()
vertex3f (x, y, z) = vertex $ Vertex3 x y z
points :: Int -> [(GLfloat,GLfloat,GLfloat)]
points n = [ (sin (2*pi*k/n'), cos (2*pi*k/n'), 0) | k <- [1..n'] ]
where n' = fromIntegral n
cube :: GLfloat -> IO ()
cube w = renderPrimitive Quads $ mapM_ vertex3f
[ ( w, w, w), ( w, w,-w), ( w,-w,-w), ( w,-w, w),
( w, w, w), ( w, w,-w), (-w, w,-w), (-w, w, w),
( w, w, w), ( w,-w, w), (-w,-w, w), (-w, w, w),
(-w, w, w), (-w, w,-w), (-w,-w,-w), (-w,-w, w),
( w,-w, w), ( w,-w,-w), (-w,-w,-w), (-w,-w, w),
( w, w,-w), ( w,-w,-w), (-w,-w,-w), (-w, w,-w) ]
Here's an example Haskell FRP program using the reactive-banana library. I'm only just starting to feel my way with Haskell, and especially haven't quite got my head around what FRP means. I'd really appreciate some critique of the code below
{-# LANGUAGE DeriveDataTypeable #-}
module Main where
{-
Example FRP/zeromq app.
The idea is that messages come into a zeromq socket in the form "id state". The state is of each id is tracked until it's complete.
-}
import Control.Monad
import Data.ByteString.Char8 as C (unpack)
import Data.Map as M
import Data.Maybe
import Reactive.Banana
import System.Environment (getArgs)
import System.ZMQ
data Msg = Msg {mid :: String, state :: String}
deriving (Show, Typeable)
type IdMap = Map String String
-- | Deserialize a string to a Maybe Msg
fromString :: String -> Maybe Msg
fromString s =
case words s of
(x:y:[]) -> Just $ Msg x y
_ -> Nothing
-- | Map a message to a partial operation on a map
-- If the 'state' of the message is "complete" the operation is a delete
-- otherwise it's an insert
toMap :: Msg -> IdMap -> IdMap
toMap msg = case msg of
Msg id_ "complete" -> delete id_
_ -> insert (mid msg) (state msg)
main :: IO ()
main = do
(socketHandle,runSocket) <- newAddHandler
args <- getArgs
let sockAddr = case args of
[s] -> s
_ -> "tcp://127.0.0.1:9999"
putStrLn ("Socket: " ++ sockAddr)
network <- compile $ do
recvd <- fromAddHandler socketHandle
let
-- Filter out the Nothings
justs = filterE isJust recvd
-- Accumulate the partially applied toMap operations
counter = accumE M.empty $ (toMap . fromJust <$> justs)
-- Print the contents
reactimate $ fmap print counter
actuate network
-- Get a socket and kick off the eventloop
withContext 1 $ \ctx ->
withSocket ctx Sub $ \sub -> do
connect sub sockAddr
subscribe sub ""
linkSocketHandler sub runSocket
-- | Recieve a message, deserialize it to a 'Msg' and call the action with the message
linkSocketHandler :: Socket a -> (Maybe Msg -> IO ()) -> IO ()
linkSocketHandler s runner = forever $ do
receive s [] >>= runner . fromString . C.unpack
There's a gist here: https://gist.github.com/1099712.
I'd particularly welcome any comments around whether this is a "good" use of accumE, (I'm unclear of this function will traverse the whole event stream each time although I'm guessing not).
Also I'd like to know how one would go about pulling in messages from multiple sockets - at the moment I have one event loop inside a forever. As a concrete example of this how would I add second socket (a REQ/REP pair in zeromq parlance) to query to the current state of the IdMap inside counter?
(Author of reactive-banana speaking.)
Overall, your code looks fine to me. I don't actually understand why you are using reactive-banana in the first place, but you'll have your reasons. That said, if you are looking for something like Node.js, remember that Haskell's leightweight threads make it unnecessary to use an event-based architecture.
Addendum: Basically, functional reactive programming is useful when you have a variety of different inputs, states and output that must work together with just the right timing (think GUIs, animations, audio). In contrast, it's overkill when you are dealing with many essentially independent events; these are best handled with ordinary functions and the occasional state.
Concerning the individual questions:
"I'd particularly welcome any comments around whether this is a "good" use of accumE, (I'm unclear of this function will traverse the whole event stream each time although I'm guessing not)."
Looks fine to me. As you guessed, the accumE function is indeed real-time; it will only store the current accumulated value.
Judging from your guess, you seem to be thinking that whenever a new event comes in, it will travel through the network like a firefly. While this does happen internally, it is not how you should think about functional reactive programming. Rather, the right picture is this: the result of fromAddHandler is the complete list of input events as they will happen. In other words, you should think that recvd contains the ordered list of each and every event from the future. (Of course, in the interest of your own sanity, you shouldn't try to look at them before their time has come. ;-)) The accumE function simply transforms one list into another by traversing it once.
I will need to make this way of thinking more clear in the documentation.
"Also I'd like to know how one would go about pulling in messages from multiple sockets - at the moment I have on event loop inside a forever. As a concrete example of this how would I add second socket (a REQ/REP pair in zeromq parlance) to query to the current state of the IdMap inside counter?"
If the receive function does not block, you can simply call it twice on different sockets
linkSocketHandler s1 s2 runner1 runner2 = forever $ do
receive s1 [] >>= runner1 . fromString . C.unpack
receive s2 [] >>= runner2 . fromString . C.unpack
If it does block, you will need to use threads, see also the section Handling Multiple TCP Streams in the book Real World Haskell. (Feel free to ask a new question on this, as it is outside the scope of this one.)