
Hello! In process of adapting 'netwire-5.0.0' to my needs I discovered following strange thing. Let us consider following simple program: {-# LANGUAGE Arrows #-} import FRP.Netwire import Data.Monoid -- I almost sure this is correct, since it is copied -- from "Programming with Arrows", J. Hughes mapA :: (ArrowChoice a) => a b c -> a [b] [c] mapA f = proc input -> case input of [] -> returnA -< [] z:zs -> do y_ <- f -< z ys_ <- mapA f -< zs returnA -< y_:ys_ mconcatA :: (ArrowChoice a, Monoid m) => a b m -> a [b] m mconcatA f = mapA f >>> arr mconcat -- Note the commented line. wire :: (Monad m, HasTime t s) => Wire s () m a Double wire = pure (Sum 1.0) -- >>> arr (: []) >>> mconcatA returnA >>> arr getSum >>> integral 10 main = testWire (countSession_ 1) wire Problem is that, compiled with ghc-8.0.1 this program hangs if I uncomment second line in body of ``wire`` function[1], which is wierd, since assuming monoid and arrow laws, I believe -- (Arrow a, Monoid e) => a e e arr (: []) >>> mconcatA returnA = returnA Is it false? Any suggestions? .. [1] with that line commented program works and prints sequence of numbers, with every next over previous.

Hi,
-- I almost sure this is correct, since it is copied -- from "Programming with Arrows", J. Hughes mapA :: (ArrowChoice a) => a b c -> a [b] [c] mapA f = proc input -> case input of [] -> returnA -< [] z:zs -> do y_ <- f -< z ys_ <- mapA f -< zs returnA -< y_:ys_
Yes, this is correct. However, the ArrowChoice instance in Netwire has always been questionable. The correct (and much more efficient) way to implement mapA is as a primitive combinator much like the parallel switches in Yampa. The Netwire implementation and API has been more focussed on providing features over reasonable semantics, and that eventually led me to abandon it in favour of a more minimalistic library that is easier to reason about (wires). Please consider Netwire deprecated and I recommend you don't use it for new applications, if possible. I'm still open to reviewing and merging code contributions to support legacy applications, but other than that I would much prefer to just let it become a piece of AFRP history. =) If you must use AFRP, I recommend either my new library called wires, or the progenitor of all, Yampa. However, unless you have a strong reason to use arrowized FRP I would recommend that you go with one of the first-class FRP libraries. I currently recommend either: * reactive-banana: very simple and easy to learn API, plus the author runs a blog with lots of information on FRP. This is the library I recommend to FRP beginners. Or * reflex: my personal favourite, more focussed on practical concerns and efficiency, a more versatile API that easily integrates with applications with a "main loop", such as real-time games. The trade-off is far less documentation and a more complicated API. Sorry for not directly addressing your question, but I hope I convinced you to just switch to a different library. =) Greets ertes

Hi
However, unless you have a strong reason to use arrowized FRP I would recommend that you go with one of the first-class FRP libraries.
TL;DR: Shameless self promotion ahead: we built an elementary library that
seems to subsume many others, including AFRP and Classic FRP libraries, I'd
like to know how it compares.
Seeing what's just been said about netwire, I'd like to ask how these
compare to each other. Among themselves, and also in relation to a separate
construct that Manuel Bärenz and I built (note: I am the Yampa maintainer;
Yampa is alive and well and more updates are coming your way :) ).
In 2016 we published an article [1; mirror: 4] and a library [2] which aim
at merging ideas in this field. I always thought they were pretty powerful,
and so far I haven't found many limitations. (But I am biased, so maybe not
the ideal judge.)
It combines the CPS-based arrowized construct of Yampa with a monad, in a
tiny definition:
newtype MSF m a b = MSF { step :: a -> m (b, MSF m a b) }
So, you provide one input sample and get, in a monadic context, an output
and a continuation. Next time you provide the next input to the
continuation, and so on.
You can define stream as:
type MStream m b = MSF m () b
You can define sinks as:
type MSink m a = MSF m a ()
They have really cool properties [3], for instance, they are arrows, and if
the monad is commutative then the arrow is commutative. We have instances
for many other Arrow* classes.
You can also define FRP on top of it, in the time-continuous sense, by
using a Reader monad:
type YampaSF a b = MSF (Reader Time) a b
We have a version of Yampa defined on top of this that runs full (free and
commercial) games just fine. It's API compatible (for what it implements).
And, you can define classic FRP signals (and sinks, a-la reactive banana
and, if paired, more similar to Daniel Winograd-Cort's work or Keera Hails):
type Signal a = MStream Time a
So you can use applicative style:
s :: Signal Double
s = -- predefined somewhere
biggerS :: Signal Double
biggerS = (* 100) <*> s
You can do extremely cool things just by altering the monad:
- If the monad is Maybe, they terminate because there may not be a
continuation (and an output).
- If the monad is Either, they terminate with a result. This is the basis
for switching, which we get "for free".
- If the monad is [], they spawn. This implements parallelism with
broadcasting for free.
- You can use a Writer monad and some smart tricks to do continuous
collision detection.
- You can use state if to avoid the bottleneck issue that people criticise
AFRP for.
- You can use transformers to stack these effects.
- You can also use IO as your monad, if you want to access mouse position
and other external stuff, print a log, or sink directly from your network.
So far, I've found that we can pretty much do anything we want with this.
It's simple to use, classic or arrowized at will (you can combine the two).
I'm investigating performance, which for the games I've tried is really
good and gives us flat and low memory profiles, and I believe we can do
some pretty smart things with GADTS and re-writes to make things as fast as
they can theoretically be.
How does this compare to other FRP and F;RP libraries around?
Cheers
Ivan
PS. For whoever is interested, there's the FRP zoo on github that shows the
same example in multiple variants.
[1] https://dl.acm.org/citation.cfm?id=2976010
[2] https://hackage.haskell.org/package/dunai
[3] http://www.cs.nott.ac.uk/~psxip1/papers/msfmathprops.pdf
[4]
http://www.cs.nott.ac.uk/~psxip1/papers/2016-HaskellSymposium-Perez-Barenz-N...
On 17 February 2018 at 11:43, Ertugrul Söylemez
Hi,
-- I almost sure this is correct, since it is copied -- from "Programming with Arrows", J. Hughes mapA :: (ArrowChoice a) => a b c -> a [b] [c] mapA f = proc input -> case input of [] -> returnA -< [] z:zs -> do y_ <- f -< z ys_ <- mapA f -< zs returnA -< y_:ys_
Yes, this is correct. However, the ArrowChoice instance in Netwire has always been questionable. The correct (and much more efficient) way to implement mapA is as a primitive combinator much like the parallel switches in Yampa.
The Netwire implementation and API has been more focussed on providing features over reasonable semantics, and that eventually led me to abandon it in favour of a more minimalistic library that is easier to reason about (wires). Please consider Netwire deprecated and I recommend you don't use it for new applications, if possible. I'm still open to reviewing and merging code contributions to support legacy applications, but other than that I would much prefer to just let it become a piece of AFRP history. =)
If you must use AFRP, I recommend either my new library called wires, or the progenitor of all, Yampa. However, unless you have a strong reason to use arrowized FRP I would recommend that you go with one of the first-class FRP libraries. I currently recommend either:
* reactive-banana: very simple and easy to learn API, plus the author runs a blog with lots of information on FRP. This is the library I recommend to FRP beginners. Or
* reflex: my personal favourite, more focussed on practical concerns and efficiency, a more versatile API that easily integrates with applications with a "main loop", such as real-time games. The trade-off is far less documentation and a more complicated API.
Sorry for not directly addressing your question, but I hope I convinced you to just switch to a different library. =)
Greets ertes
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

