summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/basis.urs2
-rw-r--r--lib/top.ur9
-rw-r--r--lib/top.urs5
-rw-r--r--tests/crud.ur7
4 files changed, 18 insertions, 5 deletions
diff --git a/lib/basis.urs b/lib/basis.urs
index e1cb5082..f5bfa740 100644
--- a/lib/basis.urs
+++ b/lib/basis.urs
@@ -259,6 +259,8 @@ con html = [Html]
con head = [Head]
con body = [Body]
con lform = [Body, LForm]
+con tabl = [Body, Table]
+con tr = [Body, Tr]
val head : unit -> tag [] html head [] []
val title : unit -> tag [] head [] [] []
diff --git a/lib/top.ur b/lib/top.ur
index d94f8bf6..af009242 100644
--- a/lib/top.ur
+++ b/lib/top.ur
@@ -17,3 +17,12 @@ fun foldTR2 (tf1 :: Type -> Type) (tf2 :: Type -> Type) (tr :: {Type} -> Type)
[[nm] ~ rest] =>
fn r1 r2 => f [nm] [t] [rest] r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
(fn _ _ => i)
+
+fun foldTRX2 (tf1 :: Type -> Type) (tf2 :: Type -> Type) (ctx :: {Unit})
+ (f : nm :: Name -> t :: Type -> rest :: {Type} -> [nm] ~ rest
+ -> tf1 t -> tf2 t -> xml ctx [] []) =
+ foldTR2 [tf1] [tf2] [fn _ => xml ctx [] []]
+ (fn (nm :: Name) (t :: Type) (rest :: {Type}) =>
+ [[nm] ~ rest] =>
+ fn r1 r2 acc => <xml>{f [nm] [t] [rest] r1 r2}{acc}</xml>)
+ <xml></xml>
diff --git a/lib/top.urs b/lib/top.urs
index c2d2fc8f..0e211373 100644
--- a/lib/top.urs
+++ b/lib/top.urs
@@ -14,3 +14,8 @@ val foldTR2 : tf1 :: (Type -> Type) -> tf2 :: (Type -> Type) -> tr :: ({Type} ->
-> (nm :: Name -> t :: Type -> rest :: {Type} -> [nm] ~ rest
-> tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
-> tr [] -> r :: {Type} -> $(mapTT tf1 r) -> $(mapTT tf2 r) -> tr r
+
+val foldTRX2 : tf1 :: (Type -> Type) -> tf2 :: (Type -> Type) -> ctx :: {Unit}
+ -> (nm :: Name -> t :: Type -> rest :: {Type} -> [nm] ~ rest
+ -> tf1 t -> tf2 t -> xml ctx [] [])
+ -> r :: {Type} -> $(mapTT tf1 r) -> $(mapTT tf2 r) -> xml ctx [] []
diff --git a/tests/crud.ur b/tests/crud.ur
index 3837061e..95d2d4b9 100644
--- a/tests/crud.ur
+++ b/tests/crud.ur
@@ -20,15 +20,12 @@ fun list () =
{acc}
<tr>
<td>{txt _ fs.T.Id}</td>
- {foldTR2 [idT] [colMeta'] [fn _ => xtr]
+ {foldTRX2 [idT] [colMeta'] [tr]
(fn (nm :: Name) (t :: Type) (rest :: {Type}) =>
[[nm] ~ rest] =>
- fn v funcs acc =>
- <tr>
+ fn v funcs => <tr>
<td>{funcs.Show v}</td>
- {acc}
</tr>)
- <tr></tr>
[M.cols] (fs.T -- #Id) M.cols}
</tr>
</body>) <body></body>;