summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--demo/more/dlist.ur32
-rw-r--r--demo/more/dlist.urs3
-rw-r--r--demo/more/grid.ur32
3 files changed, 35 insertions, 32 deletions
diff --git a/demo/more/dlist.ur b/demo/more/dlist.ur
index d4a255ee..a99244ec 100644
--- a/demo/more/dlist.ur
+++ b/demo/more/dlist.ur
@@ -6,19 +6,18 @@ datatype dlist' t =
Empty
| Nonempty of { Head : dlist'' t, Tail : source (source (dlist'' t)) }
-con dlist t = {Filter: t -> signal bool,
- Elements : source (dlist' t)}
+con dlist t = source (dlist' t)
type position = transaction unit
fun headPos [t] (dl : dlist t) =
- dl' <- get dl.Elements;
+ dl' <- get dl;
case dl' of
Nonempty { Head = Cons (_, tl), Tail = tl' } =>
cur <- get tl;
- set dl.Elements (case cur of
- Nil => Empty
- | _ => Nonempty {Head = cur, Tail = tl'})
+ set dl (case cur of
+ Nil => Empty
+ | _ => Nonempty {Head = cur, Tail = tl'})
| _ => return ()
fun tailPos [t] (cur : source (dlist'' t)) new tail =
@@ -29,20 +28,17 @@ fun tailPos [t] (cur : source (dlist'' t)) new tail =
Nil => set tail cur
| _ => return ()
-fun create [t] r =
- s <- source Empty;
- return {Filter = r.Filter,
- Elements = s}
+val create [t] = source Empty
-fun clear [t] (s : dlist t) = set s.Elements Empty
+fun clear [t] (s : dlist t) = set s Empty
fun append [t] dl v =
- dl' <- get dl.Elements;
+ dl' <- get dl;
case dl' of
Empty =>
tl <- source Nil;
tl' <- source tl;
- set dl.Elements (Nonempty {Head = Cons (v, tl), Tail = tl'});
+ set dl (Nonempty {Head = Cons (v, tl), Tail = tl'});
return (headPos dl)
| Nonempty {Tail = tl, ...} =>
@@ -52,8 +48,8 @@ fun append [t] dl v =
set tl new;
return (tailPos cur new tl)
-fun render [ctx] [ctx ~ body] [t] f dl = <xml>
- <dyn signal={dl' <- signal dl.Elements;
+fun render [ctx] [ctx ~ body] [t] f {Filter = filter, ...} dl = <xml>
+ <dyn signal={dl' <- signal dl;
return (case dl' of
Empty => <xml/>
| Nonempty {Head = hd, Tail = tlTop} =>
@@ -67,7 +63,7 @@ fun render [ctx] [ctx ~ body] [t] f dl = <xml>
None => headPos dl
| Some prev => tailPos prev tl tlTop
in
- <xml><dyn signal={b <- dl.Filter v;
+ <xml><dyn signal={b <- filter v;
return (if b then
f v pos
else
@@ -91,7 +87,7 @@ fun elements' [t] (dl'' : dlist'' t) =
return (x :: tl)
fun elements [t] (dl : dlist t) =
- dl' <- signal dl.Elements;
+ dl' <- signal dl;
case dl' of
Empty => return []
| Nonempty {Head = hd, ...} => elements' hd
@@ -107,7 +103,7 @@ fun foldl [t] [acc] (f : t -> acc -> signal acc) =
foldl'' i' dl'
fun foldl' (i : acc) (dl : dlist t) : signal acc =
- dl <- signal dl.Elements;
+ dl <- signal dl;
case dl of
Empty => return i
| Nonempty {Head = dl, ...} => foldl'' i dl
diff --git a/demo/more/dlist.urs b/demo/more/dlist.urs
index a55a1774..a775113e 100644
--- a/demo/more/dlist.urs
+++ b/demo/more/dlist.urs
@@ -1,7 +1,7 @@
con dlist :: Type -> Type
type position
-val create : t ::: Type -> {Filter : t -> signal bool} -> transaction (dlist t)
+val create : t ::: Type -> transaction (dlist t)
val clear : t ::: Type -> dlist t -> transaction unit
val append : t ::: Type -> dlist t -> t -> transaction position
val delete : position -> transaction unit
@@ -10,5 +10,6 @@ val foldl : t ::: Type -> acc ::: Type -> (t -> acc -> signal acc) -> acc -> dli
val render : ctx ::: {Unit} -> [ctx ~ body] => t ::: Type
-> (t -> position -> xml (ctx ++ body) [] [])
+ -> {Filter : t -> signal bool}
-> dlist t
-> xml (ctx ++ body) [] []
diff --git a/demo/more/grid.ur b/demo/more/grid.ur
index 424c3b6f..6dd0543a 100644
--- a/demo/more/grid.ur
+++ b/demo/more/grid.ur
@@ -80,19 +80,13 @@ functor Make(M : sig
(meta.Handlers state).CreateFilter)
[_] M.folder M.cols cols;
- rows <- Dlist.create {Filter = fn all =>
- row <- signal all.Row;
- foldR3 [colMeta M.row] [fst3] [thd3] [fn _ => M.row -> signal bool]
- (fn [nm :: Name] [p :: (Type * Type * Type)]
- [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
- meta state filter combinedFilter row =>
- previous <- combinedFilter row;
- this <- (meta.Handlers state).Filter filter row;
- return (previous && this))
- (fn _ => return True)
- [_] M.folder M.cols cols filters row};
+ rows <- Dlist.create;
sel <- source False;
- return {Cols = cols, Rows = rows, Selection = sel, Filters = filters}
+
+ return {Cols = cols,
+ Rows = rows,
+ Selection = sel,
+ Filters = filters}
fun sync {Cols = cols, Rows = rows, ...} =
Dlist.clear rows;
@@ -207,7 +201,19 @@ functor Make(M : sig
</td></xml>)
[_] M.folder grid.Cols M.cols cols)}/>
</tr></xml>
- end) grid.Rows}
+ end)
+ {Filter = fn all =>
+ row <- signal all.Row;
+ foldR3 [colMeta M.row] [fst3] [thd3] [fn _ => M.row -> signal bool]
+ (fn [nm :: Name] [p :: (Type * Type * Type)]
+ [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
+ meta state filter combinedFilter row =>
+ previous <- combinedFilter row;
+ this <- (meta.Handlers state).Filter filter row;
+ return (previous && this))
+ (fn _ => return True)
+ [_] M.folder M.cols grid.Cols grid.Filters row}
+ grid.Rows}
<dyn signal={rows <- Dlist.foldl (fn row => Monad.mapR2 [aggregateMeta M.row] [id] [id]
(fn [nm :: Name] [t :: Type] meta acc =>