As a side comment, it's fun how this is re-invented in similar-ish contexts :) E.g. `machines` [1] newtype MealyT m a b = MealyT { runMealyT :: a -> m (b, MealyT m a b) } or `arrows` (a = Kleisli m) [2] newtype Automaton a b c = Automaton (a b (c, Automaton a b c)) [1]: http://hackage.haskell.org/package/machines-0.6.3/docs/Data-Machine-MealyT.h... [2]: http://hackage.haskell.org/package/arrows-0.4.4.1/docs/Control-Arrow-Transfo... On 18.02.2018 11:17, Ivan Perez wrote:
Hi
However, unless you have a strong reason to use arrowized FRP I would recommend that you go with one of the first-class FRP libraries.
TL;DR: Shameless self promotion ahead: we built an elementary library that seems to subsume many others, including AFRP and Classic FRP libraries, I'd like to know how it compares.
Seeing what's just been said about netwire, I'd like to ask how these compare to each other. Among themselves, and also in relation to a separate construct that Manuel Bärenz and I built (note: I am the Yampa maintainer; Yampa is alive and well and more updates are coming your way :) ).
In 2016 we published an article [1; mirror: 4] and a library [2] which aim at merging ideas in this field. I always thought they were pretty powerful, and so far I haven't found many limitations. (But I am biased, so maybe not the ideal judge.)
It combines the CPS-based arrowized construct of Yampa with a monad, in a tiny definition:
newtype MSF m a b = MSF { step :: a -> m (b, MSF m a b) }
So, you provide one input sample and get, in a monadic context, an output and a continuation. Next time you provide the next input to the continuation, and so on.
You can define stream as:
type MStream m b = MSF m () b
You can define sinks as:
type MSink m a = MSF m a ()
They have really cool properties [3], for instance, they are arrows, and if the monad is commutative then the arrow is commutative. We have instances for many other Arrow* classes.
You can also define FRP on top of it, in the time-continuous sense, by using a Reader monad:
type YampaSF a b = MSF (Reader Time) a b
We have a version of Yampa defined on top of this that runs full (free and commercial) games just fine. It's API compatible (for what it implements).
And, you can define classic FRP signals (and sinks, a-la reactive banana and, if paired, more similar to Daniel Winograd-Cort's work or Keera Hails):
type Signal a = MStream Time a
So you can use applicative style:
s :: Signal Double s = -- predefined somewhere
biggerS :: Signal Double biggerS = (* 100) <*> s
You can do extremely cool things just by altering the monad: - If the monad is Maybe, they terminate because there may not be a continuation (and an output). - If the monad is Either, they terminate with a result. This is the basis for switching, which we get "for free". - If the monad is [], they spawn. This implements parallelism with broadcasting for free. - You can use a Writer monad and some smart tricks to do continuous collision detection. - You can use state if to avoid the bottleneck issue that people criticise AFRP for. - You can use transformers to stack these effects. - You can also use IO as your monad, if you want to access mouse position and other external stuff, print a log, or sink directly from your network.
So far, I've found that we can pretty much do anything we want with this. It's simple to use, classic or arrowized at will (you can combine the two). I'm investigating performance, which for the games I've tried is really good and gives us flat and low memory profiles, and I believe we can do some pretty smart things with GADTS and re-writes to make things as fast as they can theoretically be.
How does this compare to other FRP and F;RP libraries around?
Cheers
Ivan
PS. For whoever is interested, there's the FRP zoo on github that shows the same example in multiple variants.
[1] https://dl.acm.org/citation.cfm?id=2976010 [2] https://hackage.haskell.org/package/dunai [3] http://www.cs.nott.ac.uk/~psxip1/papers/msfmathprops.pdf http://www.cs.nott.ac.uk/%7Epsxip1/papers/msfmathprops.pdf [4] http://www.cs.nott.ac.uk/~psxip1/papers/2016-HaskellSymposium-Perez-Barenz-N... http://www.cs.nott.ac.uk/%7Epsxip1/papers/2016-HaskellSymposium-Perez-Barenz...
On 17 February 2018 at 11:43, Ertugrul Söylemez
mailto:esz@posteo.de> wrote: Hi,
> -- I almost sure this is correct, since it is copied > -- from "Programming with Arrows", J. Hughes > mapA :: (ArrowChoice a) => a b c -> a [b] [c] > mapA f = proc input -> > case input of > [] -> returnA -< [] > z:zs -> do y_ <- f -< z > ys_ <- mapA f -< zs > returnA -< y_:ys_
Yes, this is correct. However, the ArrowChoice instance in Netwire has always been questionable. The correct (and much more efficient) way to implement mapA is as a primitive combinator much like the parallel switches in Yampa.
The Netwire implementation and API has been more focussed on providing features over reasonable semantics, and that eventually led me to abandon it in favour of a more minimalistic library that is easier to reason about (wires). Please consider Netwire deprecated and I recommend you don't use it for new applications, if possible. I'm still open to reviewing and merging code contributions to support legacy applications, but other than that I would much prefer to just let it become a piece of AFRP history. =)
If you must use AFRP, I recommend either my new library called wires, or the progenitor of all, Yampa. However, unless you have a strong reason to use arrowized FRP I would recommend that you go with one of the first-class FRP libraries. I currently recommend either:
* reactive-banana: very simple and easy to learn API, plus the author runs a blog with lots of information on FRP. This is the library I recommend to FRP beginners. Or
* reflex: my personal favourite, more focussed on practical concerns and efficiency, a more versatile API that easily integrates with applications with a "main loop", such as real-time games. The trade-off is far less documentation and a more complicated API.
Sorry for not directly addressing your question, but I hope I convinced you to just switch to a different library. =)
Greets ertes
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

