Samhain 21

Converter
- type selection
- subdir conversion
- htm extension

Gemini
- index.gmi
- topics and latest
- gmi.atom feed

Add pull (http(s)) operation
- peers.pub.conf and peers.priv.conf

HTML5 format & fixes by Novaburst
Phony target (thanks Gergely)

May

Basic unit renamed from Note to Text.
New modular text-parser, internal to Logarion, for generic notation parsing. The default input format is now a much plainer text.
Logarion created texts have part of the UUID in filename.
Logarion's index re-written in Messagepack format. Removed `indices` command. They are generated during `convert`.

git-svn-id: file:///srv/svn/repo/kosuzu/trunk@2 eb64cd80-c68d-6f47-b6a3-0ada418499da

lib/archive.ml

@@ -0,0 +1,33 @@
+(*let module S = Set.Make (Text) in*)
+(*let module M = Map.Make (String) in*)
+(*let module I = Map.Make (Id) in*)
+(*let aggr = I.empty, M.empty, M.empty, M.empty in*)
+(*let fn (id, a, t, k) (n,_) =*)
+(* let id = I.add n.Text.uuid n id in*)
+(* let a =*)
+(*   let f e a = M.update (e.Person.name) (function Some v -> Some (S.add n v) | None -> Some (S.singleton n)) a in*)
+(*   Person.Set.fold f n.Text.authors a in*)
+(* let t =*)
+(*   let f e a = M.update e (function Some v -> Some (S.add n v) | None -> Some (S.singleton n)) a in*)
+(*   String_set.fold f (Text.set "Topics" n) t in*)
+(* let k =*)
+(*   let f e a = M.update e (function Some v -> Some (S.add n v) | None -> Some (S.singleton n)) a in*)
+(*   String_set.fold f (Text.set "Keywords" n) k in*)
+(* (id, a, t, k)*)
+
+module Make (Store : Store.T) = struct
+  include Store
+  let predicate fn opt = Option.(to_list @@ map fn opt)
+
+  let authored query_string =
+    let q = Person.Set.of_query @@ String_set.query query_string in
+    fun n -> Person.Set.predicate q n.Text.authors
+
+  let keyworded query_string =
+    let q = String_set.query query_string in
+    fun n -> String_set.(predicate q (Text.set "Keywords" n))
+
+  let topics query_string =
+    let q = String_set.query query_string in
+    fun n -> String_set.(predicate q (Text.set "Topics" n))
+end

lib/category.ml

@@ -0,0 +1,22 @@
+module Category = struct
+  type t = Unlisted | Published | Invalid | Custom of string
+  let compare = Stdlib.compare
+  let of_string = function "unlisted" | "published" -> Invalid | c -> Custom c
+  let to_string = function Custom c -> c | _ -> ""
+end
+
+include Category
+
+module CategorySet = struct
+  include Set.Make (Category)
+  let of_stringset s = String_set.fold (fun e a -> add (Category.of_string e) a) s empty
+  let of_query q = of_stringset (fst q), of_stringset (snd q)
+  let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set
+  let of_string x = of_stringset (String_set.of_string x)
+  let to_string set =
+    let f elt a =
+      let s = Category.to_string elt in
+      if a <> "" then a ^ ", " ^ s else s
+    in
+    fold f set ""
+end

lib/date.ml

@@ -0,0 +1,8 @@
+type t = { created: Ptime.t option; edited: Ptime.t option }
+let compare = compare
+let rfc_string date = match date with Some t -> Ptime.to_rfc3339 t | None -> ""
+let of_string (rfc : string) = match Ptime.of_rfc3339 rfc with Ok (t,_,_) -> Some t | Error _ -> None
+let listing date = if Option.is_some date.edited then date.edited else date.created
+let pretty_date = function
+  | Some t -> Ptime.to_date t |> fun (y, m, d) -> Printf.sprintf "%04d-%02d-%02d" y m d
+  | None -> ""

