Ur/Web Examples
Check-in [224be5ae9a]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:adjust composableSignals API
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:224be5ae9aded7a547e923f13efc19e1c6136aba
User & Date: beyert 2016-08-17 05:23:29
Context
2016-08-17
05:40
add liftS3 / liftS3' to composableSignals library, with examples provided check-in: 7a264a41b0 user: beyert tags: trunk
05:23
adjust composableSignals API check-in: 224be5ae9a user: beyert tags: trunk
05:05
tiny updates to documentation (again) check-in: 44e95edf08 user: beyert tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to composableSignals/composableSignals.ur.

2
3
4
5
6
7
8

9
10
11



12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35












36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68

(* lift and map operations defined for signals in Ur/Web
   similar to liftA / liftA2 in Haskell, which are used to lift regular
   functions to be used as applicative functors *)

(* incidental helper functions *)
fun s [t] (a: source t) : signal t = signal a


fun pure [a] (s: a) : signal a =
  return s




fun mapS' [a] [b] (f: a -> b) (s: signal a) : signal b =
  s' <- s;
  pure (f s')

fun mapS [a] [b] (f: signal a -> signal b) (s: signal a) : signal b =
  f s

fun liftS [a] [b] (f: signal a -> signal b) (s: signal a) : signal b =
  f s

fun liftS2 [a] [b] [c] (f: signal a -> signal b -> signal c)
                       (s1: signal a) (s2: signal b) : signal c =
  f s1 s2

fun liftS' [a] [b] (f: a -> b) (s: signal a) : signal b =
  s' <- s;
  pure (f s')

fun liftS2' [a] [b] [c] (f: a -> b -> c)
                        (s1: signal a) (s2: signal b) : signal c =
  s1' <- s1;
  s2' <- s2;
  pure (f s1' s2')













fun main () : transaction page =
  srcN <- source (0: int);
  srcX <- source (3: int);
  srcY <- source (2: int);

  return <xml><head>
    <title>Test of map and lifted signals</title>
    </head>
    <body>
      <dyn signal={s' <- mapS (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- liftS (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={x' <- liftS2 (fn sx sy => x <- sx; y <- sy;
                                    return (x + y)) (s srcX) (s srcY);
                   return <xml>{[x']}</xml>}/>
      <dyn signal={x' <- liftS2 (fn sx sy => x <- sx; y <- sy;
                                    pure (x * y)) (s srcX) (s srcY);
                   return <xml>{[x']}</xml>}/>
      <dyn signal={s' <- liftS (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={x' <- liftS2' (fn x y => x * y) (s srcX) (s srcY);
                   y' <- liftS' (fn x => x + 11) (pure x');
                   return <xml>{[x']} {[y']}</xml>}/>
      <dyn signal={s' <- liftS' (fn x => x + 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- mapS' (fn x => x - 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- liftS' (fn x => x + 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
    </body>
    </xml>







>

<
|
>
>
>

|



<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|



>
>
>
>
>
>
>
>
>
>
>
>










|

|

|


|


|

|
|

|

|

|



2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19














20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

(* lift and map operations defined for signals in Ur/Web
   similar to liftA / liftA2 in Haskell, which are used to lift regular
   functions to be used as applicative functors *)

(* incidental helper functions *)
fun s [t] (a: source t) : signal t = signal a
fun pure [a] (s: a) : signal a = return s


(* typical lifting functions, modeled after the equivalent in Haskell *)
fun mapS [a] [b] (f: a -> b) (s: signal a) : signal b =
  s' <- s;
  pure (f s')

fun liftS [a] [b] (f: a -> b) (s: signal a) : signal b =
  s' <- s;
  pure (f s')















fun liftS2 [a] [b] [c] (f: a -> b -> c)
                       (s1: signal a) (s2: signal b) : signal c =
  s1' <- s1;
  s2' <- s2;
  pure (f s1' s2')

(* variations on the above functions with raw signals passed directly to (and
returned by) the function argument *)
fun mapS' [a] [b] (f: signal a -> signal b) (s: signal a) : signal b =
  f s

fun liftS' [a] [b] (f: signal a -> signal b) (s: signal a) : signal b =
  f s

fun liftS2' [a] [b] [c] (f: signal a -> signal b -> signal c)
                       (s1: signal a) (s2: signal b) : signal c =
  f s1 s2

fun main () : transaction page =
  srcN <- source (0: int);
  srcX <- source (3: int);
  srcY <- source (2: int);

  return <xml><head>
    <title>Test of map and lifted signals</title>
    </head>
    <body>
      <dyn signal={s' <- mapS' (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- liftS' (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={x' <- liftS2' (fn sx sy => x <- sx; y <- sy;
                                    return (x + y)) (s srcX) (s srcY);
                   return <xml>{[x']}</xml>}/>
      <dyn signal={x' <- liftS2' (fn sx sy => x <- sx; y <- sy;
                                    pure (x * y)) (s srcX) (s srcY);
                   return <xml>{[x']}</xml>}/>
      <dyn signal={s' <- liftS' (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={x' <- liftS2 (fn x y => x * y) (s srcX) (s srcY);
                   y' <- liftS (fn x => x + 11) (pure x');
                   return <xml>{[x']} {[y']}</xml>}/>
      <dyn signal={s' <- liftS (fn x => x + 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- mapS (fn x => x - 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- liftS (fn x => x + 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
    </body>
    </xml>