JeffreyZhao/Chat.aspx

## Chat.aspx
<%@ Page Language="C#" AutoEventWireup="true" CodeBehind="Chat.aspx.cs" Inherits="CometServer.Chat" %>

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html xmlns="http://www.w3.org/1999/xhtml">
<head runat="server">
    <title>Chat</title>
</head>
<body>
    <script language="javascript" type="text/javascript" src="Scripts/jquery-1.3.2.min.js"></script>
    <script language="javascript">
        var name = "<%= Request.QueryString["name"] %>";

        function sendMsg() {
            var msg = $("#msg").val();
            var toName = $("#toName").val();

            record("sending " + msg + "...")

            $.ajax({
                type: "POST",
                url: "Send.ashx",
                data: { from: name, to: toName, msg: msg },
                success: function() { $("#msg").val(""); }});
        }

        function receive() {
            record("receiving...");
            lastReceiving = new Date().getTime();
            $.getJSON("Receive.ashx", { name: name }, receiveCallback);
        }

        function receiveCallback(messages) {
            var receiveTime = new Date().getTime() - lastReceiving;

            if (messages.length <= 0) {
                record("received nothing (" + receiveTime + "ms)");
            }

            for (var i = messages.length - 1; i >= 0; i--) {
                var m = messages[i];
                record("received: " + m.text + " (" + receiveTime + "ms)");
            }

            receive();
        }

        var startTime = new Date().getTime();

        function record(text) {
            var time = new Date().getTime() - startTime;
            var html = $("<div></div>").text(time + " - " + text);
            $("#data").append(html);
        }

        $(document).ready(receive);
    </script>

    对方：<input type="text" value="<%= Request.QueryString["name"] %>" id="toName" disabled="disabled" /><br />
    消息：<input type="text" value="" id="msg" />
    <input type="button" value="发送" onclick="sendMsg()" />
    <div id="data"></div>
</body>
</html>

## Chat.fs
#light

module internal Comet.Chating.Chat

open System
open System.Collections.Concurrent

type ChatMsg = {
    From: string;
    Text: string;
}

let private agentCache = new ConcurrentDictionary<string, MailboxProcessor<ChatMsg>>()

let private agentFactory = new Func<string, MailboxProcessor<ChatMsg>>(fun _ ->
    MailboxProcessor.Start(fun o -> async { o |> ignore }))

let private GetAgent name = agentCache.GetOrAdd(name, agentFactory)

let send fromName toName msg =
    let agent = GetAgent toName
    { From = fromName; Text = msg; } |> agent.Post

let receive name =
    let rec receive' (agent: MailboxProcessor<ChatMsg>) messages =
        async {
            let! msg = agent.TryReceive 0
            match msg with
            | None -> return messages
            | Some s -> return! receive' agent (s :: messages)
        }

    let agent = GetAgent name

    async {
        let! messages = receive' agent List.empty
        if (not messages.IsEmpty) then return messages
        else
            let! msg = agent.TryReceive 3000
            match msg with
            | None -> return []
            | Some s -> return [s]
    }

## ReceiveHandler.fs
#light

namespace Comet.Chating

open Comet
open System
open System.Collections.Generic
open System.Web
open System.Web.Script.Serialization

type ReceiveHandler() =

    let mutable m_context = null
    let mutable m_endWork = null

    interface IHttpAsyncHandler with
        member h.IsReusable = false
        member h.ProcessRequest(context) = failwith "not supported"

        member h.BeginProcessRequest(c, cb, state) =
            m_context <- c

            let name = c.Request.QueryString.Item("name")
            let receive = Chat.receive name
            let beginWork, e, _ = Async.AsBeginEnd receive
            m_endWork <- new Func<_, _>(e)

            beginWork (cb, state)

        member h.EndProcessRequest(ar) =
            let convert (m: Chat.ChatMsg) =
                let o = new Dictionary<_, _>();
                o.Add("from", m.From)
                o.Add("text", m.Text)
                o

            let result = m_endWork.Invoke ar
            let serializer = new JavaScriptSerializer()
            result
            |> List.map convert
            |> serializer.Serialize
            |> m_context.Response.Write

## SendHandler.fs
#light

namespace Comet.Chating

open Comet
open System
open System.Web

