Add experimental command for extracting (string) contents from extension points

tools/CHANGELOG.md

@@ -12,6 +12,10 @@
 
 ## master
 
+#### :rocket: New Feature
+
+- _internal_ Add experimental command for extracting (string) contents from extension points.
+
 ## 0.5.0
 
 #### :rocket: New Feature

tools/bin/main.ml

@@ -50,6 +50,12 @@ let main () =
     done;
     Sys.argv.(len - 1) <- "";
     Reanalyze.cli ()
+  | "extract-embedded" :: extPointNames :: filename :: _ ->
+    logAndExit
+      (Ok
+         (Tools.extractEmbedded
+            ~extensionPoints:(extPointNames |> String.split_on_char ',')
+            ~filename))
   | ["-h"] | ["--help"] -> logAndExit (Ok help)
   | ["-v"] | ["--version"] -> logAndExit (Ok version)
   | _ -> logAndExit (Error help)

tools/src/tools.ml

@@ -443,3 +443,42 @@ let extractDocs ~entryPointFile ~debug =
   in
 
   result
+
+let extractEmbedded ~extensionPoints ~filename =
+  let {Res_driver.parsetree = structure} =
+    Res_driver.parsingEngine.parseImplementation ~forPrinter:false ~filename
+  in
+  let content = ref [] in
+  let append item = content := item :: !content in
+  let extension (iterator : Ast_iterator.iterator) (ext : Parsetree.extension) =
+    (match ext with
+    | ( {txt},
+        PStr
+          [
+            {
+              pstr_desc =
+                Pstr_eval
+                  ( {
+                      pexp_loc;
+                      pexp_desc = Pexp_constant (Pconst_string (contents, _));
+                    },
+                    _ );
+            };
+          ] )
+      when extensionPoints |> List.exists (fun v -> v = txt) ->
+      append (pexp_loc, txt, contents)
+    | _ -> ());
+    Ast_iterator.default_iterator.extension iterator ext
+  in
+  let iterator = {Ast_iterator.default_iterator with extension} in
+  iterator.structure iterator structure;
+  let open Analysis.Protocol in
+  !content
+  |> List.map (fun (loc, extensionName, contents) ->
+         stringifyObject
+           [
+             ("extensionName", Some extensionName);
+             ("contents", Some contents);
+             ("loc", Some (Analysis.Utils.cmtLocToRange loc |> stringifyRange));
+           ])
+  |> array