_

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>

bin/main.ml

@@ -374,60 +374,69 @@ let compute =
     ]
   in
   let term =
+    Term.ret @@
     let%map common = Common.term
     and fn =
       Arg.(required
            & pos 0 (some string) None
            & info [] ~docv:"FUNCTION"
                ~doc:"Compute $(docv) for a given input.")
     and inp =
-      Arg.(required
+      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 res =
+    let action =
       Scheduler.go ~log ~common
         (Main.setup ~log common ~external_lib_deps_mode:true
          >>= fun _setup ->
-         let sexp =
-           Dune_lang.parse_string
-             ~fname:"<command-line>"
-             ~mode:Dune_lang.Parser.Mode.Single inp
-         in
-         Memo.call fn sexp)
+         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
+           Memo.call fn sexp >>| fun res ->
+           `Result res
+         | fn, None ->
+           Fiber.return (`Error (sprintf "argument missing for '%s'" fn))
+        )
     in
-    Format.printf "%a\n%!" Sexp.pp res
+    match action with
+    | `Error msg ->
+      `Error (true, msg)
+    | `Result res ->
+      Format.printf "%a\n%!" Sexp.pp res;
+      `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 ()
   in
   (term, Term.info "compute" ~doc ~man)
 
-let list_functions =
-  let doc = "List internal functions." in
-  let man =
-    [ `S "DESCRIPTION"
-    ; `P {|Print the list of internal functions that can be used with
-           $(b,dune compute).|}
-    ; `Blocks Common.help_secs
-    ]
-  in
-  let term =
-    let%map common = Common.term in
-    Common.set_common common ~targets:[];
-    let log = Log.create common in
-    let _setup =
-      Scheduler.go ~log ~common
-        (Main.setup ~log common ~external_lib_deps_mode:true)
-    in
-    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
-  in
-  (term, Term.info "list-functions" ~doc ~man)
-
 let rules =
   let doc = "Dump internal rules." in
   let man =
@@ -1253,7 +1262,6 @@ let all =
   ; Help.help
   ; fmt
   ; compute
-  ; list_functions
   ]
 
 let default =

doc/dune.inc

@@ -71,15 +71,6 @@
  (package dune)
  (files   dune-installed-libraries.1))
 
-(rule
- (with-stdout-to dune-list-functions.1
-  (run dune list-functions --help=groff)))
-
-(install
- (section man)
- (package dune)
- (files   dune-list-functions.1))
-
 (rule
  (with-stdout-to dune-printenv.1
   (run dune printenv --help=groff)))

src/memo/memo.ml

@@ -391,17 +391,20 @@ module Make_hidden(Input : Input) =
       Exn.fatalf ~loc "<not-implemented>"
   end)
 
-let call name input =
+let get_func name =
   match
     let open Option.O in
     Function_name.get name >>= Spec.find
   with
   | None -> Exn.fatalf "@{<error>Error@}: function %s doesn't exist!" name
-  | Some (Spec.T spec) ->
-    let (module Output : Output with type t = _) = spec.output in
-    let input = Dune_lang.Decoder.parse spec.decode Univ_map.empty input in
-    spec.f input >>| fun output ->
-    Output.to_sexp output
+  | Some spec -> spec
+
+let call name input =
+  let (Spec.T spec) = get_func name in
+  let (module Output : Output with type t = _) = spec.output in
+  let input = Dune_lang.Decoder.parse spec.decode Univ_map.empty input in
+  spec.f input >>| fun output ->
+  Output.to_sexp output
 
 module Function_info = struct
   type t =
@@ -421,3 +424,6 @@ let registered_functions () =
   |> List.map ~f:Function_info.of_spec
   |> List.sort ~compare:(fun a b ->
     String.compare a.Function_info.name b.Function_info.name)
+
+let function_info name =
+  get_func name |> Function_info.of_spec

src/memo/memo.mli

@@ -69,3 +69,6 @@ end
 
 (** Return the list of registered functions *)
 val registered_functions : unit -> Function_info.t list
+
+(** Lookup function's info *)
+val function_info : string -> Function_info.t