comparison demo/more/dbgrid.ur @ 1304:f0afe61a6f8b

Tweaking unification fix to apply to demo/more
author Adam Chlipala <adam@chlipala.net>
date Sun, 10 Oct 2010 15:37:14 -0400
parents 8d3aa6c7cee0
children e2611b5dafce
comparison
equal deleted inserted replaced
1303:c7b9a33c26c8 1304:f0afe61a6f8b
36 36
37 datatype metaBoth actual input filter = 37 datatype metaBoth actual input filter =
38 NonNull of metaBase (actual, input, filter) * metaBase (option actual, input, filter) 38 NonNull of metaBase (actual, input, filter) * metaBase (option actual, input, filter)
39 | Nullable of metaBase (actual, input, filter) 39 | Nullable of metaBase (actual, input, filter)
40 40
41 con meta = fn global_actual_input_filter :: (Type * Type * Type * Type) => 41 con meta = fn global_actual_input_filter =>
42 {Initialize : transaction global_actual_input_filter.1, 42 {Initialize : transaction global_actual_input_filter.1,
43 Handlers : global_actual_input_filter.1 43 Handlers : global_actual_input_filter.1
44 -> metaBoth global_actual_input_filter.2 global_actual_input_filter.3 44 -> metaBoth global_actual_input_filter.2 global_actual_input_filter.3
45 global_actual_input_filter.4} 45 global_actual_input_filter.4}
46 46
47 con editableState (ts :: (Type * Type * Type * Type)) = (ts.1, ts.3, ts.4) 47 con editableState (ts :: (Type * Type * Type * Type)) = (ts.1, ts.3, ts.4)
48 fun editable [ts] [rest] [nm :: Name] [[nm] ~ rest] name (m : meta ts) : colMeta ([nm = ts.2] ++ rest) 48 fun editable [ts] [rest] [nm :: Name] [[nm] ~ rest] name (m : meta ts) : colMeta ([nm = ts.2] ++ rest)
49 (editableState ts) = 49 (editableState ts) =
50 let 50 let
51 fun doMr mr = {Header = name, 51 fun doMr (mr : metaBase (ts.2, ts.3, ts.4)) : colMeta' ([nm = ts.2] ++ rest) ts.3 ts.4 =
52 Project = fn r => mr.Initialize r.nm, 52 {Header = name,
53 Update = fn r s => 53 Project = fn r => mr.Initialize r.nm,
54 vo <- current (mr.Parse s); 54 Update = fn r s =>
55 return (case vo of 55 vo <- current (mr.Parse s);
56 None => r 56 return (case vo of
57 | Some v => r -- nm ++ {nm = v}), 57 None => r
58 Display = mr.Display, 58 | Some v => r -- nm ++ {nm = v}),
59 Edit = mr.Edit, 59 Display = mr.Display,
60 Validate = fn s => vo <- mr.Parse s; return (Option.isSome vo), 60 Edit = mr.Edit,
61 CreateFilter = mr.CreateFilter, 61 Validate = fn s => vo <- mr.Parse s; return (Option.isSome vo),
62 DisplayFilter = mr.DisplayFilter, 62 CreateFilter = mr.CreateFilter,
63 Filter = fn i r => mr.Filter i r.nm, 63 DisplayFilter = mr.DisplayFilter,
64 Sort = Some (fn r1 r2 => mr.Sort r1.nm r2.nm)} 64 Filter = fn i r => mr.Filter i r.nm,
65 Sort = Some (fn r1 r2 => mr.Sort r1.nm r2.nm)}
65 in 66 in
66 {Initialize = m.Initialize, 67 {Initialize = m.Initialize,
67 Handlers = fn data => case m.Handlers data of 68 Handlers = fn data => case m.Handlers data of
68 NonNull (mr, _) => doMr mr 69 NonNull (mr, _) => doMr mr
69 | Nullable mr => doMr mr} 70 | Nullable mr => doMr mr}
70 end 71 end
71 72
72 con readOnlyState (ts :: (Type * Type * Type * Type)) = (ts.1, ts.3, ts.4) 73 con readOnlyState (ts :: (Type * Type * Type * Type)) = (ts.1, ts.3, ts.4)
73 fun readOnly [ts] [rest] [nm :: Name] [[nm] ~ rest] name (m : meta ts) : colMeta ([nm = ts.2] ++ rest) 74 fun readOnly [ts] [rest] [nm :: Name] [[nm] ~ rest] name (m : meta ts) : colMeta ([nm = ts.2] ++ rest)
74 (readOnlyState ts) = 75 (readOnlyState ts) =