On Sun, Feb 18, 2018 at 9:17 AM, Ivan Perez
Hi
However, unless you have a strong reason to use arrowized FRP I would recommend that you go with one of the first-class FRP libraries.
TL;DR: Shameless self promotion ahead: we built an elementary library that seems to subsume many others, including AFRP and Classic FRP libraries, I'd like to know how it compares.
Seeing what's just been said about netwire, I'd like to ask how these compare to each other. Among themselves, and also in relation to a separate construct that Manuel Bärenz and I built (note: I am the Yampa maintainer; Yampa is alive and well and more updates are coming your way :) ).
In 2016 we published an article [1; mirror: 4] and a library [2] which aim at merging ideas in this field. I always thought they were pretty powerful, and so far I haven't found many limitations. (But I am biased, so maybe not the ideal judge.)
It combines the CPS-based arrowized construct of Yampa with a monad, in a tiny definition:
newtype MSF m a b = MSF { step :: a -> m (b, MSF m a b) }
I believe this is exactly what a `Wire` is from the `wires` library: https://github.com/esoeylemez/wires/blob/master/Control/Wire/Internal.hs#L89 Ollie

On 18 February 2018 at 11:36, Oliver Charles
On Sun, Feb 18, 2018 at 9:17 AM, Ivan Perez
wrote: Hi
However, unless you have a strong reason to use arrowized FRP I would recommend that you go with one of the first-class FRP libraries.
TL;DR: Shameless self promotion ahead: we built an elementary library that seems to subsume many others, including AFRP and Classic FRP libraries, I'd like to know how it compares.
Seeing what's just been said about netwire, I'd like to ask how these compare to each other. Among themselves, and also in relation to a separate construct that Manuel Bärenz and I built (note: I am the Yampa maintainer; Yampa is alive and well and more updates are coming your way :) ).
In 2016 we published an article [1; mirror: 4] and a library [2] which aim at merging ideas in this field. I always thought they were pretty powerful, and so far I haven't found many limitations. (But I am biased, so maybe not the ideal judge.)
It combines the CPS-based arrowized construct of Yampa with a monad, in a tiny definition:
newtype MSF m a b = MSF { step :: a -> m (b, MSF m a b) }
I believe this is exactly what a `Wire` is from the `wires` library:
https://github.com/esoeylemez/wires/blob/master/Control/Wire /Internal.hs#L89
Ollie
This is great to know :) Given then that what I said about classic FRP and many variants of FRP should apply to wires too, how would programming in a classic FRP library be any different from using Wires, Dunai, Varying, etc., all of which are based on the same construct? (Performance aside.) Ivan [1] https://hackage.haskell.org/package/varying

Hi Ivan,
Given then that what I said about classic FRP and many variants of FRP should apply to wires too, how would programming in a classic FRP library be any different from using Wires, Dunai, Varying, etc., all of which are based on the same construct? (Performance aside.)
the main difference between AFRP and first-class FRP is that in the latter behaviours and events are, well, *first-class*. For example in reflex when you construct a (Behavior t Integer), this is an actual value that is not tied to any particular monad or arrow. It can be stored in data structures and is subject to garbage-collection like every other value. Some operations still require a certain monad, but that is only necessary because those are bound to an instant in time. For example you can't 'hold' an event in a pure function, holding requires a notion of "now", which a pure function cannot provide. In AFRP all behaviours and events are "virtual" in a sense. Though arrow notation can make it look like they are actual values this is really just an illusion. That's why you can't sensibly communicate an event out of the wire/SF/MSF/MealyT/… Greets ertes

