69 lines
2.5 KiB
OCaml
69 lines
2.5 KiB
OCaml
let persons ps =
|
|
let add x a = Msgpck.String (Person.to_string x) :: a in
|
|
List.rev @@ Person.Set.fold add ps []
|
|
|
|
let of_set field t =
|
|
let add x a = Msgpck.String x :: a in
|
|
List.rev @@ String_set.fold add (Text.set field t) []
|
|
|
|
let date = function
|
|
| None -> Int32.zero
|
|
| Some date ->
|
|
let days, ps = Ptime.Span.to_d_ps (Ptime.to_span date) in
|
|
Int32.add Int32.(mul (of_int days) 86400l) Int64.(to_int32 (div ps 1000000000000L))
|
|
|
|
let columns = Msgpck.(List
|
|
[String "id"; String "time"; String "title";
|
|
String "authors"; String "topics"])
|
|
|
|
let to_pack a t =
|
|
let open Text in
|
|
Msgpck.(List [Bytes (Id.to_bytes t.uuid);
|
|
of_uint32 (date (Date.listing t.date));
|
|
String t.title; List (persons t.authors);
|
|
List (of_set "topics" t)]) :: a
|
|
|
|
let pack_filename ?(filename="index.pck") archive =
|
|
let dir = Store.KV.find "Export-Dir" archive.File_store.kv in (*raises Not_found*)
|
|
dir ^ "/" ^ filename
|
|
|
|
let with_info fn = let open Msgpck in function
|
|
| Msgpck.List (v::n::a) -> fn (to_int v) (to_string n) a
|
|
| _ -> invalid_arg "Pack header"
|
|
|
|
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 Id.of_bytes (Msgpck.to_bytes id) with
|
|
| None -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title); false
|
|
| Some id -> text.Text.uuid = id)
|
|
| _ -> prerr_endline ("Invalid record pattern"); false
|
|
|
|
let pack archive records =
|
|
let header_pack = List.fold_left to_pack [] records in
|
|
let archive = Msgpck.(List [Int 0; String archive.File_store.name;
|
|
List (persons archive.archivists)]) in
|
|
Bytes.to_string @@ Msgpck.Bytes.to_string (List [archive; columns;
|
|
Msgpck.List header_pack])
|
|
|
|
let add archive records =
|
|
let fname = pack_filename archive in
|
|
let append_fn published (t, _f) =
|
|
if List.exists (contains t) published then published
|
|
else to_pack published t in
|
|
match list fname with Error e -> prerr_endline e | Ok published_list ->
|
|
let header_pack = List.fold_left append_fn published_list records in
|
|
let archive = Msgpck.(List [Int 0; String archive.File_store.name;
|
|
List (persons archive.archivists)]) in
|
|
File_store.file fname @@ Bytes.to_string @@ Msgpck.Bytes.to_string (List
|
|
[archive; columns; Msgpck.List header_pack])
|
|
|
|
let unpublish _archive _records = ()
|