Permalink
Browse files

Join Behaviour

  • Loading branch information...
1 parent d783c8c commit 39cabedade67467193f0cfb4c18e7124d79845ff @larrytheliquid committed Feb 11, 2012
View
@@ -1,7 +1,7 @@
SRC_JS = require agda.frp agda.frp.main agda.frp.signal agda.frp.time agda.frp.taskqueue agda.mixin agda.box agda.array agda.keys agda.object
-DEMO_AGDA = FRP.JS.Demo.Hello FRP.JS.Demo.Clock FRP.JS.Demo.Button FRP.JS.Demo.HRef FRP.JS.Demo.Calculator FRP.JS.Demo.Geolocation
-DEMO_HTML = hello clock button href calculator geolocation
+DEMO_AGDA = FRP.JS.Demo.Hello FRP.JS.Demo.Clock FRP.JS.Demo.FastClock FRP.JS.Demo.Button FRP.JS.Demo.HRef FRP.JS.Demo.Calculator FRP.JS.Demo.Geolocation
+DEMO_HTML = hello clock fastclock button href calculator geolocation
DEMO_CSS = demo
DEMO_PNG = alu
@@ -0,0 +1,18 @@
+open import FRP.JS.String using ( String )
+open import FRP.JS.Time using ( Time ; _+_ )
+open import FRP.JS.Behaviour using ( Beh ; map ; [_] ; join )
+open import FRP.JS.DOM using ( DOM ; text )
+open import FRP.JS.RSet using ( ⟦_⟧; ⟨_⟩ )
+open import FRP.JS.Time using ( toUTCString ; every )
+open import FRP.JS.Delay using ( _sec ; _min )
+
+module FRP.JS.Demo.FastClock where
+
+model : ⟦ Beh ⟨ Time ⟩ ⟧
+model = map (λ t t + 5 min) (every (1 sec))
+
+view : {w} ⟦ Beh (DOM w) ⟧
+view = join (map (λ t text [ toUTCString t ]) model)
+
+main : {w} ⟦ Beh (DOM w) ⟧
+main = view
View
@@ -0,0 +1,15 @@
+<html>
+ <head>
+ <title>Fast Clock</title>
+ <meta name="apple-mobile-web-app-capable" content="yes"/>
+ <meta name="viewport" content="width=device-width, initial-scale=1"/>
+ <link rel="stylesheet" type="text/css" href="demo.css"/>
+ <link rel="apple-touch-icon" href="alu.png"/>
+ <link rel="apple-touch-icon-precomposed" href="alu.png"/>
+ <script data-main="agda.frp.main" src="require.js"></script>
+ </head>
+ <body>
+ <h1>A fast clock</h1>
+ <div class="agda" data-agda="FRP.JS.Demo.FastClock"></div>
+ </body>
+</html>
@@ -9,6 +9,7 @@ postulate
map : {A B} ⟦ A ⇒ B ⟧ ⟦ Beh A ⇒ Beh B ⟧
map2 : {A B C} ⟦ A ⇒ B ⇒ C ⟧ ⟦ Beh A ⇒ Beh B ⇒ Beh C ⟧
[_] : {A} A ⟦ Beh ⟨ A ⟩ ⟧
+ join : {A} ⟦ Beh (Beh A) ⇒ Beh A ⟧
hold : {A} ⟦ ⟨ A ⟩ ⇒ Evt ⟨ A ⟩ ⇒ Beh ⟨ A ⟩ ⟧
{-# COMPILED_JS map function(A) { return function(B) {
@@ -27,6 +28,10 @@ postulate
return require("agda.frp").constant(a);
}; }; } #-}
+{-# COMPILED_JS join function(A) { return function(s) { return function(b) {
+ return b.join();
+}; }; } #-}
+
{-# COMPILED_JS hold function(A) { return function(s) { return function(a) { return function(e) {
return e.hold(a);
}; }; }; } #-}
View
@@ -17,7 +17,7 @@ define(["agda.frp.taskqueue","agda.mixin"],function(taskqueue,mixin) {
// The abstract superclass of signals.
// Each signal has a *rank*, such that
// a) the rank of every signal is at least that of its downstream neighbours
- // b) the rank of a signal with more than one downstream neighour
+ // b) the rank of a signal with more than one downstream neighbour
// is strictly greer than that of its downstream neighbours.
var signals = 0;
function Signal() {
@@ -348,6 +348,9 @@ define(["agda.frp.taskqueue","agda.mixin"],function(taskqueue,mixin) {
Behaviour.prototype.map2 = function(b,fun) {
return new Map2Behaviour(fun,this,b);
}
+ Behaviour.prototype.join = function() {
+ return new JoinBehaviour(this);
+ }
Behaviour.prototype.text = function() {
return new TextBehaviour(this);
}
@@ -379,7 +382,7 @@ define(["agda.frp.taskqueue","agda.mixin"],function(taskqueue,mixin) {
Behaviour0.call(this);
}
Behaviour0.prototype.mixin(ConstantBehaviour.prototype);
- // Map a function onto a event
+ // Map a function onto a behaviour
function MapBehaviour(fun,downstream) {
this.fun = fun;
Behaviour1.call(this,downstream);
@@ -397,6 +400,19 @@ define(["agda.frp.taskqueue","agda.mixin"],function(taskqueue,mixin) {
Map2Behaviour.prototype.notify = function(now,value) {
this.notifyUpstream(now,this.fun(now,this.downstream1.value,this.downstream2.value));
}
+ // Join a behavior of behaviours into a behaviour
+ function JoinBehaviour(downstream) {
+ Behaviour1.call(this,downstream);
+ }
+ Behaviour1.prototype.mixin(JoinBehaviour.prototype);
+ JoinBehaviour.prototype.notify = function(now,behaviour) {
+ this.notifyUpstream(now,behaviour.value);
+ }
+ JoinBehaviour.prototype.attachTo = function(node) {
+ this.anchor(function(now, value) {
+ value.initializeChildrenOf(node);
+ });
+ }
// Convert an event into a behaviour
function HoldBehaviour(init,downstream) {
this.value = init;
@@ -502,8 +518,8 @@ define(["agda.frp.taskqueue","agda.mixin"],function(taskqueue,mixin) {
}
DOMNodesBehaviour.prototype.mixin(Behaviour2.prototype.mixin(ConcatBehaviour.prototype));
ConcatBehaviour.prototype.notify = function(now,value) {
- this.length = this.downstream1.length + this.downstream2.length;
- this.attributes = this.downstream1.attributes + this.downstream2.attributes;
+ this.length = this.downstream1.value.length + this.downstream2.value.length;
+ this.attributes = this.downstream1.value.attributes + this.downstream2.value.attributes;
this.notifyUpstream(now,this);
}
ConcatBehaviour.prototype.appendChildrenOf = function(node) {
@@ -583,13 +599,13 @@ define(["agda.frp.taskqueue","agda.mixin"],function(taskqueue,mixin) {
DOMNodeBehaviour.prototype.replaceChildrenAt = function(node,index) {
for (var i = 0; i < this.pool.length; i++) {
if((!this.pool[i].parentNode) || ((this.pool[i].parentNode === this) && (index <= this.pool[i].index))) {
- node.insertBefore(node.childNodes[index],this.pool[i]);
+ node.insertBefore(this.pool[i],node.childNodes[index]);
return;
}
}
var fresh = this.build();
this.pool.push(fresh);
- node.insertBefore(node.childNodes[i],fresh);
+ node.insertBefore(fresh,node.childNodes[i]);
}
DOMNodeBehaviour.prototype.length = 1;
// TextBehaviour <: DOMNodeBehaviour, Behaviour1<String,TextBehaviour>
@@ -23,6 +23,9 @@ tests =
, test "map"
( ok◇ "map suc [ 0 ] ≟* [ 1 ]" (map suc [ 0 ] ≟* [ 1 ])
, ok◇ "map suc [ 1 ] ≟* [ 1 ]" (not* (map suc [ 1 ] ≟* [ 1 ])) )
+ , test "join"
+ ( ok◇ "join (map [ suc ] [ 0 ] ) ≟* [ 1 ]" (join (map (λ n [ suc n ]) [ 0 ]) ≟* [ 1 ])
+ , ok◇ "join (map [ suc ] [ 1 ]) ≟* [ 1 ]" (not* (join (map (λ n [ suc n ]) [ 1 ]) ≟* [ 1 ])) )
, test "hold"
( ok◇ "hold 1 ∅ ≟* [ 1 ]" (hold 1 ∅ ≟* [ 1 ])
, ok◇ "hold 0 ∅ ≟* [ 1 ]" (not* (hold 0 ∅ ≟* [ 1 ])) ) )
@@ -56,5 +56,18 @@ tests =
(withDOW λ w element "p" {w} (text [ "abc" ]) ≟* element "p" (text [ "abc" ]))
, ok◇ "element p (text [ a ]) ++ element p (text [ b ]) ≟* element p (text [ a ])"
(withDOW λ w not* (element "p" {left w} (text [ "a" ]) ++ element "p" (text [ "b" ]) ≟* element "p" (text [ "a" ])))
- ) )
+ )
+ , test "join"
+ ( ok◇ "text (join (map [ x ] [ abc ])) ≟* text [ abc ]"
+ (withDOW λ w text {w} (join (map (λ s [ s ]) [ "abc" ])) ≟* text [ "abc" ])
+ , ok◇ "join (map (text [ x ]) [ abc ]) ≟* text [ abc ]"
+ (withDOW λ w join (map (λ s text {w} [ s ]) [ "abc" ]) ≟* text [ "abc" ])
+ , ok◇ "element p (join (map (attr foo [ x ]) [ alpha ]) ++ join (map (attr bar [ x ]) [ alpha ])) ≟* element p (attr foo [ alpha ] ++ attr bar [ alpha ])"
+ (withDOW λ w element "p" {w} (join (map (λ s attr "foo" [ s ]) [ "alpha" ]) ++ join (map (λ s attr "bar" [ s ]) [ "alpha" ])) ≟* element "p" (attr "foo" [ "alpha" ] ++ attr "bar" [ "alpha" ]))
+ , ok◇ "element p (join (map (attr foo [ x ]) [ beta ]) ++ join (map (attr bar [ x ]) [ alpha ])) ≟* element p (attr foo [ alpha ] ++ attr bar [ alpha ])"
+ (withDOW λ w not* (element "p" {w} (join (map (λ s attr "foo" [ s ]) [ "beta" ]) ++ join (map (λ s attr "bar" [ s ]) [ "alpha" ])) ≟* element "p" (attr "foo" [ "alpha" ] ++ attr "bar" [ "alpha" ])))
+ , ok◇ "text (join (map [ x ] [ a ])) ≟* text [ abc ]"
+ (withDOW λ w not* (text {w} (join (map (λ s [ s ]) [ "a" ])) ≟* text [ "abc" ]))
+ , ok◇ "join (map (text [ x ]) [ a ]) ≟* text [ abc ]"
+ (withDOW λ w not* (join (map (λ s text {w} [ s ]) [ "a" ]) ≟* text [ "abc" ])) ) )

0 comments on commit 39cabed

Please sign in to comment.