From 57df76de6441899b659e30c6a8e9d7572b85f7a0 Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Mon, 17 Dec 2018 13:13:10 -0700 Subject: Some abstractions --- lib/models/guild.ml | 98 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 98 insertions(+) (limited to 'lib/models/guild.ml') diff --git a/lib/models/guild.ml b/lib/models/guild.ml index 36b7d4b..ade67be 100644 --- a/lib/models/guild.ml +++ b/lib/models/guild.ml @@ -1,2 +1,100 @@ module Make(Http : S.Http) = struct + open Core + open Async + open Guild_t + + let ban_user ~id ?(reason="") ?(days=0) guild = + Http.guild_ban_add guild.id id (`Assoc [ + ("delete-message-days", `Int days); + ("reason", `String reason); + ]) + + let create_emoji ~name ~image guild = + Http.create_emoji guild.id (`Assoc [ + ("name", `String name); + ("image", `String image); + ("roles", `List []); + ]) + + let create_role ~name ?colour ?permissions ?hoist ?mentionable guild = + let payload = ("name", `String name) :: [] in + let payload = match permissions with + | Some p -> ("permissions", `Int p) :: payload + | None -> payload + in let payload = match colour with + | Some c -> ("color", `Int c) :: payload + | None -> payload + in let payload = match hoist with + | Some h -> ("hoist", `Bool h) :: payload + | None -> payload + in let payload = match mentionable with + | Some m -> ("mentionable", `Bool m) :: payload + | None -> payload + in Http.guild_role_add guild.id (`Assoc payload) + + let create_channel ~mode ~name guild = + let kind = match mode with + | `Text -> 0 + | `Voice -> 2 + | `Category -> 4 + in Http.create_guild_channel guild.id (`Assoc [ + ("name", `String name); + ("type", `Int kind); + ]) + + 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 get_channel ~id guild = + match List.find ~f:(fun c -> c.id = id) guild.channels with + | Some c -> return c + | None -> Http.get_channel id >>| fun c -> + c |> Yojson.Safe.to_string |> 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_member ~id guild = + match List.find ~f:(fun m -> m.user.id = id) guild.members with + | Some m -> return m + | None -> Http.get_member guild.id id >>| fun m -> + m |> Yojson.Safe.to_string |> Member_j.t_of_string + + let get_prune_count ~days guild = Http.guild_prune_count guild.id days + let get_role ~id guild = List.find ~f:(fun r -> r.id = id) guild.roles + 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 + + 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 set_afk_channel ~id guild = Http.edit_guild guild.id (`Assoc [ + ("afk_channel_id", `Int id); + ]) + + let set_afk_timeout ~timeout guild = Http.edit_guild guild.id (`Assoc [ + ("afk_timeout", `Int timeout); + ]) + + let set_name ~name guild = Http.edit_guild guild.id (`Assoc [ + ("name", `String name); + ]) + + let set_icon ~icon guild = Http.edit_guild guild.id (`Assoc [ + ("icon", `String icon); + ]) + + 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 end \ No newline at end of file -- cgit v1.2.3 From 10ff247b7643fb0bb3aade5faff37c569feb0a20 Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Mon, 17 Dec 2018 15:04:02 -0700 Subject: More stuff --- lib/models/guild.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'lib/models/guild.ml') diff --git a/lib/models/guild.ml b/lib/models/guild.ml index ade67be..7364327 100644 --- a/lib/models/guild.ml +++ b/lib/models/guild.ml @@ -62,7 +62,11 @@ module Make(Http : S.Http) = struct m |> Yojson.Safe.to_string |> Member_j.t_of_string let get_prune_count ~days guild = Http.guild_prune_count guild.id days - let get_role ~id guild = List.find ~f:(fun r -> r.id = id) guild.roles + + let get_role ~id guild = + let role = List.find ~f:(fun r -> r.id = id) guild.roles in + Option.(role >>| fun role -> Role.wrap { role; id=guild.id; }) + let get_webhooks guild = Http.get_guild_webhooks guild.id let kick_user ~id ?reason guild = -- cgit v1.2.3 From 792c8c437f45d9fd2529f1ccab27faf79d98ba91 Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Mon, 17 Dec 2018 16:09:35 -0700 Subject: Some refactoring of http code --- lib/models/guild.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lib/models/guild.ml') diff --git a/lib/models/guild.ml b/lib/models/guild.ml index 7364327..381de15 100644 --- a/lib/models/guild.ml +++ b/lib/models/guild.ml @@ -48,18 +48,18 @@ module Make(Http : S.Http) = struct let get_channel ~id guild = match List.find ~f:(fun c -> c.id = id) guild.channels with - | Some c -> return c + | Some c -> Deferred.Or_error.return c | None -> Http.get_channel id >>| fun c -> - c |> Yojson.Safe.to_string |> Channel_j.t_of_string + Result.(c >>| 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_member ~id guild = match List.find ~f:(fun m -> m.user.id = id) guild.members with - | Some m -> return m + | Some m -> Deferred.Or_error.return m | None -> Http.get_member guild.id id >>| fun m -> - m |> Yojson.Safe.to_string |> Member_j.t_of_string + Result.(m >>| Member_j.t_of_string) let get_prune_count ~days guild = Http.guild_prune_count guild.id days -- cgit v1.2.3 From 1a73007b3aaa17940173eaff1eb4f6703fd9ec0c Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Wed, 19 Dec 2018 13:44:04 -0700 Subject: Re-arrange autogen serialization files and incorporate into dune file --- lib/models/guild.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lib/models/guild.ml') diff --git a/lib/models/guild.ml b/lib/models/guild.ml index 381de15..b4e2a64 100644 --- a/lib/models/guild.ml +++ b/lib/models/guild.ml @@ -3,6 +3,8 @@ module Make(Http : S.Http) = struct open Async open Guild_t + type t = Guild_t.t + let ban_user ~id ?(reason="") ?(days=0) guild = Http.guild_ban_add guild.id id (`Assoc [ ("delete-message-days", `Int days); @@ -65,7 +67,7 @@ module Make(Http : S.Http) = struct let get_role ~id guild = let role = List.find ~f:(fun r -> r.id = id) guild.roles in - Option.(role >>| fun role -> Role.wrap { role; id=guild.id; }) + Option.(role >>| fun role -> Event.wrap_role { role; id=guild.id; }) let get_webhooks guild = Http.get_guild_webhooks guild.id -- cgit v1.2.3 From 9ed5707b63eadb17561fb8d23b0192c726398e6e Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Wed, 19 Dec 2018 15:10:57 -0700 Subject: Add proper type parsing to Guild --- lib/models/guild.ml | 88 ++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 63 insertions(+), 25 deletions(-) (limited to 'lib/models/guild.ml') 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 -- cgit v1.2.3 From 66e1462b8dd3f2b89cf066f314eeb9070b05be69 Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Wed, 19 Dec 2018 15:50:16 -0700 Subject: Fix member abstraction and helper methods --- lib/models/guild.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lib/models/guild.ml') diff --git a/lib/models/guild.ml b/lib/models/guild.ml index 1e870f9..a10cd6c 100644 --- a/lib/models/guild.ml +++ b/lib/models/guild.ml @@ -35,7 +35,7 @@ module Make(Http : S.Http) = struct 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) + |> Event.wrap_role ~guild_id:guild.id) let create_channel ~mode ~name guild = let kind = match mode with @@ -87,7 +87,7 @@ module Make(Http : S.Http) = struct (* TODO add HTTP fallback *) let get_role ~id guild = let role = List.find ~f:(fun r -> r.id = id) guild.roles in - Option.(role >>| Event.wrap_role_with_id ~guild_id:guild.id) + Option.(role >>| Event.wrap_role ~guild_id:guild.id) (* TODO add webhook abstraction? *) let get_webhooks guild = -- cgit v1.2.3 From 9e3c97eb4f5d8a808844cb2e448371ce1cc150e1 Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Thu, 20 Dec 2018 16:03:27 -0700 Subject: Working with Discord's channel bullshit --- lib/models/guild.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lib/models/guild.ml') diff --git a/lib/models/guild.ml b/lib/models/guild.ml index a10cd6c..733fc9f 100644 --- a/lib/models/guild.ml +++ b/lib/models/guild.ml @@ -47,7 +47,7 @@ module Make(Http : S.Http) = struct ("type", `Int kind); ]) >>| Result.map ~f:Channel_j.t_of_string - let delete guild = + let delete guild = Http.delete_guild guild.id >>| Result.map ~f:ignore let get_ban ~id guild = @@ -63,8 +63,8 @@ module Make(Http : S.Http) = struct 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 >>| Result.map ~f:Channel_j.t_of_string + | Some c -> Channel_j.(string_of_channel_wrapper c |> t_of_string) |> Deferred.Or_error.return + | None -> Http.get_channel id >>| Result.map ~f:Event.wrap_channel let get_emoji ~id guild = Http.get_emoji guild.id id >>| Result.map ~f:Emoji_j.t_of_string @@ -76,7 +76,7 @@ module Make(Http : S.Http) = struct 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 >>| Result.map ~f:Member_j.t_of_string + | None -> Http.get_member guild.id id >>| Result.map ~f:Member_j.member_of_string let get_prune_count ~days guild = Http.guild_prune_count guild.id days >>| Result.map ~f:(fun prune -> -- cgit v1.2.3