Add proper type parsing to Guild

3 files changed, 93 insertions, 50 deletions

diff --git a/lib/event.ml b/lib/event.ml
index bbb0ebf..988e017 100644
--- a/lib/event.ml
+++ b/lib/event.ml
@@ -39,11 +39,16 @@ type t =
 
 exception Invalid_event of string
 
-let wrap_role Role_t.{ id; role; } =
-        let open Role_t in
-        let guild_id = id in
-        let {id;name;colour;hoist;position;permissions;managed;mentionable} = role in
-        {id;name;colour;hoist;position;permissions;managed;mentionable;guild_id}
+let wrap_role_update Role_t.{ id; role; } =
+    let open Role_t in
+    let guild_id = id in
+    let {id;name;colour;hoist;position;permissions;managed;mentionable} = role in
+    {id;name;colour;hoist;position;permissions;managed;mentionable;guild_id}
+
+let wrap_role_with_id ~guild_id role =
+    let open Role_t in
+    let {id;name;colour;hoist;position;permissions;managed;mentionable} = role in
+    {id;name;colour;hoist;position;permissions;managed;mentionable;guild_id}
 
 let event_of_string ~contents t = match t with
     | "HELLO" -> HELLO (Yojson.Safe.from_string contents)
@@ -65,9 +70,9 @@ let event_of_string ~contents t = match t with
     | "GUILD_MEMBER_REMOVE" -> GUILD_MEMBER_REMOVE (Member_j.t_of_string contents)
     | "GUILD_MEMBER_UPDATE" -> GUILD_MEMBER_UPDATE (Member_j.t_of_string contents)
     | "GUILD_MEMBERS_CHUNK" -> GUILD_MEMBERS_CHUNK (Yojson.Safe.(from_string contents |> Util.to_list) |> List.map ~f:(fun m -> Yojson.Safe.to_string m |> Member_j.t_of_string))
-    | "GUILD_ROLE_CREATE" -> GUILD_ROLE_CREATE (Role_j.role_update_of_string contents |> wrap_role)
-    | "GUILD_ROLE_UPDATE" -> GUILD_ROLE_UPDATE (Role_j.role_update_of_string contents |> wrap_role)
-    | "GUILD_ROLE_DELETE" -> GUILD_ROLE_DELETE (Role_j.role_update_of_string contents |> wrap_role)
+    | "GUILD_ROLE_CREATE" -> GUILD_ROLE_CREATE (Role_j.role_update_of_string contents |> wrap_role_update)
+    | "GUILD_ROLE_UPDATE" -> GUILD_ROLE_UPDATE (Role_j.role_update_of_string contents |> wrap_role_update)
+    | "GUILD_ROLE_DELETE" -> GUILD_ROLE_DELETE (Role_j.role_update_of_string contents |> wrap_role_update)
     | "MESSAGE_CREATE" -> MESSAGE_CREATE (Message_j.t_of_string contents)
     | "MESSAGE_UPDATE" -> MESSAGE_UPDATE (Message_j.t_of_string contents)
     | "MESSAGE_DELETE" -> MESSAGE_DELETE (Message_j.t_of_string contents)