On 18 February 2018 at 17:26, Ertugrul Söylemez
[...]
In AFRP all behaviours and events are "virtual" in a sense.
Only in "pure" forms of AFRP, that is, those without a monad, and only so long as you stick to the arrow framework and/or arrow notation. Just because something supports AFRP doesn't mean that you have to use it limited to the traditional AFRP interface.
Though arrow notation can make it look like they are actual values this is really just an illusion.
But this is what I mean when I talk about applicatives. I'm honestly not seeing a big difference between behaviours in CFRP and signals in Dunai/Wires/Varying. For instance, you can define Behaviour as: type Beh a = MSF Identity a (Or maybe a better monad ,or even an adhoc monad that connects the external providers in a referentially transparent way.) You can then put it in a data structure (it's a first-class entity), it will be garbage collected when appropriately, you can demand new values as necessary, and you can operate with it also "as if it where a signal": myBeh = f <$> beh1 <*> beh2 You can define instances of Num if you want to write: myBeh = beh1 + beh2 Although that's not easily extensible to all functions that act on values.
That's why you can't sensibly communicate an event out of the wire/SF/MSF/MealyT/…
But you can. That's precisely what the monad allows you to do. I suspect I may not be understanding precisely what you mean. Perhaps you can describe this in more detail or with an example? (feel free to email me personally if this is derailing the original conversation off-topic.) If you mean what I understand from your words, I'd say you can communicate events out, and I do this all the time. I even built a system to synchronize discrete games with continuous animations without having to pipe data explicitly all the way up, based on "implicit" event passing using MSFs. Cheers Ivan

I suspect I may not be understanding precisely what you mean. Perhaps you can describe this in more detail or with an example?
The easiest way to see the difference is by looking at some of the combinators. Notice that things like 'hold', 'scan'/'accum', and 'tag' are real functions. In a first-class FRP system these would have types like the following: hold :: a -> Event a -> Moment (Behaviour a) scan :: a -> Event (a -> a) -> Moment (Event a) tag :: Behaviour (a -> b) -> Event a -> Event b The Moment monad is not inherent to the way the underlying state machine is constructed, but acts merely as a provider for the notion of "now". Since 'tag' doesn't need that notion, it's a completely pure function. You can have that function in AFRP as well: fmap :: (a -> b) -> Event a -> Event b However, unlike 'fmap', 'tag' makes sense in a pure context. You can pass an Event and a Behaviour to a different thread via an MVar, combine them there, then send the result back, and it will still work in the context of the greater application (no isolated state machines). You can hold an event in any concurrent thread, etc. Another example is that if the underlying monad is nontrivial (say IO) you can't easily split behaviours in a pure context in AFRP. This restriction does not exist in first-class FRP: unzipB :: Behavior (a, b) -> (Behavior a, Behavior b) splitE :: Event (Either a b) -> (Event a, Event b) In AFRP you always have to do it in the context of the underlying state machine, i.e. MSF/SF/Wire, which means that AFRP forces you to manage all data structures holding reactive values as part of it or, again, have isolated state machines. With first-class FRP there is nothing wrong with keeping a data structure of behaviours in an MVar and have two concurrent threads modify it: MVar (Map K (Behaviour String)) AFRP requires the following instead, and unless all changes are planned within the state machine and communicated via 'A' changes actually build up in terms of complexity (you can't just keep composing it with more and more MSF actions for free): MVar (MSF IO A (Map K String)) Let me make clear that you can express all of these things in AFRP. In fact it's easily more powerful than first-class FRP, because if the system exposes it, you get full access to the expressivity of what is basically a generic state machine. Just to provide one example: there is no first-class counterpart to 'manage' from wires, because that combinator only really makes sense in the context of the underlying state machine. But all of this comes at the expense of giving up first-class behaviours and events in the above sense. If this still doesn't convince you, I strongly suggest that you give reflex a try. It has a very similar controller interface to AFRP (stepWire/unMSF) in that it gives you control over the main loop, so it shouldn't feel too alien. As a final remark due to all these issues and more with AFRP most of my research in the past few years went into getting rid of the A while retaining most of its advantages. Reflex (by Ryan Trinkle, not me) is almost there: it has the performance, the predictability and the expressivity. The only missing component is an equivalent to 'manage', i.e. effects without the controller round-trip, or what I call "switching with effects". Greets ertes

