new event dispatching

9 files changed, 140 insertions, 78 deletions

diff --git a/bin/bot.ml b/bin/bot.ml
index 25ccc1e..3608f85 100644
--- a/bin/bot.ml
+++ b/bin/bot.ml
@@ -8,13 +8,8 @@ let main () =
     | None -> failwith "No token in env"
     in
     Client.start token
-    >>> fun client ->
-    Clock.every
-    (Time.Span.create ~sec:60 ())
-    (fun () ->
-        print_endline "Setting status";
-        Client.set_status ~status:(`String "Hello!") client
-        >>> ignore)
+    >>> ignore
 
 let _ =
+    Client.message_create := (fun msg -> print_endline msg.content);
     Scheduler.go_main ~main ()
diff --git a/bin/dune b/bin/dune
index 96be393..65360bc 100644
--- a/bin/dune
+++ b/bin/dune
@@ -1,5 +1,5 @@
 (executable
 	(name bot)
-	(modules bot handler)
+	(modules bot)
 	(libraries core async_ssl disml)
 )
\ No newline at end of file
diff --git a/bin/handler.ml b/bin/handler.ml
deleted file mode 100644
index 5afbbee..0000000
--- a/bin/handler.ml
+++ /dev/null
@@ -1,63 +0,0 @@
-module Make(Models : Disml.S.Models) = struct
-    open Core
-    open Async
-    open Models
-    open Disml.Event
-
-    let check_command (msg:Message.t) =
-        if String.is_prefix ~prefix:"!ping" msg.content then
-            Message.reply msg "Pong!" >>> ignore
-        else if String.is_prefix ~prefix:"!spam" msg.content then
-            let count = String.chop_prefix_exn ~prefix:"!spam" msg.content |> String.strip |> Int.of_string in
-            List.range 0 count
-            |> List.iter ~f:(fun i -> Message.reply msg (string_of_int i) >>> ignore)
-        else if String.is_prefix ~prefix:"!list" msg.content then
-            let count = String.chop_prefix_exn ~prefix:"!list" msg.content |> String.strip |> Int.of_string in
-            let list = List.range 0 count
-            |> List.sexp_of_t Int.sexp_of_t
-            |> Sexp.to_string_hum in
-            Message.reply msg list >>> ignore
-        else if String.is_prefix ~prefix:"!fold" msg.content then
-            let count = String.chop_prefix_exn ~prefix:"!fold" msg.content |> String.strip |> Int.of_string in
-            let list = List.range 0 count
-            |> List.fold ~init:0 ~f:(+)
-            |> Int.to_string in
-            Message.reply msg list >>> ignore
-
-    let handle_event = function
-    | HELLO _ -> print_endline "Received HELLO"
-    | READY _ -> print_endline "Received READY"
-    | RESUMED _ -> print_endline "Received RESUMED"
-    | INVALID_SESSION _ -> print_endline "Received INVALID_SESSION"
-    | CHANNEL_CREATE _ -> print_endline "Received CHANNEL_CREATE"
-    | CHANNEL_UPDATE _ -> print_endline "Received CHANNEL_UPDATE"
-    | CHANNEL_DELETE _ -> print_endline "Received CHANNEL_DELETE"
-    | CHANNEL_PINS_UPDATE _ -> print_endline "Received CHANNEL_PINS_UPDATE"
-    | GUILD_CREATE _ -> print_endline "Received GUILD_CREATE"
-    | GUILD_UPDATE _ -> print_endline "Received GUILD_UPDATE"
-    | GUILD_DELETE _ -> print_endline "Received GUILD_DELETE"
-    | GUILD_BAN_ADD _ -> print_endline "Received GUILD_BAN_ADD"
-    | GUILD_BAN_REMOVE _ -> print_endline "Received GUILD_BAN_REMOVE"
-    | GUILD_EMOJIS_UPDATE _ -> print_endline "Received GUILD_EMOJIS_UPDATE"
-    | GUILD_INTEGRATIONS_UPDATE _ -> print_endline "Received GUILD_INTEGRATIONS_UPDATE"
-    | GUILD_MEMBER_ADD _ -> print_endline "Received GUILD_MEMBER_ADD"
-    | GUILD_MEMBER_REMOVE _ -> print_endline "Received GUILD_MEMBER_REMOVE"
-    | GUILD_MEMBER_UPDATE _ -> print_endline "Received GUILD_MEMBER_UPDATE"
-    | GUILD_MEMBERS_CHUNK _ -> print_endline "Received GUILD_MEMBERS_CHUNK"
-    | GUILD_ROLE_CREATE _ -> print_endline "Received GUILD_ROLE_CREATE"
-    | GUILD_ROLE_UPDATE _ -> print_endline "Received GUILD_ROLE_UPDATE"
-    | GUILD_ROLE_DELETE _ -> print_endline "Received GUILD_ROLE_DELETE"
-    | MESSAGE_CREATE msg -> check_command msg; print_endline "Received MESSAGE_CREATE"
-    | MESSAGE_UPDATE _ -> print_endline "Received MESSAGE_UPDATE"
-    | MESSAGE_DELETE _ -> print_endline "Received MESSAGE_DELETE"
-    | MESSAGE_BULK_DELETE _ -> print_endline "Received MESSAGE_BULK_DELETE"
-    | MESSAGE_REACTION_ADD _ -> print_endline "Received MESSAGE_REACTION_ADD"
-    | MESSAGE_REACTION_REMOVE _ -> print_endline "Received MESSAGE_REACTION_REMOVE"
-    | MESSAGE_REACTION_REMOVE_ALL _ -> print_endline "Received MESSAGE_REACTION_REMOVE_ALL"
-    | PRESENCE_UPDATE _ -> print_endline "Received PRESENCE_UPDATE"
-    | TYPING_START _ -> print_endline "Received TYPING_START"
-    | USER_UPDATE _ -> print_endline "Received USER_UPDATE"
-    | VOICE_STATE_UPDATE _ -> print_endline "Received VOICE_STATE_UPDATE"
-    | VOICE_SERVER_UPDATE _ -> print_endline "Received VOICE_SERVER_UPDATE"
-    | WEBHOOKS_UPDATE _ -> print_endline "Received WEBHOOKS_UPDATE"
-end
diff --git a/lib/client.ml b/lib/client.ml
index 7504604..49d01dc 100644
--- a/lib/client.ml
+++ b/lib/client.ml
@@ -1,4 +1,5 @@
 open Async
+include Config
 
 type t = {
     sharder: Sharder.t;
diff --git a/lib/config.ml b/lib/config.ml
index 0571fea..99018ea 100644
--- a/lib/config.ml
+++ b/lib/config.ml
@@ -1 +1,37 @@
-let token = ref ""
\ No newline at end of file
+let token = ref ""
+
+ let hello = ref (fun (_:Yojson.Safe.json) -> ())
+ let ready = ref (fun (_:Yojson.Safe.json) -> ())
+ let resumed = ref (fun (_:Yojson.Safe.json) -> ())
+ let invalid_session = ref (fun (_:Yojson.Safe.json) -> ())
+ let channel_create = ref (fun (_:Channel_t.t) -> ())
+ let channel_update = ref (fun (_:Channel_t.t) -> ())
+ let channel_delete = ref (fun (_:Channel_t.t) -> ())
+ let channel_pins_update = ref (fun (_:Yojson.Safe.json) -> ())
+ let guild_create = ref (fun (_:Guild_t.t) -> ())
+ let guild_update = ref (fun (_:Guild_t.t) -> ())
+ let guild_delete = ref (fun (_:Guild_t.t) -> ())
+ let member_ban = ref (fun (_:Ban_t.t) -> ())
+ let member_unban = ref (fun (_:Ban_t.t) -> ())
+ let guild_emojis_update = ref (fun (_:Yojson.Safe.json) -> ())
+ let integrations_update = ref (fun (_:Yojson.Safe.json) -> ())
+ let member_join = ref (fun (_:Member_t.t) -> ())
+ let member_leave = ref (fun (_:Member_t.member_wrapper) -> ())
+ let member_update = ref (fun (_:Member_t.member_update) -> ())
+ let members_chunk = ref (fun (_:Member_t.t list) -> ())
+ let role_create = ref (fun (_:Role_t.t) -> ())
+ let role_update = ref (fun (_:Role_t.t) -> ())
+ let role_delete = ref (fun (_:Role_t.t) -> ())
+ let message_create = ref (fun (_:Message_t.t) -> ())
+ let message_update = ref (fun (_:Message_t.message_update) -> ())
+ let message_delete = ref (fun (_:Snowflake.t) (_:Snowflake.t) -> ())
+ let message_bulk_delete = ref (fun (_:Snowflake.t list) -> ())
+ let reaction_add = ref (fun (_:Reaction_t.reaction_event) -> ())
+ let reaction_remove = ref (fun (_:Reaction_t.reaction_event) -> ())
+ let reaction_bulk_remove = ref (fun (_:Reaction_t.t list) -> ())
+ let presence_update = ref (fun (_:Presence.t) -> ())
+ let typing_start = ref (fun (_:Yojson.Safe.json) -> ())
+ let user_update = ref (fun (_:Yojson.Safe.json) -> ())
+ let voice_state_update = ref (fun (_:Yojson.Safe.json) -> ())
+ let voice_server_update = ref (fun (_:Yojson.Safe.json) -> ())
+ let webhooks_update = ref (fun (_:Yojson.Safe.json) -> ())
\ No newline at end of file
diff --git a/lib/config.mli b/lib/config.mli
new file mode 100644
index 0000000..681e9ce
--- /dev/null
+++ b/lib/config.mli
@@ -0,0 +1,37 @@
+val token : string ref
+
+val hello : (Yojson.Safe.json -> unit) ref
+val ready : (Yojson.Safe.json -> unit) ref
+val resumed : (Yojson.Safe.json -> unit) ref
+val invalid_session : (Yojson.Safe.json -> unit) ref
+val channel_create : (Channel_t.t -> unit) ref
+val channel_update : (Channel_t.t -> unit) ref
+val channel_delete : (Channel_t.t -> unit) ref
+val channel_pins_update : (Yojson.Safe.json -> unit) ref
+val guild_create : (Guild_t.t -> unit) ref
+val guild_update : (Guild_t.t -> unit) ref
+val guild_delete : (Guild_t.t -> unit) ref
+val member_ban : (Ban_t.t -> unit) ref
+val member_unban : (Ban_t.t -> unit) ref
+val guild_emojis_update : (Yojson.Safe.json -> unit) ref
+val integrations_update : (Yojson.Safe.json -> unit) ref
+val member_join : (Member_t.t -> unit) ref
+val member_leave : (Member_t.member_wrapper -> unit) ref
+val member_update : (Member_t.member_update -> unit) ref
+val members_chunk : (Member_t.t list -> unit) ref
+val role_create : (Role_t.t -> unit) ref
+val role_update : (Role_t.t -> unit) ref
+val role_delete : (Role_t.t -> unit) ref
+val message_create : (Message_t.t -> unit) ref
+val message_update : (Message_t.message_update -> unit) ref
+val message_delete : (Snowflake.t -> Snowflake.t -> unit) ref
+val message_bulk_delete : (Snowflake.t list -> unit) ref
+val reaction_add : (Reaction_t.reaction_event -> unit) ref
+val reaction_remove : (Reaction_t.reaction_event -> unit) ref
+val reaction_bulk_remove : (Reaction_t.t list -> unit) ref
+val presence_update : (Presence.t -> unit) ref
+val typing_start : (Yojson.Safe.json -> unit) ref
+val user_update : (Yojson.Safe.json -> unit) ref
+val voice_state_update : (Yojson.Safe.json -> unit) ref
+val voice_server_update : (Yojson.Safe.json -> unit) ref
+val webhooks_update : (Yojson.Safe.json -> unit) ref
\ No newline at end of file
diff --git a/lib/event.ml b/lib/event.ml
index 6684053..1c0bcc2 100644
--- a/lib/event.ml
+++ b/lib/event.ml
@@ -22,9 +22,9 @@ type t =
 | GUILD_MEMBER_REMOVE of Member_t.member_wrapper
 | GUILD_MEMBER_UPDATE of Member_t.member_update
 | GUILD_MEMBERS_CHUNK of Member_t.t list
-| GUILD_ROLE_CREATE of Role_t.t (* * Guild_t.t *)
-| GUILD_ROLE_UPDATE of Role_t.t (* * Guild_t.t *)
-| GUILD_ROLE_DELETE of Role_t.t (* * Guild_t.t *)
+| GUILD_ROLE_CREATE of Role_t.t
+| GUILD_ROLE_UPDATE of Role_t.t
+| GUILD_ROLE_DELETE of Role_t.t
 | MESSAGE_CREATE of Message_t.t
 | MESSAGE_UPDATE of Message_t.message_update
 | MESSAGE_DELETE of Snowflake.t * Snowflake.t
@@ -77,10 +77,47 @@ let event_of_yojson ~contents t = match t with
     | "WEBHOOKS_UPDATE" -> WEBHOOKS_UPDATE contents
     | s -> raise @@ Invalid_event s
 
-let dispatch ~ev contents =
+let dispatch ev = match ev with
+| HELLO d -> !Config.hello d
+| READY d -> !Config.ready d
+| RESUMED d -> !Config.resumed d
+| INVALID_SESSION d -> !Config.invalid_session d
+| CHANNEL_CREATE d -> !Config.channel_create d
+| CHANNEL_UPDATE d -> !Config.channel_update d
+| CHANNEL_DELETE d -> !Config.channel_delete d
+| CHANNEL_PINS_UPDATE d -> !Config.channel_pins_update d
+| GUILD_CREATE d -> !Config.guild_create d
+| GUILD_UPDATE d -> !Config.guild_update d
+| GUILD_DELETE d -> !Config.guild_delete d
+| GUILD_BAN_ADD d -> !Config.member_ban d
+| GUILD_BAN_REMOVE d -> !Config.member_unban d
+| GUILD_EMOJIS_UPDATE d -> !Config.guild_emojis_update d
+| GUILD_INTEGRATIONS_UPDATE d -> !Config.integrations_update d
+| GUILD_MEMBER_ADD d -> !Config.member_join d
+| GUILD_MEMBER_REMOVE d -> !Config.member_leave d
+| GUILD_MEMBER_UPDATE d -> !Config.member_update d
+| GUILD_MEMBERS_CHUNK d -> !Config.members_chunk d
+| GUILD_ROLE_CREATE d -> !Config.role_create d
+| GUILD_ROLE_UPDATE d -> !Config.role_update d
+| GUILD_ROLE_DELETE d -> !Config.role_delete d
+| MESSAGE_CREATE d -> !Config.message_create d
+| MESSAGE_UPDATE d -> !Config.message_update d
+| MESSAGE_DELETE (d,e) -> !Config.message_delete d e
+| MESSAGE_BULK_DELETE d -> !Config.message_bulk_delete d
+| MESSAGE_REACTION_ADD d -> !Config.reaction_add d
+| MESSAGE_REACTION_REMOVE d -> !Config.reaction_remove d
+| MESSAGE_REACTION_REMOVE_ALL d -> !Config.reaction_bulk_remove d
+| PRESENCE_UPDATE d -> !Config.presence_update d
+| TYPING_START d -> !Config.typing_start d
+| USER_UPDATE d -> !Config.user_update d
+| VOICE_STATE_UPDATE d -> !Config.voice_state_update d
+| VOICE_SERVER_UPDATE d -> !Config.voice_server_update d
+| WEBHOOKS_UPDATE d -> !Config.webhooks_update d
+
+let handle_event ~ev contents =
     (* Printf.printf "Dispatching %s\n%!" ev; *)
     (* print_endline (Yojson.Safe.prettify contents); *)
     try
         event_of_yojson ~contents ev
-        |> ignore; (* TODO make this point to the new hanler *)
+        |> dispatch
     with Invalid_event ev -> Printf.printf "Unknown event: %s%!" ev
\ No newline at end of file
diff --git a/lib/rl.mli b/lib/rl.mli
new file mode 100644
index 0000000..f583653
--- /dev/null
+++ b/lib/rl.mli
@@ -0,0 +1,19 @@
+open Core
+open Async
+
+module RouteMap : module type of Map.Make(String)
+
+type rl = {
+    limit: int;
+    remaining: int;
+    reset: int;
+}
+
+type t = ((rl, read_write) Mvar.t) RouteMap.t
+
+val rl_of_header : Cohttp.Header.t -> rl option
+val default : rl
+val empty : t
+val update : 'a RouteMap.t -> string -> f:('a option -> 'a) -> 'a RouteMap.t
+val find : 'a RouteMap.t -> string -> 'a option
+val find_exn : 'a RouteMap.t -> string -> 'a
\ No newline at end of file
diff --git a/lib/sharder.ml b/lib/sharder.ml
index 8b32434..823fe28 100644
--- a/lib/sharder.ml
+++ b/lib/sharder.ml
@@ -63,7 +63,7 @@ module Shard = struct
             Ivar.fill_if_empty shard.ready ();
             J.(member "session_id" data |> to_string_option)
         end else None in
-        Event.dispatch ~ev:t data;
+        Event.handle_event ~ev:t data;
         return { shard with
             seq = seq;
             session = session;