Announcement - HGamer3D - 0.2.1 - why netwire

Peter Althainz wrote:
Dear All,
I'm happy to announce release 0.2.1 of HGamer3D, the game engine with Haskell API, featuring FRP based API and FRP based GUI. The new FRP API is based on the netwire package. Currently only available on Windows: http://www.hgamer3d.org.
Nice work! Of course, I have to ask: what influenced your choice of FRP library in favor of netwire instead of reactive-banana ? Best regards, Heinrich Apfelmus -- http://apfelmus.nfshost.com Hi Heinrich good question, actually I need to thank you for your excellent tutorials on FRP and GUI on the WEB. I tried the version of reactive-banana without switches as the first FRP framework to have contact with and I liked its simplicity and the cool introduction around Excel cells you gave on the Web. HGamer3D is my personal way to get more insight into FP and Haskell especially and from the beginning I wanted to have a FRP API to try it with game examples. So your intro on FRP and the examples were very helpful with that. After reading a lot on the web it became clear, that currently reactive-banana and netwire are good candidates to start with. So why in the end I decided to use netwire for the binding? It's some personal things and I do not claim to have done a proper evaluation or comparison. I also cannot judge on performance or other relevant topics. Having said that, I can give you some points why I choosed netwire: - The cool simplicity of reactive-banana API seems to have suffered a little bit after the introduction of the switch functionality. - After getting around Monads and Applicative by great help of "Learning a Haskell for great good" I was shocked to see, there is even more to learn, when I detected Arrows. So I started to look at it and discovered some nice tutorials for Arrows. - What struck me was introduction of netwire author Ertugrul Söylemez on Arrows and the explanations of local state, which can be kept into an arrow. Since I was also curious on OOP and FP and game state handling, actually this raised some interest. So I think this "Arrows keep local state" argument was the killer feature. But also behaviours keep local state and maybe I got misguided here. - I then did some trials with netwire and I felt it's a quite comprehensive and nice API, so I got started with that. regards Peter

Peter Althainz
- What struck me was introduction of netwire author Ertugrul Söylemez on Arrows and the explanations of local state, which can be kept into an arrow. Since I was also curious on OOP and FP and game state handling, actually this raised some interest. So I think this "Arrows keep local state" argument was the killer feature. But also behaviours keep local state and maybe I got misguided here.
It's not arrows that keep local state, but it's specifically the automaton arrows, in particular Auto and Wire. Both are automaton arrows. One way to express Auto is the following: data Auto a b = forall s. Auto s ((a, s) -> (b, s)) Similarly Wire can be expressed like that (simplified): data Wire a b = forall s. Wire s ((a, s) -> (Maybe b, s)) Both contain a local state value and a transition function. That's why they are called automaton arrows.
- I then did some trials with netwire and I felt it's a quite comprehensive and nice API, so I got started with that.
Thanks. =) Greets, Ertugrul -- nightmare = unsafePerformIO (getWrongWife >>= sex) http://ertes.de/

Peter Althainz wrote:
Heinrich Apfelmus wrote:
Of course, I have to ask: what influenced your choice of FRP library in favor of netwire instead of reactive-banana ?
good question, actually I need to thank you for your excellent tutorials on FRP and GUI on the WEB. I tried the version of reactive-banana without switches as the first FRP framework to have contact with and I liked its simplicity and the cool introduction around Excel cells you gave on the Web.
My pleasure. :) I have to thank Peter Minten for writing the tutorial with Excel cells, though.
HGamer3D is my personal way to get more insight into FP and Haskell especially and from the beginning I wanted to have a FRP API to try it with game examples. So your intro on FRP and the examples were very helpful with that.
After reading a lot on the web it became clear, that currently reactive-banana and netwire are good candidates to start with. So why in the end I decided to use netwire for the binding?
It's some personal things and I do not claim to have done a proper evaluation or comparison. I also cannot judge on performance or other relevant topics. Having said that, I can give you some points why I choosed netwire: - The cool simplicity of reactive-banana API seems to have suffered a little bit after the introduction of the switch functionality. - After getting around Monads and Applicative by great help of "Learning a Haskell for great good" I was shocked to see, there is even more to learn, when I detected Arrows. So I started to look at it and discovered some nice tutorials for Arrows. - What struck me was introduction of netwire author Ertugrul Söylemez on Arrows and the explanations of local state, which can be kept into an arrow. Since I was also curious on OOP and FP and game state handling, actually this raised some interest. So I think this "Arrows keep local state" argument was the killer feature. But also behaviours keep local state and maybe I got misguided here. - I then did some trials with netwire and I felt it's a quite comprehensive and nice API, so I got started with that.
I'm mainly asking because it helps me learn about issues with reactive-banana that could be fixed. Looking at other FRP libraries for fun and learning is definitely something that should be encouraged and not something that should be "fixed", so that's cool. :) You said that reactive-banana didn't feel as simple after the introduction of dynamic event switching, though. Could you pinpoint some particular thing that made you feel like that? Maybe a type signature or a tutorial or something else? I took great care trying to make the dynamic event switching stuff entirely optional, so you can use reactive-banana without understanding it at all, but I'm not sure if I succeeded. Best regards, Heinrich Apfelmus -- http://apfelmus.nfshost.com

