强曰为道
与天地相似,故不违。知周乎万物,而道济天下,故不过。旁行而不流,乐天知命,故不忧.
文档目录

OCaml 教程 / CLI 工具开发

CLI 工具开发

OCaml 非常适合构建命令行工具,编译为原生代码,启动快,性能好。本节介绍如何用 Cmdliner 构建专业的 CLI 工具。

Cmdliner 库

Cmdliner 是 OCaml 的标准 CLI 解析库,支持自动帮助文档、子命令等。

opam install cmdliner
(* 最小示例 *)
open Cmdliner

let greet name =
  Printf.printf "Hello, %s!\n" name

let name_arg =
  let doc = "要问候的人名" in
  Arg.(required & pos 0 (some string) None & info [] ~doc)

let cmd =
  let doc = "一个简单的问候工具" in
  let info = Cmd.info "greet" ~doc in
  Cmd.v info Term.(const greet $ name_arg)

let () = exit (Cmd.eval cmd)
组件说明
Arg参数定义模块
Term术语(参数组合)
Cmd命令定义
Cmd.info命令元信息(名称、文档)
Cmd.eval执行命令并返回退出码

参数解析

open Cmdliner

(* 位置参数 *)
let pos_arg =
  let doc = "输入文件" in
  Arg.(required & pos 0 (some file) None & info [] ~doc)

(* 命名参数 *)
let verbose_arg =
  let doc = "启用详细输出" in
  Arg.(value & flag & info ["v"; "verbose"] ~doc)

let output_arg =
  let doc = "输出文件路径" in
  Arg.(value & opt string "output.txt" & info ["o"; "output"] ~doc)

let count_arg =
  let doc = "重复次数" in
  Arg.(value & opt int 1 & info ["n"; "count"] ~doc)

let level_arg =
  let doc = "日志级别" in
  let enums = Arg.enum [
    ("debug", `Debug);
    ("info", `Info);
    ("warn", `Warn);
    ("error", `Error);
  ] in
  Arg.(value & opt enums `Info & info ["l"; "level"] ~doc)

(* 组合参数 *)
let run verbose output count level files =
  Printf.printf "verbose=%b output=%s count=%d level=%s files=%s\n"
    verbose output count
    (match level with `Debug -> "debug" | `Info -> "info" | `Warn -> "warn" | `Error -> "error")
    (String.concat ", " files)

let cmd =
  let doc = "文件处理工具" in
  let info = Cmd.info "process" ~doc in
  Cmd.v info Term.(const run
    $ verbose_arg
    $ output_arg
    $ count_arg
    $ level_arg
    $ Arg.(value & pos_all file [] & info [] ~doc:"输入文件列表"))

let () = exit (Cmd.eval cmd)

💡 提示Arg.enum 定义可选值,自动验证输入并生成帮助文档。

子命令

open Cmdliner

(* 子命令:init *)
let init_cmd =
  let name_arg =
    let doc = "项目名称" in
    Arg.(required & pos 0 (some string) None & info [] ~doc)
  in
  let run name =
    Printf.printf "初始化项目: %s\n" name
  in
  let doc = "创建新项目" in
  let info = Cmd.info "init" ~doc in
  Cmd.v info Term.(const run $ name_arg)

(* 子命令:build *)
let build_cmd =
  let release_arg =
    let doc = "发布构建" in
    Arg.(value & flag & info ["r"; "release"] ~doc)
  in
  let run release =
    Printf.printf "构建%s\n" (if release then "(发布模式)" else "")
  in
  let doc = "构建项目" in
  let info = Cmd.info "build" ~doc in
  Cmd.v info Term.(const run $ release_arg)

(* 子命令:run *)
let run_cmd =
  let args_arg =
    let doc = "传递给程序的参数" in
    Arg.(value & pos_all string [] & info [] ~doc)
  in
  let run args =
    Printf.printf "运行: %s\n" (String.concat " " args)
  in
  let doc = "运行项目" in
  let info = Cmd.info "run" ~doc in
  Cmd.v info Term.(const run $ args_arg)

(* 子命令:test *)
let test_cmd =
  let pattern_arg =
    let doc = "测试名称模式" in
    Arg.(value & opt string "*" & info ["p"; "pattern"] ~doc)
  in
  let run pattern =
    Printf.printf "运行测试: %s\n" pattern
  in
  let doc = "运行测试" in
  let info = Cmd.info "test" ~doc in
  Cmd.v info Term.(const run $ pattern_arg)

(* 主命令 *)
let main_cmd =
  let doc = "项目管理工具" in
  let info = Cmd.info "mytool" ~doc ~version:"1.0.0" in
  Cmd.group info [init_cmd; build_cmd; run_cmd; test_cmd]

let () = exit (Cmd.eval main_cmd)
$ mytool --help
$ mytool init myproject
$ mytool build --release
$ mytool run arg1 arg2
$ mytool test --pattern="test_*"

⚠️ 注意Cmd.group 用于创建子命令组。每个子命令应有独立的 infoTerm

帮助文档生成

open Cmdliner

(* 自动帮助 *)
let cmd =
  let doc = "高级文件搜索工具" in
  let man = [
    `S Manpage.s_description;
    `P "在指定目录中搜索文件,支持正则表达式和多种过滤条件。";
    `S Manpage.s_examples;
    `Pre "  myfind /tmp -name '*.ml' -size +100k";
    `Pre "  myfind . -mtime -7 -type f";
    `S Manpage.s_bugs;
    `P "报告问题到 <https://github.com/example/myfind/issues>";
  ] in
  let info = Cmd.info "myfind" ~doc ~man in
  (* ... *)
  Cmd.v info Term.(const run $ args)

