atzeus / frpnow Goto Github PK

Getting the following compile error with 7.8.4:

Control/FRPNow/Core.hs:624:76:
Can't make a derived instance of
‘Typeable FRPWaitsForNeverException’:
You need DeriveDataTypeable to derive an instance for this class
In the data declaration for ‘FRPWaitsForNeverException’

I have the following program:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}

module Main where

import Control.FRPNow
import Control.Monad.Trans.Class
import Data.Bool
import Data.Char
import Francium
import Francium.Components.Form.Input
import Francium.HTML
import Francium.Hooks
import GHCJS.Foreign
import GHCJS.Types
import VirtualDom

one
  :: String -> Behavior Bool -> Now (HTML Behavior (), EvStream String)
one label hasFocus =
  do (clickHook,clicks) <- newClickHook
     return (do suffix <-
                  fmap (bool "" "!")
                       (lift hasFocus)
                div_ (applyHooks clickHook)
                     (do text (toJSString label)
                         suffix)
            ,label <$ clicks)

main :: IO ()
main =
  react (mdo (item1,focus1) <-
               one "One" (fmap ("One" ==) focus)
             (item2,focus2) <-
               one "Two" (fmap ("Two" ==) focus)
             focus <-
               sample (fromChanges "One"
                                   (merge focus1 focus2))
             return (do item1
                        item2))

Unfortunately it's quite deeply tied to work I'm doing, and not a standalone example. It shows two HTML <div> elements that can be clicked, which changes the focused element. It begins with "One" having focus.

If I use the Hackage release, I can click "Two" which immediately gives it focus. From that point on, rendering always seems to lag a frame behind - meaning I have to click "One" twice to shift focus back to "One".

If I change memoB to be the same as id, then the behavior changes. Now, I have to click on "Two" twice, right from the start, in order for it to have focus, rather than once as observed previously.

Neither of these do what I expect (it should only require a single click to change focus), but the fact that the behavior has changed makes me think that memoB and memoE are not semantically acting as identity.

In both programs a single click does cause a re-render, but it appears that the behavior containing the rendered view of each element ("One!" or "Two!") changes after the composed rendering (do item1 ; item2) is observed to change. This is probably a separate bug, and I'm trying to work out what's going on with that next.

A Behavior is defined as being a constant paired with the next future Event. I'm wondering if this means it's possible to have a toChanges that doesn't wait for an actual observable change, just the switching itself happening:

toChanges' :: Behavior a -> EvStream a
toChanges' b = S $ do
  let loop b = do
        (a,switching) <- observeSwitch b
        switched <-
          plan (fmap loop switching)
        fmap (switch (pure a) switched)
  in loop b

(something like that, anyway)

The reason this is important is for Behaviors that either do not have a notion of equality (eg functions), or for data where equality is more expensive than occasionally seeing the same event multiple times (large tree structures).

Here is a minimal example program:

{-# LANGUAGE RecursiveDo #-}

import Control.FRPNow
import Control.Monad
import System.IO

main :: IO ()
main =
  do hSetBuffering stdin NoBuffering
     hSetBuffering stdout NoBuffering
     runNowMaster
       (mdo (keyPressed,keyPress) <- callbackStream
            -- State begins in state "1", and when a key is pressed it switches to state 2
            state <-
              sample (fromChanges
                        1
                        (2 <$ (keyPressed `during` (fmap (1 ==) state))))
            -- Whenever the state changes, print it
            callIOStream (print :: Int -> IO ())
                         (toChanges state)
            async (forever (getChar >>= keyPress)))

When ran, if you press any key the process begins using all the memory it can, until it blows the stack.

If I change fmap (1 ==) state to pure True it works fine, but obviously is a different program :) Perhaps a missing call to futuristic somewhere?

Edit: I simplified my problem down to what seems to just be a problem with merge:

I expect the following program to print "Selected x" every time I press one of the keys 1-9 on my keyboard. However, I have to repeatedly press that key in order to get the event event to come through.

import Data.Char
import Control.FRPNow
import Control.Monad
import Data.Traversable
import System.IO

