I'm doing some research into practical aspects of FRP for UI's and I've been struggling with implementing the following functionality using reactive banana: based on the value of a selection box, a variable amount of list boxes are rendered which display some results. (I'm using WxHaskell.)
It was pretty straightforward to implement this using a bunch of prepared list boxes that are hidden and shown based on the result behavior, but this time I want it to create and destroy list boxes as needed, each list box linked to the results behavior.
So far I have the following ingredients:
an event eParam which is bound to the selection box
a behavior bResults :: Behavior t [[String]] defined with eParam (and stepper) which holds all the results (lists of items per list box)
an update function updateResultControls :: [SingleListBox ()] -> [[String]] -> IO [SingleListBox ()] which destroys or builds the list boxes based on the results. Note that the return type is in IO.
Looking at the BarTab example, I've tried to implement the following:
a behavior bResultControls :: Behavior t [SingleListBox ()] with the list boxes, defined as stepper [] eUpdateResultControls.
an event eUpdateResultControls :: Event t [SingleListBox ()] that performs the UI update. This event depends on the behaviors bResultControls and bResults. However, it also has to update the network and run IO, so I suspect Moment and execute will be involved. This is where I got stuck.
My latest attempt is this:
rec
let
bResultControls = stepper [] eResultControls
bResultControlsUpdate = updateResultControls <$> bResultControls <*> bResults
eResultControls <- execute $ FrameworksMoment . liftIO <$> (bResultControlsUpdate <# eParam)
But I get the following type error:
Couldn't match type `m0 [SingleListBox ()]'
with `forall t1. Frameworks t1 => Moment t1 [SingleListBox ()]'
Expected type: IO [SingleListBox ()]
-> forall t. Frameworks t => Moment t [SingleListBox ()]
Actual type: IO [SingleListBox ()] -> m0 [SingleListBox ()]
In the second argument of `(.)', namely `liftIO'
In the first argument of `(<$>)', namely
`FrameworksMoment . liftIO'
In the second argument of `($)', namely
`FrameworksMoment . liftIO <$> (bResultControlsUpdate <# eParam)'
I suspect this will involve trimming some behaviors, or perhaps I'm going about this entirely the wrong way.
After some more reading and experimenting I got it to work with some careful trimming and refactoring (as hinted at by Heinrich):
networkDescription :: forall t. Frameworks t => Moment t ()
networkDescription = do
eParam <- choiceSelection cParam
let bResults = results <$> stepper x eParam
bResults_ <- trimB bResults
rec
let
bResultControls = stepper [] eResultControls
mkResultControls :: [SingleListBox ()] -> [[String]] -> FrameworksMoment [SingleListBox ()]
mkResultControls cs rs = FrameworksMoment $ do
slResults <- liftIO $ updateResultControls cs rs
bResults <- now bResults_
sequence_ [sink sl [items :== (!! i) <$> bResults] | sl <- slResults | i <- [0..]]
liftIO $ do
let n = length rs
set f [clientSize := sz (150 * n) 200]
set pResults [layout := fill $ boxed "results" $ row n (map (fill . widget) slResults)]
refit f
return slResults
eResultControls <- execute $ (mkResultControls <$> stepper [] eResultControls <*> bResults) <# eParam
return ()
(Just got a little bug now where the event fires before the behavior updates but that should be easy to fix.)
Related
I am using a library that I can provide with a function a -> IO (), which it will call occasionally.
Because the output of my function depends not only on the a it receives as input, but also on the previous a's, it would be much easier for me to write a function [a] -> IO (), where [a] is infinite.
Can I write a function:
magical :: ([a] -> IO ()) -> (a -> IO ())
That collects the a's it receives from the callback and passes them to my function as a lazy infinite list?
The IORef solution is indeed the simplest one. If you'd like to explore a pure (but more complex) variant, have a look at conduit. There are other implementations of the same concept, see Iteratee I/O, but I found myself conduit to be very easy to use.
A conduit (AKA pipe) is an abstraction of of program that can accept input and/or produce output. As such, it can keep internal state, if needed. In your case, magical would be a sink, that is, a conduit that accepts input of some type, but produces no output. By wiring it into a source, a program that produces output, you complete the pipeline and then ever time the sink asks for an input, the source is run until it produces its output.
In your case you'd have roughly something like
magical :: Sink a IO () -- consumes a stream of `a`s, no result
magical = go (some initial state)
where
go state = do
m'input <- await
case m'input of
Nothing -> return () -- finish
Just input -> do
-- do something with the input
go (some updated state)
This is not exactly what you asked for, but it might be enough for your purposes, I think.
magical :: ([a] -> IO ()) -> IO (a -> IO ())
magical f = do
list <- newIORef []
let g x = do
modifyIORef list (x:)
xs <- readIORef list
f xs -- or (reverse xs), if you need FIFO ordering
return g
So if you have a function fooHistory :: [a] -> IO (), you can use
main = do
...
foo <- magical fooHistory
setHandler foo -- here we have foo :: a -> IO ()
...
As #danidaz wrote above, you probably do not need magical, but can play the same trick directly in your fooHistory, modifying a list reference (IORef [a]).
main = do
...
list <- newIORef []
let fooHistory x = do
modifyIORef list (x:)
xs <- readIORef list
use xs -- or (reverse xs), if you need FIFO ordering
setHandler fooHistory -- here we have fooHistory :: a -> IO ()
...
Control.Concurrent.Chan does almost exactly what I wanted!
import Control.Monad (forever)
import Control.Concurrent (forkIO)
import Control.Concurrent.Chan
setHandler :: (Char -> IO ()) -> IO ()
setHandler f = void . forkIO . forever $ getChar >>= f
process :: String -> IO ()
process ('h':'i':xs) = putStrLn "hi" >> process xs
process ('a':xs) = putStrLn "a" >> process xs
process (x:xs) = process xs
process _ = error "Guaranteed to be infinite"
main :: IO ()
main = do
c <- newChan
setHandler $ writeChan c
list <- getChanContents c
process list
This seems like a flaw in the library design to me. You might consider an upstream patch so that you could provide something more versatile as input.
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 tried to print map function's list output using putStrLn as,
main = do
let out = "hello\nworld\nbye\nworld\n"
putStrLn $ map ("out: " ++) $ lines out
It throws error as,
Couldn't match type ‘[Char]’ with ‘Char’
I referred some other code and changed the lastline to
mapM_ putStrLn $ map ("out: " ++) $ lines out
It solves the problem, but how does map monad with underscore suffix work in this case?
mapM_ is based on the mapM function, which has the type
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
And mapM_ has the type
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
With the former, it acts like the normal map over a list, but where each element has an action run with the results aggregated. So for example if you wanted to read multiple files you could use contents <- mapM readFile [filename1, filename2, filename3], and contents would be a list where each element represented the contents of the corresponding file. The mapM_ function does the same thing, but throws away the results. One definition is
mapM_ f list = do
mapM f list
return ()
Every action gets executed, but nothing is returned. This is useful in situations like yours where the result value is useless, namely that () is the only value of type () and therefore no actual decisions can be made from it. If you had mapM putStrLn someListOfStrings then the result of this would have type IO [()], but with mapM_ putStrLn someListOfStrings the [()] is thrown away and just replaced with ().
I'm trying to work out if it's possible to write an abstraction for the following situation. Suppose I have a type a with function a -> m Bool e.g. MVar Bool and readMVar. To abstract this concept out I create a newtype wrapper for the type and its function:
newtype MPredicate m a = MPredicate (a,a -> m Bool)
I can define a fairly simple operation like so:
doUnless :: (Monad m) => Predicate m a -> m () -> m ()
doUnless (MPredicate (a,mg)) g = mg a >>= \b -> unless b g
main = do
b <- newMVar False
let mpred = MPredicate (b,readMVar)
doUnless mpred (print "foo")
In this case doUnless would print "foo". Aside: I'm not sure whether a type class might be more appropriate to use instead of a newtype.
Now take the code below, which outputs an incrementing number then waits a second and repeats. It does this until it receives a "turn off" instruction via the MVar.
foobar :: MVar Bool -> IO ()
foobar mvb = foobar' 0
where
foobar' :: Int -> IO ()
foobar' x = readMVar mvb >>= \b -> unless b $ do
let x' = x + 1
print x'
threadDelay 1000000
foobar' x'
goTillEnter :: MVar Bool -> IO ()
goTillEnter mv = do
_ <- getLine
_ <- takeMVar mv
putMVar mv True
main = do
mvb <- newMVar False
forkIO $ foobar mvb
goTillEnter mvb
Is it possible to refactor foobar so that it uses MPredicate and doUnless?
Ignoring the actual implementation of foobar' I can think of a simplistic way of doing something similar:
cycleUnless :: x -> (x -> x) -> MPredicate m a -> m ()
cycleUnless x g mp = let g' x' = doUnless mp (g' $ g x')
in g' $ g x
Aside: I feel like fix could be used to make the above neater, though I still have trouble working out how to use it
But cycleUnless won't work on foobar because the type of foobar' is actually Int -> IO () (from the use of print x').
I'd also like to take this abstraction further, so that it can work threading around a Monad. With stateful Monads it becomes even harder. E.g.
-- EDIT: Updated the below to show an example of how the code is used
{- ^^ some parent function which has the MVar ^^ -}
cycleST :: (forall s. ST s (STArray s Int Int)) -> IO ()
cycleST sta = readMVar mvb >>= \b -> unless b $ do
n <- readMVar someMVar
i <- readMVar someOtherMVar
let sta' = do
arr <- sta
x <- readArray arr n
writeArray arr n (x + i)
return arr
y = runSTArray sta'
print y
cycleST sta'
I have something similar to the above working with RankNTypes. Now there's the additional problem of trying to thread through the existential s, which is not likely to type check if threaded around through an abstraction the likes of cycleUnless.
Additionally, this is simplified to make the question easier to answer. I also use a set of semaphores built from MVar [MVar ()] similar to the skip channel example in the MVar module. If I can solve the above problem I plan to generalize the semaphores as well.
Ultimately this isn't some blocking problem. I have 3 components of the application operating in a cycle off the same MVar Bool but doing fairly different asynchronous tasks. In each one I have written a custom function that performs the appropriate cycle.
I'm trying to learn the "don't write large programs" approach. What I'd like to do is refactor chunks of code into their own mini libraries so that I'm not building a large program but assembling lots of small ones. But so far this particular abstraction is escaping me.
Any thoughts on how I might go about this are very much appreciated!
You want to cleanly combine a stateful action having side effects, a delay, and an independent stopping condition.
The iterative monad transformer from the free package can be useful in these cases.
This monad transformer lets you describe a (possibly nonending) computation as a series of discrete steps. And what's better, it let's you interleave "stepped" computations using mplus. The combined computation stops when any of the individual computations stops.
Some preliminary imports:
import Data.Bool
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Iter (delay,untilJust,IterT,retract,cutoff)
import Control.Concurrent
Your foobar function could be understood as a "sum" of three things:
A computation that does nothing but reading from the MVar at each step, and finishes when the Mvar is True.
untilTrue :: (MonadIO m) => MVar Bool -> IterT m ()
untilTrue = untilJust . liftM guard . liftIO . readMVar
An infinite computation that takes a delay at each step.
delays :: (MonadIO m) => Int -> IterT m a
delays = forever . delay . liftIO . threadDelay
An infinite computation that prints an increasing series of numbers.
foobar' :: (MonadIO m) => Int -> IterT m a
foobar' x = do
let x' = x + 1
liftIO (print x')
delay (foobar' x')
With this in place, we can write foobar as:
foobar :: (MonadIO m) => MVar Bool -> m ()
foobar v = retract (delays 1000000 `mplus` untilTrue v `mplus` foobar' 0)
The neat thing about this is that you can change or remove the "stopping condition" and the delay very easily.
Some clarifications:
The delay function is not a delay in IO, it just tells the iterative monad transformer to "put the argument in a separate step".
retract brings you back from the iterative monad transformer to the base monad. It's like saying "I don't care about the steps, just run the computation". You can combine retract with cutoff if you want to limit the maximum number of iterations.
untilJustconverts a value m (Maybe a) of the base monad into a IterT m a by retrying in each step until a Just is returned. Of course, this risks non-termination!
MPredicate is rather superfluous here; m Bool can be used instead. The monad-loops package contains plenty of control structures with m Bool conditions. whileM_ in particular is applicable here, although we need to include a State monad for the Int that we're threading around:
import Control.Monad.State
import Control.Monad.Loops
import Control.Applicative
foobar :: MVar Bool -> IO ()
foobar mvb = (`evalStateT` (0 :: Int)) $
whileM_ (not <$> lift (readMVar mvb)) $ do
modify (+1)
lift . print =<< get
lift $ threadDelay 1000000
Alternatively, we can use a monadic version of unless. For some reason monad-loops doesn't export such a function, so let's write it:
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM mb action = do
b <- mb
unless b action
It's somewhat more convenient and more modular in a monadic setting, since we can always go from a pure Bool to m Bool, but not vice versa.
foobar :: MVar Bool -> IO ()
foobar mvb = go 0
where
go :: Int -> IO ()
go x = unlessM (readMVar mvb) $ do
let x' = x + 1
print x'
threadDelay 1000000
go x'
You mentioned fix; sometimes people indeed use it for ad-hoc monadic loops, for example:
printUntil0 :: IO ()
printUntil0 =
putStrLn "hello"
fix $ \loop -> do
n <- fmap read getLine :: IO Int
print n
when (n /= 0) loop
putStrLn "bye"
With some juggling it's possible to use fix with multi-argument functions. In the case of foobar:
foobar :: MVar Bool -> IO ()
foobar mvb = ($(0 :: Int)) $ fix $ \loop x -> do
unlessM (readMVar mvb) $ do
let x' = x + 1
print x'
threadDelay 1000000
loop x'
I'm not sure what's your MPredicate is doing.
First, instead of newtyping a tuple, it's probably better to use a normal algebric data type
data MPredicate a m = MPredicate a (a -> m Bool)
Second, the way you use it, MPredicate is equivalent to m Bool.
Haskell is lazzy, therefore there is no need to pass, a function and it's argument (even though
it's usefull with strict languages). Just pass the result, and the function will be called when needed.
I mean, instead of passing (x, f) around, just pass f x
Of course, if you are not trying to delay the evaluation and really need at some point, the argument or the function as well as the result, a tuple is fine.
Anyway, in the case your MPredicate is only there to delay the function evaluation, MPredicat reduces to m Bool and doUnless to unless.
Your first example is strictly equivalent :
main = do
b <- newMVar False
unless (readMVar b) (print "foo")
Now, if you want to loop a monad until a condition is reach (or equivalent) you should have a look at the monad-loop package. What you are looking it at is probably untilM_ or equivalent.
The problem is that I do not know how to create the Behavior of type Behavior t GameState
I have more code, but am trying to just show what I think is neccessary to talk about the problem. Let me know if there are blanks to be filled in. Here's what I have :
data GameState = GameState {agent :: Agent
,universe :: Universe
}
type Universe = Gr Planet ()
data Command = Move PlanetName
| Look
| Quit
deriving Show
data PlayerCommand = PlayerCommand Command PID
| Null
deriving Show
updateGS :: PlayerCommand -> GameState -> GameState
updateGS (PlayerCommand (Move planet) pid) gs =
let agent = getAgent pid gs
nodes = labNodes $ universe gs
current = location agent
Just fromP = lookup (fromEnum current) nodes
Just toP = lookup (fromEnum planet) nodes
fromNode = fromEnum current
toNode = fromEnum planet
uPlayer = Player pid (getPlanetName toP) (Location planet)
mData = MoveData uPlayer (toNode,toP) (fromNode,fromP) nodes
uPlanets = updateLNodeList mData
in GameState uPlayer (mkGraph uPlanets $ labUEdges gates
initialGS :: GameState
initialGS = GameState initPlayer (makeUniverse makePlanetNodes)
and the event network
makeNetworkDescription :: AddHandler PlayerCommand -> IO EventNetwork
makeNetworkDescription addCommandEvent = compile $ do
eInput <- fromAddHandler addCommandEvent
let bCommand = stepper Null eInput
eCommandChanged <- changes bCommand
let bGameState :: Behavior t GameState
bGameState = stepper initialGS
reactimate $ (\n -> appendFile "output.txt" ("Command is " ++ show n)) <$> eCommandChanged
I believe bGameState needs to use eCommandChange, but I run into a problem with the types
stepper :: a -> Event t a -> Behavior t a
this leads me to believe I need to transform eInput :: Event t PlayerCommand into a
eGameState :: Event t GameState, which I can use with stepper to make the Behavior t GameState
So, My questions are, is my line of thinking correct? If not, could I be re-directed? If so, what would eGameState :: Event t GameState look like?
In response to the response below. When I considered accumB initially, I saw a type error in the making. Which is what happened when I tried your suggestion.
let bGameState :: Behavior t GameState
bGameState = accumB initialGS $ updateGS <$ eInput
yields the error
Couldn't match expected type `GameState'
with actual type `PlayerCommand'
Expected type: GameState -> GameState
Actual type: PlayerCommand -> GameState -> GameState
In the first argument of `(<$)', namely `updateGS'
In the second argument of `($)', namely `updateGS <$ eInput'
Not sure what to do about that. I'll look at your examples and see if the answer becomes clear. Thanks for poiting out accumB was the right way to go, as I was focused on stepper
The more I study the suggested code, the more I am puzzled by the type error.
Indeed, you need to create an event which remembers a GameState and applies the updateGS function to it to create a new one. That's the purpose of the function accumE and its cousin accumB. In particular, you can write
bGameState = accumB initialGS $ updateGS <$> eInput
To learn more about this pattern, have a look at the examples on the examples pages, in particular the Counter.hs and TwoCounters.hs examples.
Another point worth mentioning is that I recommend to avoid the changes function unless you are dealing with low-level framework stuff. As noted in the documentation, it has several restrictions; the nastiest restriction being that the value is not available until the reactimate are executed. You can easily make an infinite loop that way, its purpose is really very narrow.
In your case, the bCommand seems superfluous anyway, you have eCommandChanged = eInput.
Morale: Turning an event into a behavior is easy, but there is no way back.