diff options
Diffstat (limited to 'lib/models')
52 files changed, 256 insertions, 189 deletions
diff --git a/lib/models/channel/channel.ml b/lib/models/channel/channel.ml index 52eda02..47cf500 100644 --- a/lib/models/channel/channel.ml +++ b/lib/models/channel/channel.ml @@ -6,7 +6,7 @@ exception No_message_found let send_message ?embed ?content ?file ?(tts=false) ch =
let embed = match embed with
- | Some e -> Embed.yojson_of_t e
+ | Some e -> Embed.to_yojson e
| None -> `Null in
let content = match content with
| Some c -> `String c
@@ -33,13 +33,16 @@ let delete ch = let get_message ~id ch =
Http.get_message (get_id ch) id
-let get_messages ?(mode=`Around) ~id ?(limit=50) ch =
+let get_messages ?(mode=`Around) ?id ?(limit=50) ch =
let kind = match mode with
- | `Around -> "around", id
- | `Before -> "before", id
- | `After -> "after", id
+ | `Around -> "around", limit
+ | `Before -> "before", limit
+ | `After -> "after", limit
in
- Http.get_messages (get_id ch) limit kind
+ let id = match id with
+ | Some id -> id
+ | None -> raise No_message_found in
+ Http.get_messages (get_id ch) id kind
let broadcast_typing ch =
Http.broadcast_typing (get_id ch)
@@ -48,5 +51,5 @@ let get_pins ch = Http.get_pinned_messages (get_id ch)
let bulk_delete msgs ch =
- let msgs = `List (List.map ~f:(fun id -> `Intlit (Int64.to_string id)) msgs) in
+ let msgs = `List (List.map ~f:(fun id -> `Int id) msgs) in
Http.bulk_delete (get_id ch) msgs
\ No newline at end of file diff --git a/lib/models/channel/channel.mli b/lib/models/channel/channel.mli index cb01533..0d7431b 100644 --- a/lib/models/channel/channel.mli +++ b/lib/models/channel/channel.mli @@ -36,7 +36,7 @@ val delete : t -> Channel_t.t Deferred.Or_error.t val get_message : id:Snowflake.t -> t -> Message_t.t Deferred.Or_error.t
val get_messages :
?mode:[ `Before | `After | `Around ] ->
- id:Snowflake.t ->
+ ?id:Snowflake.t ->
?limit:int ->
t ->
Message_t.t list Deferred.Or_error.t
diff --git a/lib/models/channel/channel_t.ml b/lib/models/channel/channel_t.ml index a103090..e332c36 100644 --- a/lib/models/channel/channel_t.ml +++ b/lib/models/channel/channel_t.ml @@ -10,13 +10,13 @@ type group = { name: string option [@default None];
owner_id: User_id_t.t;
recipients: User_t.t list [@default []];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type dm = {
id: Channel_id_t.t;
last_message_id: Message_id.t option [@default None];
last_pin_timestamp: string option [@default None];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type guild_text = {
id: Channel_id_t.t;
@@ -30,7 +30,7 @@ type guild_text = { nsfw: bool;
slow_mode_timeout: int option [@default None];
permission_overwrites: Overwrites.t list [@default []];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type guild_voice = {
id: Channel_id_t.t;
@@ -41,7 +41,7 @@ type guild_voice = { user_limit: int [@default -1];
bitrate: int option [@default None];
permission_overwrites: Overwrites.t list [@default []];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type category = {
id: Channel_id_t.t;
@@ -49,7 +49,7 @@ type category = { position: int;
name: string;
permission_overwrites: Overwrites.t list [@default []];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type t = [
| `Group of group
@@ -57,7 +57,7 @@ type t = [ | `GuildText of guild_text
| `GuildVoice of guild_voice
| `Category of category
-] [@@deriving sexp, yojson]
+] [@@deriving sexp, yojson { strict = false; exn = true }]
type channel_wrapper = {
id: Channel_id_t.t;
@@ -78,7 +78,7 @@ type channel_wrapper = { category_id: Channel_id_t.t option [@default None][@key "parent_id"];
last_pin_timestamp: string option [@default None];
permission_overwrites: Overwrites.t list [@default []];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
let unwrap_as_guild_text {id;guild_id;position;name;topic;nsfw;last_message_id;slow_mode_timeout;category_id;last_pin_timestamp;permission_overwrites;_} =
let position = Option.value_exn position in
@@ -112,7 +112,7 @@ let wrap s = | 2 -> `GuildVoice (unwrap_as_guild_voice s)
| 3 -> `Group (unwrap_as_group s)
| 4 -> `Category (unwrap_as_category s)
- | _ -> raise (Invalid_channel (yojson_of_channel_wrapper s))
+ | _ -> raise (Invalid_channel (channel_wrapper_to_yojson s))
let get_id (c:t) = match c with
| `Group g -> let `Channel_id id = g.id in id
diff --git a/lib/models/channel/channel_t.mli b/lib/models/channel/channel_t.mli index f5d538b..c6c6a0b 100644 --- a/lib/models/channel/channel_t.mli +++ b/lib/models/channel/channel_t.mli @@ -9,14 +9,14 @@ type group = { name: string option;
owner_id: User_id_t.t;
recipients: User_t.t list;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** Represents a private channel with a single user. *)
type dm = {
id: Channel_id_t.t;
last_message_id: Message_id.t option;
last_pin_timestamp: string option;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** Represents a text channel in a guild. *)
type guild_text = {
@@ -31,7 +31,7 @@ type guild_text = { nsfw: bool;
slow_mode_timeout: int option;
permission_overwrites: Overwrites.t list;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** Represents a voice channel in a guild. *)
type guild_voice = {
@@ -43,7 +43,7 @@ type guild_voice = { user_limit: int;
bitrate: int option;
permission_overwrites: Overwrites.t list;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** Represents a guild category. *)
type category = {
@@ -52,7 +52,7 @@ type category = { position: int;
name: string;
permission_overwrites: Overwrites.t list;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** Wrapper variant for all channel types. *)
type t = [
@@ -61,7 +61,7 @@ type t = [ | `GuildText of guild_text
| `GuildVoice of guild_voice
| `Category of category
-] [@@deriving sexp, yojson]
+] [@@deriving sexp, yojson { exn = true }]
(** Intermediate used internally. *)
type channel_wrapper = {
@@ -83,7 +83,7 @@ type channel_wrapper = { category_id: Channel_id_t.t option;
last_pin_timestamp: string option;
permission_overwrites: Overwrites.t list;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
val unwrap_as_guild_text : channel_wrapper -> guild_text
diff --git a/lib/models/channel/message/attachment.ml b/lib/models/channel/message/attachment.ml index cf52078..d720a81 100644 --- a/lib/models/channel/message/attachment.ml +++ b/lib/models/channel/message/attachment.ml @@ -8,4 +8,4 @@ type t = { proxy_url: string; height: int [@default -1]; width: int [@default -1]; -} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { strict = false; exn = true }]
\ No newline at end of file diff --git a/lib/models/channel/message/attachment.mli b/lib/models/channel/message/attachment.mli index f935471..56006dc 100644 --- a/lib/models/channel/message/attachment.mli +++ b/lib/models/channel/message/attachment.mli @@ -6,4 +6,4 @@ type t = { proxy_url: string;
height: int;
width: int;
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { exn = true }]
\ No newline at end of file diff --git a/lib/models/channel/message/embed.ml b/lib/models/channel/message/embed.ml index e7ebbcc..0dd7343 100644 --- a/lib/models/channel/message/embed.ml +++ b/lib/models/channel/message/embed.ml @@ -4,38 +4,38 @@ type footer = { text: string;
icon_url: string option [@default None];
proxy_icon_url: string option [@default None];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type image = {
url: string option [@default None];
proxy_url: string option [@default None];
height: int option [@default None];
width: int option [@default None];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type video = {
url: string option [@default None];
height: int option [@default None];
width: int option [@default None];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type provider = {
name: string option [@default None];
url: string option [@default None];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type author = {
name: string option [@default None];
url: string option [@default None];
icon_url: string option [@default None];
proxy_icon_url: string option [@default None];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type field = {
name: string;
value: string;
inline: bool [@default false];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type t = {
title: string option [@default None];
@@ -51,7 +51,7 @@ type t = { provider: provider option [@default None];
author: author option [@default None];
fields: field list [@default []];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
let default = {
title = None;
diff --git a/lib/models/channel/message/embed.mli b/lib/models/channel/message/embed.mli index 17fea52..fb86c94 100644 --- a/lib/models/channel/message/embed.mli +++ b/lib/models/channel/message/embed.mli @@ -3,7 +3,7 @@ type footer = { text: string;
icon_url: string option;
proxy_icon_url: string option;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** An image object belonging to an embed. *)
type image = {
@@ -11,20 +11,20 @@ type image = { proxy_url: string option;
height: int option;
width: int option;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** A video object belonging to an embed. *)
type video = {
url: string option;
height: int option;
width: int option;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** A provider object belonging to an embed. *)
type provider = {
name: string option;
url: string option;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** An author object belonging to an embed. *)
type author = {
@@ -32,14 +32,14 @@ type author = { url: string option;
icon_url: string option;
proxy_icon_url: string option;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** A field object belonging to an embed. *)
type field = {
name: string;
value: string;
inline: bool;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** An embed object. See this {{:https://leovoel.github.io/embed-visualizer/}embed visualiser} if you need help understanding each component. *)
type t = {
@@ -56,7 +56,7 @@ type t = { provider: provider option;
author: author option;
fields: field list [@default []];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
(** An embed where all values are empty. *)
val default : t
diff --git a/lib/models/channel/message/message.ml b/lib/models/channel/message/message.ml index 2aaa0da..7f03638 100644 --- a/lib/models/channel/message/message.ml +++ b/lib/models/channel/message/message.ml @@ -6,7 +6,7 @@ let add_reaction msg (emoji:Emoji.t) = let `Message_id id = msg.id in
let `Channel_id channel_id = msg.channel_id in
let e = match emoji.id with
- | Some i -> Printf.sprintf "%s:%Ld" emoji.name i
+ | Some i -> Printf.sprintf "%s:%d" emoji.name i
| None -> emoji.name
in
Http.create_reaction channel_id id e
@@ -15,9 +15,9 @@ let add_reaction msg (emoji:Emoji.t) = let remove_reaction msg (emoji:Emoji.t) (user:User_t.t) =
let `Message_id id = msg.id in
let `Channel_id channel_id = msg.channel_id in
- let user_id = User_id.get_id user.id in
+ let `User_id user_id = user.id in
let e = match emoji.id with
- | Some i -> Printf.sprintf "%s:%Ld" emoji.name i
+ | Some i -> Printf.sprintf "%s:%d" emoji.name i
| None -> emoji.name
in
Http.delete_reaction channel_id id e user_id
@@ -57,13 +57,13 @@ let reply_with ?embed ?content ?files ?tts ?(reply_mention=false) msg = let set_content msg cont =
let `Message_id id = msg.id in
let `Channel_id channel_id = msg.channel_id in
- yojson_of_t { msg with content = cont; }
+ to_yojson { msg with content = cont; }
|> Http.edit_message channel_id id
let set_embed msg embed =
let `Message_id id = msg.id in
let `Channel_id channel_id = msg.channel_id in
- yojson_of_t { msg with embeds = [embed]; }
+ to_yojson { msg with embeds = [embed]; }
|> Http.edit_message channel_id id
diff --git a/lib/models/channel/message/message_t.ml b/lib/models/channel/message/message_t.ml index 0f8e08e..31fc88c 100644 --- a/lib/models/channel/message/message_t.ml +++ b/lib/models/channel/message/message_t.ml @@ -20,4 +20,4 @@ type t = { pinned: bool;
webhook_id: Snowflake.t option [@default None];
kind: int [@key "type"];
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { strict = false; exn = true }]
\ No newline at end of file diff --git a/lib/models/channel/message/message_t.mli b/lib/models/channel/message/message_t.mli index ba8c62a..907565c 100644 --- a/lib/models/channel/message/message_t.mli +++ b/lib/models/channel/message/message_t.mli @@ -19,4 +19,4 @@ type t = { pinned: bool; (** Whether the message is pinned. *)
webhook_id: Snowflake.t option; (** The webhook ID, if the message was sent by a webhook. *)
kind: int; (** See {{:https://discordapp.com/developers/docs/resources/channel#message-object-message-types}the discord docs} for message type enumeration. *)
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { exn = true }]
\ No newline at end of file diff --git a/lib/models/channel/message/reaction_t.ml b/lib/models/channel/message/reaction_t.ml index b072b01..e8ec5a0 100644 --- a/lib/models/channel/message/reaction_t.ml +++ b/lib/models/channel/message/reaction_t.ml @@ -6,9 +6,9 @@ type reaction_event = { message_id: Message_id.t;
guild_id: Guild_id_t.t option [@default None];
emoji: Emoji.partial_emoji;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
type t = {
count: int;
emoji: Emoji.t;
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { strict = false; exn = true }]
\ No newline at end of file diff --git a/lib/models/channel/message/reaction_t.mli b/lib/models/channel/message/reaction_t.mli index ace8f55..f9b2a98 100644 --- a/lib/models/channel/message/reaction_t.mli +++ b/lib/models/channel/message/reaction_t.mli @@ -5,10 +5,10 @@ type reaction_event = { message_id: Message_id.t;
guild_id: Guild_id_t.t option;
emoji: Emoji.partial_emoji;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** Represents a number of emojis used as a reaction on a message. *)
type t = {
count: int;
emoji: Emoji.t;
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { exn = true }]
\ No newline at end of file diff --git a/lib/models/emoji.ml b/lib/models/emoji.ml index f8490e8..09a51ab 100644 --- a/lib/models/emoji.ml +++ b/lib/models/emoji.ml @@ -3,7 +3,7 @@ open Core type partial_emoji = {
id: Snowflake.t option [@default None];
name: string;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type t = {
id: Snowflake.t option [@default None];
@@ -13,4 +13,4 @@ type t = { require_colons: bool [@default false];
managed: bool [@default false];
animated: bool [@default false];
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { strict = false; exn = true }]
\ No newline at end of file diff --git a/lib/models/emoji.mli b/lib/models/emoji.mli index c159a0e..935c13a 100644 --- a/lib/models/emoji.mli +++ b/lib/models/emoji.mli @@ -2,7 +2,7 @@ type partial_emoji = {
id: Snowflake.t option;
name: string;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** A full emoji object. *)
type t = {
@@ -13,4 +13,4 @@ type t = { require_colons: bool; (** Whether the emoji must be wrapped in colons. Is false for unicode emojis. *)
managed: bool; (** Whether the emoji is managed by an integration. *)
animated: bool; (** Whether the emoji is animated. *)
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { exn = true }]
\ No newline at end of file diff --git a/lib/models/event_models.ml b/lib/models/event_models.ml index efaeeaa..40ff299 100644 --- a/lib/models/event_models.ml +++ b/lib/models/event_models.ml @@ -4,7 +4,7 @@ module ChannelCreate = struct type t = Channel_t.t
let deserialize ev =
- Channel_t.(channel_wrapper_of_yojson ev |> wrap)
+ Channel_t.(channel_wrapper_of_yojson_exn ev |> wrap)
let update_cache (cache:Cache.t) (t:t) =
let module C = Cache.ChannelMap in
@@ -35,7 +35,7 @@ module ChannelDelete = struct type t = Channel_t.t
let deserialize ev =
- Channel_t.(channel_wrapper_of_yojson ev |> wrap)
+ Channel_t.(channel_wrapper_of_yojson_exn ev |> wrap)
let update_cache (cache:Cache.t) (t:t) =
let module C = Cache.ChannelMap in
@@ -61,7 +61,7 @@ module ChannelUpdate = struct type t = Channel_t.t
let deserialize ev =
- Channel_t.(channel_wrapper_of_yojson ev |> wrap)
+ Channel_t.(channel_wrapper_of_yojson_exn ev |> wrap)
let update_cache (cache:Cache.t) (t:t) =
let module C = Cache.ChannelMap in
@@ -97,9 +97,9 @@ module ChannelPinsUpdate = struct type t =
{ channel_id: Channel_id.t
; last_pin_timestamp: string option [@default None]
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) t =
let module C = Cache.ChannelMap in
@@ -127,7 +127,7 @@ end type t = {
channel_id: Channel_id.t;
user: User_t.t;
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
@@ -138,7 +138,7 @@ end *) type t = {
channel_id: Channel_id.t;
user: User_t.t;
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
@@ -150,9 +150,9 @@ module GuildBanAdd = struct type t =
{ guild_id: Guild_id.t
; user: User_t.t
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
@@ -161,9 +161,9 @@ module GuildBanRemove = struct type t =
{ guild_id: Guild_id.t
; user: User_t.t
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
@@ -172,7 +172,7 @@ module GuildCreate = struct type t = Guild_t.t
let deserialize ev =
- Guild_t.(pre_of_yojson ev |> wrap)
+ Guild_t.(pre_of_yojson_exn ev |> wrap)
let update_cache (cache:Cache.t) (t:t) =
let open Channel_t in
@@ -221,7 +221,7 @@ module GuildDelete = struct ; unavailable: bool
}
- let deserialize = Guild_t.unavailable_of_yojson
+ let deserialize = Guild_t.unavailable_of_yojson_exn
let update_cache (cache:Cache.t) (t:t) =
let open Channel_t in
@@ -261,7 +261,7 @@ module GuildUpdate = struct type t = Guild_t.t
let deserialize ev =
- Guild_t.(pre_of_yojson ev |> wrap)
+ Guild_t.(pre_of_yojson_exn ev |> wrap)
let update_cache (cache:Cache.t) t =
let open Guild_t in
@@ -275,9 +275,9 @@ module GuildEmojisUpdate = struct type t =
{ emojis: Emoji.t list
; guild_id: Guild_id.t
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) t =
if Cache.GuildMap.mem cache.guilds t.guild_id then
@@ -293,7 +293,7 @@ end module GuildMemberAdd = struct
type t = Member_t.t
- let deserialize = Member_t.t_of_yojson
+ let deserialize = Member_t.of_yojson_exn
let update_cache (cache:Cache.t) (t:t) =
if Cache.GuildMap.mem cache.guilds t.guild_id then
@@ -311,9 +311,9 @@ module GuildMemberRemove = struct type t =
{ guild_id: Guild_id.t
; user: User_t.t
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) t =
if Cache.GuildMap.mem cache.guilds t.guild_id then
@@ -333,9 +333,9 @@ module GuildMemberUpdate = struct ; nick: string option
; roles: Role_id.t list
; user: User_t.t
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) t =
if Cache.GuildMap.mem cache.guilds t.guild_id then
@@ -356,9 +356,9 @@ module GuildMembersChunk = struct type t =
{ guild_id: Guild_id.t
; members: Member_t.member list
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) t =
match Cache.GuildMap.find cache.guilds t.guild_id with
@@ -386,9 +386,9 @@ module GuildRoleCreate = struct type t =
{ guild_id: Guild_id.t
; role: Role_t.role
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) t =
if Cache.GuildMap.mem cache.guilds t.guild_id then
@@ -407,15 +407,15 @@ module GuildRoleDelete = struct type t =
{ guild_id: Guild_id.t
; role_id: Role_id.t
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) t =
if Cache.GuildMap.mem cache.guilds t.guild_id then
let guilds = match Cache.GuildMap.find cache.guilds t.guild_id with
| Some g ->
- let roles = List.filter g.roles ~f:(fun r -> Int64.(Role_id.get_id r.id <> Role_id.get_id t.role_id)) in
+ let roles = List.filter g.roles ~f:(fun r -> Role_id.get_id r.id <> Role_id.get_id t.role_id) in
let data = { g with roles } in
Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data
| None -> cache.guilds in
@@ -427,9 +427,9 @@ module GuildRoleUpdate = struct type t =
{ guild_id: Guild_id.t
; role: Role_t.role
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) t =
if Cache.GuildMap.mem cache.guilds t.guild_id then
@@ -437,7 +437,7 @@ module GuildRoleUpdate = struct | Some g ->
let `Guild_id guild_id = t.guild_id in
let roles = List.map g.roles ~f:(fun r ->
- if Int64.(Role_id.get_id r.id = Role_id.get_id t.role.id) then Role_t.wrap ~guild_id t.role else r) in
+ if Role_id.get_id r.id = Role_id.get_id t.role.id then Role_t.wrap ~guild_id t.role else r) in
let data = { g with roles } in
Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data
| None -> cache.guilds in
@@ -449,7 +449,7 @@ module MessageCreate = struct type t = Message_t.t
let deserialize =
- Message_t.t_of_yojson
+ Message_t.of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
@@ -459,9 +459,9 @@ module MessageDelete = struct { id: Message_id.t
; channel_id: Channel_id.t
; guild_id: Guild_id.t option [@default None]
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
@@ -487,9 +487,9 @@ module MessageUpdate = struct ; pinned: bool option [@default None]
; webhook_id: Snowflake.t option [@default None]
; kind: int option [@default None][@key "type"]
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
@@ -499,9 +499,9 @@ module MessageDeleteBulk = struct { guild_id: Guild_id.t option [@default None]
; channel_id: Channel_id.t
; ids: Message_id.t list
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
@@ -509,7 +509,7 @@ end module PresenceUpdate = struct
type t = Presence.t
- let deserialize = Presence.t_of_yojson
+ let deserialize = Presence.of_yojson_exn
let update_cache (cache:Cache.t) (t:t) =
let id = t.user.id in
@@ -520,7 +520,7 @@ end (* module PresencesReplace = struct
type t =
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
end *)
module ReactionAdd = struct
@@ -530,9 +530,9 @@ module ReactionAdd = struct ; message_id: Message_id.t
; guild_id: Guild_id.t option [@default None]
; emoji: Emoji.partial_emoji
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
@@ -544,9 +544,9 @@ module ReactionRemove = struct ; message_id: Message_id.t
; guild_id: Guild_id.t option [@default None]
; emoji: Emoji.partial_emoji
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
@@ -556,9 +556,9 @@ module ReactionRemoveAll = struct { channel_id: Channel_id.t
; message_id: Message_id.t
; guild_id: Guild_id.t option [@default None]
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
@@ -570,9 +570,9 @@ module Ready = struct ; private_channels: Channel_id.t list
; guilds: Guild_t.unavailable list
; session_id: string
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) t =
let unavailable_guilds = match List.map t.guilds ~f:(fun g -> g.id, g) |> Cache.GuildMap.of_alist with
@@ -588,9 +588,9 @@ end module Resumed = struct
type t = { trace: string option list [@key "_trace"] }
- [@@deriving sexp, yojson]
+ [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
@@ -601,9 +601,9 @@ module TypingStart = struct ; guild_id: Guild_id.t option [@default None]
; timestamp: int
; user_id: User_id.t
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
@@ -611,7 +611,7 @@ end module UserUpdate = struct
type t = User_t.t
- let deserialize = User_t.t_of_yojson
+ let deserialize = User_t.of_yojson_exn
let update_cache (cache:Cache.t) t =
let user = Some t in
@@ -622,9 +622,9 @@ module WebhookUpdate = struct type t =
{ channel_id: Channel_id.t
; guild_id: Guild_id.t
- } [@@deriving sexp, yojson]
+ } [@@deriving sexp, yojson { strict = false; exn = true }]
- let deserialize = t_of_yojson
+ let deserialize = of_yojson_exn
let update_cache (cache:Cache.t) _t = cache
end
diff --git a/lib/models/guild/ban_t.ml b/lib/models/guild/ban_t.ml index 518b93e..2ebc91d 100644 --- a/lib/models/guild/ban_t.ml +++ b/lib/models/guild/ban_t.ml @@ -3,4 +3,4 @@ open Core type t = { reason: string option [@default None]; user: User_t.t; -} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { strict = false; exn = true }]
\ No newline at end of file diff --git a/lib/models/guild/ban_t.mli b/lib/models/guild/ban_t.mli index 37e5cfa..63d8ca8 100644 --- a/lib/models/guild/ban_t.mli +++ b/lib/models/guild/ban_t.mli @@ -1,4 +1,4 @@ type t = {
reason: string option; (** The reason for the ban. *)
user: User_t.t; (** The banned user. *)
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { exn = true }]
\ No newline at end of file diff --git a/lib/models/guild/guild.ml b/lib/models/guild/guild.ml index f67d5c2..95485a4 100644 --- a/lib/models/guild/guild.ml +++ b/lib/models/guild/guild.ml @@ -89,7 +89,7 @@ let request_members guild = Http.get_members (get_id guild)
let set_afk_channel ~id guild = Http.edit_guild (get_id guild) (`Assoc [
- ("afk_channel_id", `Intlit (Int64.to_string id));
+ ("afk_channel_id", `Int id);
])
let set_afk_timeout ~timeout guild = Http.edit_guild (get_id guild) (`Assoc [
@@ -113,14 +113,16 @@ let unban_user ~id ?reason guild = let get_member ~(id:User_id_t.t) guild =
match List.find ~f:(fun m -> User_id.compare m.user.id id = 0) guild.members with
| Some m -> Deferred.Or_error.return m
- | None -> Http.get_member (get_id guild) (User_id.get_id id)
+ | None ->
+ let `User_id id = id in
+ Http.get_member (get_id guild) id
let get_channel ~(id:Channel_id_t.t) guild =
let `Channel_id id = id in
- match List.find ~f:(fun c -> Int64.(Channel_t.get_id c = id)) guild.channels with
+ match List.find ~f:(fun c -> Channel_t.get_id c = id) guild.channels with
| Some c -> Deferred.Or_error.return c
| None -> Http.get_channel id
(* TODO add HTTP fallback *)
let get_role ~(id:Role_id.t) guild =
- List.find ~f:(fun r -> Int64.(Role_id.get_id r.id = Role_id.get_id id)) guild.roles
+ List.find ~f:(fun r -> Role_id.get_id r.id = Role_id.get_id id) guild.roles
diff --git a/lib/models/guild/guild_t.ml b/lib/models/guild/guild_t.ml index 4445ce2..afe3d19 100644 --- a/lib/models/guild/guild_t.ml +++ b/lib/models/guild/guild_t.ml @@ -3,7 +3,7 @@ open Core type unavailable = {
id: Guild_id_t.t;
unavailable: bool [@default false];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type pre = {
id: Guild_id_t.t;
@@ -31,7 +31,7 @@ type pre = { member_count: int option [@default None];
members: Member_t.member list [@default []];
channels: Channel_t.channel_wrapper list [@default []];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type t = {
id: Guild_id_t.t;
@@ -59,7 +59,7 @@ type t = { member_count: int option [@default None];
members: Member_t.t list;
channels: Channel_t.t list;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
let wrap ({id;name;icon;splash;owner_id;region;afk_channel_id;afk_timeout;embed_enabled;embed_channel_id;verification_level;default_message_notifications;explicit_content_filter;roles;emojis;features;mfa_level;application_id;widget_enabled;widget_channel_id;system_channel_id;large;member_count;members;channels}:pre) =
let `Guild_id id = id in
diff --git a/lib/models/guild/guild_t.mli b/lib/models/guild/guild_t.mli index 42a0669..7327be9 100644 --- a/lib/models/guild/guild_t.mli +++ b/lib/models/guild/guild_t.mli @@ -1,7 +1,7 @@ type unavailable = {
id: Guild_id_t.t;
unavailable: bool;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** Used internally. *)
type pre = {
@@ -30,7 +30,7 @@ type pre = { member_count: int option;
members: Member_t.member list;
channels: Channel_t.channel_wrapper list;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** A Guild object *)
type t = {
@@ -59,7 +59,7 @@ type t = { member_count: int option; (** Total number of members in the guild. *)
members: Member_t.t list; (** List of guild members. *)
channels: Channel_t.t list; (** List of guild channels. *)
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
val wrap : pre -> t
val get_id : t -> Snowflake.t
\ No newline at end of file diff --git a/lib/models/guild/member.ml b/lib/models/guild/member.ml index e680ecc..c5a7455 100644 --- a/lib/models/guild/member.ml +++ b/lib/models/guild/member.ml @@ -2,19 +2,19 @@ include Member_t let add_role ~(role:Role_t.t) member =
let `Guild_id guild_id = member.guild_id in
- let user_id = User_id.get_id member.user.id in
+ let `User_id user_id = member.user.id in
let `Role_id role_id = role.id in
Http.add_member_role guild_id user_id role_id
let remove_role ~(role:Role_t.t) member =
let `Guild_id guild_id = member.guild_id in
- let user_id = User_id.get_id member.user.id in
+ let `User_id user_id = member.user.id in
let `Role_id role_id = role.id in
Http.remove_member_role guild_id user_id role_id
let ban ?(reason="") ?(days=0) member =
let `Guild_id guild_id = member.guild_id in
- let user_id = User_id.get_id member.user.id in
+ let `User_id user_id = member.user.id in
Http.guild_ban_add guild_id user_id (`Assoc [
("delete-message-days", `Int days);
("reason", `String reason);
@@ -22,7 +22,7 @@ let ban ?(reason="") ?(days=0) member = let kick ?reason member =
let `Guild_id guild_id = member.guild_id in
- let user_id = User_id.get_id member.user.id in
+ let `User_id user_id = member.user.id in
let payload = match reason with
| Some r -> `Assoc [("reason", `String r)]
| None -> `Null
@@ -30,28 +30,28 @@ let kick ?reason member = let mute member =
let `Guild_id guild_id = member.guild_id in
- let user_id = User_id.get_id member.user.id in
+ let `User_id user_id = member.user.id in
Http.edit_member guild_id user_id (`Assoc [
("mute", `Bool true);
])
let deafen member =
let `Guild_id guild_id = member.guild_id in
- let user_id = User_id.get_id member.user.id in
+ let `User_id user_id = member.user.id in
Http.edit_member guild_id user_id (`Assoc [
("deaf", `Bool true);
])
let unmute member =
let `Guild_id guild_id = member.guild_id in
- let user_id = User_id.get_id member.user.id in
+ let `User_id user_id = member.user.id in
Http.edit_member guild_id user_id (`Assoc [
("mute", `Bool false);
])
let undeafen member =
let `Guild_id guild_id = member.guild_id in
- let user_id = User_id.get_id member.user.id in
+ let `User_id user_id = member.user.id in
Http.edit_member guild_id user_id (`Assoc [
("deaf", `Bool false);
])
diff --git a/lib/models/guild/member_t.ml b/lib/models/guild/member_t.ml index 0724e54..4e01b9a 100644 --- a/lib/models/guild/member_t.ml +++ b/lib/models/guild/member_t.ml @@ -6,7 +6,7 @@ type partial_member = { joined_at: string;
deaf: bool;
mute: bool;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type member = {
nick: string option [@default None];
@@ -15,19 +15,19 @@ type member = { deaf: bool;
mute: bool;
user: User_t.t;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type member_wrapper = {
guild_id: Guild_id_t.t;
user: User_t.t;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type member_update = {
guild_id: Guild_id_t.t;
roles: Role_id.t list [@default []];
user: User_t.t;
nick: string option [@default None];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type t = {
nick: string option [@default None];
@@ -37,7 +37,7 @@ type t = { mute: bool;
user: User_t.t;
guild_id: Guild_id_t.t;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
let wrap ~guild_id ({nick;roles;joined_at;deaf;mute;user}:member) =
{nick;roles;joined_at;deaf;mute;user;guild_id = `Guild_id guild_id}
\ No newline at end of file diff --git a/lib/models/guild/member_t.mli b/lib/models/guild/member_t.mli index 170504f..abfc1af 100644 --- a/lib/models/guild/member_t.mli +++ b/lib/models/guild/member_t.mli @@ -4,7 +4,7 @@ type partial_member = { joined_at: string;
deaf: bool;
mute: bool;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
type member = {
nick: string option;
@@ -13,19 +13,19 @@ type member = { deaf: bool;
mute: bool;
user: User_t.t;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
type member_wrapper = {
guild_id: Guild_id_t.t;
user: User_t.t;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
type member_update = {
guild_id: Guild_id_t.t;
roles: Role_id.t list;
user: User_t.t;
nick: string option;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** A member object. *)
type t = {
@@ -36,6 +36,6 @@ type t = { mute: bool; (** Whether the user is muted. *)
user: User_t.t; (** The underlying user object for the member. *)
guild_id: Guild_id_t.t; (** The guild ID in which the member exists. *)
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
val wrap : guild_id:Snowflake.t -> member -> t
\ No newline at end of file diff --git a/lib/models/guild/role_t.ml b/lib/models/guild/role_t.ml index 6f27483..2927c20 100644 --- a/lib/models/guild/role_t.ml +++ b/lib/models/guild/role_t.ml @@ -9,7 +9,7 @@ type role = { permissions: Permissions.t;
managed: bool;
mentionable: bool;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type t = {
id: Role_id.t;
@@ -21,7 +21,7 @@ type t = { managed: bool;
mentionable: bool;
guild_id: Guild_id_t.t;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
let wrap ~guild_id ({id;name;colour;hoist;position;permissions;managed;mentionable}:role) =
{id;name;colour;hoist;position;permissions;managed;mentionable;guild_id = `Guild_id guild_id}
\ No newline at end of file diff --git a/lib/models/guild/role_t.mli b/lib/models/guild/role_t.mli index 630ba53..98c1559 100644 --- a/lib/models/guild/role_t.mli +++ b/lib/models/guild/role_t.mli @@ -8,7 +8,7 @@ type role = { permissions: Permissions.t;
managed: bool;
mentionable: bool;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** A role object. *)
type t = {
@@ -21,7 +21,7 @@ type t = { managed: bool; (** Whether the guild is managed by an integration. *)
mentionable: bool; (** Whether the role can be mentioned. *)
guild_id: Guild_id_t.t; (** The guild ID this role belongs to. *)
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** Convenience method to produce {!t} from {!role} and a snowflake. *)
val wrap : guild_id:Snowflake.t -> role -> t
\ No newline at end of file diff --git a/lib/models/id/channel_id.ml b/lib/models/id/channel_id.ml index 6c08711..1ea7a46 100644 --- a/lib/models/id/channel_id.ml +++ b/lib/models/id/channel_id.ml @@ -6,7 +6,7 @@ exception No_message_found let send_message ?embed ?content ?files ?(tts=false) ?reply ch =
let embed = match embed with
- | Some e -> Embed.yojson_of_t e
+ | Some e -> Embed.to_yojson e
| None -> `Null in
let content = match content with
| Some c -> `String c
@@ -15,7 +15,7 @@ let send_message ?embed ?content ?files ?(tts=false) ?reply ch = | `Null, `Null -> raise Invalid_message
| _ -> () in
let message_reference = match reply with
- | Some m -> `Assoc [("message_id", Message_id.yojson_of_t m)]
+ | Some m -> `Assoc [("message_id", Message_id.to_yojson m)]
| None -> `Null in
Http.create_message ?files (get_id ch) (`Assoc [
("embed", embed);
@@ -33,13 +33,16 @@ let delete ch = let get_message ~id ch =
Http.get_message (get_id ch) id
-let get_messages ?(mode=`Around) ~id ?(limit=50) ch =
+let get_messages ?(mode=`Around) ?id ?(limit=50) ch =
let kind = match mode with
- | `Around -> "around", id
- | `Before -> "before", id
- | `After -> "after", id
+ | `Around -> "around", limit
+ | `Before -> "before", limit
+ | `After -> "after", limit
in
- Http.get_messages (get_id ch) limit kind
+ let id = match id with
+ | Some id -> id
+ | None -> raise No_message_found in
+ Http.get_messages (get_id ch) id kind
let broadcast_typing ch =
Http.broadcast_typing (get_id ch)
@@ -48,5 +51,5 @@ let get_pins ch = Http.get_pinned_messages (get_id ch)
let bulk_delete msgs ch =
- let msgs = `List (List.map ~f:(fun id -> `Intlit (Int64.to_string id)) msgs) in
+ let msgs = `List (List.map ~f:(fun id -> `Int id) msgs) in
Http.bulk_delete (get_id ch) msgs
\ No newline at end of file diff --git a/lib/models/id/channel_id.mli b/lib/models/id/channel_id.mli index 5ecad0c..2dfff8f 100644 --- a/lib/models/id/channel_id.mli +++ b/lib/models/id/channel_id.mli @@ -37,7 +37,7 @@ val delete : t -> Channel_t.t Deferred.Or_error.t val get_message : id:Snowflake.t -> t -> Message_t.t Deferred.Or_error.t
val get_messages :
?mode:[ `Before | `After | `Around ] ->
- id:Snowflake.t ->
+ ?id:Snowflake.t ->
?limit:int ->
t ->
Message_t.t list Deferred.Or_error.t
diff --git a/lib/models/id/channel_id_t.ml b/lib/models/id/channel_id_t.ml index 74588b1..cea85e0 100644 --- a/lib/models/id/channel_id_t.ml +++ b/lib/models/id/channel_id_t.ml @@ -1,7 +1,15 @@ open Core
-type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp, yojson]
+type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp]
-let compare (`Channel_id t) (`Channel_id t') = Int64.compare t t'
+let compare (`Channel_id t) (`Channel_id t') = Int.compare t t'
+
+let of_yojson a : (t, string) result =
+ match Snowflake.of_yojson a with
+ | Ok id -> Ok (`Channel_id id)
+ | Error err -> Error err
+
+let of_yojson_exn a : t = `Channel_id (Snowflake.of_yojson_exn a)
+let to_yojson (`Channel_id id) = (Snowflake.to_yojson id)
let get_id (`Channel_id id) = id
\ No newline at end of file diff --git a/lib/models/id/channel_id_t.mli b/lib/models/id/channel_id_t.mli index 851fa8f..72324a7 100644 --- a/lib/models/id/channel_id_t.mli +++ b/lib/models/id/channel_id_t.mli @@ -1,4 +1,4 @@ -type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp, yojson]
+type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }]
val compare : t -> t -> int
val get_id : t -> Snowflake.t
\ No newline at end of file diff --git a/lib/models/id/guild_id.ml b/lib/models/id/guild_id.ml index 1e0168f..d4db185 100644 --- a/lib/models/id/guild_id.ml +++ b/lib/models/id/guild_id.ml @@ -82,7 +82,7 @@ let request_members guild = Http.get_members (get_id guild)
let set_afk_channel ~id guild = Http.edit_guild (get_id guild) (`Assoc [
- ("afk_channel_id", `Intlit (Int64.to_string id));
+ ("afk_channel_id", `Int id);
])
let set_afk_timeout ~timeout guild = Http.edit_guild (get_id guild) (`Assoc [
diff --git a/lib/models/id/guild_id_t.ml b/lib/models/id/guild_id_t.ml index 6fc3777..a39c07d 100644 --- a/lib/models/id/guild_id_t.ml +++ b/lib/models/id/guild_id_t.ml @@ -1,7 +1,15 @@ open Core
-type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp, yojson]
+type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp]
-let compare (`Guild_id t) (`Guild_id t') = Int64.compare t t'
+let compare (`Guild_id t) (`Guild_id t') = Int.compare t t'
+
+let of_yojson a : (t, string) result =
+ match Snowflake.of_yojson a with
+ | Ok id -> Ok (`Guild_id id)
+ | Error err -> Error err
+
+let of_yojson_exn a : t = `Guild_id (Snowflake.of_yojson_exn a)
+let to_yojson (`Guild_id id) = (Snowflake.to_yojson id)
let get_id (`Guild_id id) = id
\ No newline at end of file diff --git a/lib/models/id/guild_id_t.mli b/lib/models/id/guild_id_t.mli index 17bd951..f4d415a 100644 --- a/lib/models/id/guild_id_t.mli +++ b/lib/models/id/guild_id_t.mli @@ -1,4 +1,4 @@ -type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp, yojson]
+type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }]
val compare : t -> t -> int
val get_id : t -> Snowflake.t
\ No newline at end of file diff --git a/lib/models/id/message_id.ml b/lib/models/id/message_id.ml index 0de01f0..3c45e16 100644 --- a/lib/models/id/message_id.ml +++ b/lib/models/id/message_id.ml @@ -1,3 +1,13 @@ -type t = [ `Message_id of Snowflake.t ] [@@deriving sexp, yojson]
+open Core
+
+type t = [ `Message_id of Snowflake.t ] [@@deriving sexp]
+
+let of_yojson a : (t, string) result =
+ match Snowflake.of_yojson a with
+ | Ok id -> Ok (`Message_id id)
+ | Error err -> Error err
+
+let of_yojson_exn a : t = `Message_id (Snowflake.of_yojson_exn a)
+let to_yojson (`Message_id id) = (Snowflake.to_yojson id)
let get_id (`Message_id id) = id
\ No newline at end of file diff --git a/lib/models/id/message_id.mli b/lib/models/id/message_id.mli index 90107b5..77a228a 100644 --- a/lib/models/id/message_id.mli +++ b/lib/models/id/message_id.mli @@ -1,3 +1,3 @@ -type t = [ `Message_id of Snowflake.t ] [@@deriving sexp, yojson]
+type t = [ `Message_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }]
val get_id : t -> Snowflake.t
\ No newline at end of file diff --git a/lib/models/id/role_id.ml b/lib/models/id/role_id.ml index a86253c..0bbf8be 100644 --- a/lib/models/id/role_id.ml +++ b/lib/models/id/role_id.ml @@ -1,3 +1,13 @@ -type t = [ `Role_id of Snowflake.t ] [@@deriving sexp, yojson]
+open Core
+
+type t = [ `Role_id of Snowflake.t ] [@@deriving sexp]
+
+let of_yojson a : (t, string) result =
+ match Snowflake.of_yojson a with
+ | Ok id -> Ok (`Role_id id)
+ | Error err -> Error err
+
+let of_yojson_exn a : t = `Role_id (Snowflake.of_yojson_exn a)
+let to_yojson (`Role_id id) = (Snowflake.to_yojson id)
let get_id (`Role_id id) = id
\ No newline at end of file diff --git a/lib/models/id/role_id.mli b/lib/models/id/role_id.mli index 701e4a9..e28e300 100644 --- a/lib/models/id/role_id.mli +++ b/lib/models/id/role_id.mli @@ -1,3 +1,3 @@ -type t = [ `Role_id of Snowflake.t ] [@@deriving sexp, yojson]
+type t = [ `Role_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }]
val get_id : t -> Snowflake.t
\ No newline at end of file diff --git a/lib/models/id/user_id_t.ml b/lib/models/id/user_id_t.ml index fab0f00..cf1634a 100644 --- a/lib/models/id/user_id_t.ml +++ b/lib/models/id/user_id_t.ml @@ -1,7 +1,15 @@ open Core
-type t = Snowflake.t [@@deriving sexp, yojson]
+type t = [ `User_id of Snowflake.t ] [@@deriving sexp]
-let compare t t' = Int64.compare t t'
+let compare (`User_id t) (`User_id t') = Int.compare t t'
-let get_id id = id
\ No newline at end of file +let of_yojson a : (t, string) result =
+ match Snowflake.of_yojson a with
+ | Ok id -> Ok (`User_id id)
+ | Error err -> Error err
+
+let of_yojson_exn a : t = `User_id (Snowflake.of_yojson_exn a)
+let to_yojson (`User_id id) = (Snowflake.to_yojson id)
+
+let get_id (`User_id id) = id
\ No newline at end of file diff --git a/lib/models/id/user_id_t.mli b/lib/models/id/user_id_t.mli index 1bac390..e728b00 100644 --- a/lib/models/id/user_id_t.mli +++ b/lib/models/id/user_id_t.mli @@ -1,4 +1,4 @@ -type t = Snowflake.t [@@deriving sexp, yojson]
+type t = [ `User_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }]
val compare : t -> t -> int
val get_id : t -> Snowflake.t
\ No newline at end of file diff --git a/lib/models/overwrites.ml b/lib/models/overwrites.ml index 424a3aa..4603c91 100644 --- a/lib/models/overwrites.ml +++ b/lib/models/overwrites.ml @@ -5,4 +5,4 @@ type t = ; kind: string [@key "type"] ; allow: Permissions.t ; deny: Permissions.t -} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { strict = false; exn = true }]
\ No newline at end of file diff --git a/lib/models/overwrites.mli b/lib/models/overwrites.mli index cae4047..ed823dc 100644 --- a/lib/models/overwrites.mli +++ b/lib/models/overwrites.mli @@ -3,4 +3,4 @@ type t = ; kind: string ; allow: Permissions.t ; deny: Permissions.t -} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { exn = true }]
\ No newline at end of file diff --git a/lib/models/permissions.ml b/lib/models/permissions.ml index 1380594..7a0892b 100644 --- a/lib/models/permissions.ml +++ b/lib/models/permissions.ml @@ -39,9 +39,13 @@ end) let sexp_of_t = Core.Int.sexp_of_t let t_of_sexp = Core.Int.t_of_sexp -let t_of_yojson j = create @@ Yojson.Safe.Util.to_int j +let of_yojson_exn j = create @@ Yojson.Safe.Util.to_int j -let yojson_of_t t : Yojson.Safe.t = `Int t +let of_yojson j = + try Ok (of_yojson_exn j) + with Yojson.Safe.Util.Type_error (why,_) -> Error why + +let to_yojson t : Yojson.Safe.t = `Int t let of_seq seq = List.of_seq seq |> of_list diff --git a/lib/models/permissions.mli b/lib/models/permissions.mli index a023033..ce5913a 100644 --- a/lib/models/permissions.mli +++ b/lib/models/permissions.mli @@ -36,5 +36,6 @@ include BitMaskSet.S with type elt := elt val sexp_of_t : t -> Sexplib.Sexp.t val t_of_sexp : Sexplib.Sexp.t -> t -val t_of_yojson : Yojson.Safe.t -> t -val yojson_of_t : t -> Yojson.Safe.t +val of_yojson_exn : Yojson.Safe.t -> t +val of_yojson : Yojson.Safe.t -> (t, string) result +val to_yojson : t -> Yojson.Safe.t diff --git a/lib/models/snowflake.ml b/lib/models/snowflake.ml index 92d94fa..2bf2281 100644 --- a/lib/models/snowflake.ml +++ b/lib/models/snowflake.ml @@ -1,11 +1,19 @@ open Core
-type t = int64 [@@deriving sexp, yojson]
+type t = Int.t [@@deriving sexp]
-let timestamp snowflake = Int64.((snowflake lsr 22) + 1_420_070_400_000L)
+let of_yojson_exn d = Yojson.Safe.Util.to_string d |> Int.of_string
+
+let of_yojson d =
+ try Ok (of_yojson_exn d)
+ with Yojson.Safe.Util.Type_error (why,_) -> Error why
+
+let to_yojson s : Yojson.Safe.t = `String (Int.to_string s)
+
+let timestamp snowflake = (snowflake lsr 22) + 1_420_070_400_000
let time_of_t snowflake =
- let t = timestamp snowflake |> Int64.to_float in
+ let t = timestamp snowflake |> float_of_int in
Time.(Span.of_ms t
|> of_span_since_epoch)
diff --git a/lib/models/snowflake.mli b/lib/models/snowflake.mli index f2a56e3..0c42e4a 100644 --- a/lib/models/snowflake.mli +++ b/lib/models/snowflake.mli @@ -1,12 +1,12 @@ open Core
-type t = int64 [@@deriving sexp, yojson]
+type t = Int.t [@@deriving sexp, yojson { exn = true }]
(** Convert a snowflake into a {!Core.Time.t} *)
val time_of_t : t -> Time.t
(** Convert a snowflake into a Unix timestamp. Millisecond precision. *)
-val timestamp : t -> int64
+val timestamp : t -> int
(** Convert a snowflake into an ISO8601 timestamp string. This is equivalent to calling [Snowflake.time_of_t snowflake |> Time.(to_string_iso8601_basic ~zone:Zone.utc)] *)
val timestamp_iso : t -> string
\ No newline at end of file diff --git a/lib/models/user/activity.ml b/lib/models/user/activity.ml index 293de3b..926c899 100644 --- a/lib/models/user/activity.ml +++ b/lib/models/user/activity.ml @@ -4,4 +4,4 @@ type t = { name: string; kind: int [@key "type"]; url: string option [@default None]; -} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { strict = false; exn = true }]
\ No newline at end of file diff --git a/lib/models/user/activity.mli b/lib/models/user/activity.mli index 1ddd4e7..2757f54 100644 --- a/lib/models/user/activity.mli +++ b/lib/models/user/activity.mli @@ -3,4 +3,4 @@ type t = { name: string; (** The name of the activity. *)
kind: int; (** 0 = Playing, 1 = Streaming, 2 = Listening, 3 = Watching *)
url: string option; (** Stream URL. Only validated for kind = 1. *)
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { exn = true }]
\ No newline at end of file diff --git a/lib/models/user/presence.ml b/lib/models/user/presence.ml index 8d5d205..d8683b7 100644 --- a/lib/models/user/presence.ml +++ b/lib/models/user/presence.ml @@ -5,4 +5,4 @@ type t = { game: Activity.t option [@default None]; status: string; activities: Activity.t list; -} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { strict = false; exn = true }]
\ No newline at end of file diff --git a/lib/models/user/presence.mli b/lib/models/user/presence.mli index 58a7c25..ae01373 100644 --- a/lib/models/user/presence.mli +++ b/lib/models/user/presence.mli @@ -4,4 +4,4 @@ type t = { game: Activity.t option; (** The current activity of the user, if any. *)
status: string; (** One of [online], [idle], [offline], or [dnd]. *)
activities: Activity.t list; (** A list of all of the user's current activities. *)
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { exn = true }]
\ No newline at end of file diff --git a/lib/models/user/user.ml b/lib/models/user/user.ml index 8b14b76..b8c3b25 100644 --- a/lib/models/user/user.ml +++ b/lib/models/user/user.ml @@ -5,17 +5,19 @@ let tag user = Printf.sprintf "%s#%s" user.username user.discriminator
let mention user =
- Printf.sprintf "<@%Ld>" (User_id.get_id user.id)
+ let `User_id id = user.id in
+ Printf.sprintf "<@%d>" id
let default_avatar user =
- let avatar = Int64.(of_string user.discriminator % 5L) in
+ let avatar = Int.of_string user.discriminator % 5 in
Endpoints.cdn_default_avatar avatar
let face user =
+ let `User_id id = user.id in
match user.avatar with
| Some avatar ->
let ext = if String.is_substring ~substring:"a_" avatar
then "gif"
else "png" in
- Endpoints.cdn_avatar (User_id.get_id user.id) avatar ext
+ Endpoints.cdn_avatar id avatar ext
| None -> default_avatar user
\ No newline at end of file diff --git a/lib/models/user/user_t.ml b/lib/models/user/user_t.ml index 8c367fc..b68808d 100644 --- a/lib/models/user/user_t.ml +++ b/lib/models/user/user_t.ml @@ -6,7 +6,7 @@ type partial_user = { discriminator: string option [@default None];
avatar: string option [@default None];
bot: bool [@default false];
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { strict = false; exn = true }]
type t = {
id: User_id_t.t;
@@ -14,4 +14,4 @@ type t = { discriminator: string;
avatar: string option [@default None];
bot: bool [@default false];
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { strict = false; exn = true }]
\ No newline at end of file diff --git a/lib/models/user/user_t.mli b/lib/models/user/user_t.mli index e971531..78f7a28 100644 --- a/lib/models/user/user_t.mli +++ b/lib/models/user/user_t.mli @@ -5,7 +5,7 @@ type partial_user = { discriminator: string option;
avatar: string option;
bot: bool;
-} [@@deriving sexp, yojson]
+} [@@deriving sexp, yojson { exn = true }]
(** A user object. *)
type t = {
@@ -14,4 +14,4 @@ type t = { discriminator: string; (** The 4 digits, as a string, that come after the '#' in a Discord username. *)
avatar: string option; (** The hash of the user avatar, if they have one set. See {!User.face} to get the avatar URL. *)
bot: bool; (** Whether the user is a bot. *)
-} [@@deriving sexp, yojson]
\ No newline at end of file +} [@@deriving sexp, yojson { exn = true }]
\ No newline at end of file |