diff options
author | Adam Chlipala <adamc@hcoop.net> | 2009-02-24 15:12:13 -0500 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2009-02-24 15:12:13 -0500 |
commit | 0351ba637e206cdf397c85e3cfe2cfcf52aa4c9d (patch) | |
tree | 163895f20f3556dd9ebb32a2deb09842eced212e /demo | |
parent | ff76ba5e41d9a10ec59b181bee87d3fe65d61fdc (diff) |
Demos compile again, with manual folders
Diffstat (limited to 'demo')
-rw-r--r-- | demo/crud.ur | 88 | ||||
-rw-r--r-- | demo/crud.urs | 2 | ||||
-rw-r--r-- | demo/crud1.ur | 6 | ||||
-rw-r--r-- | demo/crud2.ur | 4 | ||||
-rw-r--r-- | demo/metaform.ur | 5 | ||||
-rw-r--r-- | demo/metaform.urs | 1 | ||||
-rw-r--r-- | demo/metaform1.ur | 1 | ||||
-rw-r--r-- | demo/metaform2.ur | 1 | ||||
-rw-r--r-- | demo/sum.ur | 4 | ||||
-rw-r--r-- | demo/tcSum.ur | 8 |
10 files changed, 69 insertions, 51 deletions
diff --git a/demo/crud.ur b/demo/crud.ur index b365f69b..a6a65bb3 100644 --- a/demo/crud.ur +++ b/demo/crud.ur @@ -33,6 +33,8 @@ fun bool name = {Nam = name, functor Make(M : sig con cols :: {(Type * Type)} constraint [Id] ~ cols + val fl : folder cols + val tab : sql_table ([Id = int] ++ map fstTT cols) val title : string @@ -50,12 +52,12 @@ functor Make(M : sig (fn (fs : {T : $([Id = int] ++ map fstTT M.cols)}) => <xml> <tr> <td>{[fs.T.Id]}</td> - {foldT2RX2 [fstTT] [colMeta] [tr] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] v col => <xml> - <td>{col.Show v}</td> - </xml>) - [M.cols] (fs.T -- #Id) M.cols} + {foldRX2 [fstTT] [colMeta] [tr] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] v col => <xml> + <td>{col.Show v}</td> + </xml>) + [M.cols] M.fl (fs.T -- #Id) M.cols} <td> <a link={upd fs.T.Id}>[Update]</a> <a link={confirm fs.T.Id}>[Delete]</a> @@ -66,12 +68,12 @@ functor Make(M : sig <table border={1}> <tr> <th>ID</th> - {foldT2RX [colMeta] [tr] + {foldRX [colMeta] [tr] (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) [[nm] ~ rest] col => <xml> <th>{cdata col.Nam}</th> </xml>) - [M.cols] M.cols} + [M.cols] M.fl M.cols} </tr> {rows} </table> @@ -79,14 +81,14 @@ functor Make(M : sig <br/><hr/><br/> <form> - {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map sndTT rest)) => <xml> - <li> {cdata col.Nam}: {col.Widget [nm]}</li> - {useMore acc} - </xml>) + {foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map sndTT rest)) => <xml> + <li> {cdata col.Nam}: {col.Widget [nm]}</li> + {useMore acc} + </xml>) <xml/> - [M.cols] M.cols} + [M.cols] M.fl M.cols} <submit action={create}/> </form> @@ -95,13 +97,13 @@ functor Make(M : sig and create (inputs : $(map sndTT M.cols)) = id <- nextval seq; dml (insert tab - (foldT2R2 [sndTT] [colMeta] - [fn cols => $(map (fn t :: (Type * Type) => - sql_exp [] [] [] t.1) cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] => - fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)}) - {} [M.cols] inputs M.cols + (foldR2 [sndTT] [colMeta] + [fn cols => $(map (fn t :: (Type * Type) => + sql_exp [] [] [] t.1) cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] => + fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)}) + {} [M.cols] M.fl inputs M.cols ++ {Id = (SQL {[id]})})); ls <- list (); return <xml><body> @@ -113,17 +115,17 @@ functor Make(M : sig and upd (id : int) = let fun save (inputs : $(map sndTT M.cols)) = - dml (update [map fstTT M.cols] - (foldT2R2 [sndTT] [colMeta] - [fn cols => $(map (fn t :: (Type * Type) => - sql_exp [T = [Id = int] - ++ map fstTT M.cols] - [] [] t.1) cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] => - fn input col acc => acc ++ {nm = - @sql_inject col.Inject (col.Parse input)}) - {} [M.cols] inputs M.cols) + dml (update [map fstTT M.cols] ! + (foldR2 [sndTT] [colMeta] + [fn cols => $(map (fn t :: (Type * Type) => + sql_exp [T = [Id = int] + ++ map fstTT M.cols] + [] [] t.1) cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] => + fn input col acc => acc ++ {nm = + @sql_inject col.Inject (col.Parse input)}) + {} [M.cols] M.fl inputs M.cols) tab (WHERE T.Id = {[id]})); ls <- list (); return <xml><body> @@ -136,16 +138,16 @@ functor Make(M : sig case fso : (Basis.option {Tab : $(map fstTT M.cols)}) of None => return <xml><body>Not found!</body></xml> | Some fs => return <xml><body><form> - {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] (v : t.1) (col : colMeta t) - (acc : xml form [] (map sndTT rest)) => - <xml> - <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> - {useMore acc} - </xml>) - <xml/> - [M.cols] fs.Tab M.cols} + {foldR2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] (v : t.1) (col : colMeta t) + (acc : xml form [] (map sndTT rest)) => + <xml> + <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> + {useMore acc} + </xml>) + <xml/> + [M.cols] M.fl fs.Tab M.cols} <submit action={save}/> </form></body></xml> diff --git a/demo/crud.urs b/demo/crud.urs index 8c9cebcf..b240b7c1 100644 --- a/demo/crud.urs +++ b/demo/crud.urs @@ -16,6 +16,8 @@ val bool : string -> colMeta (bool, bool) functor Make(M : sig con cols :: {(Type * Type)} constraint [Id] ~ cols + val fl : folder cols + val tab : sql_table ([Id = int] ++ map fstTT cols) val title : string diff --git a/demo/crud1.ur b/demo/crud1.ur index 3849e822..65140035 100644 --- a/demo/crud1.ur +++ b/demo/crud1.ur @@ -9,4 +9,10 @@ open Crud.Make(struct B = Crud.string "B", C = Crud.float "C", D = Crud.bool "D"} + + val fl = Folder.cons [#A] [_] ! + (Folder.cons [#B] [_] ! + (Folder.cons [#C] [_] ! + (Folder.cons [#D] [_] ! + Folder.nil))) end) diff --git a/demo/crud2.ur b/demo/crud2.ur index 1db376d4..f7adf29b 100644 --- a/demo/crud2.ur +++ b/demo/crud2.ur @@ -31,4 +31,8 @@ open Crud.Make(struct Inject = _ } } + + val fl = Folder.cons [#Nam] [_] ! + (Folder.cons [#Ready] [_] ! + Folder.nil) end) diff --git a/demo/metaform.ur b/demo/metaform.ur index ae1197f4..0e2e5ee3 100644 --- a/demo/metaform.ur +++ b/demo/metaform.ur @@ -1,5 +1,6 @@ functor Make (M : sig con fs :: {Unit} + val fl : folder fs val names : $(mapUT string fs) end) = struct @@ -8,7 +9,7 @@ functor Make (M : sig (fn (nm :: Name) (rest :: {Unit}) [[nm] ~ rest] name value => <xml> <li> {[name]} = {[value]}</li> </xml>) - [M.fs] M.names values} + [M.fs] M.fl M.names values} </body></xml> fun main () = return <xml><body> @@ -20,7 +21,7 @@ functor Make (M : sig {useMore acc} </xml>) <xml/> - [M.fs] M.names} + [M.fs] M.fl M.names} <submit action={handler}/> </form> </body></xml> diff --git a/demo/metaform.urs b/demo/metaform.urs index 7a3fa62e..505cb906 100644 --- a/demo/metaform.urs +++ b/demo/metaform.urs @@ -1,5 +1,6 @@ functor Make (M : sig con fs :: {Unit} + val fl : folder fs val names : $(mapUT string fs) end) : sig val main : unit -> transaction page diff --git a/demo/metaform1.ur b/demo/metaform1.ur index c6a4664d..2f3356fa 100644 --- a/demo/metaform1.ur +++ b/demo/metaform1.ur @@ -1,3 +1,4 @@ open Metaform.Make(struct val names = {A = "Tic", B = "Tac", C = "Toe"} + val fl = Folder.cons [#A] [()] ! (Folder.cons [#B] [()] ! (Folder.cons [#C] [()] ! Folder.nil)) end) diff --git a/demo/metaform2.ur b/demo/metaform2.ur index 430a42f0..87d40b18 100644 --- a/demo/metaform2.ur +++ b/demo/metaform2.ur @@ -1,5 +1,6 @@ structure MM = Metaform.Make(struct val names = {X = "x", Y = "y"} + val fl = Folder.cons [#X] [()] ! (Folder.cons [#Y] [()] ! Folder.nil) end) fun diversion () = return <xml><body> diff --git a/demo/sum.ur b/demo/sum.ur index 87b2967a..62954e20 100644 --- a/demo/sum.ur +++ b/demo/sum.ur @@ -1,7 +1,7 @@ -fun sum (fs ::: {Unit}) (fold : folder fs) (x : $(mapUT int fs)) = +fun sum (fs ::: {Unit}) (fl : folder fs) (x : $(mapUT int fs)) = foldUR [int] [fn _ => int] (fn (nm :: Name) (rest :: {Unit}) [[nm] ~ rest] n acc => n + acc) - 0 [fs] fold x + 0 [fs] fl x fun main () = return <xml><body> {[sum Folder.nil {}]}<br/> diff --git a/demo/tcSum.ur b/demo/tcSum.ur index 53679116..e3340021 100644 --- a/demo/tcSum.ur +++ b/demo/tcSum.ur @@ -1,9 +1,9 @@ -fun sum (t ::: Type) (_ : num t) (fs ::: {Unit}) (x : $(mapUT t fs)) = +fun sum (t ::: Type) (_ : num t) (fs ::: {Unit}) (fl : folder fs) (x : $(mapUT t fs)) = foldUR [t] [fn _ => t] (fn (nm :: Name) (rest :: {Unit}) [[nm] ~ rest] n acc => n + acc) - zero [fs] x + zero [fs] fl x fun main () = return <xml><body> - {[sum {A = 0, B = 1}]}<br/> - {[sum {C = 2.1, D = 3.2, E = 4.3}]} + {[sum (Folder.cons [#A] [()] ! (Folder.cons [#B] [()] ! Folder.nil)) {A = 0, B = 1}]}<br/> + {[sum (Folder.cons [#D] [()] ! (Folder.cons [#C] [()] ! (Folder.cons [#E] [()] ! Folder.nil))) {C = 2.1, D = 3.2, E = 4.3}]} </body></xml> |