diff --git a/lib/models/guild.ml b/lib/models/guild.ml
index b4e2a64..1e870f9 100644
--- a/lib/models/guild.ml
+++ b/lib/models/guild.ml
@@ -9,14 +9,14 @@ module Make(Http : S.Http) = struct
         Http.guild_ban_add guild.id id (`Assoc [
             ("delete-message-days", `Int days);
             ("reason", `String reason);
-        ])
+        ]) >>| Result.map ~f:ignore
 
     let create_emoji ~name ~image guild =
         Http.create_emoji guild.id (`Assoc [
             ("name", `String name);
             ("image", `String image);
             ("roles", `List []);
-        ])
+        ]) >>| Result.map ~f:Emoji_j.t_of_string
 
     let create_role ~name ?colour ?permissions ?hoist ?mentionable guild =
         let payload = ("name", `String name) :: [] in
@@ -33,6 +33,9 @@ module Make(Http : S.Http) = struct
         | Some m -> ("mentionable", `Bool m) :: payload
         | None -> payload
         in Http.guild_role_add guild.id (`Assoc payload)
+         >>| Result.map ~f:(fun r ->
+            Role_j.role_of_string r 
+            |> Event.wrap_role_with_id ~guild_id:guild.id)
     
     let create_channel ~mode ~name guild =
         let kind = match mode with
@@ -42,65 +45,100 @@ module Make(Http : S.Http) = struct
         in Http.create_guild_channel guild.id (`Assoc [
             ("name", `String name);
             ("type", `Int kind);
-        ])
+        ]) >>| Result.map ~f:Channel_j.t_of_string
     
-    let delete guild = Http.delete_guild guild.id
-    let get_ban ~id guild = Http.get_ban guild.id id
-    let get_bans guild = Http.get_bans guild.id
+    let delete guild =
+        Http.delete_guild guild.id >>| Result.map ~f:ignore
+
+    let get_ban ~id guild =
+        Http.get_ban guild.id id >>| Result.map ~f:Ban_j.t_of_string
+    
+    let get_bans guild =
+        Http.get_bans guild.id >>| Result.map ~f:(fun bans ->
+            Yojson.Safe.from_string bans
+            |> Yojson.Safe.Util.to_list
+            |> List.map ~f:(fun ban ->
+                Yojson.Safe.to_string ban
+                |> Ban_j.t_of_string))
 
     let get_channel ~id guild =
         match List.find ~f:(fun c -> c.id = id) guild.channels with
         | Some c -> Deferred.Or_error.return c
-        | None -> Http.get_channel id >>| fun c ->
-            Result.(c >>| Channel_j.t_of_string)
+        | None -> Http.get_channel id >>| Result.map ~f:Channel_j.t_of_string
     
-    let get_emoji ~id guild = Http.get_emoji guild.id id
-    let get_invites guild = Http.get_guild_invites guild.id
+    let get_emoji ~id guild =
+        Http.get_emoji guild.id id >>| Result.map ~f:Emoji_j.t_of_string
+
+    (* TODO add invite abstraction? *)
+    let get_invites guild =
+        Http.get_guild_invites guild.id
 
     let get_member ~id guild =
         match List.find ~f:(fun m -> m.user.id = id) guild.members with
         | Some m -> Deferred.Or_error.return m
-        | None -> Http.get_member guild.id id >>| fun m ->
-             Result.(m >>| Member_j.t_of_string)
+        | None -> Http.get_member guild.id id >>| Result.map ~f:Member_j.t_of_string
 
-    let get_prune_count ~days guild = Http.guild_prune_count guild.id days
+    let get_prune_count ~days guild =
+        Http.guild_prune_count guild.id days >>| Result.map ~f:(fun prune ->
+            Yojson.Safe.(from_string prune
+            |> Util.member "pruned"
+            |> Util.to_int))
 
+    (* TODO add HTTP fallback *)
     let get_role ~id guild =
         let role = List.find ~f:(fun r -> r.id = id) guild.roles in
-        Option.(role >>| fun role -> Event.wrap_role { role; id=guild.id; })
+        Option.(role >>| Event.wrap_role_with_id ~guild_id:guild.id)
     
-    let get_webhooks guild = Http.get_guild_webhooks guild.id
+    (* TODO add webhook abstraction? *)
+    let get_webhooks guild =
+        Http.get_guild_webhooks guild.id
 
     let kick_user ~id ?reason guild =
         let payload = match reason with
         | Some r -> `Assoc [("reason", `String r)]
         | None -> `Null
-        in Http.remove_member guild.id id payload
+        in Http.remove_member guild.id id payload >>| Result.map ~f:ignore
 
-    let leave guild = Http.leave_guild guild.id
-    let list_voice_regions guild = Http.get_guild_voice_regions guild.id
-    let prune ~days guild = Http.guild_prune_start guild.id days
-    let request_members guild = Http.get_members guild.id
+    let leave guild =
+        Http.leave_guild guild.id
+
+    (* TODO Voice region abstractions? *)
+    let list_voice_regions guild =
+        Http.get_guild_voice_regions guild.id
+
+    let prune ~days guild =
+        Http.guild_prune_start guild.id days >>| Result.map ~f:(fun prune ->
+            Yojson.Safe.(from_string prune
+            |> Util.member "pruned"
+            |> Util.to_int))
+    
+    let request_members guild =
+        Http.get_members guild.id >>| Result.map ~f:(fun members ->
+            Yojson.Safe.from_string members
+            |> Yojson.Safe.Util.to_list
+            |> List.map ~f:(fun ban ->
+                Yojson.Safe.to_string ban
+                |> Member_j.t_of_string))
 
     let set_afk_channel ~id guild = Http.edit_guild guild.id (`Assoc [
         ("afk_channel_id", `Int id);
-    ])
+    ]) >>| Result.map ~f:Guild_j.t_of_string
 
     let set_afk_timeout ~timeout guild = Http.edit_guild guild.id (`Assoc [
         ("afk_timeout", `Int timeout);
-    ])
+    ]) >>| Result.map ~f:Guild_j.t_of_string
 
     let set_name ~name guild = Http.edit_guild guild.id (`Assoc [
         ("name", `String name);
-    ])
+    ]) >>| Result.map ~f:Guild_j.t_of_string
 
     let set_icon ~icon guild = Http.edit_guild guild.id (`Assoc [
         ("icon", `String icon);
