Fix all the errors from coding without merlin

5 files changed, 226 insertions, 65 deletions

diff --git a/lib/client.ml b/lib/client.ml
index 7adaae3..b27a2ee 100644
--- a/lib/client.ml
+++ b/lib/client.ml
@@ -2,7 +2,7 @@ open Async
 
 module Make(T : S.Token) = struct
     include T
-    
+
     module Http = Http.Make(T)
     module Sharder = Sharder.Make(Http)
 
@@ -20,7 +20,7 @@ module Make(T : S.Token) = struct
         }
 
     let start ?count client =
-        Sharder.start ?count client.token
+        Sharder.start ?count ()
         >>| fun sharder ->
         Ivar.fill_if_empty client.sharder sharder;
         client
@@ -28,12 +28,12 @@ module Make(T : S.Token) = struct
     let set_status ~status client =
         Ivar.read client.sharder
         >>= fun sharder ->
-        Sharder.set_status sharder status
+        Sharder.set_status ~status sharder
 
     let set_status_with ~f client =
         Ivar.read client.sharder
         >>= fun sharder ->
-        Sharder.set_status_with sharder f
+        Sharder.set_status_with ~f sharder
 
     let request_guild_members ~guild ?query ?limit client =
         Ivar.read client.sharder
diff --git a/lib/http.ml b/lib/http.ml
index 8cc56fb..6f14a22 100644
--- a/lib/http.ml
+++ b/lib/http.ml
@@ -1,7 +1,6 @@
-open Async
-open Cohttp
-
 module Make(T : S.Token) = struct
+    open Async
+    open Cohttp
     include T
 
     module Base = struct
@@ -18,7 +17,7 @@ module Make(T : S.Token) = struct
             |> Cohttp_async.Body.of_string
 
         let process_request_headers () =
-            let h = Header.init () in 
+            let h = Header.init () in
             Header.add_list h [
                 "User-Agent", "Dis.ml v0.1.0";
                 "Authorization", ("Bot " ^ token);
@@ -26,7 +25,7 @@ module Make(T : S.Token) = struct
             ]
 
         (* TODO Finish processor *)
