e878dedbb6
Format - New B32 ID Index - New option: txt index --print - Move scheme to peers - Replace peer.*.conf files with index packed locations Instead of adding a URL to peers.*.conf, run `txt pull <url>` Conversion - Rewritten converters - txt-convert looks for a .convert.conf containing `key: value` lines. - Specifiable topic-roots from .convert.conf. - Added `Topics:` key, with comma seperated topics. If set only those topics will appear in the main index and used as topic roots. Other topics will have sub-indices generated, but won't be listed in the main index. - HTML converter header & footer options - HTML-index renamed to HTM-index Internal - Change types: uuid:Uuid -> id:string - File_store merges identical texts - Use peer ID for store path, store peers' texts in .local/share/texts - Simple URN resolution for converter Continue to next feed if parsing one fails - Phasing-out Archive, replaced by improved packs - Eliminate Bos, Cohttp, lwt, uri, tls, Re, Ptime, dependencies - Lock version for Cmdliner, fix dune-project - Optional resursive store - Improve header_pack - Fix recursive mkdir
35 lines
1.2 KiB
OCaml
35 lines
1.2 KiB
OCaml
let of_string x = 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
|
|
|