adamc@1004: open Meta adamc@1004: adamc@1004: functor Make(M : sig adamc@1004: con keyName :: Name adamc@1004: con keyType :: Type adamc@1004: val showKey : show keyType adamc@1005: val readKey : read keyType adamc@1005: val injKey : sql_injectable keyType adamc@1004: adamc@1004: con visible :: {(Type * Type)} adamc@1004: constraint [keyName] ~ visible adamc@1004: val folder : folder visible adamc@1004: val visible : $(map Meta.meta visible) adamc@1004: adamc@1004: con invisible :: {Type} adamc@1004: constraint [keyName] ~ invisible adamc@1004: constraint visible ~ invisible adamc@1004: adamc@1004: val title : string adamc@1004: val isAllowed : transaction bool adamc@1004: table t : ([keyName = keyType] ++ map fst visible ++ invisible) adamc@1004: end) = struct adamc@1004: adamc@1004: open M adamc@1004: adamc@1005: fun ensql [avail] (r : $(map snd visible)) : $(map (sql_exp avail [] []) (map fst visible)) = adamc@1005: map2 [meta] [snd] [fn ts :: (Type * Type) => sql_exp avail [] [] ts.1] adamc@1005: (fn [ts] meta v => @sql_inject meta.Inject (meta.Parse v)) adamc@1005: [_] folder visible r adamc@1005: adamc@1004: fun main () = adamc@1004: items <- queryX (SELECT t.{keyName}, t.{{map fst visible}} FROM t) adamc@1004: (fn r => adamc@1004: adamc@1004: {useMore (foldR2 [meta] [fst] [fn cols :: {(Type * Type)} => adamc@1004: xml [Body, Form, Tr] [] (map snd cols)] adamc@1004: (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] adamc@1004: (m : meta p) v (acc : xml [Body, Form, Tr] [] (map snd rest)) => adamc@1004: adamc@1004: {m.WidgetPopulated [nm] v} adamc@1004: {useMore acc} adamc@1004: ) adamc@1004: adamc@1004: [_] folder visible (r.T -- keyName))} adamc@1004: ); adamc@1004: adamc@1004: return adamc@1004: {[title]} adamc@1004: adamc@1004: adamc@1004: {foldRX [meta] [_] adamc@1004: (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] m => adamc@1004: {[m.Nam]}) [_] folder visible} adamc@1004: {items} adamc@1005: adamc@1004: adamc@1004: adamc@1004: adamc@1005: and save r = adamc@1005: List.app (fn user => dml (update [map fst visible] ! adamc@1005: (ensql (user -- keyName)) adamc@1005: t adamc@1005: (WHERE t.{keyName} = {[readError user.keyName]}))) r.Users; adamc@1005: main () adamc@1005: adamc@1004: end