Create command for printing magic numbers

Author: liam923

src/commands/dune

@@ -4,11 +4,13 @@
   (flags
     :standard
     -open Ocaml_parsing
+    -open Ocaml_utils
     -open Merlin_utils
     -open Merlin_kernel)
   (libraries
     merlin-lib.ocaml_parsing
     merlin-lib.utils
     merlin-lib.kernel
     merlin-lib.query_protocol
-    merlin-lib.query_commands))
+    merlin-lib.query_commands
+    merlin-lib.ocaml_utils))

src/commands/new_commands.ml

@@ -867,6 +867,11 @@ let all_commands =
             run buffer (Query_protocol.Signature_help sh)
       end;
     (* Used only for testing *)
+    command "version" ~spec:[] ~default:() ~doc:"Print version information"
+      begin
+        fun buffer () -> run buffer Query_protocol.Version
+      end;
+    (* Used only for testing *)
     command "dump"
       ~spec:
         [ arg "-what"

src/commands/query_json.ml

@@ -514,4 +514,8 @@ let json_of_response (type a) (query : a t) (response : a) : json =
     let with_file = scope = `Project in
     `List (List.map locations ~f:(fun loc -> with_location ~with_file loc []))
   | Signature_help _, s -> json_of_signature_help s
-  | Version, version -> `String version
+  | Version, (version, magic_numbers) ->
+    `Assoc
+      [ ("version", `String version);
+        ("magicNumbers", Config.Magic_numbers.to_json magic_numbers)
+      ]

src/frontend/dune

@@ -2,8 +2,8 @@
  (name        query_protocol)
  (public_name merlin-lib.query_protocol)
  (modules     query_protocol)
- (flags :standard -open Merlin_utils -open Merlin_kernel -open Ocaml_parsing -open Merlin_kernel)
- (libraries merlin_kernel merlin_utils ocaml_parsing))
+ (flags :standard -open Merlin_utils -open Merlin_kernel -open Ocaml_parsing -open Ocaml_utils)
+ (libraries merlin_kernel merlin_utils ocaml_parsing ocaml_utils))
 
 (library
  (name        query_commands)

src/frontend/query_commands.ml

@@ -978,5 +978,9 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function
         }
     | None -> None)
   | Version ->
-    Printf.sprintf "The Merlin toolkit version %s, for Ocaml %s\n"
-      Merlin_config.version Sys.ocaml_version
+    let version =
+      Printf.sprintf "The Merlin toolkit version %s, for Ocaml %s\n"
+        Merlin_config.version Sys.ocaml_version
+    in
+    let magic_numbers = Config.Magic_numbers.current in
+    (version, magic_numbers)

src/frontend/query_protocol.ml

@@ -272,4 +272,4 @@ type _ t =
       (** In current version, Merlin only uses the parameter [position] to answer
         signature_help queries. The additionnal parameters are described in the
         LSP protocol and might enable finer behaviour in the future. *)
-  | Version : string t
+  | Version : (string * Config.Magic_numbers.t) t

src/ocaml-index/bin/dune

@@ -2,7 +2,7 @@
  (name ocaml_index)
  (public_name ocaml-index)
  (package ocaml-index)
- (libraries lib ocaml_typing ocaml_utils merlin_index_format)
+ (libraries lib ocaml_typing ocaml_utils merlin_index_format merlin_utils yojson)
  (flags
   :standard
   -open Ocaml_typing

src/ocaml-index/bin/ocaml_index.ml

@@ -15,14 +15,21 @@ let rewrite_root = ref false
 let store_shapes = ref false
 let do_not_use_cmt_loadpath = ref false
 
-type command = Aggregate | Dump | Dump_file_stats | Stats | Gather_shapes
+type command =
+  | Aggregate
+  | Dump
+  | Dump_file_stats
+  | Stats
+  | Gather_shapes
+  | Magic_numbers
 
 let parse_command = function
   | "aggregate" -> Some Aggregate
   | "dump" -> Some Dump
   | "dump-file-stats" -> Some Dump_file_stats
   | "stats" -> Some Stats
   | "gather-shapes" -> Some Gather_shapes
+  | "magic-numbers" -> Some Magic_numbers
   | _ -> None
 
 let command = ref None
@@ -128,5 +135,9 @@ let () =
           (Hashtbl.length cu_shape)
           (Option.value ~default:"none" root_directory))
       (List.rev !input_files_rev)
-  | _ -> Printf.printf "Nothing to do.\n%!");
+  | Some Magic_numbers ->
+    let json = Config.Magic_numbers.(to_json current) in
+    Yojson.Basic.to_channel stdout json;
+    print_newline ()
+  | None -> Printf.printf "Nothing to do.\n%!");
   exit 0

src/ocaml/utils/config.ml

@@ -48,3 +48,38 @@ let reserved_header_bits = 8
 let runtime5 = true
 
 let merlin = true
+
+module Magic_numbers = struct
+  type t =
+    { cmi_magic_number : string;
+      ast_intf_magic_number : string;
+      ast_impl_magic_number : string;
+      cmt_magic_number : string;
+      cms_magic_number : string;
+      index_magic_number : string
+    }
+
+  let current =
+    { cmi_magic_number;
+      ast_intf_magic_number;
+      ast_impl_magic_number;
+      cmt_magic_number;
+      cms_magic_number;
+      index_magic_number
+    }
+
+  let to_json t =
+    let nums =
+      [ ("cmi_magic_number", t.cmi_magic_number);
+        ("ast_intf_magic_number", t.ast_intf_magic_number);
+        ("ast_impl_magic_number", t.ast_impl_magic_number);
+        ("cmt_magic_number", t.cmt_magic_number);
+        ("cms_magic_number", t.cms_magic_number);
+        ("index_magic_number", t.index_magic_number)
+      ]
+    in
+    `Assoc
+      (List.map
+         (fun (key, value) -> (key, Merlin_utils.Std.Json.string value))
+         nums)
+end

src/ocaml/utils/config.mli

@@ -46,4 +46,19 @@ val runtime5 : bool
 
 val merlin : bool
 
+module Magic_numbers : sig
+  type t =
+    { cmi_magic_number : string;
+      ast_intf_magic_number : string;
+      ast_impl_magic_number : string;
+      cmt_magic_number : string;
+      cms_magic_number : string;
+      index_magic_number : string
+    }
+
+  val current : t
+
+  val to_json : t -> Std.json
+end
+
 (**/**)