kythe.io@v0.0.68-0.20240422202219-7225dbc01741/kythe/ocaml/js_indexer/dumpKytheCommand.ml (about)

     1  (**
     2   * Copyright 2015 The Kythe Authors. All rights reserved.
     3   *
     4   * Licensed under the Apache License, Version 2.0 (the "License");
     5   * you may not use this file except in compliance with the License.
     6   * You may obtain a copy of the License at
     7   *
     8   *   http://www.apache.org/licenses/LICENSE-2.0
     9   *
    10   * Unless required by applicable law or agreed to in writing, software
    11   * distributed under the License is distributed on an "AS IS" BASIS,
    12   * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    13   * See the License for the specific language governing permissions and
    14   * limitations under the License.
    15   *
    16   * Derived from flow/src/commands/dumpTypesCommand.ml:
    17   *
    18   * Copyright (c) 2015, Facebook, Inc.
    19   * All rights reserved.
    20   *
    21   * This source code is licensed under the BSD-style license found in the
    22   * LICENSE file in the "flow" directory of this source tree. An additional grant
    23   * of patent rights can be found in the PATENTS file in the same directory.
    24   *
    25  *)
    26  
    27  (***********************************************************************)
    28  (* flow dump-kythe command *)
    29  (***********************************************************************)
    30  
    31  module DKS = DumpKytheService_js
    32  
    33  open Hh_json
    34  open CommandUtils
    35  
    36  let spec = {
    37    CommandSpec.
    38    name = "dump-kythe";
    39    doc = "Dumps Flow data using Kythe format";
    40    usage = Printf.sprintf
    41        "Usage: %s dump-kythe [OPTION]... [FILE]\n\n\
    42         e.g. %s dump-kythe foo.js\n\
    43         or   %s dump-kythe < foo.js\n"
    44        CommandUtils.exe_name
    45        CommandUtils.exe_name
    46        CommandUtils.exe_name;
    47    args = CommandSpec.ArgSpec.(
    48        empty
    49        |> server_flags
    50        |> flag "--path" (optional string)
    51          ~doc:"Specify (fake) path to file when reading data from stdin"
    52        |> anon "file" (optional string) ~doc:"[FILE]"
    53      )
    54  }
    55  
    56  let get_file path = function
    57    | Some filename ->
    58      ServerProt.FileName (expand_path filename)
    59    | None ->
    60      let contents = Sys_utils.read_stdin_to_string () in
    61      let filename = (match path with
    62          | Some ""
    63          | None -> None
    64          | Some str -> Some (get_path_of_file str)
    65        ) in
    66      ServerProt.FileContent (filename, contents)
    67  
    68  let string_of_pos pos =
    69    let file = Pos.filename pos in
    70    if file = Relative_path.default then
    71      ""
    72    else
    73      let line, start, end_ = Pos.info_pos pos in
    74      if line <= 0 then
    75        Utils.spf "%s:1:0" (Relative_path.to_absolute file)
    76      else if Pos.length pos = 1 then
    77        Utils.spf "%s:%d:%d"
    78          (Relative_path.to_absolute file) line start
    79      else
    80        Utils.spf "%s:%d:%d-%d"
    81          (Relative_path.to_absolute file) line start end_
    82  
    83  let handle_error (pos, err) =
    84    let pos = Reason_js.string_of_pos pos in
    85    output_string stderr (Utils.spf "%s:\n%s\n" pos err);
    86    flush stderr
    87  
    88  let main option_values path filename () =
    89    let file = get_file path filename in
    90    let root = guess_root (ServerProt.path_of_input file) in
    91    let ic, oc = connect_with_autostart option_values root in
    92    ServerProt.cmd_to_channel oc (ServerProt.DUMP_KYTHE file);
    93  
    94    match (Marshal.from_channel ic : DKS.resp_t) with
    95    | (Some err, None) -> handle_error err
    96    | (None, Some jsons) -> List.iter
    97                              (fun j -> print_endline (json_to_string j)) jsons
    98    | (_, _) -> assert false
    99  
   100  let command = CommandSpec.command spec (collect_server_flags main)