Source

hack-and-slash / server.ml

Full commit
open Core.Std
open Async.Std
module Log = Log.Global

module type Game = sig
  module State : State_intf.S
  val state : State.t ref
end

let states : (module State_intf.S) list =
  [ (module Findme)
  ]

let send_update w u =
  Writer.write w (Update.to_line u);
  Writer.flushed w

let run ~port =
  let games = List.map states ~f:(fun (module State : State_intf.S) ->
    (module struct
       module State = State
       let state = ref (State.create ())
     end : Game))
  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_and_game ->
             match String.lsplit2 ~on:' ' pname_and_game with
             | None ->
               "Must specify player name and game name"
               |> Update.error
               |> send_update w
             | Some (pname,gname) ->
               let pname = String.strip pname in
               let gname = String.strip gname in
               match
                 List.find games ~f:(fun (module Game : Game) ->
                   Game.State.name = gname)
               with
               | None ->
                 Update.error "Couldn't find game"
                 |> send_update w
               | Some (module Game : Game) ->
                 let module State  = Game.State   in
                 Log.debug "user logon %s, %s" pname (Socket.Address.Inet.to_string addr);
                 send_update w (String.concat ["Welcome ";pname;"!"] |> Update.ok)
                 >>= fun () ->
                 let pname = Player_name.of_string pname in
                 Game.state := State.register_player !Game.state pname;
                 let rec loop () =
                   Reader.read_line r >>= function
                   | `Eof -> Deferred.unit
                   | `Ok line ->
                     Log.debug "(%s) line: %s" (Player_name.to_string pname) line;
                     begin match State.line_to_action line with
                     | None ->
                       let u = Update.error "Unknown action" in
                       send_update w u
                     | Some action ->
                       let (state',u) = State.act !Game.state pname action in
                       Game.state := state';
                       send_update w u
                     end
                     >>= fun () ->
                     loop ()
                 in
                 loop ()
                 >>| fun () ->
                 Log.debug "Client %s disconnected" (Socket.Address.Inet.to_string addr)
      )
  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)
      +> flag "-debug" no_arg
           ~doc:"Turns on debug logging"
    )
    (fun port debug () ->
       if debug then Log.set_level `Debug;
       run ~port
    )