Permalink
Browse files

First (non-working) attempt at dynamic messages update.

  • Loading branch information...
1 parent aee5d31 commit b8da3aba1a2961d45abe0016fe5516d470249863 @akoprow akoprow committed Mar 31, 2011
Showing with 51 additions and 16 deletions.
  1. +2 −2 src/data.opa
  2. +9 −4 src/msg.opa
  3. +6 −6 src/msg_box.opa
  4. +28 −3 src/msg_factory.opa
  5. +6 −1 src/pages.opa
View
4 src/data.opa
@@ -7,8 +7,8 @@ package mlstate.twopenny
Data = {{
- new_message(user, msg) =
- debug("New message from: '{user}' -> '{msg}'")
+ new_message(msg) =
+ debug("New message: {msg}")
new_user_mention(user, msg) =
debug("New user mention: '{user}' in '{msg}'")
View
13 src/msg.opa
@@ -5,7 +5,11 @@
package mlstate.twopenny
-type Msg.t = private(string)
+type Msg.t = private(
+ { author: User.ref
+ ; content : string
+ ; created_at : Date.date
+ })
type Msg.segment =
{ text : string }
@@ -15,8 +19,9 @@ type Msg.segment =
Msg = {{
- create(s : string) : Msg.t =
- @wrap(s)
+ create(author : User.ref, content : string) : Msg.t =
+ msg = { ~author ~content created_at=Date.now() }
+ @wrap(msg)
parse(msg : Msg.t) : list(Msg.segment) =
word = parser
@@ -39,7 +44,7 @@ Msg = {{
| txt=((!special_prefix (word | .))+) -> // Warning! + not * ; otherwise it will loop
{ text = Text.to_string(txt) }
msg_parser = parser res=segment_parser* -> res
- Parser.parse(msg_parser, @unwrap(msg))
+ Parser.parse(msg_parser, @unwrap(msg).content)
render(msg : Msg.t) : xhtml =
render_segment =
View
12 src/msg_box.opa
@@ -31,7 +31,7 @@ WMsgBox =
Dom.get_value(#{get_input_text_id(id)})
{{
- @private @client update(id : string) = _ ->
+ @private @client update(id : string, mk_msg) = _ ->
content = get_content(id)
remaining = MAXIMUM_MESSAGE_LENGTH - String.length(content)
counter_css =
@@ -46,7 +46,7 @@ WMsgBox =
do exec([#{get_counter_id(id)} <- counter_xhtml])
preview =
if remaining > 0 then
- Msg.create(content) |> Msg.render(_)
+ mk_msg(content) |> Msg.render(_)
else
MSG_TOO_LONG_WARNING
do exec([#{get_preview_id(id)} <- preview])
@@ -55,21 +55,21 @@ WMsgBox =
enabled)
void
- html(id : string, submit : string -> void) : xhtml =
+ html(id : string, mk_msg : string -> Msg.t, submit : Msg.t -> void) : xhtml =
text_id = get_input_text_id(id)
inputbox =
/* WARNING! If we change the function call below
into a closure then we have to be careful with
slicing, as at the moment this whole function ends
up on the server. But there must be a better
way of doing it than the repetition below... */
- <textarea id=#{text_id} onready={update(id)}
- onkeyup={update(id)} onchange={update(id)} />
+ <textarea id=#{text_id} onready={update(id, mk_msg)}
+ onkeyup={update(id, mk_msg)} onchange={update(id, mk_msg)} />
counter =
<div id=#{get_counter_id(id)}></>
preview =
<div id=#{get_preview_id(id)}></>
- submit_msg(_) = submit(get_content(id))
+ submit_msg(_) = get_content(id) |> mk_msg(_) |> submit(_)
accept = WButton.html(submit_button_cfg, get_submit_button_id(id),
[({click}, submit_msg)], MSG_SUBMIT)
<>
View
31 src/msg_factory.opa
@@ -5,17 +5,42 @@
package mlstate.twopenny
+/**
+ * @private
+**/
+type MsgFactory.msg_subscription = channel(
+ { newmsg : Msg.t }
+)
+
MsgFactory = {{
- submit(user : User.ref)(content : string) =
- msg = Msg.create(content)
- do Data.new_message(user, msg)
+ @private on_subscription(callbacks, msg) =
+ match msg with
+ | { SubscribeToAll=callback } ->
+ {set = [callback | callbacks]}
+ | { NewMessage=newmsg } ->
+ /* REMARK Type annotation below needed to avoid value
+ restriction error */
+ notify(callback) = callback(newmsg : Msg.t)
+ do List.iter(notify, callbacks)
+ {unchanged}
+
+ @private @server subscribers =
+ Session.make([], on_subscription)
+
+ submit(msg : Msg.t) =
+ do Data.new_message(msg)
index =
| ~{user} -> Data.new_user_mention(user, msg)
| ~{label} -> Data.new_label_msg(label, msg)
| {url=_}
| {text=_} -> void
do List.iter(index, Msg.parse(msg))
+ do Session.send(subscribers, {NewMessage=msg})
+ void
+
+ subscribe_to_all(callback : Msg.t -> void) : void =
+ do Session.send(subscribers, {SubscribeToAll=callback})
void
}}
View
7 src/pages.opa
@@ -20,11 +20,16 @@ Pages = {{
html("Twopenny", unimplemented)
user_page(user : User.ref) =
+ submission = WMsgBox.html("msgbox", Msg.create(user, _), MsgFactory.submit)
+ show_new_msg(msg) =
+ exec([#msgs +<- Msg.render(msg)])
content =
<>
<h1>User: {@unwrap(user)}</>
- {WMsgBox.html("msgbox", MsgFactory.submit(user))}
+ {submission}
+ <div id=#msgs />
</>
+ do MsgFactory.subscribe_to_all(show_new_msg)
html("Twopenny :: {user}", content)
label_page(label) =

0 comments on commit b8da3ab

Please sign in to comment.