compute.ml 2.14 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
open Stdune
open Import

let doc = "Compute internal function."

let man =
  [ `S "DESCRIPTION"
  ; `P {|Run a registered memoize function with the given input and
           print the output. |}
  ; `P {|This should only be used for debugging dune.|}
  ; `Blocks Common.help_secs
  ]

let info = Term.info "compute" ~doc ~man

let term =
  Term.ret @@
18 19
  let+ common = Common.term
  and+ fn =
20 21 22 23
    Arg.(required
         & pos 0 (some string) None
         & info [] ~docv:"FUNCTION"
             ~doc:"Compute $(docv) for a given input.")
24
  and+ inp =
25 26 27 28 29 30 31 32 33
    Arg.(value
         & pos 1 (some string) None
         & info [] ~docv:"INPUT"
             ~doc:"Use $(docv) as the input to the function.")
  in
  Common.set_common common ~targets:[];
  let log = Log.create common in
  let action =
    Scheduler.go ~log ~common (fun () ->
34 35 36 37
      let open Fiber.O in
      let* _setup =
        Import.Main.setup ~log common ~external_lib_deps_mode:true
      in
38 39 40 41 42 43 44 45 46 47 48 49 50
      match fn, inp with
      | "list", None ->
        Fiber.return `List
      | "list", Some _ ->
        Fiber.return (`Error "'list' doesn't take an argument")
      | "help", Some fn ->
        Fiber.return (`Show_doc fn)
      | fn, Some inp ->
        let sexp =
          Dune_lang.parse_string
            ~fname:"<command-line>"
            ~mode:Dune_lang.Parser.Mode.Single inp
        in
51
        let+ res = Memo.call fn sexp in
52 53 54 55 56 57 58 59 60
        `Result res
      | fn, None ->
        Fiber.return (`Error (sprintf "argument missing for '%s'" fn))
    )
  in
  match action with
  | `Error msg ->
    `Error (true, msg)
  | `Result res ->
61 62
    Ansi_color.print (Dyn.pp res);
    print_newline ();
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
    `Ok ()
  | `List ->
    let fns = Memo.registered_functions () in
    let longest = String.longest_map fns ~f:(fun info -> info.name) in
    List.iter fns ~f:(fun { Memo.Function_info.name; doc } ->
      Printf.printf "%-*s : %s\n" longest name doc);
    flush stdout;
    `Ok ()
  | `Show_doc fn ->
    let info = Memo.function_info fn in
    Printf.printf "%s\n\
                   %s\n\
                   %s\n"
      info.name
      (String.make (String.length info.name) '=')
      info.doc;
    `Ok ()

let command = term, info