adamc@1003: con meta = fn (db :: Type, widget :: Type) =>
adamc@1003: {Show : db -> xbody,
adamc@1003: Widget : nm :: Name -> xml form [] [nm = widget],
adamc@1003: WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget],
adamc@1003: Parse : widget -> db,
adamc@1003: Inject : sql_injectable db}
adamc@1001:
adamc@1003: fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t) : meta (t, string) =
adamc@1001: {Show = txt,
adamc@1001: Widget = fn [nm :: Name] => ,
adamc@1001: WidgetPopulated = fn [nm :: Name] n =>
adamc@1001: ,
adamc@1001: Parse = readError,
adamc@1001: Inject = _}
adamc@1001:
adamc@1001: val int = default
adamc@1001: val float = default
adamc@1001: val string = default
adamc@1001: val bool = {Show = txt,
adamc@1001: Widget = fn [nm :: Name] => ,
adamc@1001: WidgetPopulated = fn [nm :: Name] b =>
adamc@1001: ,
adamc@1001: Parse = fn x => x,
adamc@1001: Inject = _}
adamc@1001:
adamc@1001: functor Make(M : sig
adamc@1003: con paper :: {(Type * Type)}
adamc@1003: constraint [Id, Title] ~ paper
adamc@1003: val paper : $(map meta paper)
adamc@1003:
adamc@1001: con review :: {(Type * Type)}
adamc@1003: constraint [Paper, User] ~ review
adamc@1003: val review : $(map meta review)
adamc@1001: end) = struct
adamc@1001:
adamc@1003: table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool}
adamc@1003: PRIMARY KEY Id,
adamc@1003: CONSTRAINT Nam UNIQUE Nam
adamc@1003: sequence userId
adamc@1003:
adamc@1003: con paper = [Id = int, Title = string] ++ map fst M.paper
adamc@1003: table paper : paper
adamc@1003: PRIMARY KEY Id
adamc@1003: sequence paperId
adamc@1003:
adamc@1003: con review = [Paper = int, User = int] ++ map fst M.review
adamc@1003: table review : review
adamc@1003: PRIMARY KEY (Paper, User),
adamc@1003: CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
adamc@1003: CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
adamc@1003: sequence reviewId
adamc@1003:
adamc@1003: cookie login : {Id : int, Password : string}
adamc@1003:
adamc@1003: fun checkLogin () =
adamc@1003: r <- getCookie login;
adamc@1003: case r of
adamc@1003: None => return None
adamc@1003: | Some r =>
adamc@1003: oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc
adamc@1003: FROM user
adamc@1003: WHERE user.Id = {[r.Id]}
adamc@1003: AND user.Password = {[r.Password]})
adamc@1003:
adamc@1003: fun doRegister r =
adamc@1003: n <- oneRowE1 (SELECT COUNT( * ) AS N
adamc@1003: FROM user
adamc@1003: WHERE user.Nam = {[r.Nam]});
adamc@1003: if n > 0 then
adamc@1003: register (Some "Sorry; that username is taken.")
adamc@1003: else
adamc@1003: id <- nextval userId;
adamc@1003: dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc)
adamc@1003: VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE));
adamc@1003: setCookie login {Id = id, Password = r.Password};
adamc@1003: main ()
adamc@1003:
adamc@1003: and register msg = return
adamc@1003: Registering a New Account
adamc@1003:
adamc@1003: {case msg of
adamc@1003: None =>
adamc@1003: | Some msg => {[msg]}
}
adamc@1003:
adamc@1003:
adamc@1003:
adamc@1003:
adamc@1003: and main () =
adamc@1003: me <- checkLogin ();
adamc@1003: return
adamc@1003: {case me of
adamc@1003: None => Register for access
adamc@1003: | Some {Nam = name, ...} => Welcome, {[name]}!}
adamc@1003:
adamc@1001:
adamc@1001: end