ANSI 颜色输出

(* 颜色模块 *)
module Color = struct
  let enabled = ref true

  let code n s =
    if !enabled then Printf.sprintf "\027[%dm%s\027[0m" n s
    else s

  let red s = code 31 s
  let green s = code 32 s
  let yellow s = code 33 s
  let blue s = code 34 s
  let magenta s = code 35 s
  let cyan s = code 36 s
  let white s = code 37 s
  let bold s = code 1 s
  let dim s = code 2 s
  let underline s = code 4 s

  (* 256 色 *)
  let color256 n s =
    if !enabled then Printf.sprintf "\027[38;5;%dm%s\027[0m" n s
    else s

  (* 背景色 *)
  let bg_red s = code 41 s
  let bg_green s = code 42 s
  let bg_yellow s = code 43 s
end

(* 使用 *)
let () =
  Printf.printf "%s %s %s\n"
    (Color.green "✓ 成功")
    (Color.yellow "⚠ 警告")
    (Color.red "✗ 错误");
  Printf.printf "%s: %s\n"
    (Color.bold "重要")
    (Color.dim "这是详细信息")

(* 终端检测 *)
let is_terminal () =
  Unix.isatty Unix.stdout

let setup_color () =
  Color.enabled := is_terminal ()
颜色函数ANSI 码用途
red31错误
green32成功
yellow33警告
blue34信息
bold1强调
dim2次要信息

💡 提示:使用 isatty 检测输出是否为终端,管道输出时禁用颜色避免乱码。

进度条

(* 简单进度条 *)
module ProgressBar = struct
  let create total =
    { total; current = 0; width = 40; start_time = Unix.gettimeofday () }

  type t = {
    total: int;
    mutable current: int;
    width: int;
    start_time: float;
  }

  let update t n =
    t.current <- n;
    let pct = float t.current /. float t.total in
    let filled = int_of_float (pct *. float t.width) in
    let empty = t.width - filled in
    let elapsed = Unix.gettimeofday () -. t.start_time in
    let eta = if t.current > 0 then
      elapsed /. float t.current *. float (t.total - t.current)
    else 0.0 in
    Printf.printf "\r  %3d%% [%s%s] %d/%d ETA %.0fs  "
      (int_of_float (pct *. 100.0))
      (String.make filled '#')
      (String.make empty ' ')
      t.current t.total eta;
    flush stdout

  let finish t =
    update t t.total;
    Printf.printf "\n%!"
end

(* 使用 *)
let () =
  let total = 100 in
  let pb = ProgressBar.create total in
  for i = 1 to total do
    Unix.sleepf 0.05;
    ProgressBar.update pb i
  done;
  ProgressBar.finish pb

文件遍历

(* 递归遍历目录 *)
let rec traverse_dir ~follow_symlinks path =
  let stat = if follow_symlinks then Unix.stat else Unix.lstat in
  let entries = Sys.readdir path |> Array.to_list in
  List.concat_map (fun name ->
    let full_path = Filename.concat path name in
    let st = stat full_path in
    match st.st_kind with
    | S_DIR ->
      (full_path, st) :: traverse_dir ~follow_symlinks full_path
    | S_REG ->
      [(full_path, st)]
    | _ ->
      []
  ) entries

