Hi all,

This is a small patch based on forester 4.3.1 which I imagine is hopelessly out of date (especially with the datalog changes!), but I wanted to get some feedback on the general idea, and I can re-implement it once the datalog version stabilizes.

This adds a "forester transplant" command, with syntax "forester transplant FOREST_TOML_FILE TAG OUTPUT_FILE". It outputs all of paths to the source code of trees that either contain the tag TAG or are recursively transcluded in some tree that contain the tag TAG.

This is already in use at Topos to create the topos public forest: https://forest.topos.site/public (not much there right now!). In CI, I build the forest as normal, and then I transplant the public tag, and build just that by itself.

Right now transplant does not follow links. I think that this is perhaps the right behavior, because one would not want to accidentally link to something and then drag along your entire private notes. Rather, if you link to something and you want it to come along, you should add the right tag to it.

It seems to me that this functionality (exporting only a subset of a forest) is perhaps orthogonal to the cross-forest transclusions? Because it's probably easier to have one big repo with all of your stuff, a portion of which you publish, than it is to have a separate public and private forest where the private forest can include some of the public. More generally, one might want to expose different subsets of their forest to different collaborators. So there might be room for this feature even after cross-forest transclusions get worked out.

What do you think?
-Owen

---
 Dockerfile           |  2 +-
 bin/forester/main.ml | 45 +++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 43 insertions(+), 4 deletions(-)

diff --git a/Dockerfile b/Dockerfile
index c1d7917..fa0cc3c 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -1,4 +1,4 @@
-FROM ocaml/opam:alpine-ocaml-5.1-flambda AS forester-builder
 RUN sudo apk update

+FROM ocaml/opam:alpine-ocaml-5.2-flambda AS forester-builder

diff --git a/bin/forester/main.ml b/bin/forester/main.ml
index 0d96043..e94359a 100644
--- a/bin/forester/main.ml
+++ b/bin/forester/main.ml
@@ -110,7 +110,7 @@ let query_tag ~env filter_tags config_filename =
   let tags = Forest.tags ~forest in
   let filtered =
     tags |> Seq.filter @@ fun (_, ts) ->
-    List.for_all (fun t -> List.mem t ts) ts
+    List.for_all (fun t -> List.mem t filter_tags) ts
   in
   filtered
   |> Seq.iter @@ fun (addr, tags) ->
@@ -132,6 +132,34 @@ let query_all ~env config_filename =
   |> Yojson.Basic.to_string
   |> Format.printf "%s"

+module String_set = Set.Make (String)
+
+let transplant ~env tag output config_filename =
+  let config = Forester_frontend.Config.parse_forest_config_file config_filename in
+  let forest =
+    Forest.plant_forest @@
+    Process.read_trees_in_dirs ~dev:true ~ignore_malformed:true @@
+    make_dirs ~env config.trees
+  in
+  let query_lnvar = Query.(
+      union_fam_rel
+        (rel Edges Incoming Rel.tags (Addr (User_addr tag)))
+        Paths
+        Outgoing
+        Rel.transclusion) in
+  let query = Query.distill_expr query_lnvar in
+  let results = forest.run_query query in
+  let get_source addr = Option.bind
+                          (Addr_map.find_opt addr forest.trees)
+                          (fun tree -> tree.fm.source_path) in
+  let sources = results
+                |> Addr_set.to_list
+                |> List.filter_map get_source
+                |> String_set.of_list
+  in
+  let oc = open_out output in
+  sources |> String_set.iter (fun path -> Printf.fprintf oc "%s\n" path);
 let init ~env () =
   let default_theme_url =
 let query_tag_cmd ~env =
   let arg_tags =
+  close_out oc

@@ -313,7 +341,7 @@ let query_taxon_cmd ~env =

-    Arg.(value @@ pos_all string [] @@ info [] ~docv:"TAG")
+    Arg.(value @@ pos_right 0 string [] @@ info [] ~docv:"TAG")
   in
   let doc = "List all trees with tag TAG" in
   let info = Cmd.info "tag" ~version ~doc in
@@ -329,6 +357,17 @@ let query_cmd ~env =
   let info = Cmd.info "query" ~version ~doc in
   Cmd.group info [query_taxon_cmd ~env; query_tag_cmd ~env; query_all_cmd ~env]

+let transplant_cmd ~env =
+  let tag =
+    Arg.(value @@ pos 1 string "" @@ info [] ~docv:"TAG")
+  in
+  let output =
+    Arg.(value @@ pos 2 string "" @@ info [] ~docv:"OUTPUT")
+  in
+  let doc = "Get a list of trees to transplant" in
+  let info = Cmd.info "transplant" ~version ~doc in
+  Cmd.v info Term.(const (transplant ~env) $ tag $ output $ arg_config)
+
 let init_cmd ~env =
   let doc = "Initialize a new forest" in
   let man = [
   let info = Cmd.info "forester" ~version ~doc ~man in
@@ -350,7 +389,7 @@ let cmd ~env =
   in

 let () =
-  Cmd.group info [build_cmd ~env; new_tree_cmd ~env; complete_cmd ~env; query_cmd ~env; init_cmd ~env;]

+  Cmd.group info [build_cmd ~env; new_tree_cmd ~env; complete_cmd ~env; query_cmd ~env; transplant_cmd ~env; init_cmd ~env;]

--
2.46.1
Date: Sun, 20 Oct 2024 21:04:37 +0100
Message-ID: <87iktm35ii.fsf@owenlynch.org>