-        let process_response (_resp, body) =
+        let process_response ((_resp:Response.t), body) =
             body |> Cohttp_async.Body.to_string >>| Yojson.Basic.from_string
 
         let request ?(body=`Null) m path =
diff --git a/lib/http.mli b/lib/http.mli
index caf2ad7..858420a 100644
--- a/lib/http.mli
+++ b/lib/http.mli
@@ -1 +1 @@
-module Make(T: S.Token) : S.Http
\ No newline at end of file
+module Make(T : S.Token) : S.Http
\ No newline at end of file
diff --git a/lib/s.ml b/lib/s.ml
index 454d2e7..ce1bef7 100644
--- a/lib/s.ml
+++ b/lib/s.ml
@@ -6,6 +6,8 @@ module type Token = sig
 end
 
 module type Http = sig
+    val token : string
+
     module Base : sig
         exception Invalid_Method
 
@@ -13,20 +15,177 @@ module type Http = sig
 
         val process_url : string -> Uri.t
         val process_request_body : Yojson.Basic.json -> Cohttp_async.Body.t
-        val process_request_headers : unit -> Headers.t
+        val process_request_headers : unit -> Header.t
 
         val process_response :
             Cohttp_async.Response.t * Cohttp_async.Body.t ->
-            Yojson.Basic.json
+            Yojson.Basic.json Deferred.t
 
         val request :
             ?body:Yojson.Basic.json ->
-            [ `Delete | `Get | `Patch | `Post | `Put ] ->
+            [> `DELETE | `GET | `PATCH | `POST | `PUT ] ->
             string ->
             Yojson.Basic.json Deferred.t
     end
 
-    (* TODO add abstraction sigs *)
+    (* Auto-generated signatures *)
+    val get_gateway : unit -> Yojson.Basic.json Async.Deferred.t
+    val get_gateway_bot : unit -> Yojson.Basic.json Async.Deferred.t
+    val get_channel : string -> Yojson.Basic.json Async.Deferred.t
+    val modify_channel :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val delete_channel : string -> Yojson.Basic.json Async.Deferred.t
+    val get_messages : string -> Yojson.Basic.json Async.Deferred.t
+    val get_message : string -> string -> Yojson.Basic.json Async.Deferred.t
+    val create_message :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val create_reaction :
+      string -> string -> string -> Yojson.Basic.json Async.Deferred.t
+    val delete_own_reaction :
+      string -> string -> string -> Yojson.Basic.json Async.Deferred.t
+    val delete_reaction :
+      string ->
+      string -> string -> string -> Yojson.Basic.json Async.Deferred.t
+    val get_reactions :
+      string -> string -> string -> Yojson.Basic.json Async.Deferred.t
+    val delete_reactions :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val edit_message :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val delete_message :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val bulk_delete :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val edit_channel_permissions :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val get_channel_invites : string -> Yojson.Basic.json Async.Deferred.t
+    val create_channel_invite :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val delete_channel_permission :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val broadcast_typing : string -> Yojson.Basic.json Async.Deferred.t
+    val get_pinned_messages : string -> Yojson.Basic.json Async.Deferred.t
+    val pin_message : string -> string -> Yojson.Basic.json Async.Deferred.t
+    val unpin_message :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val group_recipient_add :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val group_recipient_remove :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val get_emojis : string -> Yojson.Basic.json Async.Deferred.t
+    val get_emoji : string -> string -> Yojson.Basic.json Async.Deferred.t
+    val create_emoji :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val edit_emoji :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val delete_emoji : string -> string -> Yojson.Basic.json Async.Deferred.t
+    val create_guild :
+      Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val get_guild : string -> Yojson.Basic.json Async.Deferred.t
+    val edit_guild :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val delete_guild : string -> Yojson.Basic.json Async.Deferred.t
+    val get_guild_channels : string -> Yojson.Basic.json Async.Deferred.t
+    val create_guild_channel :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val modify_guild_channel_positions :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val get_member : string -> string -> Yojson.Basic.json Async.Deferred.t
+    val get_members : string -> Yojson.Basic.json Async.Deferred.t
+    val add_member :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val edit_member :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val remove_member :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val change_nickname :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val add_member_role :
+      string -> string -> string -> Yojson.Basic.json Async.Deferred.t
+    val remove_member_role :
+      string -> string -> string -> Yojson.Basic.json Async.Deferred.t
+    val get_bans : string -> Yojson.Basic.json Async.Deferred.t
+    val get_ban : string -> string -> Yojson.Basic.json Async.Deferred.t
+    val guild_ban_add :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val guild_ban_remove :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val get_roles : string -> Yojson.Basic.json Async.Deferred.t
+    val guild_role_add :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val guild_roles_edit :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val guild_role_edit :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val guild_role_remove :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val guild_prune_count : string -> Yojson.Basic.json Async.Deferred.t
+    val guild_prune_start :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val get_guild_voice_regions :
+      string -> Yojson.Basic.json Async.Deferred.t
+    val get_guild_invites : string -> Yojson.Basic.json Async.Deferred.t
+    val get_integrations : string -> Yojson.Basic.json Async.Deferred.t
+    val add_integration :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val edit_integration :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val delete_integration :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val sync_integration :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val get_guild_embed : string -> Yojson.Basic.json Async.Deferred.t
+    val edit_guild_embed :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val get_vanity_url : string -> Yojson.Basic.json Async.Deferred.t
+    val get_invite : string -> Yojson.Basic.json Async.Deferred.t
+    val delete_invite : string -> Yojson.Basic.json Async.Deferred.t
+    val get_current_user : unit -> Yojson.Basic.json Async.Deferred.t
+    val edit_current_user :
+      Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val get_guilds : unit -> Yojson.Basic.json Async.Deferred.t
+    val leave_guild : string -> Yojson.Basic.json Async.Deferred.t
+    val get_private_channels : unit -> Yojson.Basic.json Async.Deferred.t
+    val create_dm : Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val create_group_dm :
+      Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val get_connections : unit -> Yojson.Basic.json Async.Deferred.t
+    val get_user : string -> Yojson.Basic.json Async.Deferred.t
+    val get_voice_regions : unit -> Yojson.Basic.json Async.Deferred.t
+    val create_webhook :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val get_channel_webhooks : string -> Yojson.Basic.json Async.Deferred.t
+    val get_guild_webhooks : string -> Yojson.Basic.json Async.Deferred.t
+    val get_webhook : string -> Yojson.Basic.json Async.Deferred.t
+    val get_webhook_with_token :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val edit_webhook :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val edit_webhook_with_token :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val delete_webhook : string -> Yojson.Basic.json Async.Deferred.t
+    val delete_webhook_with_token :
+      string -> string -> Yojson.Basic.json Async.Deferred.t
+    val execute_webhook :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val execute_slack_webhook :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val execute_git_webhook :
+      string ->
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
+    val get_audit_logs :
+      string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t
 end
 
 module type Sharder = sig
@@ -37,29 +196,15 @@ module type Sharder = sig
 
     val start :
         ?count:int ->
-        string ->
+        unit ->
         t Deferred.t
 
-    val set_status :
-        status:Yojson.Basic.json ->
-        t ->
-        (Shard.shard Shard.t) list Deferred.t
-
-    val set_status_with :
-        f:(Shard.shard -> Yojson.Basic.json) ->
-        t ->
-        (Shard.shard Shard.t) list Deferred.t
-
-    val request_guild_members :
-        ?query:string ->
-        ?count:string ->
-        guild:Snowflake.t ->
-        t ->
-        (Shard.shard Shard.t) list Deferred.t
-
     module Shard : sig
         type shard
-        type 'a t
+        type 'a t = {
+            mutable state: 'a;
+            mutable binds: ('a -> unit) list;
+        }
 
         val bind :
             f:('a -> unit) ->
@@ -78,13 +223,31 @@ module type Sharder = sig
         val request_guild_members :
             ?query:string ->
             ?limit:int ->
-            guild:Snowflake.t
+            guild:Snowflake.t ->
+            shard ->
+            shard Deferred.t
 
         val create :
             url:string ->
             shards:int * int ->
-            token:string ->
             unit ->
-            t Deferred.t
+            shard Deferred.t
     end
+
+    val set_status :
+        status:Yojson.Basic.json ->
+        t ->
+        Shard.shard list Deferred.t
+
+    val set_status_with :
+        f:(Shard.shard -> Yojson.Basic.json) ->
+        t ->
+        Shard.shard list Deferred.t
+
+    val request_guild_members :
+        ?query:string ->
+        ?limit:int ->
+        guild:Snowflake.t ->
+        t ->
+        Shard.shard list Deferred.t
 end
\ No newline at end of file
diff --git a/lib/sharder.ml b/lib/sharder.ml
index 0984050..7b14884 100644
--- a/lib/sharder.ml
+++ b/lib/sharder.ml
@@ -1,8 +1,8 @@
-open Async
-open Core
-open Websocket_async
-
 module Make(H: S.Http) = struct
+    open Async
+    open Core
+    open Websocket_async
+
     exception Invalid_Payload
     exception Failure_to_Establish_Heartbeat
 
@@ -20,7 +20,7 @@ module Make(H: S.Http) = struct
         }
 
         type 'a t = {
-            mutable shard: 'a;
+            mutable state: 'a;
             mutable binds: ('a -> unit) list;
         }
 
@@ -75,7 +75,7 @@ module Make(H: S.Http) = struct
                 session = session;
             }
 
-        let set_status ~status shard =
+        let set_status ~(status:Yojson.Basic.json) shard =
             let payload = match status with
             | `Assoc [("name", `String name); ("type", `Int t)] ->
                 `Assoc [
@@ -102,7 +102,7 @@ module Make(H: S.Http) = struct
             Ivar.read shard.ready >>= fun _ ->
             push_frame ~payload ~ev:STATUS_UPDATE shard
 
-        let request_guild_members ~guild ?(query="") ?(limit=0) shard =
+        let request_guild_members ?(query="") ?(limit=0) ~guild shard =
             let payload = `Assoc [
                 ("guild_id", `String (Snowflake.to_string guild));
                 ("query", `String query);
@@ -136,7 +136,7 @@ module Make(H: S.Http) = struct
             | None -> begin
                 Mutex.lock identify_lock;
                 let payload = `Assoc [
-                    ("token", `String shard.token);
+                    ("token", `String token);
                     ("properties", `Assoc [
                         ("$os", `String Sys.os_type);
                         ("$device", `String "dis.ml");
@@ -155,7 +155,7 @@ module Make(H: S.Http) = struct
             end
             | Some s ->
                 let payload = `Assoc [
-                    ("token", `String shard.token);
+                    ("token", `String token);
                     ("session_id", `String s);
                     ("seq", `Int shard.seq)
                 ] in
@@ -183,7 +183,7 @@ module Make(H: S.Http) = struct
                 print_endline @@ "Invalid Opcode: " ^ Opcode.to_string opcode;
                 return shard
 
-        let rec create ~url ~shards ~token () =
+        let rec create ~url ~shards () =
             let open Core in
             let uri = (url ^ "?v=6&encoding=json") |> Uri.of_string in
             let extra_headers = H.Base.process_request_headers () in
@@ -215,7 +215,6 @@ module Make(H: S.Http) = struct
                     seq = 0;
                     id = shards;
                     session = None;
-                    token;
                     url;
                 }
             in
@@ -240,46 +239,46 @@ module Make(H: S.Http) = struct
             | Some hb -> Ivar.fill_if_empty hb ()
             | None -> ()
             );
-            create ~url:(shard.url) ~shards:(shard.id) ~token:(shard.token) ()
+            create ~url:(shard.url) ~shards:(shard.id) ()
     end
 
     type t = {
         shards: (Shard.shard Shard.t) list;
     }
 
-    let start ?count token =
+    let start ?count () =
         let module J = Yojson.Basic.Util in
-        Http.get_gateway_bot () >>= fun data ->
+        H.get_gateway_bot () >>= fun data ->
         let url = J.(member "url" data |> to_string) in
         let count = match count with
         | Some c -> c
         | None -> J.(member "shards" data |> to_int)
         in
         let shard_list = (0, count) in
-        let rec ev_loop t =
-            let (read, _) = t.shard.pipe in
+        let rec ev_loop (t:Shard.shard Shard.t) =
+            let (read, _) = t.state.pipe in
             Pipe.read read
-            >>| fun frame ->
-            let _ = match parse frame with
+            >>= fun frame ->
+            let _ = match Shard.parse frame with
             | Some f -> begin
-                handle_frame ~f t.shard
+                Shard.handle_frame ~f t.state
                 >>> fun shard ->
-                t.shard <- shard;
+                t.state <- shard;
             end
-            | None -> t.shard <- recreate t.shard;
+            | None -> Shard.recreate t.state >>> fun s -> t.state <- s;
             in
-            t
+            return t
             >>= fun t ->
-            List.iter ~f:(fun f -> f t.shard) t.binds;
+            List.iter ~f:(fun f -> f t.state) t.binds;
             ev_loop t
         in
         let rec gen_shards l a =
             match l with
             | (id, total) when id >= total -> return a
             | (id, total) ->
-                Shard.create ~url ~shards:(id, total) ~token ()
+                Shard.create ~url ~shards:(id, total) ()
                 >>= fun shard ->
-                let t = { shard; binds = []; } in
+                let t = Shard.{ state = shard; binds = []; } in
                 ev_loop t >>> ignore;
                 gen_shards (id+1, total) (t :: a)
         in
@@ -289,16 +288,16 @@ module Make(H: S.Http) = struct
 
     let set_status ~status sharder =
         Deferred.all @@ List.map ~f:(fun t ->
-            Shard.set_status ~status t.shard
+            Shard.set_status ~status t.state
         ) sharder.shards
 
     let set_status_with ~f sharder =
         Deferred.all @@ List.map ~f:(fun t ->
-            Shard.set_status ~status:(f t.shard) t.shard
+            Shard.set_status ~status:(f t.state) t.state
         ) sharder.shards
 
-    let request_guild_members ~guild ?query ?limit sharder =
+    let request_guild_members ?query ?limit ~guild sharder =
         Deferred.all @@ List.map ~f:(fun t ->
-            Shard.request_guild_members ~guild ?query ?limit t.shard
+            Shard.request_guild_members ~guild ?query ?limit t.state
         ) sharder.shards
 end
\ No newline at end of file