I'm getting a bit confused with too many low-level details. Some of my
responses are educated guesses, so maybe there's implementations that
manage to circumvent what I say. Please, correct me where I'm wrong.
On 19 February 2018 at 03:31, Ertugrul Söylemez
I suspect I may not be understanding precisely what you mean. Perhaps you can describe this in more detail or with an example?
The easiest way to see the difference is by looking at some of the combinators. Notice that things like 'hold', 'scan'/'accum', and 'tag' are real functions. In a first-class FRP system these would have types like the following:
hold :: a -> Event a -> Moment (Behaviour a) scan :: a -> Event (a -> a) -> Moment (Event a) tag :: Behaviour (a -> b) -> Event a -> Event b
The Moment monad is not inherent to the way the underlying state machine is constructed, but acts merely as a provider for the notion of "now". Since 'tag' doesn't need that notion, it's a completely pure function.
Well, in a way. Yes, it can be a pure function, and an event can somehow be a delayed computation of how/when it is actually produced, computed/consumed the moment you want to actually evaluate the network. Saying that they are pure would be just fine if Behaviours did not depend on the outside world (that is, if they were "calculated" from pure haskell functions). But I don't think they are. Not always. Not if you want to depend on any external user input. In Reflex (and I'm not trying to discuss the particularities of this implementation), yes, Behaviour and Event are types in a family, but the actual definitions in Spider I can seee are records of IORefs with bangs. Far from pure.
You can have that function in AFRP as well:
fmap :: (a -> b) -> Event a -> Event b
However, unlike 'fmap', 'tag' makes sense in a pure context. You can pass an Event and a Behaviour to a different thread via an MVar, combine them there, then send the result back, and it will still work in the context of the greater application (no isolated state machines).
I don't see how you cannot do that with wires. For instance, you can send a Wire m () (Event b), and a Wire m () (a -> b), and compose them in a pure context. Then you can bring that back and use it. You
can hold an event in any concurrent thread, etc.
Can you use it without doing IO and executing the computation associated to calculating/polling the behaviour? If so, it must be because the FRP evaluation method has some inherent thread-safety (I you need IO + more for that). Wouldn't you be able to put that thread safety in your monad, and then use it with MSFs/Wires?
Another example is that if the underlying monad is nontrivial (say IO) you can't easily split behaviours in a pure context in AFRP.
You can, but you need a monad such that: (,) <$> ma <*> ma == (\x -> (x,x)) <$> ma. Is this called idempotent? But to implement any form of Classic FRP or Reactive Programming on top of MSFs, you want that kind of monad. This
restriction does not exist in first-class FRP:
Well, it is not exposed to the user, but someone must have thought about it and solved it. Duplication of effects is inherent to having monadic computations associated to obtaining the values of behaviours. If you don't cache for a given timestamp, you duplicate effects. The same mechanism they used could be applicable to your monadic AFRP variant.
unzipB :: Behavior (a, b) -> (Behavior a, Behavior b) splitE :: Event (Either a b) -> (Event a, Event b)
In AFRP you always have to do it in the context of the underlying state machine, i.e. MSF/SF/Wire, which means that AFRP forces you to manage all data structures holding reactive values as part of it or, again, have isolated state machines. With first-class FRP there is nothing wrong with keeping a data structure of behaviours in an MVar and have two concurrent threads modify it:
MVar (Map K (Behaviour String))
AFRP requires the following instead, and unless all changes are planned within the state machine and communicated via 'A' changes actually build up in terms of complexity (you can't just keep composing it with more and more MSF actions for free):
MVar (MSF IO A (Map K String))
I could be wrong, but I think most of your problems go away with the kind of monad I mentioned.
Let me make clear that you can express all of these things in AFRP. In fact it's easily more powerful than first-class FRP, because if the system exposes it, you get full access to the expressivity of what is basically a generic state machine. Just to provide one example: there is no first-class counterpart to 'manage' from wires, because that combinator only really makes sense in the context of the underlying state machine. But all of this comes at the expense of giving up first-class behaviours and events in the above sense.
If this still doesn't convince you, I strongly suggest that you give reflex a try. It has a very similar controller interface to AFRP (stepWire/unMSF) in that it gives you control over the main loop, so it shouldn't feel too alien.
As a final remark due to all these issues and more with AFRP most of my research in the past few years went into getting rid of the A while retaining most of its advantages.
I cannot say I like arrow notation, or inputs based on tuples. We need more work on this. However, I decided to embrace the A and I am finding a lot of extensions and guarantees that are possible, or easier, thanks to that.
[...]
Ivan

Hi Ivan,
The easiest way to see the difference is by looking at some of the combinators. Notice that things like 'hold', 'scan'/'accum', and 'tag' are real functions. In a first-class FRP system these would have types like the following:
hold :: a -> Event a -> Moment (Behaviour a) scan :: a -> Event (a -> a) -> Moment (Event a) tag :: Behaviour (a -> b) -> Event a -> Event b
The Moment monad is not inherent to the way the underlying state machine is constructed, but acts merely as a provider for the notion of "now". Since 'tag' doesn't need that notion, it's a completely pure function.
Well, in a way. Yes, it can be a pure function, and an event can somehow be a delayed computation of how/when it is actually produced, computed/consumed the moment you want to actually evaluate the network.
Saying that they are pure would be just fine if Behaviours did not depend on the outside world (that is, if they were "calculated" from pure haskell functions). But I don't think they are. Not always. Not if you want to depend on any external user input.
Behaviours are actually pure values. They don't really depend on time or any effects. Their values may very well be generated from effects, for example the "current cursor position", but conceptually the behaviour that represents the whole timeline of values is indeed a pure value. There is a caveat of course: We like to think of behaviours as functions of time, but that's not the whole truth, because our capability to observe the value of a behaviour is very limited, in most implementations to an abstract notion of "now". The same is true for events: we can only ever ask whether an event is happening "now". That's how effects and a pure API can be compatible. We can think of behaviours as pure timelines (or functions of time), but the API cannot possibly give us full access to it.
In Reflex (and I'm not trying to discuss the particularities of this implementation), yes, Behaviour and Event are types in a family, but the actual definitions in Spider I can seee are records of IORefs with bangs. Far from pure.
Yes, of course. The implementation is shockingly impure and hacky, which is why there is such a massive test suite. =) There are much less hacky ways to implement it, but unfortunately some impurity is inevitable. The reason for Spider's hacikness is efficiency: Reflex is incredibly fast, and a lot of effort went into only ever computing things that matter, and never computing them twice. In my benchmarks it comes very close to wires, which is quite impressive, if you consider what thin an abstraction layer Wire (or MSF) is.
You can have that function in AFRP as well:
fmap :: (a -> b) -> Event a -> Event b
However, unlike 'fmap', 'tag' makes sense in a pure context. You can pass an Event and a Behaviour to a different thread via an MVar, combine them there, then send the result back, and it will still work in the context of the greater application (no isolated state machines).
I don't see how you cannot do that with wires. For instance, you can send a Wire m () (Event b), and a Wire m () (a -> b), and compose them in a pure context. Then you can bring that back and use it.
Right. The difference is that you need to be very careful about context. If you have a "main wire", you must make sure to communicate that result back into it *or* run two wires concurrently. This caution is not necessary with first-class FRP, because it does not have that context-sensitivity.
You can hold an event in any concurrent thread, etc.
Can you use it without doing IO and executing the computation associated to calculating/polling the behaviour? If so, it must be because the FRP evaluation method has some inherent thread-safety (I you need IO + more for that). Wouldn't you be able to put that thread safety in your monad, and then use it with MSFs/Wires?
Thread safety is a different matter, and yes, the implementation must be thread-safe for that to work. This is the reason why I was investigating an FRP implementation based on STM to see how fine-grained regions would pan out, but it was so slow that i abandoned that approach. Reflex does global locking, which sucks, but I can't think of a better way. To answer your question: it depends on the controller API of the framework. For example in Reflex the frame boundary is created by 'fireEventsAndRead'. This is the only action that can "advance time". You can use it from multiple threads, and it will have a timeline-global effect (you can have multiple timelines in Reflex, but if that doesn't make sense to you, just think of "timeline-global" as "global"). In reactive-banana the frame boundery is created by registered callbacks. R-b registers callbacks for events that matter (that's where 'fromAddHandler' and 'reactimate' meet), and whenever one of them is invoked, a new frame begins. In both cases the clock ticks as events fire.
Another example is that if the underlying monad is nontrivial (say IO) you can't easily split behaviours in a pure context in AFRP.
You can, but you need a monad such that: (,) <$> ma <*> ma == (\x -> (x,x)) <$> ma.
Is this called idempotent?
But to implement any form of Classic FRP or Reactive Programming on top of MSFs, you want that kind of monad.
Not sure if idempotency is the right term, but in any case you have that monad in fist-class FRP. It's called Behavio(u)r. =) Note: The Monad instance for Behavior is not implemented yet in Reflex 0.4.0, but you can easily achieve the same by using 'pull' and 'sample': pull (liftA2 (,) (sample b1) (sample b2)) The instance is implemented in the git version.
This restriction does not exist in first-class FRP:
Well, it is not exposed to the user, but someone must have thought about it and solved it. Duplication of effects is inherent to having monadic computations associated to obtaining the values of behaviours. If you don't cache for a given timestamp, you duplicate effects.
This is only really inherent to the mealy-machine approach (i.e. "what AFRP does"). The monads involved in first-class FRP really only serve to tie reactive combinators to "now". Their implementations only control when exactly (in which frame) you hold an event, which is usually a simple matter of effect sequencing, i.e. "having a monad". In other words: moment monads are generally just IO in disguise.
I cannot say I like arrow notation, or inputs based on tuples. We need more work on this.
However, I decided to embrace the A and I am finding a lot of extensions and guarantees that are possible, or easier, thanks to that.
Cale Gibbard has done some work on desugaring arrow notation in smarter ways than the tuple-based approach we have now, but ultimately the whole arrow approach was abandoned (and eventually Reflex was born). My original approach with Netwire was to provide higher-level composition capabilities to reduce the amount of "side channels" necessary, which lead to an interesting Alternative instance for Netwire's version of Wire. One of the defining features of Netwire is the ability to "inhibit", which facilitates a form of switching that eliminates most use cases of Yampa's event-based switches. The following is a string-valued wire that displays "---", but every five seconds it switches to "Ding!" temporarily for one second: ("Ding!" . holdFor 1 <|> "---") . periodic 5 However, nowadays I think first-class FRP is the superior approach. Greets ertes

On 19 February 2018 at 23:17, Ertugrul Söylemez
Hi Ivan,
The easiest way to see the difference is by looking at some of the combinators. Notice that things like 'hold', 'scan'/'accum', and 'tag' are real functions. In a first-class FRP system these would have types like the following:
hold :: a -> Event a -> Moment (Behaviour a) scan :: a -> Event (a -> a) -> Moment (Event a) tag :: Behaviour (a -> b) -> Event a -> Event b
The Moment monad is not inherent to the way the underlying state machine is constructed, but acts merely as a provider for the notion of "now". Since 'tag' doesn't need that notion, it's a completely pure function.
Well, in a way. Yes, it can be a pure function, and an event can somehow be a delayed computation of how/when it is actually produced, computed/consumed the moment you want to actually evaluate the network.
Saying that they are pure would be just fine if Behaviours did not depend on the outside world (that is, if they were "calculated" from pure haskell functions). But I don't think they are. Not always. Not if you want to depend on any external user input.
Behaviours are actually pure values. They don't really depend on time or any effects. Their values may very well be generated from effects, for example the "current cursor position", but conceptually the behaviour that represents the whole timeline of values is indeed a pure value.
I know how they are conceptually defined, but I think the word pure was stretched a lot here to fit this model, not the other way around. See [6]. Are we discussing Classic FRP as a concept, or as it is normally implemented?
There is a caveat of course: We like to think of behaviours as functions of time, but that's not the whole truth, because our capability to observe the value of a behaviour is very limited, in most implementations to an abstract notion of "now". The same is true for events: we can only ever ask whether an event is happening "now".
That's how effects and a pure API can be compatible. We can think of behaviours as pure timelines (or functions of time), but the API cannot possibly give us full access to it.
In Reflex (and I'm not trying to discuss the particularities of this implementation), yes, Behaviour and Event are types in a family, but the actual definitions in Spider I can seee are records of IORefs with bangs. Far from pure.
Yes, of course. The implementation is shockingly impure and hacky, which is why there is such a massive test suite. =)
There are much less hacky ways to implement it, but unfortunately some impurity is inevitable. The reason for Spider's hacikness is efficiency: Reflex is incredibly fast, and a lot of effort went into only ever computing things that matter, and never computing them twice. In my benchmarks it comes very close to wires, which is quite impressive, if you consider what thin an abstraction layer Wire (or MSF) is.
You can have that function in AFRP as well:
fmap :: (a -> b) -> Event a -> Event b
However, unlike 'fmap', 'tag' makes sense in a pure context. You can pass an Event and a Behaviour to a different thread via an MVar, combine them there, then send the result back, and it will still work in the context of the greater application (no isolated state machines).
I don't see how you cannot do that with wires. For instance, you can send a Wire m () (Event b), and a Wire m () (a -> b), and compose them in a pure context. Then you can bring that back and use it.
Right. The difference is that you need to be very careful about context. If you have a "main wire", you must make sure to communicate that result back into it *or* run two wires concurrently. This caution is not necessary with first-class FRP, because it does not have that context-sensitivity.
That is only possible if, at the time of polling or connecting to the outside world, someone has done the job of avoiding double polling. Which you can do in the monad in wires, and get the same benefit.
You can hold an event in any concurrent thread, etc.
Can you use it without doing IO and executing the computation associated to calculating/polling the behaviour? If so, it must be because the FRP evaluation method has some inherent thread-safety (I you need IO + more for that). Wouldn't you be able to put that thread safety in your monad, and then use it with MSFs/Wires?
Thread safety is a different matter, and yes, the implementation must be thread-safe for that to work. This is the reason why I was investigating an FRP implementation based on STM to see how fine-grained regions would pan out, but it was so slow that i abandoned that approach.
I've used this for F;RP (the comma important) and the results were ok. For widget-based GUIs, this is fast enough. For games, probably not (haven't tried large games).
Reflex does global locking, which sucks, but I can't think of a better way.
To answer your question: it depends on the controller API of the framework. For example in Reflex the frame boundary is created by 'fireEventsAndRead'. This is the only action that can "advance time". You can use it from multiple threads, and it will have a timeline-global effect (you can have multiple timelines in Reflex, but if that doesn't make sense to you, just think of "timeline-global" as "global").
In reactive-banana the frame boundery is created by registered callbacks. R-b registers callbacks for events that matter (that's where 'fromAddHandler' and 'reactimate' meet), and whenever one of them is invoked, a new frame begins.
In both cases the clock ticks as events fire.
Another example is that if the underlying monad is nontrivial (say IO) you can't easily split behaviours in a pure context in AFRP.
You can, but you need a monad such that: (,) <$> ma <*> ma == (\x -> (x,x)) <$> ma.
Is this called idempotent?
But to implement any form of Classic FRP or Reactive Programming on top of MSFs, you want that kind of monad.
Not sure if idempotency is the right term, but in any case you have that monad in fist-class FRP. It's called Behavio(u)r. =)
A behaviour is stronger than this. What I am giving is the broadest characterisation of a monad with the property we want.
Note: The Monad instance for Behavior is not implemented yet in Reflex 0.4.0, but you can easily achieve the same by using 'pull' and 'sample':
pull (liftA2 (,) (sample b1) (sample b2))
The instance is implemented in the git version.
This restriction does not exist in first-class FRP:
Well, it is not exposed to the user, but someone must have thought about it and solved it. Duplication of effects is inherent to having monadic computations associated to obtaining the values of behaviours. If you don't cache for a given timestamp, you duplicate effects.
This is only really inherent to the mealy-machine approach (i.e. "what AFRP does"). The monads involved in first-class FRP really only serve to tie reactive combinators to "now". Their implementations only control when exactly (in which frame) you hold an event, which is usually a simple matter of effect sequencing, i.e. "having a monad". In other words: moment monads are generally just IO in disguise.
If I depend on the same external behaviour (e.g. mouse position) from two parts of my program at the same time, what prevents the mouse position from being polled twice?
I cannot say I like arrow notation, or inputs based on tuples. We need
more work on this.
However, I decided to embrace the A and I am finding a lot of extensions and guarantees that are possible, or easier, thanks to that.
Cale Gibbard has done some work on desugaring arrow notation in smarter ways than the tuple-based approach we have now, but ultimately the whole arrow approach was abandoned (and eventually Reflex was born).
Aha! That is interesting. Do you have a pointer to find that work?
My original approach with Netwire was to provide higher-level composition capabilities to reduce the amount of "side channels" necessary, which lead to an interesting Alternative instance for Netwire's version of Wire. One of the defining features of Netwire is the ability to "inhibit", which facilitates a form of switching that eliminates most use cases of Yampa's event-based switches. The following is a string-valued wire that displays "---", but every five seconds it switches to "Ding!" temporarily for one second:
("Ding!" . holdFor 1 <|> "---") . periodic 5
However, nowadays I think first-class FRP is the superior approach.
Greets ertes

On 20 February 2018 at 03:33, Ivan Perez
On 19 February 2018 at 23:17, Ertugrul Söylemez
wrote: Hi Ivan,
The easiest way to see the difference is by looking at some of the combinators. Notice that things like 'hold', 'scan'/'accum', and 'tag' are real functions. In a first-class FRP system these would have types like the following:
hold :: a -> Event a -> Moment (Behaviour a) scan :: a -> Event (a -> a) -> Moment (Event a) tag :: Behaviour (a -> b) -> Event a -> Event b
The Moment monad is not inherent to the way the underlying state machine is constructed, but acts merely as a provider for the notion of "now". Since 'tag' doesn't need that notion, it's a completely pure function.
Well, in a way. Yes, it can be a pure function, and an event can somehow be a delayed computation of how/when it is actually produced, computed/consumed the moment you want to actually evaluate the network.
Saying that they are pure would be just fine if Behaviours did not depend on the outside world (that is, if they were "calculated" from pure haskell functions). But I don't think they are. Not always. Not if you want to depend on any external user input.
Behaviours are actually pure values. They don't really depend on time or any effects. Their values may very well be generated from effects, for example the "current cursor position", but conceptually the behaviour that represents the whole timeline of values is indeed a pure value.
I know how they are conceptually defined, but I think the word pure was stretched a lot here to fit this model, not the other way around. See [6].
Are we discussing Classic FRP as a concept, or as it is normally implemented?
There is a caveat of course: We like to think of behaviours as functions of time, but that's not the whole truth, because our capability to observe the value of a behaviour is very limited, in most implementations to an abstract notion of "now". The same is true for events: we can only ever ask whether an event is happening "now".
I forgot to say: this is precisely how a definition of behaviour and Monadic Stream are related. The fact that, regardless of the conceptual definition, you'll be obtaining values progressively, always now, always "towards" the future.
That's how effects and a pure API can be compatible. We can think of behaviours as pure timelines (or functions of time), but the API cannot possibly give us full access to it.
In Reflex (and I'm not trying to discuss the particularities of this implementation), yes, Behaviour and Event are types in a family, but the actual definitions in Spider I can seee are records of IORefs with bangs. Far from pure.
Yes, of course. The implementation is shockingly impure and hacky, which is why there is such a massive test suite. =)
There are much less hacky ways to implement it, but unfortunately some impurity is inevitable. The reason for Spider's hacikness is efficiency: Reflex is incredibly fast, and a lot of effort went into only ever computing things that matter, and never computing them twice. In my benchmarks it comes very close to wires, which is quite impressive, if you consider what thin an abstraction layer Wire (or MSF) is.
You can have that function in AFRP as well:
fmap :: (a -> b) -> Event a -> Event b
However, unlike 'fmap', 'tag' makes sense in a pure context. You can pass an Event and a Behaviour to a different thread via an MVar, combine them there, then send the result back, and it will still work in the context of the greater application (no isolated state machines).
I don't see how you cannot do that with wires. For instance, you can send a Wire m () (Event b), and a Wire m () (a -> b), and compose them in a pure context. Then you can bring that back and use it.
Right. The difference is that you need to be very careful about context. If you have a "main wire", you must make sure to communicate that result back into it *or* run two wires concurrently. This caution is not necessary with first-class FRP, because it does not have that context-sensitivity.
That is only possible if, at the time of polling or connecting to the outside world, someone has done the job of avoiding double polling. Which you can do in the monad in wires, and get the same benefit.
You can hold an event in any concurrent thread, etc.
Can you use it without doing IO and executing the computation associated to calculating/polling the behaviour? If so, it must be because the FRP evaluation method has some inherent thread-safety (I you need IO + more for that). Wouldn't you be able to put that thread safety in your monad, and then use it with MSFs/Wires?
Thread safety is a different matter, and yes, the implementation must be thread-safe for that to work. This is the reason why I was investigating an FRP implementation based on STM to see how fine-grained regions would pan out, but it was so slow that i abandoned that approach.
I've used this for F;RP (the comma important) and the results were ok. For widget-based GUIs, this is fast enough. For games, probably not (haven't tried large games).
Reflex does global locking, which sucks, but I can't think of a better way.
To answer your question: it depends on the controller API of the framework. For example in Reflex the frame boundary is created by 'fireEventsAndRead'. This is the only action that can "advance time". You can use it from multiple threads, and it will have a timeline-global effect (you can have multiple timelines in Reflex, but if that doesn't make sense to you, just think of "timeline-global" as "global").
In reactive-banana the frame boundery is created by registered callbacks. R-b registers callbacks for events that matter (that's where 'fromAddHandler' and 'reactimate' meet), and whenever one of them is invoked, a new frame begins.
In both cases the clock ticks as events fire.
Another example is that if the underlying monad is nontrivial (say IO) you can't easily split behaviours in a pure context in AFRP.
You can, but you need a monad such that: (,) <$> ma <*> ma == (\x -> (x,x)) <$> ma.
Is this called idempotent?
But to implement any form of Classic FRP or Reactive Programming on top of MSFs, you want that kind of monad.
Not sure if idempotency is the right term, but in any case you have that monad in fist-class FRP. It's called Behavio(u)r. =)
A behaviour is stronger than this.
What I am giving is the broadest characterisation of a monad with the property we want.
Note: The Monad instance for Behavior is not implemented yet in Reflex 0.4.0, but you can easily achieve the same by using 'pull' and 'sample':
pull (liftA2 (,) (sample b1) (sample b2))
The instance is implemented in the git version.
This restriction does not exist in first-class FRP:
Well, it is not exposed to the user, but someone must have thought about it and solved it. Duplication of effects is inherent to having monadic computations associated to obtaining the values of behaviours. If you don't cache for a given timestamp, you duplicate effects.
This is only really inherent to the mealy-machine approach (i.e. "what AFRP does"). The monads involved in first-class FRP really only serve to tie reactive combinators to "now". Their implementations only control when exactly (in which frame) you hold an event, which is usually a simple matter of effect sequencing, i.e. "having a monad". In other words: moment monads are generally just IO in disguise.
If I depend on the same external behaviour (e.g. mouse position) from two parts of my program at the same time, what prevents the mouse position from being polled twice?
I cannot say I like arrow notation, or inputs based on tuples. We need
more work on this.
However, I decided to embrace the A and I am finding a lot of extensions and guarantees that are possible, or easier, thanks to that.
Cale Gibbard has done some work on desugaring arrow notation in smarter ways than the tuple-based approach we have now, but ultimately the whole arrow approach was abandoned (and eventually Reflex was born).
Aha! That is interesting. Do you have a pointer to find that work?
My original approach with Netwire was to provide higher-level composition capabilities to reduce the amount of "side channels" necessary, which lead to an interesting Alternative instance for Netwire's version of Wire. One of the defining features of Netwire is the ability to "inhibit", which facilitates a form of switching that eliminates most use cases of Yampa's event-based switches. The following is a string-valued wire that displays "---", but every five seconds it switches to "Ding!" temporarily for one second:
("Ding!" . holdFor 1 <|> "---") . periodic 5
However, nowadays I think first-class FRP is the superior approach.
Greets ertes
participants (5)
-
Ertugrul Söylemez
-
Ivan Perez
-
KAction@gnu.org
-
Oleg Grenrus
-
Oliver Charles