main :: IO ()
main =
  do hSetBuffering stdin NoBuffering
     hSetBuffering stdout NoBuffering
     runNowMaster
       (do items <-
             for [1 .. 9]
                 (\n ->
                    do (presses,press) <- callbackStream
                       _ <-
                         async (forever (getChar >>= press))
                       return (n <$ filterEs (intToDigit n ==) presses))
           callIOStream (putStrLn . ("Selected " ++) . show)
                        (foldl merge mempty items)
           return never)

Below is my original post, for posterity

I've managed to construct a small minimal program here that exhibits some confusing (to me) behavior.

The program models a selector that allows the user to select one of three items. Each item can be constructed with newItemSelector, which yields a rendering of that item, allowing it to indicate whether or not it is selected, and an event stream indicating whenever it is selected. These items are provided with a Behavior Bool to indicate whether or not they are the current selection. Users can select items by pressing 1/2/3 on their keyboard.

In the main loop, I create three possible item selectors, and I simply print out a list of the items whenever they change their rendered representation.

Something odd happens when I run this.

[nix-shell:~/work/scratchpad]$ ./frpnow
["True","False","False"]
22["False","True","False"]
3["False","False","True"]
22["False","True","False"]
11["True","False","False"]
2["False","True","False"]
3["False","False","True"]
22["False","True","False"]

Notice how sometimes I have to select the item multiple times for the change to actually be presented. To highlight one example, note I select '3' with one key press, but then have to press 2 twice in order to trigger that re-rendering.

I can't quite figure out if I'm wrong, on frpnow is wrong. Any ideas?

{-# LANGUAGE RecursiveDo #-}

import Control.Applicative
import Control.FRPNow
import Control.Monad
import Data.Traversable

data Item
  = Item1
  | Item2
  | Item3
  deriving (Bounded,Enum,Eq,Ord,Show)

index :: Item -> Char
index Item1 = '1'
index Item2 = '2'
index Item3 = '3'

main :: IO ()
main =
  do runNowMaster
       (mdo items <-
              for [minBound .. maxBound]
                  (\item ->
                     let active =
                           fmap (item ==) currentState
                     in newItemSelector item active)
            currentState <-
              sample (fromChanges Item1
                                  (foldl merge mempty (fmap snd items)))
            callIOStream print
                         (toChanges (mapM fst items))
            return never)

newItemSelector
  :: Item -> Behavior Bool -> Now (Behavior String,EvStream Item)
newItemSelector item isActive =
  do (presses,press) <- callbackStream
     async (forever (getChar >>= press))
     return (fmap show isActive,item <$ (filterEs (index item ==) presses))

The revision in the cabal file should be bumped to 0.15 to match hackage.

The paper referenced here is a dead link.

The documentation currently reads as

Yet another type of fold.

Which doesn't help the user at all. We should improve this to explain what the fold does and why it's useful.

In general, I'd like to spend a bit of time improving documentation - will coordinate with @atzeus when he's back to see when is a good time to do this (no point starting if there are big API changes coming!)

Hi Atze, it was nice chatting with you at lunch. Here is some code that I adapted from your sample program, trying to learn how I can define recursive behaviors using integrate, which returns a type of Behavior (Behavior a). The natural way of getting a single Behavior a was to use join since Behavior is a monad, however, it wouldn't work (see e' below). I had to resort to recursive monads and go through conversion from Behavior to Now monad in order to get a working definition (see e below). Any explanation is greatly appreciated!