-    ])
+    ]) >>| Result.map ~f:Guild_j.t_of_string
 
     let unban_user ~id ?reason guild =
         let payload = match reason with
         | Some r -> `Assoc [("reason", `String r)]
         | None -> `Null
-        in Http.guild_ban_remove guild.id id payload
+        in Http.guild_ban_remove guild.id id payload >>| Result.map ~f:ignore
 end
\ No newline at end of file
diff --git a/lib/s.ml b/lib/s.ml
index a1b1699..657b010 100644
--- a/lib/s.ml
+++ b/lib/s.ml
@@ -35,8 +35,8 @@ end
 
 module type Guild = sig
     type t = Guild_t.t
-    val ban_user : id:Snowflake_t.t -> ?reason:string -> ?days:int -> Guild_t.t -> string Deferred.Or_error.t
-    val create_emoji : name:string -> image:string -> Guild_t.t -> string Deferred.Or_error.t
+    val ban_user : id:Snowflake_t.t -> ?reason:string -> ?days:int -> Guild_t.t -> unit Deferred.Or_error.t
+    val create_emoji : name:string -> image:string -> Guild_t.t -> Emoji_t.t Deferred.Or_error.t
     val create_role :
         name:string ->
         ?colour:int ->
@@ -44,28 +44,28 @@ module type Guild = sig
         ?hoist:bool ->
         ?mentionable:bool ->
         Guild_t.t ->
-        string Deferred.Or_error.t
-    val create_channel : mode:[ `Text | `Voice | `Category ] -> name:string -> Guild_t.t -> string Deferred.Or_error.t
-    val delete : Guild_t.t -> string Deferred.Or_error.t
-    val get_ban : id:Snowflake_t.t -> Guild_t.t -> string Deferred.Or_error.t
-    val get_bans : Guild_t.t -> string Deferred.Or_error.t
+        Role_t.t Deferred.Or_error.t
+    val create_channel : mode:[ `Text | `Voice | `Category ] -> name:string -> Guild_t.t -> Channel_t.t Deferred.Or_error.t
+    val delete : Guild_t.t -> unit Deferred.Or_error.t
+    val get_ban : id:Snowflake_t.t -> Guild_t.t -> Ban_t.t Deferred.Or_error.t
+    val get_bans : Guild_t.t -> Ban_t.t list Deferred.Or_error.t
     val get_channel : id:Snowflake_t.t -> Guild_t.t -> Channel_t.t Deferred.Or_error.t
-    val get_emoji : id:Snowflake_t.t -> Guild_t.t -> string Deferred.Or_error.t
+    val get_emoji : id:Snowflake_t.t -> Guild_t.t -> Emoji_t.t Deferred.Or_error.t
     val get_invites : Guild_t.t -> string Deferred.Or_error.t
     val get_member : id:Snowflake_t.t -> Guild_t.t -> Member_t.t Deferred.Or_error.t
-    val get_prune_count : days:int -> Guild_t.t -> string Deferred.Or_error.t
+    val get_prune_count : days:int -> Guild_t.t -> int Deferred.Or_error.t
     val get_role : id:Snowflake_t.t -> Guild_t.t -> Role_t.t option
     val get_webhooks : Guild_t.t -> string Deferred.Or_error.t
-    val kick_user : id:Snowflake_t.t -> ?reason:string -> Guild_t.t -> string Deferred.Or_error.t
+    val kick_user : id:Snowflake_t.t -> ?reason:string -> Guild_t.t -> unit Deferred.Or_error.t
     val leave : Guild_t.t -> string Deferred.Or_error.t
     val list_voice_regions : Guild_t.t -> string Deferred.Or_error.t
-    val prune : days:int -> Guild_t.t -> string Deferred.Or_error.t
-    val request_members : Guild_t.t -> string Deferred.Or_error.t
-    val set_afk_channel : id:Snowflake_t.t -> Guild_t.t -> string Deferred.Or_error.t
-    val set_afk_timeout : timeout:int -> Guild_t.t -> string Deferred.Or_error.t
-    val set_name : name:string -> Guild_t.t -> string Deferred.Or_error.t
-    val set_icon : icon:string -> Guild_t.t -> string Deferred.Or_error.t
-    val unban_user : id:Snowflake_t.t -> ?reason:string -> Guild_t.t -> string Deferred.Or_error.t
+    val prune : days:int -> Guild_t.t -> int Deferred.Or_error.t
+    val request_members : Guild_t.t -> Member_t.t list Deferred.Or_error.t
+    val set_afk_channel : id:Snowflake_t.t -> Guild_t.t -> Guild_t.t Deferred.Or_error.t
+    val set_afk_timeout : timeout:int -> Guild_t.t -> Guild_t.t Deferred.Or_error.t
+    val set_name : name:string -> Guild_t.t -> Guild_t.t Deferred.Or_error.t
+    val set_icon : icon:string -> Guild_t.t -> Guild_t.t Deferred.Or_error.t
+    val unban_user : id:Snowflake_t.t -> ?reason:string -> Guild_t.t -> unit Deferred.Or_error.t
 end
 
 module type Member = sig