Standalone utility; OCaml 4.06 + ocaml-migrate-parsetree

Author: cknitt

bin/Extract.re

@@ -0,0 +1,28 @@
+open Migrate_parsetree;
+
+open Ast_mapper;
+
+open Parsetree;
+
+open Lib;
+
+let messages = ref([]);
+
+let mapper = ExtractionMapper.getMapper(message => messages := [message, ...messages^]);
+
+let extractMessages = ast => {
+  mapper.structure(mapper, Obj.magic(ast)) |> ignore;
+  let sortedJsonObjects = messages^ |> List.sort(Message.compare) |> List.map(Message.toJson);
+  Yojson.Basic.pretty_to_channel(stdout, `List(sortedJsonObjects));
+  print_newline();
+};
+
+switch (Ast_io.from_channel(stdin)) {
+| Result.Ok((_, Ast_io.Impl((module Version), ast))) =>
+  module Convert = Convert(Version, OCaml_406);
+  let converted = Obj.magic(Convert.copy_structure(ast));
+  extractMessages(converted);
+| Result.Ok((_, Ast_io.Intf(_, _))) => print_endline("Intf AST!")
+| Result.Error(Not_a_binary_ast(_)) => print_endline("Error: not a binary AST: ")
+| Result.Error(Unknown_version(v)) => print_endline("Error: unknown version: " ++ v)
+};

bin/Ppx.re

@@ -1,6 +1,6 @@
 (jbuild_version 1)
 
 (executable
- ((name Ppx)
-  (public_name Ppx)
+ ((name Extract)
+  (public_name Extract)
   (libraries (lib))))

bin/jbuild

@@ -0,0 +1,48 @@
+open Ast_mapper;
+
+open Parsetree;
+
+let getLabelString = (key, labels) =>
+  try (
+    {
+      let value = labels |> List.assoc(Asttypes.Labelled(key));
+      switch (value) {
+      | {pexp_desc: Pexp_constant(Pconst_string(text, _))} => Some(text)
+      | _ => None
+      };
+    }
+  ) {
+  | Not_found => None
+  };
+
+let getMessage = expr =>
+  switch (expr) {
+  | {
+      pexp_desc:
+        Pexp_apply(
+          {
+            pexp_desc: Pexp_ident({txt: Ldot(Ldot(Lident("ReactIntl"), "FormattedMessage"), "createElement"), loc}),
+          },
+          labels,
+        ),
+    } =>
+    let id = labels |> getLabelString("id");
+    let defaultMessage = labels |> getLabelString("defaultMessage");
+    let description = labels |> getLabelString("description");
+    switch (id, defaultMessage) {
+    | (Some(id), Some(defaultMessage)) => Some({Message.id, defaultMessage, description})
+    | _ => None
+    };
+  | _ => None
+  };
+
+let getMapper = callback => {
+  ...default_mapper,
+  expr: (mapper, expr) => {
+    switch (getMessage(expr)) {
+    | Some(message) => callback(message)
+    | None => ()
+    };
+    default_mapper.expr(mapper, expr);
+  },
+};

esy.lock

@@ -0,0 +1,18 @@
+type t = {
+  id: string,
+  defaultMessage: string,
+  description: option(string),
+};
+
+let compare = (a, b) => compare(a.id, b.id);
+
+let toJson = ({id, defaultMessage, description}) =>
+  switch (description) {
+  | Some(description) =>
+    `Assoc([
+      ("id", `String(id)),
+      ("defaultMessage", `String(defaultMessage)),
+      ("description", `String(description)),
+    ])
+  | None => `Assoc([("id", `String(id)), ("defaultMessage", `String(defaultMessage))])
+  };

lib/ExtractIntlMessages.re

@@ -4,4 +4,4 @@
  ((name lib)
   (flags (-w -40 -w +26))
   (public_name esy-reason-project)
-  (libraries (compiler-libs.common))))
+  (libraries (ocaml-migrate-parsetree yojson))))

lib/ExtractionMapper.re

@@ -1,7 +1,7 @@
 {
-  "name": "esy-reason-project",
+  "name": "bs-react-intl-extractor",
   "version": "0.1.0",
-  "description": "Reason workflow with Esy",
+  "description": "Message extractor for bs-react-intl",
   "license": "MIT",
   "esy": {
     "build": [["refmterr", "jbuilder", "build"]],
@@ -11,17 +11,19 @@
   "dependencies": {
     "@esy-ocaml/esy-installer": "^0.0.0",
     "@opam/jbuilder": "^1.0.0-beta14",
+    "@opam/ocaml-migrate-parsetree": "^1.0.10",
     "@opam/reason": "^3.0.0",
+    "@opam/yojson": "^1.4.1",
     "refmterr": "^3.0.4"
   },
   "resolutions": {
     "**/@opam/result": "1.2.0"
   },
   "peerDependencies": {
-    "ocaml": "~4.2.3"
+    "ocaml": "~4.6.1"
   },
   "devDependencies": {
     "@esy-ocaml/merlin": "*",
-    "ocaml": "~4.2.3"
+    "ocaml": "~4.6.1"
   }
 }