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 用于创建子命令组。每个子命令应有独立的 info 和 Term。
帮助文档生成
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 码 | 用途 |
|---|---|---|
red | 31 | 错误 |
green | 32 | 成功 |
yellow | 33 | 警告 |
blue | 34 | 信息 |
bold | 1 | 强调 |
dim | 2 | 次要信息 |
💡 提示:使用 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)