diff --git a/tools/CHANGELOG.md b/tools/CHANGELOG.md index 22872f017..65d0abed2 100644 --- a/tools/CHANGELOG.md +++ b/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 diff --git a/tools/bin/main.ml b/tools/bin/main.ml index d9b4f2ae4..06be383b1 100644 --- a/tools/bin/main.ml +++ b/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) diff --git a/tools/src/tools.ml b/tools/src/tools.ml index 0db7ee50b..efac75d75 100644 --- a/tools/src/tools.ml +++ b/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