Mercurial > urweb

annotate demo/more/meta.ur @ 1008:1911e84df461

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move stuff from bulkEdit to meta
author Adam Chlipala <adamc@hcoop.net>
date Thu, 22 Oct 2009 11:51:31 -0400
parents d3af9e54c828
children 59097824f19b
rev   line source
adamc@1004 1 con meta = fn (db :: Type, widget :: Type) =>
adamc@1004 2 {Nam : string,
adamc@1004 3 Show : db -> xbody,
adamc@1004 4 Widget : nm :: Name -> xml form [] [nm = widget],
adamc@1004 5 WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget],
adamc@1004 6 Parse : widget -> db,
adamc@1004 7 Inject : sql_injectable db}
adamc@1004 8
adamc@1004 9 fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t) name : meta (t, string) =
adamc@1004 10 {Nam = name,
adamc@1004 11 Show = txt,
adamc@1004 12 Widget = fn [nm :: Name] => <xml><textbox{nm}/></xml>,
adamc@1004 13 WidgetPopulated = fn [nm :: Name] n =>
adamc@1004 14 <xml><textbox{nm} value={show n}/></xml>,
adamc@1004 15 Parse = readError,
adamc@1004 16 Inject = _}
adamc@1004 17
adamc@1004 18 val int = default
adamc@1004 19 val float = default
adamc@1004 20 val string = default
adamc@1004 21 fun bool name = {Nam = name,
adamc@1004 22 Show = txt,
adamc@1004 23 Widget = fn [nm :: Name] => <xml><checkbox{nm}/></xml>,
adamc@1004 24 WidgetPopulated = fn [nm :: Name] b =>
adamc@1004 25 <xml><checkbox{nm} checked={b}/></xml>,
adamc@1004 26 Parse = fn x => x,
adamc@1004 27 Inject = _}
adamc@1007 28
adamc@1007 29 fun textarea name = {Nam = name,
adamc@1007 30 Show = cdata,
adamc@1007 31 Widget = fn [nm :: Name] => <xml><br/><textarea{nm} rows={10} cols={80}/></xml>,
adamc@1007 32 WidgetPopulated = fn [nm :: Name] s => <xml><br/>
adamc@1007 33 <textarea{nm} rows={10} cols={80}>{[s]}</textarea>
adamc@1007 34 </xml>,
adamc@1007 35 Parse = fn s => s,
adamc@1007 36 Inject = _}
adamc@1007 37
adamc@1007 38 fun allWidgets [ts ::: {(Type * Type)}] (r : $(map meta ts)) (fl : folder ts) =
adamc@1007 39 foldR [meta] [fn ts :: {(Type * Type)} => xml form [] (map snd ts)]
adamc@1007 40 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
adamc@1007 41 [[nm] ~ rest] (col : meta t) (acc : xml form [] (map snd rest)) => <xml>
adamc@1007 42 <b>{[col.Nam]}</b>: {col.Widget [nm]}<br/>
adamc@1007 43 {useMore acc}
adamc@1007 44 </xml>)
adamc@1007 45 <xml/>
adamc@1007 46 [_] fl r
adamc@1008 47
adamc@1008 48 fun allPopulatedTr [ts ::: {(Type * Type)}] (r : $(map meta ts)) (vs : $(map fst ts)) (fl : folder ts) =
adamc@1008 49 foldR2 [meta] [fst] [fn cols :: {(Type * Type)} =>
adamc@1008 50 xml [Body, Form, Tr] [] (map snd cols)]
adamc@1008 51 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest]
adamc@1008 52 (m : meta p) v (acc : xml [Body, Form, Tr] [] (map snd rest)) =>
adamc@1008 53 <xml>
adamc@1008 54 <td>{m.WidgetPopulated [nm] v}</td>
adamc@1008 55 {useMore acc}
adamc@1008 56 </xml>)
adamc@1008 57 <xml/>
adamc@1008 58 [_] fl r vs
adamc@1008 59
adamc@1008 60 fun ensql [avail] [ts ::: {(Type * Type)}] (r : $(map meta ts)) (vs : $(map snd ts)) (fl : folder ts) =
adamc@1008 61 map2 [meta] [snd] [fn ts :: (Type * Type) => sql_exp avail [] [] ts.1]
adamc@1008 62 (fn [ts] meta v => @sql_inject meta.Inject (meta.Parse v))
adamc@1008 63 [_] fl r vs