type SendHandler() =

    interface IHttpHandler with
        member h.IsReusable = false
        member h.ProcessRequest(context) =
            let fromName = context.Request.Form.Item("from");
            let toName = context.Request.Form.Item("to")
            let msg = context.Request.Form.Item("msg")
            Chat.send fromName toName msg
            context.Response.Write "sent"
	<%@ Page Language="C#" AutoEventWireup="true" CodeBehind="Chat.aspx.cs" Inherits="CometServer.Chat" %>

	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

	<html xmlns="http://www.w3.org/1999/xhtml">
	<head runat="server">
	<title>Chat</title>
	</head>
	<body>
	<script language="javascript" type="text/javascript" src="Scripts/jquery-1.3.2.min.js"></script>
	<script language="javascript">
	var name = "<%= Request.QueryString["name"] %>";

	function sendMsg() {
	var msg = $("#msg").val();
	var toName = $("#toName").val();

	record("sending " + msg + "...")

	$.ajax({
	type: "POST",
	url: "Send.ashx",
	data: { from: name, to: toName, msg: msg },
	success: function() { $("#msg").val(""); }});
	}

	function receive() {
	record("receiving...");
	lastReceiving = new Date().getTime();
	$.getJSON("Receive.ashx", { name: name }, receiveCallback);
	}

	function receiveCallback(messages) {
	var receiveTime = new Date().getTime() - lastReceiving;

	if (messages.length <= 0) {
	record("received nothing (" + receiveTime + "ms)");
	}

	for (var i = messages.length - 1; i >= 0; i--) {
	var m = messages[i];
	record("received: " + m.text + " (" + receiveTime + "ms)");
	}

	receive();
	}

	var startTime = new Date().getTime();

	function record(text) {
	var time = new Date().getTime() - startTime;
	var html = $("<div></div>").text(time + " - " + text);
	$("#data").append(html);
	}

	$(document).ready(receive);
	</script>

	对方：<input type="text" value="<%= Request.QueryString["name"] %>" id="toName" disabled="disabled" /><br />
	消息：<input type="text" value="" id="msg" />
	<input type="button" value="发送" onclick="sendMsg()" />
	<div id="data"></div>
	</body>
	</html>
	#light

	module internal Comet.Chating.Chat

	open System
	open System.Collections.Concurrent

	type ChatMsg = {
	From: string;
	Text: string;
	}

	let private agentCache = new ConcurrentDictionary<string, MailboxProcessor<ChatMsg>>()

	let private agentFactory = new Func<string, MailboxProcessor<ChatMsg>>(fun _ ->
	MailboxProcessor.Start(fun o -> async { o \|> ignore }))

	let private GetAgent name = agentCache.GetOrAdd(name, agentFactory)

	let send fromName toName msg =
	let agent = GetAgent toName
	{ From = fromName; Text = msg; } \|> agent.Post

	let receive name =
	let rec receive' (agent: MailboxProcessor<ChatMsg>) messages =
	async {
	let! msg = agent.TryReceive 0
	match msg with
	\| None -> return messages
	\| Some s -> return! receive' agent (s :: messages)
	}

	let agent = GetAgent name

	async {
	let! messages = receive' agent List.empty
	if (not messages.IsEmpty) then return messages
	else
	let! msg = agent.TryReceive 3000
	match msg with
	\| None -> return []
	\| Some s -> return [s]
	}
	#light

	namespace Comet.Chating

	open Comet
	open System
	open System.Collections.Generic
	open System.Web
	open System.Web.Script.Serialization

	type ReceiveHandler() =

	let mutable m_context = null
	let mutable m_endWork = null

	interface IHttpAsyncHandler with
	member h.IsReusable = false
	member h.ProcessRequest(context) = failwith "not supported"

	member h.BeginProcessRequest(c, cb, state) =
	m_context <- c

	let name = c.Request.QueryString.Item("name")
	let receive = Chat.receive name
	let beginWork, e, _ = Async.AsBeginEnd receive
	m_endWork <- new Func<_, _>(e)

	beginWork (cb, state)

	member h.EndProcessRequest(ar) =
	let convert (m: Chat.ChatMsg) =
	let o = new Dictionary<_, _>();
	o.Add("from", m.From)
	o.Add("text", m.Text)
	o

	let result = m_endWork.Invoke ar
	let serializer = new JavaScriptSerializer()
	result
	\|> List.map convert
	\|> serializer.Serialize
	\|> m_context.Response.Write