Heinrich Apfelmus
You said that reactive-banana didn't feel as simple after the introduction of dynamic event switching, though. Could you pinpoint some particular thing that made you feel like that? Maybe a type signature or a tutorial or something else? I took great care trying to make the dynamic event switching stuff entirely optional, so you can use reactive-banana without understanding it at all, but I'm not sure if I succeeded.
I think this is less of an issue with reactive-banana than with classic FRP in general. The type signatures of Netwire can be scary at first sight, but they are consistent throughout the entire library. Once you understand one of these type signatures you understand all of them. Once you know how to use one wire, you know how to use all others. Let me pinpoint something in particular: events. In reactive-banana events are special, in Netwire they are not. This makes dynamic switching special in reactive-banana and natural in Netwire. Let me show you an example: You want to dispaly "one" for ten seconds, then "two" for twelve seconds, then start over: myWire = "one" . for 10 --> "two" . for 12 --> myWire Events and particularly dynamic event switching is one of the main problems Netwire solves elegantly. You can add this to reactive-banana, too, but it would require changing almost the entire event interface. Greets, Ertugrul -- Not to be or to be and (not to be or to be and (not to be or to be and (not to be or to be and ... that is the list monad.

Ertugrul Söylemez wrote:
Heinrich Apfelmus
wrote: You said that reactive-banana didn't feel as simple after the introduction of dynamic event switching, though. Could you pinpoint some particular thing that made you feel like that? Maybe a type signature or a tutorial or something else? I took great care trying to make the dynamic event switching stuff entirely optional, so you can use reactive-banana without understanding it at all, but I'm not sure if I succeeded.
I think this is less of an issue with reactive-banana than with classic FRP in general. The type signatures of Netwire can be scary at first sight, but they are consistent throughout the entire library. Once you understand one of these type signatures you understand all of them. Once you know how to use one wire, you know how to use all others.
Let me pinpoint something in particular: events. In reactive-banana events are special, in Netwire they are not. This makes dynamic switching special in reactive-banana and natural in Netwire. Let me show you an example: You want to dispaly "one" for ten seconds, then "two" for twelve seconds, then start over:
myWire = "one" . for 10 --> "two" . for 12 --> myWire
Events and particularly dynamic event switching is one of the main problems Netwire solves elegantly. You can add this to reactive-banana, too, but it would require changing almost the entire event interface.
I concur that chaining wires with the andThen combinator is very slick, I like it a lot. Wolfgang Jeltsch recently described a similar pattern for classical FRP, namely a behavior that doesn't live forever, but actually ends at some point in time, which can be interpreted as an event occurrence. ("It ends with a bang!") However, do note that the andThen combinator in netwire can only be so slick because "switching restarts time" (as the documentation puts it). I don't see a nice way to switch between wires that have accumulated state. How would you express the TwoCounters example [1] using dynamic event switching in netwire? (The example can be implemented without dynamic event switching, but that's not what I mean.) What about the BarTab example [2]? [1]: http://www.haskell.org/haskellwiki/Reactive-banana/Examples#twoCounters [2]: http://www.haskell.org/haskellwiki/Reactive-banana/Examples#bartab Best regards, Heinrich Apfelmus -- http://apfelmus.nfshost.com

Heinrich Apfelmus
I concur that chaining wires with the andThen combinator is very slick, I like it a lot. Wolfgang Jeltsch recently described a similar pattern for classical FRP, namely a behavior that doesn't live forever, but actually ends at some point in time, which can be interpreted as an event occurrence. ("It ends with a bang!")
Well, that would work, but I wonder why then you wouldn't want to go all the way to signal inhibition. You don't need AFRP to have it. It's actually quite a light-weight change. Allow behaviors not to produce a value, i.e. somewhere in your library replace "a" by "Maybe a".
However, do note that the andThen combinator in netwire can only be so slick because "switching restarts time" (as the documentation puts it). I don't see a nice way to switch between wires that have accumulated state.
Time doesn't necessarily restart. This choice is left to the (-->) combinator. I've decided for that one to restart time, because it more closely resembles the behavior of other libraries. As a counterexample consider this: time . holdFor 0.5 (periodically 1) <|> 2*time This wire will switch back and forth between the two wires 'time' and '2*time' filling the gap between the inactive times of each. Unlike (-->), the (<|>) combinator keeps state. This is also true for the context wires (see below).
How would you express the TwoCounters example [1] using dynamic event switching in netwire? (The example can be implemented without dynamic event switching, but that's not what I mean.) What about the BarTab example [2]?
I've been asked that via private mail. Let me just quote my answer: "This is a misconception caused by the very different nature of Netwire. In Netwire everything is dynamic. What really happens in w1 --> w2 is that at the beginning only w1 exists. When it inhibits it is removed from the network and w2 takes its place. The missing ingredient is that w2 is not actually produced by a wire, but this is equally easy and natural. Just consider the context wires: context id w This wire will dynamically create a version of 'w' for every different input, so it acts like a router that will create wires if they don't already exist. Deletion works similarly: contextLatest id 1000 w This is a version that only keeps the 1000 latest contexts. There is also the classic dynamic switcher called 'switch': switch nw w This wire acts like 'w' until 'nw' produces a new wire, then switches to that one. Indeed 'nw' is of type Wire e m a (Wire e m a b). Really nothing is static in Netwire. It's actually very easy to write combinators like 'switch' and 'context' yourself. In fact you can even write a sensible ArrowApply instance. The problem is that it would have linear time complexity with respect to the number of instants that have passed, so it's not exactly useful." Notice that wires (just like all other arrowic automata in Haskell) switch all the time. Moving forward in time involves switching, so it's their very nature to do it. They could decide to switch to anything (provided the types fit) and they can observe the switching of other wires. There is no need for special library support for wires that manage a set of wires. Greets, Ertugrul -- Not to be or to be and (not to be or to be and (not to be or to be and (not to be or to be and ... that is the list monad.

Ertugrul Söylemez wrote:
Heinrich Apfelmus
wrote: I concur that chaining wires with the andThen combinator is very slick, I like it a lot. Wolfgang Jeltsch recently described a similar pattern for classical FRP, namely a behavior that doesn't live forever, but actually ends at some point in time, which can be interpreted as an event occurrence. ("It ends with a bang!")
Well, that would work, but I wonder why then you wouldn't want to go all the way to signal inhibition. You don't need AFRP to have it. It's actually quite a light-weight change. Allow behaviors not to produce a value, i.e. somewhere in your library replace "a" by "Maybe a".
I think that the andThen combinator is slick, but I'm not sure whether I find the underlying model -- signal inhibition -- to be equally pleasing. In the context of GUI programming, chaining several events with the andThen combinator is almost never needed, so I've postponed these questions for now.
How would you express the TwoCounters example [1] using dynamic event switching in netwire? (The example can be implemented without dynamic event switching, but that's not what I mean.) What about the BarTab example [2]?
I've been asked that via private mail. Let me just quote my answer:
"This is a misconception caused by the very different nature of Netwire. In Netwire everything is dynamic. What really happens in w1 --> w2 is that at the beginning only w1 exists. When it inhibits it is removed from the network and w2 takes its place. The missing ingredient is that w2 is not actually produced by a wire, but this is equally easy and natural. Just consider the context wires:
context id w
This wire will dynamically create a version of 'w' for every different input, so it acts like a router that will create wires if they don't already exist. Deletion works similarly:
contextLatest id 1000 w
This is a version that only keeps the 1000 latest contexts.
So context has the same purpose as Conal's trim combinator [1]. However, I believe that it is too inconvenient for managing very dynamic collections that need to keep track of state, as the context function significantly limits the scope of the stateful wire. That's why I've opted for a more flexible approach in Reactive.Banana.Switch , even if that introduces significant complexity in the type signatures. Again, I would be interested in an implementation of the BarTab example [2] to compare the two approaches. [1]: http://conal.net/blog/posts/trimming-inputs-in-functional-reactive-programmi... [2]: http://www.haskell.org/haskellwiki/Reactive-banana/Examples#bartab Best regards, Heinrich Apfelmus -- http://apfelmus.nfshost.com

Heinrich Apfelmus
So context has the same purpose as Conal's trim combinator [1]. However, I believe that it is too inconvenient for managing very dynamic collections that need to keep track of state, as the context function significantly limits the scope of the stateful wire. That's why I've opted for a more flexible approach in Reactive.Banana.Switch , even if that introduces significant complexity in the type signatures.
Again you are thinking in primitive combinators. Keep in mind that context is nothing primitive. In earlier releases of Netwire I had a "manager" wire that allowed to manage a set of running wires by message passing. However, that wire turned out to be either too generic or too specific. There was no good balance, so I decided to get rid of it altogether. Now every library layer or application would write its own application-specific manager wire.
Again, I would be interested in an implementation of the BarTab example [2] to compare the two approaches.
I'm happy to provide one. Please be patient until I release netwire-vty, a terminal UI library based on Netwire. Greets, Ertugrul -- Not to be or to be and (not to be or to be and (not to be or to be and (not to be or to be and ... that is the list monad.

Hi Heinrich: Its simply the types are more cumbersome, now. In netwire you basically have one type, which is "Wire ...." with some type parameters (underlying monad, inhibition type, in-type, out-type), When underlying monad and inhibition type is choosen, you can define a type synonym and all boils done to "GameWire a b" in all types, events (GameWire a a), behaviours (GameWire a b), what you want. Signal inhibition makes Events and Behviours looks equal. Also the overall network has this type. And by the way, no generalized datatypes (forall t. ....), which I'm also not too comfortable with. In reactive banana we have considerably more types then in netwire: - One tpye for Behaviours - One type for Events - sinks in addition: sinkoutput[text:==showNumber<$>result]- what is that? (I know it has something to do with feedback loops) - scary type for the network description: "forallt.Frameworkst=>Momentt()" best regards Peter

Peter Althainz
Its simply the types are more cumbersome, now. In netwire you basically have one type, which is "Wire ...." with some type parameters (underlying monad, inhibition type, in-type, out-type), When underlying monad and inhibition type is choosen, you can define a type synonym and all boils done to "GameWire a b" in all types, events (GameWire a a), behaviours (GameWire a b), what you want. Signal inhibition makes Events and Behviours looks equal. Also the overall network has this type. And by the way, no generalized datatypes (forall t. ....), which I'm also not too comfortable with.
Actually for the higher rank types there is a rationale: safety. In fact I first had this: type Event e m = forall a. Wire e m a a However, this turned out to be too restrictive, when I decided to simplify it: type Event e m a = Wire e m a a The reason is that many events like 'require', even though they still act like identities, have to examine the input value to make decisions. Also you can expect that there will be at least one higher rank type in all libraries I release based on Netwire, for example my upcoming Vty-based text UI library: simpleUI :: (Monad m) => (forall a. m a -> IO a) -> UI m () b -> IO b The first argument is a monad morphism. It would be totally fine for it to be less restrictive for this case, but I want to stick with categorical concepts as far as possible. This makes it easier to reason about the code. Greets, Ertugrul -- Not to be or to be and (not to be or to be and (not to be or to be and (not to be or to be and ... that is the list monad.

Peter Althainz wrote:
Hi Heinrich:
Its simply the types are more cumbersome, now. In netwire you basically have one type, which is "Wire ...." with some type parameters (underlying monad, inhibition type, in-type, out-type), When underlying monad and inhibition type is choosen, you can define a type synonym and all boils done to "GameWire a b" in all types, events (GameWire a a), behaviours (GameWire a b), what you want. Signal inhibition makes Events and Behviours looks equal. Also the overall network has this type. And by the way, no generalized datatypes (forall t. ....), which I'm also not too comfortable with.
In reactive banana we have considerably more types then in netwire:
- One tpye for Behaviours
- One type for Events
- sinks in addition: sinkoutput[text:==showNumber<$>result]- what is that? (I know it has something to do with feedback loops)
- scary type for the network description: "forallt.Frameworkst=>Momentt()"
Thanks Peter! The distinction between Behavior and Event is something fundamental that I don't want to give up easily. They behave differently under products and coproducts, they correspond to modalities in temporal logic and they are also very useful for recursion. Concerning the sink combinator, it's actually part of the GUI bindings and not of the core library. It's used to bind, say the text value of an edit widget to display the value of a Behavior String . Likewise, the forall t. Frameworks t => Moment t () type signature is used when binding to a GUI framework. The explicit forall is only used to be get the right name for the type t , usually you would just write Frameworks t => Moment t () . Overall, I like to think that the complexity is only superficial. I agree that the type parameter t is somewhat annoying, but it's necessary for fundamental reasons. Fortunately, it has a nice conceptual interpretation as "starting time". In the case of HGamer3D, the sink combinator would replace the need to declare a final "wire which runs all the wires at each step". It feels a bit weird to me to have wires like guiSetPropW that perform side effects, i.e. where it makes a different whether you observe their results or not. That's a complexity where I feel that something "has been swept under the rug". Best regards, Heinrich Apfelmus -- http://apfelmus.nfshost.com

Heinrich Apfelmus
In the case of HGamer3D, the sink combinator would replace the need to declare a final "wire which runs all the wires at each step". It feels a bit weird to me to have wires like guiSetPropW that perform side effects, i.e. where it makes a different whether you observe their results or not. That's a complexity where I feel that something "has been swept under the rug".
I did not review the interface of HGamer3D, mostly because it's Windows-only. But I'd like to point out that you would prefer a non-IO monad for wires. In most cases I would recommend a monad for which (>>) is commutative like a reader and/or a commutative writer. The purpose of the underlying monad is to allow some event wires to be written more cleanly. Without the monad: keyPressed :: (Monad m, Monoid e) => SDL.Keysym -> Wire e m SDL.Event SDL.Event With the monad: keyPressed :: (SDLMonad m, Monoid e) => SDL.Keysym -> Wire e m a a In particular imperative wires like guiSetPropW (or anything for which *set* is a sensible name) are simply wrong. A widget, e.g. a button, should look like this: type MyWire = WireM (Reader MyConfig) type MyEvent a = MyWire a a button :: MyEvent Button This wire takes a button configuration describing the current state of the button. Given an IsString Button instance and OverloadedStrings a GUI with a button could look like this: numberField = label >>> textField "" <|> errorLabel . "Please enter a valid number" dialog = proc _ -> do n1 <- numberField -< "Number 1" n2 <- numberField -< "Number 2" let s = n1 + n2 :: Integer label -< "Sum: " ++ show s button -< "Okay" id -< s As most event wires the button wire acts like identity when the button is pressed, so it would return back the button configuration. I hope this sheds some light onto what GUI code in Netwire /should/ (in fact /will/) look like. Greets, Ertugrul -- Not to be or to be and (not to be or to be and (not to be or to be and (not to be or to be and ... that is the list monad.

Hi Heinrich, Hi Ertugrul
thanks for all your comments so far. In last e-mail, you wrote:
Heinrich Apfelmus
In the case of HGamer3D, the sink combinator would replace the need to declare a final "wire which runs all the wires at each step". It feels a bit weird to me to have wires like guiSetPropW that perform side effects, i.e. where it makes a different whether you observe their results or not. That's a complexity where I feel that something "has been swept under the rug".
In particular imperative wires like guiSetPropW (or anything for which *set* is a sensible name) are simply wrong. A widget, e.g. a button, should look like this: type MyWire = WireM (Reader MyConfig) type MyEvent a = MyWire a a button :: MyEvent Button => A short explanation on the guiSetPropW wire: The guiSetPropW can be considered as being part of the GUI binding actually. It is in the public Api to overcome the limitation of not having all properties as single wires coded. Anyhow, if you want to act on something in the GUI (for example make a window visible or not) you will probably need something with a side effect. That is, where the guiSetPropW is used in the examples. But it is a little bit low level, the higher level wires look more nicer: for example, the button wire creation acutally looks like that: buttonW:: GUIElement -> GameWire a a with the button wire having the type of: GameWire a a It is a pure event wire, which gets fired, when the button is pressed. the "label" wire creation staticTextW :: GUIElement -> GameWire String String with the labe wire having the type of: GameWire String String the "editbox" wire creation: editBoxW :: GUIElement -> (GameWire a String, GameWire String String) creates two wires, one for getting notified on changes of the element: type: GameWire a String and one for setting a new value to the string: type: GameWire String String Here, I would be interested in your view. Of course you can make one wire out of it, but this has different consequences: - how to check for a change in the widget, if the wire is not executed, because no input value occur? - usually you need the output of the wire in different places of your final network where the input wire is needed, if you have only one wire this might be cumbersome, to code in combining the final network - and: yes, there has been also something swept under the rug here, because since both wires refer to the same GUI element, there is the same GUI element used inside, which is a reference. Actually this is somthing more OO/Scala like then Haskell but it works fine for me so far, since it does overcome the limitations of the points above. BR Peter
participants (3)
-
Ertugrul Söylemez
-
Heinrich Apfelmus
-
Peter Althainz