atzeus / frpnow Goto Github PK
View Code? Open in Web Editor NEWLicense: Other
License: Other
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.
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!)
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.
FRPNow.cabal indicates BSD3 licence, but the LICENCE file itself is missing.
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.
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’
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?
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 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.
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).
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
.
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
The revision in the cabal file should be bumped to 0.15 to match hackage.
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.
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))
{-# 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 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
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
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.
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.
A declarative, efficient, and flexible JavaScript library for building user interfaces.
🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.
TypeScript is a superset of JavaScript that compiles to clean JavaScript output.
An Open Source Machine Learning Framework for Everyone
The Web framework for perfectionists with deadlines.
A PHP framework for web artisans
Bring data to life with SVG, Canvas and HTML. 📊📈🎉
JavaScript (JS) is a lightweight interpreted programming language with first-class functions.
Some thing interesting about web. New door for the world.
A server is a program made to process requests and deliver data to clients.
Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.
Some thing interesting about visualization, use data art
Some thing interesting about game, make everyone happy.
We are working to build community through open source technology. NB: members must have two-factor auth.
Open source projects and samples from Microsoft.
Google ❤️ Open Source for everyone.
Alibaba Open Source for everyone
Data-Driven Documents codes.
China tencent open source team.