{-# LANGUAGE RecursiveDo #-}
import Control.Monad (join)
import Control.FRPNow
import Control.Applicative

n = 1000

main = runNowMaster (test n)

test :: Int -> Now (Event ())
test n = do b <- count 
            let time = fmap ((*0.001) . fromIntegral) b
{- Recursively define an exponential signal -}
            rec e <- sample $ delayTime time (1.0::Double) e >>= integrate time 
            traceChanges "e = " e
{- however, the following doesn't work, and is constant -}
            let e' = join $ delayTime time (1.0::Double) e' >>= integrate time 
            traceChanges "e' = " e'
            stop <- sample (when ((n ==) <$> b))
            return stop

count :: Now (Behavior Int)
count = loop 0 where
  loop i =  do  e <- async (return ())
                e'<- planNow (loop (i+1) <$ e)
                return (pure i `switch` e')

My interest in this definition goes back to my early paper Plugging a Space Leak with an Arrow where it can be demonstrated that if using the function denotation of a signal (Time -> a) in an implementation, a space leak cannot be avoided under the call-by-need evaluation strategy. FRPNow obviously doesn't have this issue, but I'm just confused as in why it is useful to make Behavior a monad.

The following:

module Main where

import Control.FRPNow

main :: IO ()
main = runNowMaster (return never)

When compiled (with ghc --make -threaded) results in

Test: thread blocked indefinitely in an MVar operation

when executed.

{-# LANGUAGE RecursiveDo #-}

module Main where

import Control.FRPNow
import Control.Monad

main :: IO ()
main =
  react (do (changes,f) <- callbackStream
            _ <- async (forever (f ()))
            _ <- sample (fromChanges () changes)
            return (pure ()))

react :: Now (Behavior ()) -> IO ()
react app =
  do runNowMaster
       (do _ <- app
           pure never)

When ran:

[nix-shell:~/work/scratchpad]$ ghc -fforce-recomp -Wall --make frpnow.hs -rtsopts ; ./frpnow
[1 of 1] Compiling Main             ( frpnow.hs, frpnow.o )
Linking frpnow ...
frpnow: Prelude.undefined

The following program

module Main where

import Control.Monad
import Control.Concurrent
import Control.FRPNow

main :: IO ()
main =
  (print :: Double -> IO ()) =<<
  runNowMaster (do e <- async (threadDelay 10000)
                   let clock = pure 0 `switch` (pure 1 <$ e) :: Behavior Double
                       speed = 1 :: Double
                   distance <- sample (integrate clock (pure speed))
                   traceChanges "Distance: " distance
                   return never)

outputs

Distance: 0.0
Distance: 0.5

Given a speed of 1 unit/tick, I'd expect that after 1 tick I had travelled 1 units, rather than 0.5.

module Main where

import Control.Monad
import Control.Concurrent
import Control.FRPNow

main :: IO ()
main =
  runNowMaster
    (do (evs,fire) <- callbackStream
        async (replicateM_
                 n
                 (do threadDelay 100
                     fire 1))
        sum <- sample (scanlEv (+) 0 evs)
        callIOStream print sum
        fmap void (sample (next (filterEs (>= n) sum))))
    where n = 100000

When ran:

   5,424,406,728 bytes allocated in the heap
  18,516,064,696 bytes copied during GC
     400,022,240 bytes maximum residency (95 sample(s))
       5,068,960 bytes maximum slop
             786 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0     10364 colls,     0 par    0.970s   0.970s     0.0001s    0.0004s
  Gen  1        95 colls,     0 par   19.331s  19.348s     0.2037s    0.4301s

  INIT    time    0.001s  (  0.001s elapsed)
  MUT     time    9.577s  ( 23.963s elapsed)
  GC      time   10.713s  ( 10.725s elapsed)
  RP      time    0.000s  (  0.000s elapsed)
  PROF    time    9.587s  (  9.594s elapsed)
  EXIT    time    0.003s  (  0.004s elapsed)
  Total   time   29.885s  ( 34.693s elapsed)

  %GC     time      35.8%  (30.9% elapsed)

  Alloc rate    566,387,833 bytes per MUT second

  Productivity  32.1% of total user, 27.6% of total elapsed

There is a potential instance

instance MonadIO Now where
  liftIO = sync

What do you think about adding this? It would nicely simplify working in the Now monad if you happen to have stuff that is already polymorphic over MonadIO m.

FRPNow.cabal indicates BSD3 licence, but the LICENCE file itself is missing.

The following program has events that happen at the beginning of time, as they use return for the Monad Event instant. one returns a Behavior who's Event contains a deferred Now computation. This computation in turn does some IO, and then samples the Behavior passed in as an argument - two - to obtain a subsequent Event containing another (possibly) deferred Now computation. When this Event occurs, the Now computation is executed.

However, when one is given two, I would expect the Now computation in two to be executed, as that Event has already happened. However, instead I observe that the computation is never executed.

I think there is a bug, because in one I check whether the event has occurred and am told that it has. The documentation for plan states:

If the event has already occured when planNow is called, then the Now computation will be executed immediatly.

but that is not what I am seeing.

Code:

module Main where

import Control.FRPNow

one
  :: Behavior (Event (Now ()))
  -> Behavior (Event (Now ()))
one children =
  pure (pure (do sync (putStrLn "plan for one")
                 childrenChanged <- sample children
                 sync . print =<< sample (hasOccured childrenChanged)
                 plan (fmap id childrenChanged)
                 return ()))

two :: Behavior (Event (Now ()))
two =
  pure (pure (sync (putStrLn "two")))

main :: IO ()
main =
  do runNowMaster
       (do change <- sample (one two)
           plan (fmap id change))
     putStrLn "All done"

Output:

plan for one
True
All done

Expected output:

plan for one
True
two
All done

Here's my code:

import Control.FRPNow
import Control.Monad (forever)

ticks :: Now (EvStream ())
ticks = do
  (evs, cbk) <- callbackStream
  async (forever (cbk ()))
  return evs

count :: EvStream () -> Behavior (Behavior Integer)
count = foldEs (\a _ -> a + 1) 0

main :: IO ()
main = runNowMaster $ do
  t <- ticks
  sample $ do
    b <- count t
    when (fmap (> 10000) b)

I have compiled this with -threaded -rtsopts and when running it with +RTS -N it gives me a FRPWaitsForNeverException while it clearly doesn't wait for never. Running it without +RTS -N works just fine.

To my understanding this would be possible and fix some name clashes for me :)

I think there could be some advantages of this approach.

The Github repo is missing multiple files, including the changelog, Control/FRPNow.hs, Control/FRPNow/Time.hs, and perhaps others I have not yet noticed.

I just found an issue with emptyEs, more specifically with futuristic and how it interacts with the never event. After some trials and profiling this was the simplest program to cause the issue. The broken function just does nothing, it just waits forever. The working function prints "test" after e1 has fired.

import Control.FRPNow

broken :: IO ()
broken = runNowMaster $ do
    (e1, trigger1) <- callback
    sync $ trigger1 ()

    e2 <- sample $ futuristic $ return never
    e3 <- sample $ whenJust $ return Nothing `switch` fmap (pure . Just) e1 `switch` fmap (pure . Just) e2

    plan $ (sync $ print "test") <$ e3
    return never

working :: IO ()
working = runNowMaster $ do
    (e1, trigger1) <- callback
    sync $ trigger1 ()

    e2 <- sample $ return $ never
    e3 <- sample $ whenJust $ return Nothing `switch` fmap (pure . Just) e1 `switch` fmap (pure . Just) e2

    plan $ (sync $ print "test") <$ e3
    return never

The only difference in this code is in how e2 is produced, the broken one uses futuristic. This could cause programs to hang when emptyEs is used, particular when used with Control.FRPNow.Lib.first.

I'm currently using
Compiler: GHC 7.10.2
OS : Mac OS X 10.11

My understanding is that the following should print two lines, but it only prints once.

module Main where

import Control.Concurrent
import Control.FRPNow

main :: IO ()
main =
  runNowMaster
    (do (later,fireLater) <- callback
        plan (fmap (const (sync (putStrLn "later"))) later)
        reallyLater <-
           sample (futuristic (return later))
        plan (fmap (const (sync (putStrLn "reallyLater"))) reallyLater)
        async (threadDelay 100000 >> fireLater ())
        return never)

However, I guess this is questionable use of futuristic, as return later doesn't really denote a Behavior where the Event is always in the future, though no error is thrown either.