1. Yaron Minsky
  2. hack-and-slash

Source

hack-and-slash / server.ml

open Core.Std
open Async.Std

let send_update w u =
  match Update.to_line u with
  | None -> Deferred.unit
  | Some l ->
    Writer.write w l;
    Writer.flushed w

let run ~port =
  let state = ref (State.create ()) in
  let host_and_port =
    Tcp.Server.create
      ~on_handler_error:`Raise
      (Tcp.on_port port)
      (fun _addr r w ->
         Reader.read_line r
         >>= function
           | `Eof -> Deferred.unit
           | `Ok pname ->
             let pname = Player_name.of_string pname in
             state := State.register_player !state pname;
             let rec loop () =
               Reader.read_line r >>= function
                 | `Eof -> Deferred.unit
                 | `Ok line ->
                   begin match Action.of_line line with
                   | Error e ->
                     let u = Update.of_error e in
                     send_update w u
                   | Ok action ->
                     let (state',u) = State.act !state pname action in
                     state := state';
                     send_update w u
                   end
                   >>= fun () ->
                   loop ()
             in
             loop ()
      )
  in
  ignore (host_and_port : (Socket.Address.Inet.t, int) Tcp.Server.t Deferred.t);
  Deferred.never ()

let command =
  let default_port = 12323 in
  Command.async_basic
    ~summary:"Start the server"
    Command.Spec.(
      empty
      +> flag "-port" (optional_with_default default_port int)
        ~doc:(sprintf " Port to listen on (default %d)" default_port)
    )
    (fun port () -> run ~port)