(* 带过滤的遍历 *)
let find_files ?(min_size=0) ?(max_size=max_int) ?(extensions=[]) root =
  traverse_dir ~follow_symlinks:false root
  |> List.filter (fun (path, stat) ->
    let ext_ok = match extensions with
      | [] -> true
      | exts -> List.exists (Filename.check_suffix path) exts
    in
    let size_ok = stat.st_size >= min_size && stat.st_size <= max_size in
    ext_ok && size_ok
  )

(* 文件类型判断 *)
let file_kind = function
  | Unix.S_REG -> "文件"
  | Unix.S_DIR -> "目录"
  | Unix.S_LNK -> "链接"
  | Unix.S_CHR -> "字符设备"
  | Unix.S_BLK -> "块设备"
  | Unix.S_FIFO -> "管道"
  | Unix.S_SOCK -> "套接字"

(* 格式化文件大小 *)
let format_size size =
  if size < 1024 then Printf.sprintf "%d B" size
  else if size < 1024 * 1024 then Printf.sprintf "%.1f KB" (float size /. 1024.0)
  else if size < 1024 * 1024 * 1024 then Printf.sprintf "%.1f MB" (float size /. (1024.0 *. 1024.0))
  else Printf.sprintf "%.2f GB" (float size /. (1024.0 *. 1024.0 *. 1024.0))

⚠️ 注意:遍历目录时要处理权限错误(EACCES)和符号链接循环,避免程序崩溃。

信号处理

(* 注册信号处理器 *)
let setup_signals () =
  (* Ctrl+C *)
  Sys.set_signal Sys.sigint (Signal_handle (fun _ ->
    Printf.printf "\n收到中断信号,正在退出...\n";
    exit 130
  ));

  (* 终止信号 *)
  Sys.set_signal Sys.sigterm (Signal_handle (fun _ ->
    Printf.printf "\n收到终止信号,正在清理...\n";
    (* 清理临时文件等 *)
    exit 143
  ));

  (* 忽略管道信号(避免写入关闭的管道时崩溃) *)
  Sys.set_signal Sys.sigpipe Signal_ignore

(* 进度条与信号处理结合 *)
let with_interrupt_handling f =
  let interrupted = ref false in
  Sys.set_signal Sys.sigint (Signal_handle (fun _ ->
    interrupted := true
  ));
  let result = f interrupted in
  if !interrupted then begin
    Printf.printf "\n操作已取消\n";
    exit 130
  end;
  result

构建与分发

(* dune 配置 *)
(*
(executable
 (name mycli)
 (public_name mycli)
 (libraries cmdliner unix))
*)

(* opam 文件 *)
(*
opam-version: "2.0"
name: "mycli"
version: "1.0.0"
synopsis: "A useful CLI tool"
description: """
  A longer description of the tool.
"""
depends: [
  "ocaml" {>= "4.14"}
  "cmdliner" {>= "1.1.0"}
  "dune" {>= "3.0"}
]
build: [
  ["dune" "build" "-p" name]
]
*)
# 构建
dune build

# 测试
dune test

# 发布到 opam
opam publish mycli.1.0.0 .

# 交叉编译(可选)
opam install dune-cross
dune build --x linux_x86_64

实际案例:文件搜索工具

open Cmdliner

module C = Color

(* 文件匹配类型 *)
type match_result = {
  path: string;
  line_num: int option;
  content: string option;
  stat: Unix.stats;
}

(* 搜索模式 *)
type pattern =
  | Glob of string
  | Regex of Str.regexp
  | Literal of string

(* 搜索配置 *)
type config = {
  pattern: pattern;
  root: string;
  max_depth: int;
  file_type: string option;
  min_size: int option;
  max_size: int option;
  colorize: bool;
  count_only: bool;
}

(* glob 转正则 *)
let glob_to_regex glob =
  let buf = Buffer.create (String.length glob * 2) in
  String.iter (fun c -> match c with
    | '*' -> Buffer.add_string buf ".*"
    | '?' -> Buffer.add_char buf '.'
    | '.' -> Buffer.add_string buf "\\."
    | c -> Buffer.add_char buf c
  ) glob;
  Str.regexp (Buffer.contents buf)

(* 文件搜索 *)
let search_file pattern path =
  match pattern with
  | Glob g ->
    let re = glob_to_regex g in
    Str.string_match re (Filename.basename path) 0
  | Regex re ->
    Str.string_match re (Filename.basename path) 0
  | Literal s ->
    String.contains path s