lib/dune

@@ -0,0 +1,4 @@
+(library
+ (name        logarion)
+ (public_name logarion)
+ (libraries ptime uuidm uri re.str bos text_parse text_parse.parsers msgpck))

lib/file_store.ml

@@ -0,0 +1,166 @@
+type t = string
+type item_t = string
+type archive_t = {
+	name: string; archivists: Person.Set.t; id: Id.t;
+	kv: string Store.KV.t; store: t }
+type record_t = Text.t * item_t
+
+let extension = ".txt"
+
+let to_string f =
+	let ic = open_in f in
+	let n = in_channel_length ic in
+	let s = Bytes.create n in
+	really_input ic s 0 n;
+	close_in ic;
+	Bytes.to_string s
+
+let file path content = let out = open_out path in
+	output_string out content; close_out out
+
+let (//) a b = a ^ "/" ^ b
+
+let to_text path =
+	if Filename.extension path = extension then
+		(to_string path |> Text.of_string |> Result.map_error (fun m -> path ^": "^ m))
+	else Error "Not txt"
+
+let newest (a,_pa) (b,_pb) = Text.newest a b
+let oldest (a,_pa) (b,_pb) = Text.oldest a b
+
+let list_iter fn {store;_} paths =
+	let link f = match to_text (Filename.concat store f)
+		with Ok t -> fn store t f | Error s -> prerr_endline s in
+	List.iter link paths
+
+let iter_valid_text pred fn p =
+	match to_text p with Error _ -> () | Ok t -> if pred t then fn (t, p)
+
+let fold_valid_text pred fn acc p =
+	match to_text p with Error _ -> acc | Ok t -> if pred t then fn acc (t, p) else acc
+
+let list_fs dir =
+	let rec loop result = function
+		| [] -> result
+		| f::fs when Sys.is_directory f ->
+			Array.map (Filename.concat f) (Sys.readdir f)
+			|> Array.to_list |> List.append fs |> loop result
+		| f::fs -> loop (f::result) fs
+	in loop [] [dir]
+
+let list_take n =
+	let rec take acc n = function [] -> []
+		| x::_ when n = 1 -> x::acc
+		| x::xs -> take (x::acc) (n-1) xs
+	in take [] n
+
+let iter ?(predicate=fun _ -> true) ?order ?number fn {store;_} =
+	match order with
+	| None -> List.iter (iter_valid_text predicate fn) @@ list_fs store
+	| Some comp ->
+		List.iter fn
+		@@ (match number with None -> (fun x -> x) | Some n -> list_take n)
+		@@ List.fast_sort comp
+		@@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
+		@@ list_fs store
+
+let fold ?(predicate=fun _ -> true) ?order ?number fn acc {store;_} =
+	match order with
+	| None -> List.fold_left (fold_valid_text predicate fn) acc @@ list_fs store
+	| Some comp ->
+		List.fold_left fn acc
+		@@ (match number with None -> (fun x -> x) | Some n -> list_take n)
+		@@ List.fast_sort comp
+		@@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
+		@@ list_fs store
+
+let with_id { store; _ } id =
+	let matched acc path =
+		match to_text path with
+		| Error x -> prerr_endline x; acc
+		| Ok text when text.Text.uuid <> id -> acc
+		| Ok text ->
+			match acc with
+			| Ok None -> Ok (Some text)
+			| Ok (Some prev) -> if prev = text then acc else Error [text; prev]
+			| Error x -> Error (text :: x)
+	in List.fold_left matched (Ok None) (list_fs store)
+
+module Directory = struct
+	let print ?(descr="") dir result =
+		let () = match result with
+			| Ok true -> print_endline ("Created " ^ descr ^ " directory " ^ dir)
+			| Ok false -> print_endline ("Using existing " ^ descr ^ " directory " ^ dir)
+			| Error (`Msg msg) -> prerr_endline @@ "Failed making " ^ descr ^ ". " ^ msg
+		in
+		result
+
+	let directory dir = Result.bind (Fpath.of_string dir) Bos.OS.Dir.create
+
+	let rec directories = function
+		| [] -> Ok ()
+		| (d, descr)::tl ->
+			match directory d |> print ~descr d with
+			| Ok _ -> directories tl
+			| Error _ -> Error (d, descr)
+end
+
+let copy ?(recursive = false) src dst =
+	Bos.OS.Cmd.run (Bos.Cmd.(v "cp" %% (on recursive @@ v "-r") % src % dst))
+
+let versioned_basename_of_title ?(version=0) repo extension (title : string) =
+	let basename = Text.string_alias title in
+	let rec next version =
+		let candidate = repo // basename ^ "." ^ string_of_int version ^ extension in
+		if Sys.file_exists candidate then next (succ version) else candidate
+	in
+	next version
+
+let uuid_filename repo extension text =
+	let basename = Text.alias text in
+	let candidate = repo // String.sub (Id.to_string text.uuid) 0 6 ^ "." ^ basename ^ extension in
+	if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
+
+let with_text {store;_} new_text =
+	Result.bind (uuid_filename store extension new_text) @@
+	fun path ->
+		try file path (Text.to_string new_text); Ok (path, new_text) with Sys_error s -> Error s
+
+let basic_config () =
+	"Archive-Name: "
+	^ "\nArchive-ID: " ^ Id.(generate () |> to_string)
+	^ "\nArchivists: " ^ Bos.OS.Env.opt_var "USER" ~absent:""
+	|> Bytes.of_string
+
+let init ?(dotdir=".logarion/") () =
+	match Directory.directories [dotdir, "dotdir"] with
+	| Error (_dir, _desc) -> ()
+	| Ok () ->
+		let config_file =
+			open_out_gen [Open_creat; Open_excl; Open_wronly]
+				0o700 (dotdir // "config") in
+		output_bytes config_file (basic_config ());
+		close_out config_file
+
+module Config = struct
+	type t = archive_t
+	let key_value k v a = match k with
+		| "Archive-Name" -> { a with name = String.trim v }
+		| "Archive-ID" -> { a with id = Option.get (Id.of_string (String.trim v)) }
+		| "Archivists" -> { a with archivists = Person.Set.of_string v }
+		| _ -> { a with kv = Store.KV.add k (String.trim v) a.kv }
+end
+
+let of_path store =
+	let open Text_parse in
+	let subsyntaxes = [| (module Parsers.Key_value.Make (Config) : Parser.S with type t = Config.t); (module Parsers.Key_value.Make (Config)); |] in
+	let of_string text acc = Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in
+	Ok (
+		of_string (to_string @@ store ^ "/.logarion/config") {
+			name = "";
+			archivists = Person.Set.empty;
+			id = Id.nil;
+			kv = Store.KV.empty;
+			store = try Sys.getenv "LOGARION_DIR" with Not_found -> "."
+		}
+	)

lib/header_pack.ml

@@ -0,0 +1,84 @@
+type info_t = { version: int; name: string; archivists: string list }
+type text_t = { id: Msgpck.t; time: Msgpck.t; title: Msgpck.t; authors: Msgpck.t }
+type t = { info: info_t; fields: string list; texts: Msgpck.t; peers: Msgpck.t }
+
+let of_id id = Msgpck.Bytes (Id.to_bytes id)
+let to_id pck_id = Id.of_bytes Msgpck.(to_bytes pck_id)
+
+let person p = Msgpck.String (Person.to_string p)
+let persons ps = List.rev @@ Person.Set.fold (fun p a -> person p :: a) ps []
+
+let of_set field t =
+	List.rev @@ String_set.fold (fun s a -> Msgpck.String s :: a) (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 to_sec = function
+	Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x
+
+let public_peers () =
+	Peers.fold_file (fun x a -> Msgpck.String x :: a) [] Peers.public_fname
+
+let fields = Msgpck.(List [String "id"; String "time";  String "title"; String "authors"; String "topics"])
+let to_fields fieldpack = List.map Msgpck.to_string (Msgpck.to_list fieldpack)
+
+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 to_info = function
+	| Msgpck.List (v::n::a::[]) ->
+		let archivists = List.map Msgpck.to_string (Msgpck.to_list a) in
+		Msgpck.({version = to_int v; name = to_string n; archivists})
+	| _ -> invalid_arg "Pack header"
+
+let unpack = function
+	| Msgpck.List (i::f::texts::[]) ->
+		Some { info = to_info i; fields = to_fields f; texts; peers = Msgpck.List [] }
+	| Msgpck.List (i::f::texts::peers::[]) ->
+		Some { info = to_info i; fields = to_fields f; texts; peers }
+	| _ -> None
+
+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 info = Msgpck.(List [Int 0; String archive.File_store.name; List (persons archive.archivists)]) in
+	Bytes.to_string @@ Msgpck.Bytes.to_string
+		(List [info; fields; Msgpck.List header_pack; Msgpck.List (public_peers ())])
+
+let add archive records =
+	let fname = pack_filename archive in
+	let append 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 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; fields; Msgpck.List header_pack])
+
+let unpublish _archive _records = ()

lib/id.ml

@@ -0,0 +1,9 @@
+let random_state = Random.State.make_self_init ()
+type t = Uuidm.t
+let compare = Uuidm.compare
+let to_string = Uuidm.to_string
+let of_string = Uuidm.of_string
+let to_bytes = Uuidm.to_bytes
+let of_bytes = Uuidm.of_bytes
+let generate ?(random_state=random_state) = Uuidm.v4_gen random_state
+let nil = Uuidm.nil

lib/peers.ml

@@ -0,0 +1,9 @@
+let public_fname = "peers.pub.conf"
+let private_fname = "peers.priv.conf"
+
+let fold_file fn init file = match open_in file with
+	| exception (Sys_error msg) -> prerr_endline msg; init
+	| file ->
+		let rec read acc = try read (fn (input_line file) acc)
+			with End_of_file -> close_in file; acc in
+		read init

lib/person.ml

@@ -0,0 +1,31 @@
+module Person = struct
+  type name_t = string
+  type address_t = Uri.t
+  type t = { name: name_t; addresses: address_t list }
+  let empty = { name = ""; addresses = [] }
+  let compare = Stdlib.compare
+  let to_string p = List.fold_left (fun a e -> a^" <"^Uri.to_string e^">") p.name p.addresses
+  let of_string s = match String.trim s with "" -> empty | s ->
+    match Re.Str.(split (regexp " *< *") s) with
+    | [] -> empty
+    | [n] -> let name = String.trim n in { empty with name }
+    | n::adds ->
+      let name = String.trim n in
+      let addresses = List.map (fun f -> Uri.of_string @@ String.(sub f 0 (length f -1))) adds in
+      { name; addresses }
+end
+
+include Person
+
+module Set = struct
+  include Set.Make(Person)
+  let to_string ?(pre="") ?(sep=", ") s =
+    let str = Person.to_string in
+    let j x a = match a, x with "",_ -> str x | _,x when x = Person.empty -> a | _ -> a^sep^str x in
+    fold j s pre
+  let of_string s = of_list (List.map Person.of_string (String_set.list_of_csv s))
+
+  let of_stringset s = String_set.fold (fun e a -> union (of_string e) a) s empty
+  let of_query q = of_stringset (fst q), of_stringset (snd q)
+  let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set
+end

lib/store.ml

@@ -0,0 +1,17 @@
+module KV = Map.Make (String)
+
+module type T = sig
+	type t
+	type item_t
+	type archive_t = { name: string; archivists: Person.Set.t; id: Id.t; kv: string KV.t; store: t }
+	type record_t = Text.t * item_t
+	val of_path: string -> (archive_t, string) result
+	val newest: record_t -> record_t -> int
+	val oldest: record_t -> record_t -> int
+	val with_id: archive_t -> Id.t -> (Text.t option, Text.t list) result
+	val with_text: archive_t -> Text.t -> (string * Text.t, string) result
+	val iter: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int
+		-> (record_t -> unit) -> archive_t -> unit
+	val fold: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int
+		-> ('a -> record_t -> 'a) -> 'a -> archive_t -> 'a
+end

lib/string_set.ml

@@ -0,0 +1,15 @@
+include Set.Make(String)
+
+let list_of_csv x = Re.Str.(split (regexp " *, *")) (String.trim x)
+let of_string x = of_list (list_of_csv x)
+let to_string ?(pre="") ?(sep=", ") s =
+  let j a x = match a, x with "", _ -> x | _, "" -> a | _ -> a ^ sep ^ x in
+  fold (fun x acc -> j acc x) s pre
+
+let query string =
+  let partition (include_set, exclude_set) elt =
+    if String.get elt 0 = '!' then (include_set, add String.(sub elt 1 (length elt - 1)) exclude_set)
+    else (add elt include_set, exclude_set) in
+  List.fold_left partition (empty, empty) @@ list_of_csv string
+
+let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set

lib/text.ml

@@ -0,0 +1,102 @@
+module String_map = Map.Make (String)
+type t = {
+    title: string;
+    uuid: Id.t;
+    authors: Person.Set.t;
+    date: Date.t;
+    string_map: string String_map.t;
+    stringset_map: String_set.t String_map.t;
+    body: string;
+  }
+
+let blank ?(uuid=(Id.generate ())) () = {
+    title = "";
+    uuid;
+    authors = Person.Set.empty;
+    date = Date.({ created = None; edited = None});
+    string_map = String_map.empty;
+    stringset_map = String_map.empty;
+    body = "";
+  }
+
+let compare = Stdlib.compare
+let newest a b = Date.(compare a.date b.date)
+let oldest a b = Date.(compare b.date a.date)
+let str key m = try String_map.find (String.lowercase_ascii key) m.string_map with Not_found -> ""
+let set key m = try String_map.find (String.lowercase_ascii key) m.stringset_map with Not_found -> String_set.empty
+let str_set key m = String_set.to_string @@ set key m
+let with_str_set m key str = { m with stringset_map = String_map.add (String.lowercase_ascii key) (String_set.of_string str) m.stringset_map }
+
+let with_kv x (k,v) =
+  let trim = String.trim in
+  match String.lowercase_ascii k with
+  | "body" -> { x with body = String.trim v }
+  | "title"-> { x with title = trim v }
+  | "id"   -> (match Id.of_string v with Some id -> { x with uuid = id } | None -> x)
+  | "author"
+  | "authors" -> { x with authors = Person.Set.of_string (trim v)}
+  | "date"       -> { x with date = Date.{ x.date with created   = Date.of_string v }}
+  | "date-edited"-> { x with date = Date.{ x.date with edited    = Date.of_string v }}
+  | "licences" | "topics" | "keywords" | "series" as k -> with_str_set x k v
+  | k -> { x with string_map = String_map.add k (trim v) x.string_map }
+
+let kv_of_string line = match Re.Str.(bounded_split (regexp ": *")) line 2 with
+  | [ key; value ] -> Re.Str.(replace_first (regexp "^#\\+") "" key), value
+  | [ key ] -> Re.Str.(replace_first (regexp "^#\\+") "" key), ""
+  | _ -> "",""
+
+let of_header front_matter =
+  let fields = List.map kv_of_string (Re.Str.(split (regexp "\n")) front_matter) in
+  List.fold_left with_kv (blank ~uuid:Id.nil ()) fields
+
+let front_matter_body_split s =
+  if Re.Str.(string_match (regexp ".*:.*")) s 0
+  then match Re.Str.(bounded_split (regexp "^$")) s 2 with
+       | front::body::[] -> (front, body)
+       | _ -> ("", s)
+  else ("", s)
+
+let of_string s =
+  let front_matter, body = front_matter_body_split s in
+  try
+    let note = { (of_header front_matter) with body } in
+    if note.uuid <> Id.nil then Ok note else Error "Missing ID header"
+  with _ -> Error ("Failed parsing" ^ s)
+
+let to_string x = 
+  let has_len v = String.length v > 0 in
+  let s field value = if has_len value then field ^ ": " ^ value ^ "\n" else "" in
+  let a value = if Person.Set.is_empty value then "" else "Authors: " ^ Person.Set.to_string value ^ "\n" in
+  let d field value = match value with Some _ -> field ^ ": " ^ Date.rfc_string value ^ "\n" | None -> "" in
+  let rows =
+    [ s "Title" x.title;
+      a x.authors;
+      d "Date" x.date.Date.created;
+      d "Edited" x.date.Date.edited;
+      s "Licences" (str_set "licences" x);
+      s "Topics"   (str_set "topics" x);
+      s "Keywords" (str_set "keywords" x);
+      s "Series"   (str_set "series" x);
+      s "Abstract" (str "abstract" x);
+      s "ID" (Uuidm.to_string x.uuid);
+      s "Alias" (str "Alias" x) ]
+  in
+  String.concat "" rows ^ "\n" ^ x.body
+
+let string_alias t =
+  let is_reserved = function
+    | '!' | '*' | '\'' | '(' | ')' | ';' | ':' | '@' | '&' | '=' | '+' | '$'
+      | ',' | '/' | '?' | '#' | '[' | ']' | ' ' | '\t' | '\x00' -> true
+    | _ -> false
+  in
+  let b = Buffer.create (String.length t) in
+  let filter char =
+    let open Buffer in
+    if is_reserved char then (try (if nth b (pred (length b)) <> '-' then add_char b '-') with Invalid_argument _ -> prerr_endline "reserved")
+    else add_char b char
+  in
+  String.(iter filter (lowercase_ascii t));
+  Buffer.contents b
+
+let alias t = match str "alias" t with "" -> string_alias t.title | x -> x
+let short_id ?(len=8) t = String.sub (Id.to_string t.uuid) 0 len

lib/topic_set.ml

@@ -0,0 +1,35 @@
+let of_string x = Re.Str.(split (regexp " *> *")) (String.trim x)
+
+let topic x =
+  let path = of_string x in
+  try List.nth path (List.length path - 1) with _ -> ""
+
+module Map = Map.Make(String)
+
+let edges x map = try Map.find x map with Not_found -> (String_set.empty, String_set.empty)
+
+let edges_with_context context (contexts, subtopics) = (String_set.add context contexts, subtopics)
+let edges_with_subtopic subtopic (contexts, subtopics) = (contexts, String_set.add subtopic subtopics)
+
+let rec list_to_map map = function
+  | [] -> map
+  | [topic] ->
+     let edges = edges topic map in
+     Map.add topic edges map
+  | context :: topic :: tail ->
+     let context_edges = edges context map in
+     let topic_edges = edges topic map in
+     let map =
+       map
+       |> Map.add context (edges_with_subtopic topic context_edges)
+       |> Map.add topic (edges_with_context context topic_edges)
+     in
+     list_to_map map (topic :: tail)
+
+let to_map map set =
+  List.fold_left (fun acc elt -> list_to_map acc (of_string elt)) map @@ String_set.elements set
+
+let roots map =
+  let root_keys acc (key, (contexts, _topics)) = if String_set.is_empty contexts then key :: acc else acc in
+  List.fold_left root_keys [] @@ Map.bindings map
+