134 lines
4.9 KiB
OCaml
134 lines
4.9 KiB
OCaml
let version = 0
|
|
type info_t = { version: int; id: string; title: string; people: string list; locations: string list }
|
|
type t = { info: info_t; fields: Msgpck.t; texts: Msgpck.t; peers: Msgpck.t }
|
|
|
|
let of_id id = Msgpck.of_string id
|
|
let to_id = Msgpck.to_string
|
|
|
|
let person p = Msgpck.String (Person.to_string p)
|
|
let persons ps = Msgpck.of_list @@ List.rev @@ Person.Set.fold (fun p a -> person p :: a) ps []
|
|
|
|
let str = Msgpck.of_string
|
|
let str_list ls = Msgpck.of_list @@ List.map str ls
|
|
let to_str_list x = List.map Msgpck.to_string
|
|
(try Msgpck.to_list x with e -> prerr_endline "to_str_list"; raise e)
|
|
|
|
let of_set field t =
|
|
List.rev @@ String_set.fold (fun s a -> Msgpck.String s :: a) (Text.set field t) []
|
|
|
|
let date = function "" -> Int32.zero | date -> Int32.of_int (Date.to_secs date)
|
|
|
|
let to_sec = function Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x
|
|
|
|
let fields = Msgpck.(List [
|
|
String "id"; String "time"; String "title"; String "authors"; String "topics";
|
|
String "references"; String "replies";
|
|
])
|
|
let to_fields fieldpack = List.map Msgpck.to_string (Msgpck.to_list fieldpack)
|
|
|
|
let to_info = function
|
|
| Msgpck.List (v::id::n::a::ls::[]) ->
|
|
let people = to_str_list a in
|
|
let locations = to_str_list ls in
|
|
Msgpck.({version = to_int v; id = to_string id; title = to_string n; people; locations})
|
|
| _ -> invalid_arg "Pack header"
|
|
|
|
let of_info i = let open Msgpck in
|
|
List [Int i.version; String i.id; String i.title; str_list i.people; str_list i.locations]
|
|
|
|
let of_text a t =
|
|
let open Text in
|
|
Msgpck.(List [
|
|
of_id t.id;
|
|
of_uint32 (date (Date.listing t.date));
|
|
String t.title;
|
|
persons t.authors;
|
|
List (of_set "topics" t);
|
|
List (of_set "references" t);
|
|
List (of_set "in-reply-to" t);
|
|
]) :: a
|
|
|
|
let of_text_list l = Msgpck.List l
|
|
|
|
let pack p = Msgpck.List [of_info p.info; p.fields; p.texts; p.peers]
|
|
let string p = Bytes.to_string @@ Msgpck.Bytes.to_string @@ pack p
|
|
|
|
let unpack = function
|
|
| Msgpck.List (i::fields::texts::[]) ->
|
|
Ok { info = to_info i; fields; texts; peers = Msgpck.List [] }
|
|
| Msgpck.List (i::fields::texts::peers::[]) ->
|
|
Ok { info = to_info i; fields; texts; peers }
|
|
| _ -> Error "format mismatch"
|
|
|
|
let of_string s = unpack @@ snd @@ Msgpck.StringBuf.read s
|
|
|
|
let of_kv kv =
|
|
let find k kv = try Store.KV.find k kv with Not_found -> "" in
|
|
let find_ls k kv = try String_set.list_of_csv (Store.KV.find k kv) with Not_found -> [] in
|
|
{
|
|
info = { version = version; id = find "Id" kv; title = find "Title" kv;
|
|
people = find_ls "Authors" kv; locations = find_ls "Locations" kv };
|
|
fields;
|
|
texts = Msgpck.List [];
|
|
peers = str_list (find_ls "Peers" kv);
|
|
}
|
|
|
|
let list filename = try
|
|
let texts_list = function
|
|
| Msgpck.List (_info :: _fields :: [texts]) -> Msgpck.to_list texts
|
|
| _ -> prerr_endline "malformed feed"; [] in
|
|
let _pos, data = Msgpck.StringBuf.read @@ File_store.to_string filename in
|
|
Ok (texts_list data)
|
|
with Not_found -> Error "unspecified export dir"
|
|
|
|
let contains text = function
|
|
| Msgpck.List (id::_time::title::_authors::_topics::[]) ->
|
|
(match to_id id with
|
|
| "" -> Printf.eprintf "Invalid id for %s" (Msgpck.to_string title); false
|
|
| id -> text.Text.id = id)
|
|
| _ -> prerr_endline ("Invalid record pattern"); false
|
|
|
|
let numof_texts pack = List.length (Msgpck.to_list pack.texts)
|
|
|
|
let txt_iter_apply fn i = function
|
|
| Msgpck.List (id::time::title::authors::topics::extra) ->
|
|
let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i
|
|
| x -> Msgpck.to_uint32 x in
|
|
let id = to_id id in
|
|
let title = Msgpck.to_string title in
|
|
let topics = to_str_list topics in
|
|
let authors = to_str_list authors in
|
|
let references, replies =
|
|
try begin match extra with [] -> [], []
|
|
| refs::[] -> to_str_list refs, []
|
|
| refs::replies::_xs -> to_str_list refs, to_str_list replies
|
|
end with e -> prerr_endline "iter ref reps"; raise e
|
|
in
|
|
fn i id t title authors topics references replies
|
|
| x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x)
|
|
|
|
let txt_fold_apply fn i = function
|
|
| Msgpck.List (id::time::title::authors::topics::extra) ->
|
|
let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i
|
|
| x -> Msgpck.to_uint32 x in
|
|
let id = to_id id in
|
|
let title = Msgpck.to_string title in
|
|
let topics = to_str_list topics in
|
|
let authors = to_str_list authors in
|
|
let references, replies = begin match extra with
|
|
| [] -> [], []
|
|
| refs::[] -> to_str_list refs, []
|
|
| refs::replies::_xs -> to_str_list refs, to_str_list replies
|
|
end
|
|
in
|
|
fn i id t title authors topics references replies
|
|
| x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x); i
|
|
|
|
let iteri fn pack = List.iteri
|
|
(txt_iter_apply fn)
|
|
(Msgpck.to_list pack.texts)
|
|
|
|
let fold fn init pack = List.fold_left
|
|
(fun acc m -> try txt_fold_apply fn acc m with Invalid_argument x -> prerr_endline x; acc) init
|
|
(try Msgpck.to_list pack.texts with e -> prerr_string "Invalid pack.texts"; raise e)
|