(* 内容搜索 *)
let search_content pattern path =
  try
    let ic = open_in path in
    let results = ref [] in
    let line_num = ref 0 in
    (try while true do
      let line = input_line ic in
      incr line_num;
      let matched = match pattern with
        | Regex re -> (try ignore (Str.search_forward re line 0); true with Not_found -> false)
        | Literal s -> String.contains line s
        | Glob _ -> false
      in
      if matched then
        results := { path; line_num = Some !line_num; content = Some line; stat = Unix.stat path } :: !results
    done with End_of_file -> ());
    close_in ic;
    List.rev !results
  with _ -> []

(* 颜色高亮匹配 *)
let highlight_match text pattern =
  match pattern with
  | Literal s ->
    let re = Str.regexp_string s in
    (try
      let _ = Str.search_forward re text 0 in
      let before = String.sub text 0 (Str.match_beginning ()) in
      let matched = Str.matched_string text in
      let after = String.sub text (Str.match_end ()) (String.length text - Str.match_end ()) in
      before ^ C.red (C.bold matched) ^ after
    with Not_found -> text)
  | _ -> text

(* 输出结果 *)
let print_result config pattern result =
  if config.colorize then begin
    Printf.printf "%s" (C.cyan result.path);
    (match result.line_num with
     | Some n -> Printf.printf ":%s" (C.yellow (string_of_int n))
     | None -> ());
    (match result.content with
     | Some content ->
       Printf.printf ": %s" (highlight_match content pattern)
     | None -> ());
    Printf.printf "\n"
  end else begin
    Printf.printf "%s" result.path;
    (match result.line_num with
     | Some n -> Printf.printf ":%d" n
     | None -> ());
    (match result.content with
     | Some content -> Printf.printf ": %s" content
     | None -> ());
    Printf.printf "\n"
  end

(* 主搜索函数 *)
let search config pattern =
  let results = ref [] in
  let count = ref 0 in
  
  let rec search_dir depth dir =
    if depth > config.max_depth then ()
    else begin
      let entries =
        try Sys.readdir dir |> Array.to_list
        with Sys_error _ -> []
      in
      List.iter (fun name ->
        let path = Filename.concat dir name in
        try
          let stat = Unix.stat path in
          match stat.st_kind with
          | Unix.S_DIR ->
            search_dir (depth + 1) path
          | Unix.S_REG when search_file pattern path ->
            if config.count_only then incr count
            else begin
              let file_results = search_content pattern path in
              results := file_results @ !results
            end
          | _ -> ()
        with Unix.Unix_error _ -> ()
      ) entries
    end
  in
  
  search_dir 0 config.root;
  
  if config.count_only then
    Printf.printf "%d 个匹配\n" !count
  else
    List.iter (print_result config pattern) !results

(* CLI 定义 *)
let root_arg =
  let doc = "搜索根目录" in
  Arg.(value & opt string "." & info ["d"; "dir"] ~doc)

let pattern_arg =
  let doc = "搜索模式(glob 或正则)" in
  Arg.(required & pos 0 (some string) None & info [] ~doc)

let max_depth_arg =
  let doc = "最大递归深度" in
  Arg.(value & opt int 100 & info ["depth"] ~doc)

let count_only_arg =
  let doc = "只显示计数" in
  Arg.(value & flag & info ["c"; "count"] ~doc)

let no_color_arg =
  let doc = "禁用颜色" in
  Arg.(value & flag & info ["no-color"] ~doc)

let run root pattern_str max_depth count_only no_color =
  let config = {
    pattern = Literal pattern_str;
    root;
    max_depth;
    file_type = None;
    min_size = None;
    max_size = None;
    colorize = not no_color && is_terminal ();
    count_only;
  } in
  search config config.pattern

let cmd =
  let doc = "文件内容搜索工具" in
  let man = [
    `S Manpage.s_description;
    `P "在目录中搜索包含指定模式的文件。";
    `S Manpage.s_examples;
    `Pre "  myfind /tmp -p 'TODO'";
    `Pre "  myfind . -p 'error' --count";
    `Pre "  myfind src -p 'let.*=' --depth 3";
  ] in
  let info = Cmd.info "myfind" ~doc ~man ~version:"1.0.0" in
  Cmd.v info Term.(const run
    $ root_arg
    $ pattern_arg
    $ max_depth_arg
    $ count_only_arg
    $ no_color_arg)

let () = exit (Cmd.eval cmd)

扩展阅读


上一节Web 开发(Dream/Opium) 下一节数据序列化(JSON/Protobuf)