Mercurial > urweb

annotate demo/more/dbgrid.urs @ 930:51bc7681c47e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Nullable columns *might* be working, but too much JS is generated for the page to load in finite time
author Adam Chlipala <adamc@hcoop.net>
date Sat, 12 Sep 2009 15:08:16 -0400
parents 5e8b6fa5b48f
children 2422360c78a3
rev   line source
adamc@915 1 con rawMeta = fn t :: Type =>
adamc@915 2 {New : transaction t,
adamc@915 3 Inj : sql_injectable t}
adamc@915 4
adamc@915 5 con colMeta' = fn (row :: {Type}) (t :: Type) =>
adamc@915 6 {Header : string,
adamc@915 7 Project : $row -> transaction t,
adamc@915 8 Update : $row -> t -> transaction ($row),
adamc@915 9 Display : t -> xbody,
adamc@915 10 Edit : t -> xbody,
adamc@915 11 Validate : t -> signal bool}
adamc@915 12
adamc@915 13 con colMeta = fn (row :: {Type}) (global_t :: (Type * Type)) =>
adamc@915 14 {Initialize : transaction global_t.1,
adamc@915 15 Handlers : global_t.1 -> colMeta' row global_t.2}
adamc@915 16
adamc@915 17 structure Direct : sig
adamc@930 18 con metaBase = fn actual_input :: (Type * Type) =>
adamc@930 19 {Display : actual_input.2 -> xbody,
adamc@930 20 Edit : actual_input.2 -> xbody,
adamc@930 21 Initialize : actual_input.1 -> transaction actual_input.2,
adamc@930 22 Parse : actual_input.2 -> signal (option actual_input.1)}
adamc@930 23
adamc@930 24 datatype metaBoth actual input =
adamc@930 25 NonNull of metaBase (actual, input) * metaBase (option actual, input)
adamc@930 26 | Nullable of metaBase (actual, input)
adamc@930 27
adamc@915 28 con meta = fn global_actual_input :: (Type * Type * Type) =>
adamc@915 29 {Initialize : transaction global_actual_input.1,
adamc@915 30 Handlers : global_actual_input.1
adamc@930 31 -> metaBoth global_actual_input.2 global_actual_input.3}
adamc@915 32
adamc@915 33 con editableState :: (Type * Type * Type) -> (Type * Type)
adamc@915 34 val editable : ts ::: (Type * Type * Type) -> rest ::: {Type}
adamc@915 35 -> nm :: Name -> [[nm] ~ rest] => string -> meta ts
adamc@915 36 -> colMeta ([nm = ts.2] ++ rest)
adamc@915 37 (editableState ts)
adamc@915 38
adamc@915 39 con readOnlyState :: (Type * Type * Type) -> (Type * Type)
adamc@915 40 val readOnly : ts ::: (Type * Type * Type) -> rest ::: {Type}
adamc@915 41 -> nm :: Name -> [[nm] ~ rest] => string -> meta ts
adamc@915 42 -> colMeta ([nm = ts.2] ++ rest)
adamc@915 43 (readOnlyState ts)
adamc@915 44
adamc@930 45 val nullable : global ::: Type -> actual ::: Type -> input ::: Type
adamc@930 46 -> meta (global, actual, input)
adamc@930 47 -> meta (global, option actual, input)
adamc@930 48
adamc@915 49 type intGlobal
adamc@915 50 type intInput
adamc@915 51 val int : meta (intGlobal, int, intInput)
adamc@915 52
adamc@915 53 type stringGlobal
adamc@915 54 type stringInput
adamc@915 55 val string : meta (stringGlobal, string, stringInput)
adamc@915 56
adamc@915 57 type boolGlobal
adamc@915 58 type boolInput
adamc@915 59 val bool : meta (boolGlobal, bool, boolInput)
adamc@915 60
adamc@915 61 functor Foreign (M : sig
adamc@915 62 con row :: {Type}
adamc@915 63 con t :: Type
adamc@915 64 val show_t : show t
adamc@915 65 val read_t : read t
adamc@915 66 val eq_t : eq t
adamc@915 67 val inj_t : sql_injectable t
adamc@915 68 con nm :: Name
adamc@915 69 constraint [nm] ~ row
adamc@915 70 table tab : ([nm = t] ++ row)
adamc@915 71 val render : $([nm = t] ++ row) -> string
adamc@915 72 end) : sig
adamc@915 73 con global :: Type
adamc@915 74 con input :: Type
adamc@915 75 val meta : meta (global, M.t, input)
adamc@915 76 end
adamc@915 77 end
adamc@915 78
adamc@915 79 con computedState :: (Type * Type)
adamc@915 80 val computed : row ::: {Type} -> t ::: Type -> show t
adamc@915 81 -> string -> ($row -> t) -> colMeta row computedState
adamc@915 82 val computedHtml : row ::: {Type} -> string -> ($row -> xbody) -> colMeta row computedState
adamc@915 83
adamc@915 84 functor Make(M : sig
adamc@915 85 con key :: {Type}
adamc@915 86 con row :: {Type}
adamc@915 87 constraint key ~ row
adamc@915 88 table tab : (key ++ row)
adamc@915 89
adamc@915 90 val raw : $(map rawMeta (key ++ row))
adamc@915 91
adamc@915 92 con cols :: {(Type * Type)}
adamc@915 93 val cols : $(map (colMeta (key ++ row)) cols)
adamc@915 94
adamc@915 95 val keyFolder : folder key
adamc@915 96 val rowFolder : folder row
adamc@915 97 val colsFolder : folder cols
adamc@915 98 end) : sig
adamc@915 99 type grid
adamc@915 100
adamc@915 101 val grid : transaction grid
adamc@915 102 val sync : grid -> transaction unit
adamc@915 103 val render : grid -> xbody
adamc@915 104 end