aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/dune5
-rw-r--r--lib/post.ml45
-rw-r--r--lib/post.mli31
-rw-r--r--lib/xml.ml10
-rw-r--r--lib/xml.mli13
5 files changed, 104 insertions, 0 deletions
diff --git a/lib/dune b/lib/dune
new file mode 100644
index 0000000..2bcd146
--- /dev/null
+++ b/lib/dune
@@ -0,0 +1,5 @@
+(library
+ (name wormhole)
+ (libraries uri)
+ (modules Post)
+ (preprocess (pps lwt_ppx ppx_yojson_conv)))
diff --git a/lib/post.ml b/lib/post.ml
new file mode 100644
index 0000000..232d9a7
--- /dev/null
+++ b/lib/post.ml
@@ -0,0 +1,45 @@
+open Ppx_yojson_conv_lib.Yojson_conv.Primitives
+
+type t = {
+ link : string;
+ summary : string;
+ tags : string list;
+ published : string;
+ author : string;
+}
+
+type mastodon_tag = {
+ kind : string; [@key "type"]
+ name : string;
+ href : string;
+}
+[@@deriving yojson] [@@yojson.allow_extra_fields]
+
+type mastodon_object = { tag : mastodon_tag list }
+[@@deriving yojson] [@@yojson.allow_extra_fields]
+
+type mastodon_post = {
+ actor : string;
+ published : string;
+ obj : mastodon_object; [@key "object"]
+}
+[@@deriving yojson] [@@yojson.allow_extra_fields]
+
+let post_of_mastodon_post = function
+ | { actor; published; obj = { tag } } ->
+ let tags = List.map (fun { name; _ } -> name) tag in
+ { link = actor; summary = published; tags; published; author = actor }
+
+let get_tld (link : string) =
+ Uri.of_string link |> Uri.host_with_default ~default:""
+
+let db = ref []
+
+let add (entry : t) =
+ db := entry :: !db;
+ print_endline (entry.link ^ " added to db");
+ print_endline ("New db size: " ^ string_of_int (List.length !db))
+
+let get_all () =
+ print_endline ("db size: " ^ string_of_int (List.length !db));
+ !db
diff --git a/lib/post.mli b/lib/post.mli
new file mode 100644
index 0000000..9bf32ae
--- /dev/null
+++ b/lib/post.mli
@@ -0,0 +1,31 @@
+type t = {
+ link : string;
+ summary : string;
+ tags : string list;
+ published : string;
+ author : string;
+}
+
+type mastodon_tag = { kind : string; name : string; href : string }
+
+val mastodon_tag_of_yojson : Yojson.Safe.t -> mastodon_tag
+val yojson_of_mastodon_tag : mastodon_tag -> Yojson.Safe.t
+
+type mastodon_object = { tag : mastodon_tag list }
+
+val mastodon_object_of_yojson : Yojson.Safe.t -> mastodon_object
+val yojson_of_mastodon_object : mastodon_object -> Yojson.Safe.t
+
+type mastodon_post = {
+ actor : string;
+ published : string;
+ obj : mastodon_object;
+}
+
+val mastodon_post_of_yojson : Yojson.Safe.t -> mastodon_post
+val yojson_of_mastodon_post : mastodon_post -> Yojson.Safe.t
+val post_of_mastodon_post : mastodon_post -> t
+val get_tld : string -> string
+val db : t list ref
+val add : t -> unit
+val get_all : unit -> t list
diff --git a/lib/xml.ml b/lib/xml.ml
new file mode 100644
index 0000000..fe4abdc
--- /dev/null
+++ b/lib/xml.ml
@@ -0,0 +1,10 @@
+type xml = Tag of string * xml list | String of string
+
+let tag name body = Tag (name, body)
+let format, format_list = Format.(fprintf, pp_print_list)
+
+let rec format_xml f = function
+ | Tag (name, body) ->
+ let format_body = format_list format_xml in
+ format f "@[<hv 3><%s>@,%a@;<0 -3></%s>@]" name format_body body name
+ | String text -> format f "%s" text
diff --git a/lib/xml.mli b/lib/xml.mli
new file mode 100644
index 0000000..e1d3eb9
--- /dev/null
+++ b/lib/xml.mli
@@ -0,0 +1,13 @@
+type xml = Tag of string * xml list | String of string
+
+val tag : string -> xml list -> xml
+val format : Format.formatter -> ('a, Format.formatter, unit) format -> 'a
+
+val format_list :
+ ?pp_sep:(Format.formatter -> unit -> unit) ->
+ (Format.formatter -> 'a -> unit) ->
+ Format.formatter ->
+ 'a list ->
+ unit
+
+val format_xml : Format.formatter -> xml -> unit