Permalink
Browse files

some updates

  • Loading branch information...
1 parent 83b2de2 commit 2249cf6194c871e39a6b365eaba1e5748be43e3c @larrytheliquid committed Feb 7, 2012
View
@@ -21,10 +21,12 @@ postulate
postulate
DOW : Set
+ unattached : DOW
left right : DOW DOW
child : String DOW DOW
events : {A} EventType A DOW ⟦ Evt A ⟧
+{-# COMPILED_JS unattached require("agda.frp").unattached() #-}
{-# COMPILED_JS left function(w) { return w.left(); } #-}
{-# COMPILED_JS right function(w) { return w.right(); } #-}
{-# COMPILED_JS child function(a) { return function(w) { return w.child(a); }; } #-}
View
@@ -7,7 +7,7 @@ define(["agda.frp.signal","agda.frp.time"],function(signal,time) { return {
empty: signal.empty,
geolocation: signal.geolocation,
reactimate: signal.reactimate,
- dow: signal.dow,
+ unattached: signal.unattached,
// Re-export agda.frp.time
seconds: time.seconds,
minutes: time.minutes,
@@ -789,7 +789,7 @@ define(["agda.frp.taskqueue","agda.mixin"],function(taskqueue,mixin) {
constant: function(value) { return new ConstantBehaviour(value); },
empty: function() { return new EmptyBehaviour(); },
geolocation: function() { return geolocation; },
- reactimate: function(f) { return f(new DOW())(taskqueue.singleton.time); },
- dow: function() { return new DOW(); }
+ unattached: function() { return new DOW(); },
+ reactimate: function(f) { return f(new DOW())(taskqueue.singleton.time); }
};
});
@@ -14,7 +14,7 @@ data Test : Set where
_,_ : Test Test Test
ok : String (b : {t : ⊤} Bool) {b✓ : True b} Test
ok! : String (b : {t : ⊤} Bool) Test
- ok[t] : String (b : ⟦ Beh ⟨ Bool ⟩ ⟧) Test
+ ok : String (b : ⟦ Beh ⟨ Bool ⟩ ⟧) Test
data TestSuite : Set where
ε : TestSuite
@@ -5,7 +5,7 @@ open import FRP.JS.Delay using ( _ms )
open import FRP.JS.Behaviour
open import FRP.JS.Event using ( ∅ )
open import FRP.JS.Bool using ( Bool ; not ; true )
-open import FRP.JS.QUnit using ( TestSuite ; ok[t] ; test ; _,_ ; ε )
+open import FRP.JS.QUnit using ( TestSuite ; ok ; test ; _,_ ; ε )
module FRP.JS.Test.Behaviour where
@@ -17,15 +17,15 @@ _≟*_ = map2 _≟_
tests : TestSuite
tests =
( test "≟*"
- ( ok[t] "[ 1 ] ≟* [ 1 ]" ([ 1 ] ≟* [ 1 ])
- , ok[t] "[ 1 ] ≟* [ 0 ]" (not* ([ 1 ] ≟* [ 0 ]))
- , ok[t] "[ 0 ] ≟* [ 1 ]" (not* ([ 0 ] ≟* [ 1 ])) )
+ ( ok "[ 1 ] ≟* [ 1 ]" ([ 1 ] ≟* [ 1 ])
+ , ok "[ 1 ] ≟* [ 0 ]" (not* ([ 1 ] ≟* [ 0 ]))
+ , ok "[ 0 ] ≟* [ 1 ]" (not* ([ 0 ] ≟* [ 1 ])) )
, test "map"
- ( ok[t] "map suc [ 0 ] ≟* [ 1 ]" (map suc [ 0 ] ≟* [ 1 ])
- , ok[t] "map suc [ 1 ] ≟* [ 1 ]" (not* (map suc [ 1 ] ≟* [ 1 ])) )
+ ( ok "map suc [ 0 ] ≟* [ 1 ]" (map suc [ 0 ] ≟* [ 1 ])
+ , ok "map suc [ 1 ] ≟* [ 1 ]" (not* (map suc [ 1 ] ≟* [ 1 ])) )
, test "join"
- ( ok[t] "join (map [ suc ] [ 0 ] ) ≟* [ 1 ]" (join (map (λ n [ suc n ]) [ 0 ]) ≟* [ 1 ])
- , ok[t] "join (map [ suc ] [ 1 ]) ≟* [ 1 ]" (not* (join (map (λ n [ suc n ]) [ 1 ]) ≟* [ 1 ])) )
+ ( 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[t] "hold 1 ∅ ≟* [ 1 ]" (hold 1 ∅ ≟* [ 1 ])
- , ok[t] "hold 0 ∅ ≟* [ 1 ]" (not* (hold 0 ∅ ≟* [ 1 ])) ) )
+ ( ok "hold 1 ∅ ≟* [ 1 ]" (hold 1 ∅ ≟* [ 1 ])
+ , ok "hold 0 ∅ ≟* [ 1 ]" (not* (hold 0 ∅ ≟* [ 1 ])) ) )
@@ -5,73 +5,69 @@ open import FRP.JS.Time using ( Time ; epoch )
open import FRP.JS.Delay using ( _ms )
open import FRP.JS.Behaviour
open import FRP.JS.Bool using ( Bool ; not ; true )
-open import FRP.JS.QUnit using ( TestSuite ; ok[t] ; test ; _,_ ; ε )
+open import FRP.JS.QUnit using ( TestSuite ; ok ; test ; _,_ ; ε )
module FRP.JS.Test.DOM where
-postulate
- withDOW : {A : Set} ((w : DOW) A) A
-
-{-# COMPILED_JS withDOW function(A) { return function(f) {
- return f(require("agda.frp").dow());
-}; } #-}
+withDOW : {A : Set} ((w : DOW) A) A
+withDOW f = f unattached
tests : TestSuite
tests =
( test "≟*"
- ( ok[t] "[] ≟* []"
+ ( ok "[] ≟* []"
(withDOW λ w [] {w} ≟* [])
- , ok[t] "[] ++ [] ≟* []"
+ , ok "[] ++ [] ≟* []"
(withDOW λ w [] {left w} ++ [] ≟* []) )
, test "attr"
- ( ok[t] "attr class [ alpha ] ≟* attr class [ alpha ]"
+ ( ok "attr class [ alpha ] ≟* attr class [ alpha ]"
(withDOW λ w attr {w} "class" [ "alpha" ] ≟* attr "class" [ "alpha" ])
- , ok[t] "attr foo [ alpha ] ≟* attr foo [ alpha ]"
+ , ok "attr foo [ alpha ] ≟* attr foo [ alpha ]"
(withDOW λ w attr {w} "foo" [ "alpha" ] ≟* attr "foo" [ "alpha" ])
- , ok[t] "attr foo [ alpha ] ++ attr bar [ alpha ] ≟* attr foo [ alpha ] ++ attr bar [ alpha ]"
+ , ok "attr foo [ alpha ] ++ attr bar [ alpha ] ≟* attr foo [ alpha ] ++ attr bar [ alpha ]"
(withDOW λ w attr {left w} "foo" [ "alpha" ] ++ attr "bar" [ "alpha" ] ≟* attr "foo" [ "alpha" ] ++ attr "bar" [ "alpha" ])
- , ok[t] "attr class [ beta ] ≟* attr class [ alpha ]"
+ , ok "attr class [ beta ] ≟* attr class [ alpha ]"
(withDOW λ w not* (attr {w} "class" [ "beta" ] ≟* attr "class" [ "alpha" ]))
- , ok[t] "attr foo [ alpha ] ≟* attr class [ alpha ]"
+ , ok "attr foo [ alpha ] ≟* attr class [ alpha ]"
(withDOW λ w not* (attr {w} "foo" [ "alpha" ] ≟* attr "class" [ "alpha" ]))
- , ok[t] "attr foo [ alpha ] ++ attr bar [ alpha ] ≟* attr foo [ alpha ]"
+ , ok "attr foo [ alpha ] ++ attr bar [ alpha ] ≟* attr foo [ alpha ]"
(withDOW λ w not* (attr {left w} "foo" [ "alpha" ] ++ attr "bar" [ "alpha" ] ≟* attr "foo" [ "alpha" ])) )
, test "text"
- ( ok[t] "text [ abc ] ≟* text [ abc ]"
+ ( ok "text [ abc ] ≟* text [ abc ]"
(withDOW λ w text {w} [ "abc" ] ≟* text [ "abc" ])
- , ok[t] "text [ a ] ≟* text [ abc ]"
+ , ok "text [ a ] ≟* text [ abc ]"
(withDOW λ w not* (text {w} [ "a" ] ≟* text [ "abc" ]))
- , ok[t] "[] ≟* text [ abc ]"
+ , ok "[] ≟* text [ abc ]"
(withDOW λ w not* ([] ≟* text {w} [ "abc" ]))
- , ok[t] "text [ abc ] ++ [] ≟* text [ abc ]"
+ , ok "text [ abc ] ++ [] ≟* text [ abc ]"
(withDOW λ w text {left w} [ "abc" ] ++ [] ≟* (text [ "abc" ]))
- , ok[t] "[] ++ text [ abc ] ≟* text [ abc ]"
+ , ok "[] ++ text [ abc ] ≟* text [ abc ]"
(withDOW λ w [] ++ text {right w} [ "abc" ] ≟* (text [ "abc" ])) )
, test "element"
- ( ok[t] "element p (text [ abc ]) ≟* element p (text [ abc ])"
+ ( ok "element p (text [ abc ]) ≟* element p (text [ abc ])"
(withDOW λ w element "p" {w} (text [ "abc" ]) ≟* element "p" (text [ "abc" ]))
- , ok[t] "element p (text [ a ]) ≟* element p (text [ abc ])"
+ , ok "element p (text [ a ]) ≟* element p (text [ abc ])"
(withDOW λ w not* (element "p" {w} (text [ "a" ]) ≟* element "p" (text [ "abc" ])))
- , ok[t] "element div (attr class [ alpha ] ++ text [ abc ]) ≟* element div (attr class [ alpha ] ++ text [ abc ])"
+ , ok "element div (attr class [ alpha ] ++ text [ abc ]) ≟* element div (attr class [ alpha ] ++ text [ abc ])"
(withDOW λ w element "div" {w} (attr "class" [ "alpha" ] ++ text [ "abc" ]) ≟* element "div" {w} (attr "class" [ "alpha" ] ++ text [ "abc" ]))
- , ok[t] "element div (attr class [ beta ] ++ text [ abc ]) ≟* element div (attr class [ alpha ] ++ text [ abc ])"
+ , ok "element div (attr class [ beta ] ++ text [ abc ]) ≟* element div (attr class [ alpha ] ++ text [ abc ])"
(withDOW λ w not* (element "div" {w} (attr "class" [ "beta" ] ++ text [ "abc" ]) ≟* element "div" {w} (attr "class" [ "alpha" ] ++ text [ "abc" ])))
- , ok[t] "element p (text [ abc ]) ≟* element p (text [ abc ])"
+ , ok "element p (text [ abc ]) ≟* element p (text [ abc ])"
(withDOW λ w element "p" {w} (text [ "abc" ]) ≟* element "p" (text [ "abc" ]))
- , ok[t] "element p (text [ a ]) ++ element p (text [ b ]) ≟* element p (text [ a ])"
+ , 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[t] "text (join (map [ x ] [ abc ])) ≟* text [ abc ]"
+ ( ok "text (join (map [ x ] [ abc ])) ≟* text [ abc ]"
(withDOW λ w text {w} (join (map (λ s [ s ]) [ "abc" ])) ≟* text [ "abc" ])
- , ok[t] "join (map (text [ x ]) [ abc ]) ≟* text [ abc ]"
+ , ok "join (map (text [ x ]) [ abc ]) ≟* text [ abc ]"
(withDOW λ w join (map (λ s text {w} [ s ]) [ "abc" ]) ≟* text [ "abc" ])
- , ok[t] "element p (join (map (attr foo [ x ]) [ alpha ]) ++ join (map (attr bar [ x ]) [ alpha ])) ≟* element p (attr foo [ alpha ] ++ attr bar [ alpha ])"
+ , 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[t] "element p (join (map (attr foo [ x ]) [ beta ]) ++ join (map (attr bar [ x ]) [ 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[t] "text (join (map [ x ] [ a ])) ≟* text [ abc ]"
+ , ok "text (join (map [ x ] [ a ])) ≟* text [ abc ]"
(withDOW λ w not* (text {w} (join (map (λ s [ s ]) [ "a" ])) ≟* text [ "abc" ]))
- , ok[t] "join (map (text [ x ]) [ a ]) ≟* text [ abc ]"
+ , ok "join (map (text [ x ]) [ a ]) ≟* text [ abc ]"
(withDOW λ w not* (join (map (λ s text {w} [ s ]) [ "a" ]) ≟* text [ "abc" ])) ) )
View
@@ -6,7 +6,9 @@ require(["agda.frp.taskqueue", "qunit.js"],function(taskqueue) {
"_,_": function(test1,test2) { test1(visitor); test2(visitor); },
"ok": function(name,fun) { ok(fun(),name); },
"ok!": function(name,fun) { ok(fun(),name); },
- "ok[t]": function(name,fun) { ok(fun(taskqueue.singleton.time).value,name); },
+ // TODO: make ok◇ use setInterval + setTimeout to search for
+ // the value appearing later, mimicking LTL "eventually" semantics
+ "ok◇": function(name,fun) { ok(fun(taskqueue.singleton.time).value,name); },
"test": function(name,tests) { test(name,function() { tests(visitor); }); },
"suite": function(name,tests) { module(name); tests(visitor); }
};

0 comments on commit 2249cf6

Please sign in to comment.