folder restructure

13 files changed, 595 insertions, 0 deletions

diff --git a/lib/models/channel/channel.ml b/lib/models/channel/channel.ml
new file mode 100644
index 0000000..972f888
--- /dev/null
+++ b/lib/models/channel/channel.ml
@@ -0,0 +1,57 @@
+open Async
+open Core
+include Channel_t
+
+exception Invalid_message
+exception No_message_found
+
+let say ~content ch =
+    Http.create_message (get_id ch) (`Assoc [("content", `String content)])
+    >>| Result.map ~f:Message_t.of_yojson_exn
+
+let send_message ?embed ?content ?file ?(tts=false) ch =
+    let embed = match embed with
+    | Some e -> Embed.to_yojson e
+    | None -> `Null in
+    let content = match content with
+    | Some c -> `String c
+    | None -> `Null in
+    let file = match file with
+    | Some f -> `String f
+    | None -> `Null in
+    let () = match embed, content with
+    | `Null, `Null -> raise Invalid_message
+    | _ -> () in
+    Http.create_message (get_id ch) (`Assoc [
+        ("embed", embed);
+        ("content", content);
+        ("file", file);
+        ("tts", `Bool tts);
+    ]) >>| Result.map ~f:Message_t.of_yojson_exn
+
+let delete ch =
+    Http.delete_channel (get_id ch) >>| Result.map ~f:ignore
+
+let get_message ~id ch =
+    Http.get_message (get_id ch) id >>| Result.map ~f:Message_t.of_yojson_exn
+
+let get_messages ?(mode=`Around) ?id ?(limit=50) ch =
+    let kind = match mode with
+    | `Around -> "around", limit
+    | `Before -> "before", limit
+    | `After -> "after", limit
+    in
+    let id = match id with
+    | Some id -> id
+    | None -> raise No_message_found in
+    Http.get_messages (get_id ch) id kind >>| Result.map ~f:(fun l ->
+        Yojson.Safe.Util.to_list l
+        |> List.map ~f:Message_t.of_yojson_exn)
+
+let broadcast_typing ch =
+    Http.broadcast_typing (get_id ch) >>| Result.map ~f:ignore
+
+let get_pins ch =
+    Http.get_pinned_messages (get_id ch) >>| Result.map ~f:(fun l ->
+        Yojson.Safe.Util.to_list l
+        |> List.map ~f:Message_t.of_yojson_exn)
\ No newline at end of file
diff --git a/lib/models/channel/channel.mli b/lib/models/channel/channel.mli
new file mode 100644
index 0000000..001bb05
--- /dev/null
+++ b/lib/models/channel/channel.mli
@@ -0,0 +1,44 @@
+open Async
+include module type of Channel_t
+
+exception Invalid_message
+exception No_message_found
+
+(** Simple version of send_message that only takes [~content] *)
+val say : content:string -> t -> Message_t.t Deferred.Or_error.t
+
+(** Advanced message sending.
+
+    Raises {!Channel.Invalid_message} if one of content or embed is not set.
+
+    {3 Examples}
+    {[
+        open Core
+        open Disml
+
+        let check_command (msg : Message.t) =
+            if String.is_prefix ~prefix:"!hello" msg.content then
+                let embed = { Embed.default with title = Some "Hello World!" } in
+                Channel.send_message ~embed msg.channel >>> ignore
+
+        Client.message_create := check_command
+    ]}
+*)
+val send_message :
+    ?embed:Embed.t ->
+    ?content:string ->
+    ?file:string ->
+    ?tts:bool ->
+    t ->
+    Message_t.t Deferred.Or_error.t
+val delete : t -> unit 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 ->
+    ?limit:int ->
+    t ->
+    Message_t.t list Deferred.Or_error.t
+val broadcast_typing : t -> unit Deferred.Or_error.t
+val get_pins : t -> Message_t.t list Deferred.Or_error.t
+(* TODO more things related to guild channels *)
\ No newline at end of file
diff --git a/lib/models/channel/channel_t.ml b/lib/models/channel/channel_t.ml
new file mode 100644
index 0000000..dce1d54
--- /dev/null
+++ b/lib/models/channel/channel_t.ml
@@ -0,0 +1,118 @@
+open Core
+
+exception Invalid_channel of Yojson.Safe.json
+
+type group = {
+    id: Snowflake.t;
+    last_message_id: Snowflake.t option [@default None];
+    last_pin_timestamp: string option [@default None];
+    icon: string option [@default None];
+    name: string option [@default None];
+    owner_id: Snowflake.t;
+    recipients: User_t.t list [@default []];
+} [@@deriving sexp, yojson { strict = false}]
+
+type dm = {
+    id: Snowflake.t;
+    last_message_id: Snowflake.t option [@default None];
+    last_pin_timestamp: string option [@default None];
+} [@@deriving sexp, yojson { strict = false}]
+
+type guild_text = {
+    id: Snowflake.t;
+    last_message_id: Snowflake.t option [@default None];
+    last_pin_timestamp: string option [@default None];
+    category_id: Snowflake.t option [@default None][@key "parent_id"];
+    guild_id: Snowflake.t option [@default None];
+    name: string;
+    position: int;
+    topic: string option [@default None];
+    nsfw: bool;
+    slow_mode_timeout: int option [@default None];
+} [@@deriving sexp, yojson { strict = false}]
+
+type guild_voice = {
+    id: Snowflake.t;
+    category_id: Snowflake.t option [@default None][@key "parent_id"];
+    guild_id: Snowflake.t option [@default None];
+    name: string;
+    position: int;
+    user_limit: int [@default -1];
+    bitrate: int option [@default None];
+} [@@deriving sexp, yojson { strict = false}]
+
+type category = {
+    id: Snowflake.t;
+    guild_id: Snowflake.t option [@default None];
+    position: int;
+    name: string;
+} [@@deriving sexp, yojson { strict = false}]
+
+type t =
+| Group of group
+| Private of dm
+| GuildText of guild_text
+| GuildVoice of guild_voice
+| Category of category
+[@@deriving sexp, yojson { strict = false}]
+
+type channel_wrapper = {
+    id: Snowflake.t;
+    kind: int [@key "type"];
+    guild_id: Snowflake.t option [@default None];
+    position: int option [@default None];
+    name: string option [@default None];
+    topic: string option [@default None];
+    nsfw: bool option [@default None];
+    last_message_id: Snowflake.t option [@default None];
+    bitrate: int option [@default None];
+    user_limit: int option [@default None];
+    slow_mode_timeout: int option [@default None];
+    recipients: User_t.t list option [@default None];
+    icon: string option [@default None];
+    owner_id: Snowflake.t option [@default None];
+    application_id: Snowflake.t option [@default None];
+    category_id: Snowflake.t option [@default None][@key "parent_id"];
+    last_pin_timestamp: string option [@default None];
+} [@@deriving sexp, yojson { strict = false}]
+
+let unwrap_as_guild_text {id;guild_id;position;name;topic;nsfw;last_message_id;slow_mode_timeout;category_id;last_pin_timestamp;_} =
+    let position = Option.value_exn position in
+    let name = Option.value_exn name in
+    let nsfw = Option.value ~default:false nsfw in
+    { id; guild_id; position; name; topic; nsfw; last_message_id; slow_mode_timeout; category_id; last_pin_timestamp }
+
+let unwrap_as_guild_voice {id;guild_id;position;name;bitrate;user_limit;category_id;_} =
+    let position = Option.value_exn position in
+    let name = Option.value_exn name in
+    let user_limit = Option.value ~default:(-1) user_limit in
+    { id; guild_id; position; name; user_limit; bitrate ; category_id; }
+
+let unwrap_as_dm {id;last_message_id;last_pin_timestamp;_} =
+    { id; last_message_id; last_pin_timestamp; }
+
+let unwrap_as_group {id;name;last_message_id;recipients;icon;owner_id;last_pin_timestamp;_} =
+    let recipients = Option.value ~default:[] recipients in
+    let owner_id = Option.value_exn owner_id in
+    { id; name; last_message_id; recipients; icon; owner_id; last_pin_timestamp; }
+
+let unwrap_as_category {id;guild_id;position;name;_} =
+    let position = Option.value_exn position in
+    let name = Option.value_exn name in
+    { id; guild_id; position; name; }
+
+let wrap s =
+    match s.kind with
+    | 0 -> GuildText (unwrap_as_guild_text s)
+    | 1 -> Private (unwrap_as_dm s)
+    | 2 -> GuildVoice (unwrap_as_guild_voice s)
+    | 3 -> Group (unwrap_as_group s)
+    | 4 -> Category (unwrap_as_category s)
+    | _ -> raise (Invalid_channel (channel_wrapper_to_yojson s))
+
+let get_id = function
+| Group g -> g.id
+| Private p -> p.id
+| GuildText t -> t.id
+| GuildVoice v -> v.id
+| Category c -> c.id
\ No newline at end of file
diff --git a/lib/models/channel/message/attachment.ml b/lib/models/channel/message/attachment.ml
new file mode 100644
index 0000000..c56b389
--- /dev/null
+++ b/lib/models/channel/message/attachment.ml
@@ -0,0 +1,11 @@
+open Core
+
+type t = {
+    id: Snowflake.t;
+    filename: string;
+    size: int;
+    url: string;
+    proxy_url: string;
+    height: int [@default -1];
+    width: int [@default -1];
+} [@@deriving sexp, yojson { strict = false}]
\ No newline at end of file
diff --git a/lib/models/channel/message/attachment.mli b/lib/models/channel/message/attachment.mli
new file mode 100644
index 0000000..2780011
--- /dev/null
+++ b/lib/models/channel/message/attachment.mli
@@ -0,0 +1,9 @@
+type t = {
+    id: Snowflake.t;
+    filename: string;
+    size: int;
+    url: string;
+    proxy_url: string;
+    height: int;
+    width: int;
+} [@@deriving sexp, yojson]
\ No newline at end of file
diff --git a/lib/models/channel/message/embed.ml b/lib/models/channel/message/embed.ml
new file mode 100644
index 0000000..9f9aacd
--- /dev/null
+++ b/lib/models/channel/message/embed.ml
@@ -0,0 +1,121 @@
+open Core
+
+type footer = {
+    text: string;
+    icon_url: string option [@default None];
+    proxy_icon_url: string option [@default None];
+} [@@deriving sexp, yojson]
+
+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]
+
+type video = {
+    url: string option [@default None];
+    height: int option [@default None];
+    width: int option [@default None];
+} [@@deriving sexp, yojson]
+
+type provider = {
+    name: string option [@default None];
+    url: string option [@default None];
+} [@@deriving sexp, yojson]
+
+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]
+
+type field = {
+    name: string;
+    value: string;
+    inline: bool [@default false];
+} [@@deriving sexp, yojson]
+
+type t = {
+    title: string option [@default None];
+    kind: string option [@default None][@key "type"];
+    description: string option [@default None];
+    url: string option [@default None];
+    timestamp: string option [@default None];
+    colour: int option [@default None][@key "color"];
+    footer: footer option [@default None];
+    image: image option [@default None];
+    thumbnail: image option [@default None];
+    video: video option [@default None];
+    provider: provider option [@default None];
+    author: author option [@default None];
+    fields: field list [@default []];
+} [@@deriving sexp, yojson { strict = false }]
+
+let default = {
+    title = None;
+    kind = None;
+    description = None;
+    url = None;
+    timestamp = None;
+    colour = None;
+    footer = None;
+    image = None;
+    thumbnail = None;
+    video = None;
+    provider = None;
+    author = None;
+    fields = [];
+}
+
+let default_footer = {
+    text = "";
+    icon_url = None;
+    proxy_icon_url = None;
+}
+
+let default_image = {
+    url = None;
+    proxy_url = None;
+    height = None;
+    width = None;
+}
+
+let default_video = {
+    url = None;
+    width = None;
+    height = None;
+}
+
+let default_provider = {
+    name = None;
+    url = None;
+}
+
+let default_author = {
+    name = None;
+    url = None;
+    icon_url = None;
+    proxy_icon_url = None;
+}
+
+let title v e = { e with title = Some v }
+let description v e = { e with description = Some v }
+let url v e = { e with url = Some v }
+let timestamp v e = { e with timestamp = Some v }
+let colour v e = { e with colour = Some v }
+let color v e = { e with colour = Some v }
+let footer f e = { e with footer = Some (f default_footer) }
+let image v e = { e with image = Some { default_image with url = Some v } }
+let thumbnail v e = { e with thumbnail = Some { default_image with url = Some v } }
+let author f e = { e with author = Some (f default_author) }
+let field (name, value, inline) e = { e with fields = { name; value; inline; }::e.fields }
+let fields l e = { e with fields = List.map ~f:(fun (name, value, inline) -> { name; value; inline; }) l }
+
+let footer_text v f : footer = { f with text = v }
+let footer_icon v f : footer = { f with icon_url = Some v }
+
+let author_name v a : author = { a with name = Some v }
+let author_url v a : author = { a with url = Some v }
+let author_icon v a : author = { a with icon_url = Some v }
\ No newline at end of file
diff --git a/lib/models/channel/message/embed.mli b/lib/models/channel/message/embed.mli
new file mode 100644
index 0000000..d15c9fd
--- /dev/null
+++ b/lib/models/channel/message/embed.mli
@@ -0,0 +1,79 @@
+type footer = {
+    text: string;
+    icon_url: string option;
+    proxy_icon_url: string option;
+} [@@deriving sexp, yojson]
+
+type image = {
+    url: string option;
+    proxy_url: string option;
+    height: int option;
+    width: int option;
+} [@@deriving sexp, yojson]
+
+type video = {
+    url: string option;
+    height: int option;
+    width: int option;
+} [@@deriving sexp, yojson]
+
+type provider = {
+    name: string option;
+    url: string option;
+} [@@deriving sexp, yojson]
+
+type author = {
+    name: string option;
+    url: string option;
+    icon_url: string option;
+    proxy_icon_url: string option;
+} [@@deriving sexp, yojson]
+
+type field = {
+    name: string;
+    value: string;
+    inline: bool;
+} [@@deriving sexp, yojson]
+
+type t = {
+    title: string option;
+    kind: string option[@key "type"];
+    description: string option;
+    url: string option;
+    timestamp: string option;
+    colour: int option[@key "color"];
+    footer: footer option;
+    image: image option;
+    thumbnail: image option;
+    video: video option;
+    provider: provider option;
+    author: author option;
+    fields: field list [@default []];
+} [@@deriving sexp, yojson { strict = false }]
+
+val default : t
+val default_footer : footer
+val default_image : image
+val default_video : video
+val default_provider : provider
+val default_author : author
+
+val title : string -> t -> t
+val description : string -> t -> t
+val url : string -> t -> t
+val timestamp : string -> t -> t
+val colour : int -> t -> t
+val color : int -> t -> t
+val footer : (footer -> footer) -> t -> t
+val image : string -> t -> t
+val thumbnail : string -> t -> t
+val author : (author -> author) -> t -> t
+val field : string * string * bool -> t -> t
+val fields : (string * string * bool) list -> t -> t
+
+val footer_text : string -> footer -> footer
+val footer_icon : string -> footer -> footer
+
+val author_name : string -> author -> author
+val author_url : string -> author -> author
+val author_icon : string -> author -> author
\ No newline at end of file
diff --git a/lib/models/channel/message/message.ml b/lib/models/channel/message/message.ml
new file mode 100644
index 0000000..f772c48
--- /dev/null
+++ b/lib/models/channel/message/message.ml
@@ -0,0 +1,70 @@
+open Core
+open Async
+include Message_t
+
+let add_reaction msg (emoji:Emoji.t) =
+    let e = match emoji.id with
+    | Some i -> Printf.sprintf "%s:%d" emoji.name i
+    | None -> emoji.name
+    in
+    Http.create_reaction msg.channel_id msg.id e
+    >>| Result.map ~f:ignore
+
+let remove_reaction msg (emoji:Emoji.t) (user:User_t.t) =
+    let e = match emoji.id with
+    | Some i -> Printf.sprintf "%s:%d" emoji.name i
+    | None -> emoji.name
+    in
+    Http.delete_reaction msg.channel_id msg.id e user.id
+    >>| Result.map ~f:ignore
+
+let clear_reactions msg =
+    Http.delete_reactions msg.channel_id msg.id
+    >>| Result.map ~f:ignore
+
+let delete msg =
+    Http.delete_message msg.channel_id msg.id
+    >>| Result.map ~f:ignore
+
+let pin msg =
+    Http.pin_message msg.channel_id msg.id
+    >>| Result.map ~f:ignore
+
+let unpin msg =
+    Http.unpin_message msg.channel_id msg.id
+    >>| Result.map ~f:ignore
+
+let reply msg cont =
+    let rep = `Assoc [("content", `String cont)] in
+    Http.create_message msg.channel_id rep
+    >>| Result.map ~f:Message_t.of_yojson_exn
+
+let reply_with ?embed ?content ?file ?(tts=false) msg =
+    let embed = match embed with
+    | Some e -> Embed.to_yojson e
+    | None -> `Null in
+    let content = match content with
+    | Some c -> `String c
+    | None -> `Null in
+    let file = match file with
+    | Some f -> `String f
+    | None -> `Null in
+    let () = match embed, content with
+    | `Null, `Null -> raise Channel.Invalid_message
+    | _ -> () in
+    Http.create_message (msg.channel_id) (`Assoc [
+        ("embed", embed);
+        ("content", content);
+        ("file", file);
+        ("tts", `Bool tts);
+    ]) >>| Result.map ~f:Message_t.of_yojson_exn
+
+let set_content msg cont =
+    to_yojson { msg with content = cont; }
+    |> Http.edit_message msg.channel_id msg.id
+    >>| Result.map ~f:Message_t.of_yojson_exn
+
+let set_embed msg embed =
+    to_yojson { msg with embeds = [embed]; }
+    |> Http.edit_message msg.channel_id msg.id
+    >>| Result.map ~f:Message_t.of_yojson_exn
\ No newline at end of file
diff --git a/lib/models/channel/message/message.mli b/lib/models/channel/message/message.mli
new file mode 100644
index 0000000..09e62a4
--- /dev/null
+++ b/lib/models/channel/message/message.mli
@@ -0,0 +1,20 @@
+open Async
+
+include module type of Message_t
+
+val add_reaction : t -> Emoji.t -> unit Deferred.Or_error.t
+val remove_reaction : t -> Emoji.t -> User_t.t -> unit Deferred.Or_error.t
+val clear_reactions : t -> unit Deferred.Or_error.t
+val delete : t -> unit Deferred.Or_error.t
+val pin : t -> unit Deferred.Or_error.t
+val unpin : t -> unit Deferred.Or_error.t
+val reply : t -> string -> t Deferred.Or_error.t
+val reply_with :
+    ?embed:Embed.t ->
+    ?content:string ->
+    ?file:string ->
+    ?tts:bool ->
+    t ->
+    Message_t.t Deferred.Or_error.t
+val set_content : t -> string -> t Deferred.Or_error.t
+val set_embed : t -> Embed.t -> t Deferred.Or_error.t
\ No newline at end of file
diff --git a/lib/models/channel/message/message_t.ml b/lib/models/channel/message/message_t.ml
new file mode 100644
index 0000000..c4253d5
--- /dev/null
+++ b/lib/models/channel/message/message_t.ml
@@ -0,0 +1,45 @@
+open Core
+
+type message_update = {
+    id: Snowflake.t;
+    author: User_t.t option [@default None];
+    channel_id: Snowflake.t;
+    member: Member_t.partial_member option [@default None];
+    guild_id: Snowflake.t option [@default None];
+    content: string option [@default None];
+    timestamp: string option [@default None];
+    editedimestamp: string option [@default None];
+    tts: bool option [@default None];
+    mention_everyone: bool option [@default None];
+    mentions: Snowflake.t list [@default []];
+    role_mentions: Snowflake.t list [@default []];
+    attachments: Attachment.t list [@default []];
+    embeds: Embed.t list [@default []];
+    reactions: Snowflake.t list [@default []];
+    nonce: Snowflake.t option [@default None];
+    pinned: bool option [@default None];
+    webhook_id: Snowflake.t option [@default None];
+    kind: int option [@default None][@key "type"];
+} [@@deriving sexp, yojson { strict = false}]
+
+type t = {
+    id: Snowflake.t;
+    author: User_t.t;
+    channel_id: Snowflake.t;
+    member: Member_t.partial_member option [@default None];
+    guild_id: Snowflake.t option [@default None];
+    content: string;
+    timestamp: string;
+    editedimestamp: string option [@default None];
+    tts: bool;
+    mention_everyone: bool;
+    (* mentions: Snowflake.t list [@default []]; *)
+    (* role_mentions: Snowflake.t list [@default []]; *)
+    attachments: Attachment.t list [@default []];
+    embeds: Embed.t list [@default []];
+    reactions: Snowflake.t list [@default []];
+    nonce: Snowflake.t option [@default None];
+    pinned: bool;
+    webhook_id: Snowflake.t option [@default None];
+    kind: int [@key "type"];
+} [@@deriving sexp, yojson { strict = false}]
\ No newline at end of file
diff --git a/lib/models/channel/message/reaction.ml b/lib/models/channel/message/reaction.ml
new file mode 100644
index 0000000..c4ab326
--- /dev/null
+++ b/lib/models/channel/message/reaction.ml
@@ -0,0 +1 @@
+include Reaction_t
\ No newline at end of file
diff --git a/lib/models/channel/message/reaction.mli b/lib/models/channel/message/reaction.mli
new file mode 100644
index 0000000..38343cb
--- /dev/null
+++ b/lib/models/channel/message/reaction.mli
@@ -0,0 +1,6 @@
+include module type of Reaction_t
+
+(* val delete : Reaction_t.t -> Yojson.Safe.json Deferred.Or_error.t
+val get_users : Reaction_t.t -> int -> User_t.t list Deferred.Or_error.t
+val get_users_after : Reaction_t.t -> Snowflake.t -> int -> User_t.t list Deferred.Or_error.t
+val get_users_before : Reaction_t.t -> Snowflake.t -> int -> User_t.t list Deferred.Or_error.t *)
\ No newline at end of file
diff --git a/lib/models/channel/message/reaction_t.ml b/lib/models/channel/message/reaction_t.ml
new file mode 100644
index 0000000..c382b68
--- /dev/null
+++ b/lib/models/channel/message/reaction_t.ml
@@ -0,0 +1,14 @@
+open Core
+
+type reaction_event = {
+    user_id: Snowflake.t;
+    channel_id: Snowflake.t;
+    message_id: Snowflake.t;
+    guild_id: Snowflake.t option [@default None];
+    emoji: Emoji.partial_emoji;
+} [@@deriving sexp, yojson]
+
+type t = {
+    count: int;
+    emoji: Emoji.t;
+} [@@deriving sexp, yojson { strict = false}]
\ No newline at end of file