Re: [reactive] Feedback on my first Reactive program: Monad Laws

Digging around with the commented query -- that a "pure (string)" is getting
delayed -- I've hit a rather fundamental problem: it seems Event doesn't
obey the Monad laws. I don't know whether this is a known issue or whether
I'm being plain stupid, but this:--
module Main
where
import FRP.Reactive
import FRP.Reactive.LegacyAdapters
import Control.Concurrent
import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.Maybe
main = do
clock <- makeClock
(sink, evnt) <- makeEvent clock
forkIO . sequence_ $ repeat (getLine >>= sink)
adaptE . fmap putStrLn $ (pure "A Line!" `mappend` evnt)
-- adaptE . fmap putStrLn $ (pure "A Line!" `mappend` (evnt >>= return))
and the same with the penultimate line commented instead of the last, appear
to have different behaviours: in the version shown, "A Line!" is printed
when the program starts; and in the other, this is delayed until after the
first line is read (but before it is printed).
Should this happen?
Freddie Manners
2009/3/29 Mads Lindstrøm
Hi
As part of studying the Reactive library, I have created a simple game. The object of the game is to guess a number.
As I am a newbie with respect to FRP, I assume that my game could have been implemented more elegantly. Comments are most welcome.
The game can be found here http://hpaste.org/fastcgi/hpaste.fcgi/view?id=3037#a3037 and it is attached.
Greetings,
Mads Lindstrøm
_______________________________________________ Reactive mailing list Reactive@haskell.org http://www.haskell.org/mailman/listinfo/reactive

0.10.5, 6.10.1 btw.
2009/3/29 Freddie Manners
Digging around with the commented query -- that a "pure (string)" is getting delayed -- I've hit a rather fundamental problem: it seems Event doesn't obey the Monad laws. I don't know whether this is a known issue or whether I'm being plain stupid, but this:--
module Main where
import FRP.Reactive import FRP.Reactive.LegacyAdapters import Control.Concurrent import Control.Applicative import Control.Monad import Data.Monoid import Data.Maybe
main = do clock <- makeClock (sink, evnt) <- makeEvent clock forkIO . sequence_ $ repeat (getLine >>= sink) adaptE . fmap putStrLn $ (pure "A Line!" `mappend` evnt) -- adaptE . fmap putStrLn $ (pure "A Line!" `mappend` (evnt >>= return))
and the same with the penultimate line commented instead of the last, appear to have different behaviours: in the version shown, "A Line!" is printed when the program starts; and in the other, this is delayed until after the first line is read (but before it is printed).
Should this happen?
Freddie Manners
2009/3/29 Mads Lindstrøm
Hi
As part of studying the Reactive library, I have created a simple game. The object of the game is to guess a number.
As I am a newbie with respect to FRP, I assume that my game could have been implemented more elegantly. Comments are most welcome.
The game can be found here http://hpaste.org/fastcgi/hpaste.fcgi/view?id=3037#a3037 and it is attached.
Greetings,
Mads Lindstrøm
_______________________________________________ Reactive mailing list Reactive@haskell.org http://www.haskell.org/mailman/listinfo/reactive

Freddie Manners wrote:
I've hit a rather fundamental problem: it seems Event doesn't obey the Monad laws.
Yes, this is a known problem. Event is not a Monad. I don't think there are plans to correct it any time soon. My personal preference is to pretend that Event has no Monad instance. - Jake

We discovered during quickchecking that a monad associativity law can fail.
And that it's a semantic bug, not an implementation bug. I don't know
whether Freddie is running into this same issue or something else. - Conal
On Sun, Mar 29, 2009 at 8:27 PM, Jake McArthur
Freddie Manners wrote:
I've hit a rather fundamental problem: it seems Event doesn't obey the Monad laws.
Yes, this is a known problem. Event is not a Monad. I don't think there are plans to correct it any time soon. My personal preference is to pretend that Event has no Monad instance.
- Jake
_______________________________________________ Reactive mailing list Reactive@haskell.org http://www.haskell.org/mailman/listinfo/reactive

I believe this is the right identity law (m >>= return === m), though it may
have the same root cause. The annoying thing is that this and a probably
related bug affect all functions (I know of) with type:
Event (Maybe a) -> Event a
, namely justE, joinMaybes & the somewhat artificial "fmap fromJust .
filterE (not . isNothing)". An example is:--
module Main
where
import FRP.Reactive
import FRP.Reactive.LegacyAdapters
import Control.Concurrent
import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.Maybe
aFilter :: String -> Maybe String
aFilter (_:_) = Just "A Non-Empty Line!"
aFilter _ = Nothing
justEventFilterFunction :: (Show a) => Event (Maybe a) -> Event a
--justEventFilterFunction = justE
justEventFilterFunction = fmap fromJust . filterE (not.isNothing)
--justEventFilterFunction = joinMaybes
main = do
clock <- makeClock
(sink, evnt) <- makeEvent clock
forkIO $ forever (getLine >>= sink)
adaptE $ fmap putStrLn (pure "The First Line!" `mappend` (justE .
fmap aFilter $ evnt))
which again delays the `pure "The First Line!"` until the first line of
input is scanned, with all suitable uncommentings of the code. The problem
is definitely in justEventFilterFunction; removing it (sensibly) removes the
delay. The joinMaybes version clearly suffers from the Monad problem I
mentioned before; the fact that justE does the same thing leads me to
suspect the problem is adjustE not doing its job or being too strict, but I
know far too little about the internals to have a clue.
Freddie
2009/3/30 Conal Elliott
We discovered during quickchecking that a monad associativity law can fail. And that it's a semantic bug, not an implementation bug. I don't know whether Freddie is running into this same issue or something else. - Conal
On Sun, Mar 29, 2009 at 8:27 PM, Jake McArthur
wrote: Freddie Manners wrote:
I've hit a rather fundamental problem: it seems Event doesn't obey the Monad laws.
Yes, this is a known problem. Event is not a Monad. I don't think there are plans to correct it any time soon. My personal preference is to pretend that Event has no Monad instance.
- Jake
_______________________________________________ Reactive mailing list Reactive@haskell.org http://www.haskell.org/mailman/listinfo/reactive
participants (3)
-
Conal Elliott
-
Freddie Manners
-
Jake McArthur