ส่วนที่ 5 นี้นำเสนอการประยุกต์ใช้ OCaml 5 กับงานระบบจริง ครอบคลุมการเขียนโปรแกรม I/O ระดับต่ำ การสื่อสารเครือข่าย การ serialize ข้อมูล การเชื่อมต่อฐานข้อมูล การสร้าง CLI tools และการปรับแต่งประสิทธิภาพ โดยเน้นตัวอย่างที่พร้อมนำไปใช้งานจริงในระบบ production
การเขียนโปรแกรมระบบ (systems programming) ต้องสามารถเข้าถึงทรัพยากรของระบบปฏิบัติการได้โดยตรง OCaml 5 มีโมดูล Unix เป็น standard library ที่ห่อหุ้ม (wrap) POSIX system calls ไว้ และเมื่อใช้ร่วมกับ Eio จะได้ประสิทธิภาพแบบ non-blocking asynchronous I/O ที่ทัดเทียมกับภาษา systems สมัยใหม่
โมดูล Unix ให้การเข้าถึง system calls (การเรียกระบบ) ที่สำคัญ เช่น การเปิดไฟล์ อ่าน/เขียน และจัดการ file descriptor (ตัวชี้ไฟล์ที่ kernel ใช้)
Primitive หลักที่ควรรู้:
Unix.openfile เปิดไฟล์คืน file_descrUnix.read / Unix.write อ่าน-เขียนแบบ byte-levelUnix.close ต้องเรียกทุกครั้งเพื่อป้องกัน fd leakUnix.lseek ปรับตำแหน่ง cursor ในไฟล์(* file: low_level_io.ml *)
(* ตัวอย่างการอ่านไฟล์ระดับต่ำด้วย Unix module
โดยใช้ buffer ขนาดคงที่และจัดการ fd แบบปลอดภัย *)
let read_file_lowlevel path =
(* เปิดไฟล์แบบ read-only พร้อม permission 0o644 *)
let fd = Unix.openfile path [ Unix.O_RDONLY ] 0o644 in
let buffer = Bytes.create 4096 in
let buf_out = Buffer.create 4096 in
let rec loop () =
(* อ่านเข้า buffer ทีละ chunk ขนาด 4 KiB *)
let n = Unix.read fd buffer 0 (Bytes.length buffer) in
if n > 0 then begin
Buffer.add_subbytes buf_out buffer 0 n;
loop ()
end
in
(* ใช้ Fun.protect เพื่อให้แน่ใจว่า fd จะถูกปิดเสมอ
แม้ว่า loop จะ raise exception ขึ้นมา *)
Fun.protect
~finally:(fun () -> Unix.close fd)
loop;
Buffer.contents buf_out
(* ตัวอย่างการใช้งาน *)
let () =
let content = read_file_lowlevel "/etc/hostname" in
Printf.printf "Hostname: %s" content
สังเกตการใช้ Fun.protect ซึ่งเป็น pattern ที่ปลอดภัยกว่า try-finally แบบ manual และเป็น idiom มาตรฐานใน OCaml สำหรับ resource cleanup
File descriptor เป็น integer ที่ kernel ใช้อ้างถึงทรัพยากร I/O ทุกประเภท (ไฟล์ socket pipe terminal)
(* file: pipe_ipc.ml *)
(* Pipe สำหรับ Inter-Process Communication (IPC) ระหว่าง parent-child *)
let pipe_demo () =
(* สร้าง pipe ได้ tuple (read_end, write_end) *)
let read_fd, write_fd = Unix.pipe () in
match Unix.fork () with
| 0 ->
(* Child process: ปิดฝั่งอ่าน เขียนข้อมูลลง write_fd *)
Unix.close read_fd;
let msg = "Hello from child\n" in
let _ = Unix.write_substring write_fd msg 0 (String.length msg) in
Unix.close write_fd;
exit 0
| pid ->
(* Parent process: ปิดฝั่งเขียน อ่านจาก read_fd *)
Unix.close write_fd;
let buf = Bytes.create 1024 in
let n = Unix.read read_fd buf 0 1024 in
Unix.close read_fd;
let _ = Unix.waitpid [] pid in
Printf.printf "Parent received: %s" (Bytes.sub_string buf 0 n)
let () = pipe_demo ()
Eio เป็น library ระดับสูงที่ห่อหุ้มกลไก event notification ของระบบปฏิบัติการต่าง ๆ ไว้ภายใต้ interface เดียวกัน
%%{init: {'theme':'base','themeVariables':{
'primaryColor':'#3c3836','primaryTextColor':'#ebdbb2',
'primaryBorderColor':'#fabd2f','lineColor':'#83a598',
'secondaryColor':'#504945','tertiaryColor':'#32302f',
'background':'#282828','mainBkg':'#3c3836',
'nodeBorder':'#fabd2f','clusterBkg':'#32302f',
'clusterBorder':'#d65d0e','titleColor':'#fabd2f',
'edgeLabelBackground':'#282828','textColor':'#ebdbb2'
}}}%%
flowchart TB
subgraph App["OCaml Application
(โปรแกรมผู้ใช้)"]
Code["Eio.Flow / Eio.Net API
(high-level API)"]
end
subgraph Eio["Eio Scheduler
(ตัวจัดคิว fiber)"]
Fiber["Fiber Pool
(คิว coroutine)"]
Sched["Event Loop
(วงรอเหตุการณ์)"]
end
subgraph Backends["Platform Backends"]
Linux["eio_linux
io_uring / epoll"]
BSD["eio_posix
kqueue (macOS/BSD)"]
Win["eio_windows
IOCP"]
end
subgraph OS["Operating System Kernel"]
Uring["io_uring"]
Epoll["epoll"]
Kqueue["kqueue"]
Iocp["IOCP"]
end
Code --> Fiber
Fiber --> Sched
Sched --> Linux
Sched --> BSD
Sched --> Win
Linux --> Uring
Linux --> Epoll
BSD --> Kqueue
Win --> Iocp
(* file: eio_echo_server.ml *)
(* Echo server ใช้ Eio — non-blocking I/O พร้อม structured concurrency *)
let handle_client flow addr =
Eio.traceln "New client: %a" Eio.Net.Sockaddr.pp addr;
(* Eio.Flow.copy จะ loop อ่าน-เขียนจนกว่า client จะปิด *)
try Eio.Flow.copy flow flow
with End_of_file -> Eio.traceln "Client disconnected"
let run_server ~net ~sw port =
let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in
let socket = Eio.Net.listen ~sw ~reuse_addr:true ~backlog:128 net addr in
Eio.traceln "Listening on port %d" port;
(* Loop รับ connection — ทุก fiber มี Switch เป็นเจ้าของ *)
while true do
Eio.Net.accept_fork ~sw socket
~on_error:(fun ex -> Eio.traceln "Error: %a" Fmt.exn ex)
handle_client
done
(* ตัวอย่างการใช้งาน: รัน server บน port 9000 *)
let () =
Eio_main.run @@ fun env ->
Eio.Switch.run @@ fun sw ->
run_server ~net:(Eio.Stdenv.net env) ~sw 9000
Signal คือ software interrupt (การขัดจังหวะเชิงซอฟต์แวร์) ที่ OS ส่งมาให้ process เช่น SIGINT (Ctrl+C), SIGTERM, SIGHUP
(* file: signal_handling.ml *)
(* จัดการ signal อย่างปลอดภัย — graceful shutdown *)
let shutdown_requested = Atomic.make false
let install_handlers () =
(* Sys.signal จะติดตั้ง handler — ต้องเป็น async-signal-safe
ดังนั้นแค่ set flag แล้วให้ main loop ตรวจสอบเอง *)
let handler _ = Atomic.set shutdown_requested true in
Sys.set_signal Sys.sigint (Sys.Signal_handle handler);
Sys.set_signal Sys.sigterm (Sys.Signal_handle handler)
let main_loop () =
install_handlers ();
let rec loop n =
if Atomic.get shutdown_requested then begin
Printf.printf "\nGraceful shutdown after %d iterations\n" n;
(* ทำ cleanup: ปิด connection, flush log ฯลฯ *)
end else begin
Printf.printf "Working... %d\r%!" n;
Unix.sleepf 0.5;
loop (n + 1)
end
in
loop 0
(* ตัวอย่างการใช้งาน: กด Ctrl+C เพื่อหยุด *)
let () = main_loop ()
(* file: process_mgmt.ml *)
(* รันคำสั่งภายนอก แล้วเก็บ output — equivalent ของ subprocess.run() ใน Python *)
let run_command cmd args =
(* สร้าง pipe สำหรับอ่าน stdout ของ child *)
let read_fd, write_fd = Unix.pipe () in
match Unix.fork () with
| 0 ->
(* Child: redirect stdout ไป pipe write end *)
Unix.close read_fd;
Unix.dup2 write_fd Unix.stdout;
Unix.close write_fd;
(* execvp จะแทนที่ process image ด้วย cmd *)
Unix.execvp cmd (Array.of_list (cmd :: args))
| pid ->
(* Parent: อ่านจาก pipe, รอ child เสร็จ *)
Unix.close write_fd;
let buf = Buffer.create 4096 in
let chunk = Bytes.create 4096 in
let rec read_loop () =
let n = Unix.read read_fd chunk 0 4096 in
if n > 0 then (Buffer.add_subbytes buf chunk 0 n; read_loop ())
in
read_loop ();
Unix.close read_fd;
let _, status = Unix.waitpid [] pid in
let exit_code = match status with
| Unix.WEXITED c -> c
| Unix.WSIGNALED _ | Unix.WSTOPPED _ -> -1
in
(exit_code, Buffer.contents buf)
(* ตัวอย่างการใช้งาน *)
let () =
let code, output = run_command "uname" ["-a"] in
Printf.printf "Exit code: %d\nOutput: %s" code output
ตารางเปรียบเทียบ System Call Wrappers:
| Function | POSIX equivalent | Blocking? | ใช้เมื่อไหร่ |
|---|---|---|---|
Unix.read |
read(2) |
Blocking | I/O แบบ synchronous ง่าย ๆ |
Unix.select |
select(2) |
Blocking until ready | multiplex fd จำนวนน้อย |
Eio.Flow.read |
io_uring/epoll |
Non-blocking (fiber suspend) | high-performance servers |
Unix.fork |
fork(2) |
N/A | สร้าง child process |
Unix.execvp |
execvp(3) |
Replaces process | รันโปรแกรมภายนอก |
การเขียนโปรแกรมเครือข่าย (network programming) ใน OCaml 5 มีตัวเลือกตั้งแต่ระดับต่ำด้วย Unix module ไปจนถึง high-level frameworks อย่าง Dream และ Cohttp
(* file: tcp_echo_lowlevel.ml *)
(* TCP echo server แบบ thread-per-connection ด้วย Unix module *)
let handle_client client_fd =
let buf = Bytes.create 1024 in
let rec loop () =
let n = Unix.read client_fd buf 0 1024 in
if n > 0 then begin
(* echo ข้อมูลกลับไปยัง client *)
let _ = Unix.write client_fd buf 0 n in
loop ()
end
in
(try loop () with _ -> ());
Unix.close client_fd
let run_tcp_server port =
let server_fd = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
Unix.setsockopt server_fd Unix.SO_REUSEADDR true;
let addr = Unix.ADDR_INET (Unix.inet_addr_any, port) in
Unix.bind server_fd addr;
Unix.listen server_fd 128;
Printf.printf "TCP server listening on port %d\n%!" port;
while true do
let client_fd, _ = Unix.accept server_fd in
(* spawn thread ต่อ 1 connection — ใช้ Thread จาก threads.posix *)
let _ = Thread.create handle_client client_fd in
()
done
(* ตัวอย่างการใช้งาน *)
let () = run_tcp_server 8080
Dream เป็น web framework ทันสมัย ที่เขียนง่ายคล้าย Flask แต่ type-safe
(* file: dream_api.ml *)
(* REST API ง่าย ๆ ด้วย Dream *)
let users = Hashtbl.create 16
let next_id = ref 1
let add_user name =
let id = !next_id in
incr next_id;
Hashtbl.add users id name;
id
(* Handler สำหรับ POST /users *)
let create_user req =
let%lwt body = Dream.body req in
match Yojson.Safe.from_string body with
| `Assoc [("name", `String name)] ->
let id = add_user name in
let resp = `Assoc [("id", `Int id); ("name", `String name)] in
Dream.json (Yojson.Safe.to_string resp)
| _ -> Dream.respond ~status:`Bad_Request "Invalid JSON"
(* Handler สำหรับ GET /users/:id *)
let get_user req =
let id_str = Dream.param req "id" in
match int_of_string_opt id_str with
| None -> Dream.respond ~status:`Bad_Request "Invalid ID"
| Some id ->
(match Hashtbl.find_opt users id with
| None -> Dream.respond ~status:`Not_Found "User not found"
| Some name ->
let resp = `Assoc [("id", `Int id); ("name", `String name)] in
Dream.json (Yojson.Safe.to_string resp))
(* ตัวอย่างการใช้งาน: รัน server พร้อม routing *)
let () =
Dream.run ~port:8080
@@ Dream.logger
@@ Dream.router [
Dream.post "/users" create_user;
Dream.get "/users/:id" get_user;
]
ทดสอบด้วย curl:
curl -X POST http://localhost:8080/users \
-H "Content-Type: application/json" \
-d '{"name":"Moo"}'
# => {"id":1,"name":"Moo"}
curl http://localhost:8080/users/1
# => {"id":1,"name":"Moo"}
การ parse binary protocol (เช่น DNS, TLS, custom RPC) ต้องการ library ที่ปลอดภัยและเร็ว
(* file: binary_proto.ml *)
(* Parse custom binary message format:
| 4 bytes magic | 1 byte version | 2 bytes length | payload |
*)
open Angstrom
(* ชนิดข้อมูลของ message หลัง parse *)
type message = {
magic: int32;
version: int;
payload: string;
}
let parse_message =
let* magic = BE.any_int32 in (* big-endian 32-bit *)
let* version = any_uint8 in
let* length = BE.any_uint16 in
let* payload = take length in (* อ่าน payload ตาม length *)
return { magic; version; payload }
let serialize_message msg =
let open Faraday in
let buf = create 256 in
BE.write_uint32 buf msg.magic;
write_uint8 buf msg.version;
BE.write_uint16 buf (String.length msg.payload);
write_string buf msg.payload;
serialize_to_string buf
(* ตัวอย่างการใช้งาน: encode แล้ว decode กลับ *)
let () =
let original = { magic = 0xDEADBEEFl; version = 1; payload = "Hello" } in
let bytes = serialize_message original in
match parse_string ~consume:All parse_message bytes with
| Ok m ->
Printf.printf "magic=0x%lX version=%d payload=%S\n"
m.magic m.version m.payload
| Error e -> Printf.printf "Parse error: %s\n" e
Library tls implement TLS 1.2/1.3 ทั้งหมดด้วย OCaml ล้วน ไม่พึ่ง OpenSSL ทำให้ได้ memory safety ตั้งแต่ระดับโปรโตคอล
(* file: tls_client.ml *)
(* HTTPS client ง่าย ๆ ด้วย tls + Eio *)
let fetch_https ~env host path =
Eio.Switch.run @@ fun sw ->
let net = Eio.Stdenv.net env in
(* resolve hostname ผ่าน Eio.Net.getaddrinfo_stream *)
let addrs = Eio.Net.getaddrinfo_stream ~service:"443" net host in
let addr = List.hd addrs in
let sock = Eio.Net.connect ~sw net addr in
(* สร้าง TLS config พร้อม authenticator (verify cert) *)
let host_name = Domain_name.host_exn (Domain_name.of_string_exn host) in
let authenticator = Ca_certs.authenticator () |> Result.get_ok in
let cfg = Tls.Config.client ~authenticator () |> Result.get_ok in
let tls_flow = Tls_eio.client_of_flow cfg ~host:host_name sock in
(* ส่ง HTTP request แบบดิบ ๆ ผ่าน TLS flow *)
let req = Printf.sprintf
"GET %s HTTP/1.0\r\nHost: %s\r\nConnection: close\r\n\r\n" path host in
Eio.Flow.copy_string req tls_flow;
let buf = Buffer.create 4096 in
Eio.Flow.(copy tls_flow (buffer_sink buf));
Buffer.contents buf
(* ตัวอย่างการใช้งาน *)
let () =
Eio_main.run @@ fun env ->
let response = fetch_https ~env "example.com" "/" in
print_endline (String.sub response 0 (min 200 (String.length response)))
สำหรับ microservices ที่ใช้ gRPC library ocaml-protoc สามารถ generate OCaml code จาก .proto file ได้
ตัวอย่าง .proto file:
// file: user.proto
syntax = "proto3";
message User {
int32 id = 1;
string name = 2;
string email = 3;
}
message GetUserRequest { int32 id = 1; }
service UserService {
rpc GetUser(GetUserRequest) returns (User);
}
Generate code:
ocaml-protoc --ocaml_out ./src user.proto
# => สร้าง user.ml และ user.mli ที่มี type User.user และ functions encode/decode
ตารางเปรียบเทียบ Network Libraries:
| Library | Layer | Sync/Async | เหมาะกับ |
|---|---|---|---|
Unix |
Socket | Blocking | เรียนรู้พื้นฐาน, legacy |
Eio.Net |
Socket | Async (fiber) | High-perf servers |
Cohttp-eio |
HTTP/1.1 | Async | RESTful services |
Dream |
HTTP + routing | Async (Lwt/Eio) | Full-stack web apps |
H2 |
HTTP/2 | Async | gRPC, modern APIs |
tls |
TLS 1.2/1.3 | Pluggable | Security-critical |
Parser combinator คือแนวคิดการประกอบ parser เล็ก ๆ หลายตัวเป็น parser ใหญ่ ผ่าน function composition — อ่านง่าย แก้ไขง่าย และ type-safe
(* file: csv_parser.ml *)
(* Parse CSV แบบง่าย: รองรับ quoted strings และ escape *)
open Angstrom
let is_quote = Char.equal '"'
let is_comma = Char.equal ','
let is_newline = Char.equal '\n'
(* Field ที่ไม่มี quote: อ่านจนเจอ , หรือ \n *)
let unquoted_field =
take_while (fun c -> not (is_comma c) && not (is_newline c))
(* Field ที่มี quote: "..." โดย "" ภายในแทน " หนึ่งตัว *)
let quoted_field =
char '"' *>
(many (
(char '"' *> char '"' *> return '"') <|>
(not_char '"')
) >>| fun chars -> String.init (List.length chars) (List.nth chars)) <*
char '"'
let field = quoted_field <|> unquoted_field
(* Row = field คั่นด้วย comma *)
let row = sep_by (char ',') field
(* CSV = row คั่นด้วย newline *)
let csv = sep_by (char '\n') row
(* ตัวอย่างการใช้งาน *)
let () =
let input = {|name,age,city
"Moo, the Cat",3,"Bangkok"
Alice,30,London|} in
match parse_string ~consume:All csv input with
| Ok rows ->
List.iter (fun row ->
Printf.printf "[%s]\n" (String.concat " | " row)
) rows
| Error e -> print_endline e
Faraday เป็น library serialize ที่เป็นคู่ขนานของ Angstrom — เขียน binary/text output แบบมี buffered writer
(* file: faraday_http.ml *)
(* Serialize HTTP response แบบ efficient *)
open Faraday
let write_http_response ~status ~headers ~body =
let buf = create 4096 in
(* Status line *)
write_string buf (Printf.sprintf "HTTP/1.1 %d OK\r\n" status);
(* Headers *)
List.iter (fun (k, v) ->
write_string buf (Printf.sprintf "%s: %s\r\n" k v)
) headers;
write_string buf (Printf.sprintf "Content-Length: %d\r\n" (String.length body));
write_string buf "\r\n";
(* Body *)
write_string buf body;
serialize_to_string buf
(* ตัวอย่างการใช้งาน *)
let () =
let resp = write_http_response
~status:200
~headers:[("Content-Type", "application/json")]
~body:{|{"ok":true}|}
in
print_endline resp
ppx_yojson_conv เป็น PPX extension ที่ generate JSON encoder/decoder อัตโนมัติจาก type definition
(* file: json_demo.ml *)
(* ต้องเพิ่ม preprocess (pps ppx_yojson_conv) ใน dune file *)
(* ประกาศ type พร้อม [@@deriving yojson] *)
type address = {
street: string;
city: string;
zipcode: string;
} [@@deriving yojson]
type user = {
id: int;
name: string;
email: string option; (* option = nullable field *)
addresses: address list; (* list = JSON array *)
} [@@deriving yojson]
(* ตัวอย่างการใช้งาน: encode/decode round-trip *)
let () =
let u = {
id = 1;
name = "Moo";
email = Some "moo@rmutsv.ac.th";
addresses = [
{ street = "1 Ratchadamnoen"; city = "Songkhla"; zipcode = "90000" }
]
} in
(* encode → JSON string *)
let json_str = Yojson.Safe.pretty_to_string (user_to_yojson u) in
print_endline json_str;
(* decode ← JSON string *)
match user_of_yojson (Yojson.Safe.from_string json_str) with
| u2 -> Printf.printf "Decoded name: %s\n" u2.name
Cstruct คล้าย zerocopy ของ Rust — ประกาศ layout ของ binary struct แล้ว library จะ generate accessor ที่ปลอดภัย
(* file: cstruct_demo.ml *)
(* ต้องเพิ่ม (preprocess (pps ppx_cstruct)) ใน dune *)
(* ประกาศ struct แบบ Ethernet header *)
[%%cstruct
type ethernet = {
dst: uint8_t [@len 6]; (* destination MAC *)
src: uint8_t [@len 6]; (* source MAC *)
ethertype: uint16_t; (* 0x0800 = IPv4 *)
} [@@big_endian]]
(* Accessor ที่ถูก generate: set_ethernet_ethertype, get_ethernet_ethertype,
copy_ethernet_dst, sizeof_ethernet ฯลฯ *)
let parse_ethernet_frame (buf: Cstruct.t) =
if Cstruct.length buf < sizeof_ethernet then
Error "Frame too short"
else
let dst = copy_ethernet_dst buf in
let src = copy_ethernet_src buf in
let ethertype = get_ethernet_ethertype buf in
Ok (dst, src, ethertype)
let mac_to_string mac =
String.init 17 (fun i ->
if i mod 3 = 2 then ':'
else
let byte_idx = i / 3 in
let nibble = if i mod 3 = 0 then (Char.code mac.[byte_idx] lsr 4)
else (Char.code mac.[byte_idx] land 0xf) in
"0123456789abcdef".[nibble])
(* ตัวอย่างการใช้งาน *)
let () =
let frame = Cstruct.create 14 in
set_ethernet_ethertype frame 0x0800;
(match parse_ethernet_frame frame with
| Ok (dst, src, et) ->
Printf.printf "dst=%s src=%s ethertype=0x%04x\n"
(mac_to_string dst) (mac_to_string src) et
| Error e -> print_endline e)
Zarith ห่อหุ้ม GMP library ให้ OCaml ใช้ได้ จำเป็นสำหรับงาน cryptography และ finance ที่ต้องการ precision สูงกว่า 63-bit int
สูตรพื้นฐานของ modular exponentiation (ใช้ใน RSA, Diffie-Hellman):
โดยที่ คือ plaintext, คือ public exponent, คือ modulus (product ของ primes สองตัว) และ คือ ciphertext
(* file: zarith_demo.ml *)
(* ตัวอย่าง RSA encryption แบบง่าย — เพื่อการศึกษาเท่านั้น ห้ามใช้จริง *)
(* Zarith type: Z.t = integer ขนาดไม่จำกัด *)
let rsa_encrypt ~m ~e ~n = Z.powm m e n
let rsa_decrypt ~c ~d ~n = Z.powm c d n
(* ตัวอย่างการใช้งานด้วย primes เล็ก ๆ *)
let () =
let p = Z.of_int 61 in
let q = Z.of_int 53 in
let n = Z.mul p q in (* n = 3233 *)
let phi = Z.mul (Z.pred p) (Z.pred q) in (* (p-1)(q-1) = 3120 *)
let e = Z.of_int 17 in
let d = Z.invert e phi in (* modular inverse *)
let m = Z.of_int 65 in (* plaintext = 'A' *)
let c = rsa_encrypt ~m ~e ~n in
let m' = rsa_decrypt ~c ~d ~n in
Printf.printf "plaintext=%s ciphertext=%s decrypted=%s\n"
(Z.to_string m) (Z.to_string c) (Z.to_string m')
Caqti เป็น DB library ที่ไม่ผูกกับ driver เดียว — เขียน query ครั้งเดียว ใช้ได้ทั้ง PostgreSQL, SQLite, MariaDB
(* file: caqti_demo.ml *)
(* CRUD ง่าย ๆ ด้วย Caqti + SQLite *)
open Caqti_request.Infix
open Caqti_type.Std
(* ประกาศ query พร้อม type ของ params และ result *)
let create_table =
(unit ->. unit) {|
CREATE TABLE IF NOT EXISTS users (
id INTEGER PRIMARY KEY AUTOINCREMENT,
name TEXT NOT NULL,
age INTEGER NOT NULL
)
|}
let insert_user =
(t2 string int ->. unit)
"INSERT INTO users (name, age) VALUES (?, ?)"
let get_user_by_id =
(int ->? t2 string int)
"SELECT name, age FROM users WHERE id = ?"
let list_users =
(unit ->* t3 int string int)
"SELECT id, name, age FROM users ORDER BY id"
(* ทุก function ของ Caqti คืน Lwt.t หรือ Eio result
ในที่นี้ใช้ Caqti_lwt สำหรับตัวอย่าง *)
let ( let* ) = Lwt_result.bind
let run (module Db : Caqti_lwt.CONNECTION) =
let* () = Db.exec create_table () in
let* () = Db.exec insert_user ("Moo", 30) in
let* () = Db.exec insert_user ("Alice", 25) in
let* users = Db.collect_list list_users () in
List.iter (fun (id, name, age) ->
Printf.printf "#%d %s (%d)\n" id name age
) users;
Lwt_result.return ()
(* ตัวอย่างการใช้งาน *)
let () =
let uri = Uri.of_string "sqlite3:demo.db" in
Lwt_main.run @@
let open Lwt.Syntax in
let* conn_result = Caqti_lwt_unix.connect uri in
match conn_result with
| Error e -> Lwt.return (print_endline (Caqti_error.show e))
| Ok conn ->
let+ result = run conn in
(match result with
| Ok () -> print_endline "Done"
| Error e -> print_endline (Caqti_error.show e))
สำหรับ web service ต้องใช้ connection pool เพื่อไม่ให้เปิด-ปิด connection ใหม่ทุก request
(* file: conn_pool.ml *)
(* Connection pool ง่าย ๆ ด้วย Eio.Stream และ Eio.Switch *)
module Pool = struct
type 'a t = {
stream: 'a Eio.Stream.t;
create: unit -> 'a;
destroy: 'a -> unit;
}
let create ~size ~create ~destroy () =
let stream = Eio.Stream.create size in
for _ = 1 to size do
Eio.Stream.add stream (create ())
done;
{ stream; create; destroy }
(* ยืม connection ชั่วคราว แล้วคืนเมื่อเสร็จ *)
let with_conn t f =
let conn = Eio.Stream.take t.stream in
Fun.protect
~finally:(fun () -> Eio.Stream.add t.stream conn)
(fun () -> f conn)
let close t =
for _ = 1 to Eio.Stream.length t.stream do
t.destroy (Eio.Stream.take t.stream)
done
end
(* ตัวอย่างการใช้งานกับ mock DB connection *)
let () =
Eio_main.run @@ fun _env ->
Eio.Switch.run @@ fun sw ->
let pool = Pool.create ~size:5
~create:(fun () ->
Printf.printf "Creating connection\n";
ref 0)
~destroy:(fun _ -> Printf.printf "Destroying\n")
()
in
(* Spawn 10 fiber ใช้ pool ขนาด 5 *)
for i = 1 to 10 do
Eio.Fiber.fork ~sw (fun () ->
Pool.with_conn pool (fun conn ->
incr conn;
Printf.printf "Fiber %d: used connection %d times\n" i !conn))
done;
Eio.Switch.on_release sw (fun () -> Pool.close pool)
Index เป็น append-only on-disk KV store ที่เร็วมาก เหมาะสำหรับ cache, log, หรือ inverted index
(* file: index_demo.ml *)
(* Persistent key-value store ด้วย Index *)
(* ต้องนิยาม Key และ Value modules ที่บอกขนาด hash encode/decode *)
module Key = struct
type t = string
let v x = x
let hash = Hashtbl.hash
let hash_size = 30
let encode s = s
let decode s off = String.sub s off 32
let encoded_size = 32
let equal = String.equal
let pp = Format.pp_print_string
end
module Value = struct
type t = int64
let encode x =
let buf = Bytes.create 8 in
Bytes.set_int64_le buf 0 x;
Bytes.unsafe_to_string buf
let decode s off = Bytes.get_int64_le (Bytes.of_string s) off
let encoded_size = 8
let pp = Format.pp_print_int64
end
module I = Index_unix.Make (Key) (Value) (Index.Cache.Unbounded)
(* ตัวอย่างการใช้งาน *)
let () =
let idx = I.v ~log_size:1000 "./my_index" in
(* เขียนหลาย key-value *)
let pad k = let s = k ^ String.make 32 '\x00' in String.sub s 0 32 in
I.replace idx (pad "user:1") 100L;
I.replace idx (pad "user:2") 200L;
I.flush idx;
(* อ่านกลับ *)
Printf.printf "user:1 = %Ld\n" (I.find idx (pad "user:1"));
I.close idx
Irmin คือ Mirage project library ที่ทำให้ข้อมูลทุกอย่างมี history แบบ Git — branch, merge, diff ได้
%%{init: {'theme':'base','themeVariables':{
'primaryColor':'#3c3836','primaryTextColor':'#ebdbb2',
'primaryBorderColor':'#fabd2f','lineColor':'#83a598',
'secondaryColor':'#504945','tertiaryColor':'#32302f',
'background':'#282828','mainBkg':'#3c3836',
'nodeBorder':'#fabd2f','clusterBkg':'#32302f',
'clusterBorder':'#d65d0e','titleColor':'#fabd2f',
'edgeLabelBackground':'#282828','textColor':'#ebdbb2'
}}}%%
gitGraph
commit id: "init"
commit id: "add user:1"
branch feature
checkout feature
commit id: "experiment"
commit id: "experiment v2"
checkout main
commit id: "add user:2"
merge feature id: "merge feature"
commit id: "release v1"
(* file: irmin_demo.ml *)
(* Irmin in-memory store with branching *)
module Store = Irmin_mem.KV.Make (Irmin.Contents.String)
module Info = Irmin_unix.Info (Store.Info)
let info msg = Info.v ~author:"moo" "%s" msg
(* ตัวอย่างการใช้งาน: commit, branch, merge *)
let main () =
let open Lwt.Syntax in
let config = Irmin_mem.config () in
let* repo = Store.Repo.v config in
let* main_branch = Store.main repo in
(* Commit #1 *)
let* () = Store.set_exn ~info:(info "add readme") main_branch
["readme"] "Hello Irmin" in
(* สร้าง branch ใหม่ *)
let* dev = Store.of_branch repo "dev" in
let* () = Store.merge_into ~info:(info "sync") main_branch ~into:dev
>|= Result.get_ok in
let* () = Store.set_exn ~info:(info "add feature") dev
["feature"] "experimental" in
(* Merge กลับไป main *)
let* () = Store.merge_into ~info:(info "release") dev ~into:main_branch
>|= Result.get_ok in
let* content = Store.get main_branch ["feature"] in
Lwt_io.printf "feature = %s\n" content
let () = Lwt_main.run (main ())
ตารางเปรียบเทียบ Storage Solutions:
| Library | ชนิด | Concurrent writers | Best for |
|---|---|---|---|
| Caqti | SQL client | ขึ้นกับ DB | OLTP, รายงาน |
| Index | KV store | No (single-writer) | Cache, log |
| Irmin | Git-like | Yes (via merge) | Distributed config, state |
| lmdb | Embedded KV | Yes (MVCC) | High-throughput read |
Cmdliner มองทุก command-line option เป็น term ที่ประกอบกันแบบ applicative — auto generate man page ได้
(* file: cli_app.ml *)
(* CLI tool สำหรับ ping server พร้อม options *)
open Cmdliner
(* ประกาศ arguments เป็น term *)
let host =
let doc = "Hostname หรือ IP address ของ server" in
Arg.(required & pos 0 (some string) None & info [] ~docv:"HOST" ~doc)
let port =
let doc = "TCP port" in
Arg.(value & opt int 80 & info ["p"; "port"] ~docv:"PORT" ~doc)
let count =
let doc = "จำนวนครั้งที่ ping" in
Arg.(value & opt int 4 & info ["c"; "count"] ~docv:"N" ~doc)
let verbose =
let doc = "แสดงรายละเอียดการทำงาน" in
Arg.(value & flag & info ["v"; "verbose"] ~doc)
(* Function หลัก *)
let run host port count verbose =
if verbose then Printf.printf "Pinging %s:%d %d times\n" host port count;
for i = 1 to count do
Printf.printf "Ping #%d to %s:%d\n" i host port
done;
0 (* exit code *)
(* ประกอบ term เข้าด้วยกัน *)
let cmd =
let doc = "Ping a TCP server" in
let info = Cmd.info "tcping" ~version:"1.0" ~doc in
Cmd.v info Term.(const run $ host $ port $ count $ verbose)
(* ตัวอย่างการใช้งาน: dune exec ./cli_app.exe -- example.com -p 443 -c 3 -v *)
let () = exit (Cmd.eval' cmd)
(* file: logging_demo.ml *)
(* Structured logging ด้วย Logs + Fmt *)
(* ประกาศ log source สำหรับแต่ละ module *)
let src = Logs.Src.create "myapp.db" ~doc:"Database operations"
module Log = (val Logs.src_log src : Logs.LOG)
let process_user user_id =
Log.debug (fun m -> m "Processing user %d" user_id);
if user_id <= 0 then begin
Log.err (fun m -> m "Invalid user_id: %d" user_id);
Error "invalid"
end else begin
Log.info (fun m -> m "User %d processed successfully" user_id);
Ok user_id
end
(* ตัวอย่างการตั้งค่า log *)
let setup_log level =
Logs.set_level (Some level);
(* reporter ที่เขียนลง stderr พร้อมสีและ timestamp *)
Logs.set_reporter (Logs_fmt.reporter ())
let () =
setup_log Logs.Debug;
let _ = process_user 42 in
let _ = process_user (-1) in
()
(* file: config.ml *)
(* Config แบบ layered: defaults < env vars < config file < CLI args *)
type config = {
db_host: string;
db_port: int;
workers: int;
log_level: string;
}
let default_config = {
db_host = "localhost";
db_port = 5432;
workers = 4;
log_level = "info";
}
let from_env cfg =
let get key default =
match Sys.getenv_opt key with Some v -> v | None -> default
in
let get_int key default =
match Sys.getenv_opt key with
| Some v -> (match int_of_string_opt v with Some i -> i | None -> default)
| None -> default
in
{ cfg with
db_host = get "DB_HOST" cfg.db_host;
db_port = get_int "DB_PORT" cfg.db_port;
workers = get_int "WORKERS" cfg.workers;
log_level = get "LOG_LEVEL" cfg.log_level;
}
let from_toml cfg path =
if not (Sys.file_exists path) then cfg
else
(* ในงานจริงใช้ library เช่น otoml ทำ parse *)
let ic = open_in path in
let _content = In_channel.input_all ic in
close_in ic;
cfg (* placeholder: ใส่ logic parsing จริง *)
(* ตัวอย่างการใช้งาน *)
let load_config () =
default_config
|> fun c -> from_toml c "/etc/myapp/config.toml"
|> from_env
let () =
let cfg = load_config () in
Printf.printf "DB: %s:%d, workers=%d, level=%s\n"
cfg.db_host cfg.db_port cfg.workers cfg.log_level
สำหรับ modern Linux ไม่แนะนำ ให้ daemonize เองด้วย fork() สองครั้งแบบโบราณ — ให้ systemd จัดการแทน
# file: /etc/systemd/system/myapp.service
[Unit]
Description=My OCaml Application
After=network-online.target
Wants=network-online.target
[Service]
Type=notify # ใช้ sd_notify protocol
ExecStart=/usr/local/bin/myapp --port 8080
Restart=on-failure
RestartSec=5
User=myapp
Group=myapp
Environment=LOG_LEVEL=info
Environment=DB_HOST=localhost
# Resource limits
LimitNOFILE=65536
# Security hardening
NoNewPrivileges=true
ProtectSystem=strict
ProtectHome=true
PrivateTmp=true
[Install]
WantedBy=multi-user.target
(* file: sd_notify.ml *)
(* แจ้ง systemd ว่า service พร้อมให้บริการแล้ว *)
let notify_systemd msg =
match Sys.getenv_opt "NOTIFY_SOCKET" with
| None -> () (* ไม่ได้รันภายใต้ systemd *)
| Some sock_path ->
let sock = Unix.socket Unix.PF_UNIX Unix.SOCK_DGRAM 0 in
let addr = Unix.ADDR_UNIX sock_path in
let _ = Unix.sendto_substring sock msg 0 (String.length msg) [] addr in
Unix.close sock
(* ตัวอย่างการใช้งาน *)
let () =
(* เริ่มต้น service ... *)
Unix.sleep 1;
notify_systemd "READY=1";
notify_systemd "STATUS=Serving requests on port 8080";
(* loop service ... *)
while true do Unix.sleep 60 done
คำสั่ง systemd ที่ใช้บ่อย:
sudo systemctl daemon-reload # โหลด unit file ใหม่
sudo systemctl enable --now myapp # enable + start
sudo systemctl status myapp # เช็คสถานะ
sudo journalctl -u myapp -f # ดู log แบบ follow
sudo systemctl restart myapp # restart service
การปรับแต่งประสิทธิภาพควรเริ่มจาก profile ก่อน optimize เสมอ — Donald Knuth กล่าวไว้ว่า premature optimization is the root of all evil
perf เป็น Linux profiler ที่อ่าน CPU performance counters โดยตรง — ต้อง compile OCaml ด้วย flag -g และ (ocamlopt_flags (:standard -g))
# Compile พร้อม debug symbol
dune build --profile=release
# Profile 10 วินาที
sudo perf record -F 99 -g -- ./_build/default/bin/myapp
sudo perf report
# Flame graph
sudo perf script | stackcollapse-perf.pl | flamegraph.pl > flame.svg
Landmarks เป็น OCaml-native profiler ที่ใช้ PPX annotation
(* file: landmarks_demo.ml *)
(* ต้องเพิ่ม (preprocess (pps landmarks-ppx --auto)) ใน dune file *)
(* [@landmark] บอกให้ wrap function ด้วย timing code *)
let heavy_computation n =
[@landmark "heavy_computation"]
let rec loop acc i =
if i > n then acc
else loop (acc +. sin (float_of_int i)) (i + 1)
in
loop 0.0 0
let process_batch items =
[@landmark "process_batch"]
List.map heavy_computation items
(* ตัวอย่างการใช้งาน *)
(* รันด้วย: OCAML_LANDMARKS=on ./app
จะพิมพ์สถิติเวลาออกมาเมื่อโปรแกรมจบ *)
let () =
let results = process_batch [1000; 2000; 3000; 4000] in
List.iter (Printf.printf "%.4f\n") results
OCaml compiler สามารถ inline function ได้อัตโนมัติ แต่บางครั้งต้องบอกเป็นคำสั่ง
(* file: inline_hints.ml *)
(* [@inline always] บังคับ inline แน่นอน *)
let[@inline always] square x = x * x
(* [@inline never] ห้าม inline (เช่น function ใหญ่ หรือ cold path) *)
let[@inline never] rare_error_path msg = failwith msg
(* [@specialise] ให้ compiler สร้าง version ที่ specialize
สำหรับ argument แบบ function *)
let rec map f lst =
[@specialise]
match lst with
| [] -> []
| x :: rest -> f x :: map f rest
(* [@unrolled n] unroll loop n ครั้ง *)
let sum_array arr =
let n = Array.length arr in
let acc = ref 0 in
for i = 0 to n - 1 do
[@unrolled 4]
acc := !acc + arr.(i)
done;
!acc
(* ตัวอย่างการใช้งาน *)
let () =
let arr = Array.init 1000 (fun i -> i) in
Printf.printf "Sum = %d\n" (sum_array arr);
Printf.printf "Square 7 = %d\n" (square 7)
ใน OCaml float ปกติจะถูก box (เก็บเป็น pointer ไปยัง heap cell) แต่ float array จะ unbox อัตโนมัติ ลด allocation มหาศาล
โดยที่ คือขนาดในหน่วย bytes เมื่อเก็บแบบ boxed (pointer + header + payload) และ คือขนาดแบบ unboxed (payload อย่างเดียว)
(* file: unbox_demo.ml *)
(* เปรียบเทียบ performance ของ structure ที่ box vs unbox *)
(* BAD: tuple ของ float → box + pointer chasing *)
type point_boxed = float * float
let sum_boxed (points: point_boxed list) =
List.fold_left (fun acc (x, y) -> acc +. x +. y) 0.0 points
(* GOOD: record with float-only fields → unboxed representation *)
type point_flat = { mutable x: float; mutable y: float }
(* GOOD: Bigarray สำหรับ numerical arrays ขนาดใหญ่ *)
module BA = Bigarray
let sum_bigarray (arr: (float, BA.float64_elt, BA.c_layout) BA.Array1.t) =
let n = BA.Array1.dim arr in
let acc = ref 0.0 in
for i = 0 to n - 1 do
acc := !acc +. BA.Array1.unsafe_get arr i
done;
!acc
(* ตัวอย่างการใช้งาน + benchmark *)
let () =
let n = 1_000_000 in
(* Bigarray: off-heap allocation, GC ไม่ต้องสนใจ *)
let arr = BA.Array1.create BA.float64 BA.c_layout n in
for i = 0 to n - 1 do
BA.Array1.unsafe_set arr i (float_of_int i)
done;
let t0 = Unix.gettimeofday () in
let s = sum_bigarray arr in
let t1 = Unix.gettimeofday () in
Printf.printf "Sum = %.0f in %.4f s\n" s (t1 -. t0)
OCaml 5 ยังไม่มี native SIMD — ต้องเขียน C stub เอง
// file: simd_stub.c
// SIMD sum ด้วย AVX2 สำหรับ float64 array
#include <immintrin.h>
#include <caml/mlvalues.h>
#include <caml/bigarray.h>
CAMLprim value simd_sum_f64(value v_arr) {
double* arr = Caml_ba_data_val(v_arr);
intnat n = Caml_ba_array_val(v_arr)->dim[0];
__m256d acc = _mm256_setzero_pd();
intnat i = 0;
// ประมวลผลครั้งละ 4 elements
for (; i + 4 <= n; i += 4) {
__m256d v = _mm256_loadu_pd(arr + i);
acc = _mm256_add_pd(acc, v);
}
// Horizontal sum
double buf[4];
_mm256_storeu_pd(buf, acc);
double total = buf[0] + buf[1] + buf[2] + buf[3];
// Tail
for (; i < n; i++) total += arr[i];
return caml_copy_double(total);
}
(* file: simd.ml *)
(* Binding สำหรับ C function ด้านบน *)
external simd_sum_f64:
(float, Bigarray.float64_elt, Bigarray.c_layout) Bigarray.Array1.t -> float
= "simd_sum_f64"
(* ตัวอย่างการใช้งาน *)
let () =
let n = 1_000_000 in
let arr = Bigarray.Array1.create Bigarray.float64 Bigarray.c_layout n in
for i = 0 to n - 1 do
arr.{i} <- float_of_int i
done;
Printf.printf "SIMD sum = %.0f\n" (simd_sum_f64 arr)
dune file:
(executable
(name simd)
(libraries bigarray)
(foreign_stubs
(language c)
(names simd_stub)
(flags -mavx2 -O3)))
bechamel เป็น micro-benchmark library ที่มี statistical analysis (ค่า mean, standard deviation, confidence interval) — ทำให้เชื่อถือได้มากกว่าแค่วัดเวลาครั้งเดียว
สูตร standard error of the mean ที่ bechamel ใช้:
โดยที่ คือ sample standard deviation และ คือจำนวนครั้งที่รันซ้ำ — ยิ่ง SE ต่ำ ผลลัพธ์ยิ่งน่าเชื่อถือ
(* file: bench_demo.ml *)
(* เปรียบเทียบ performance 3 วิธีรวม list *)
open Bechamel
open Toolkit
(* Method 1: List.fold_left (tail-recursive) *)
let fold_sum lst = List.fold_left (+) 0 lst
(* Method 2: recursive naive (ไม่ tail-recursive) *)
let rec naive_sum = function
| [] -> 0
| x :: rest -> x + naive_sum rest
(* Method 3: Array.fold_left หลังแปลง list → array *)
let array_sum lst = Array.fold_left (+) 0 (Array.of_list lst)
(* ประกาศ benchmark แต่ละตัว *)
let make_bench name f data =
Test.make ~name (Staged.stage (fun () -> f data))
let tests =
let data = List.init 10_000 (fun i -> i) in
Test.make_grouped ~name:"sum" [
make_bench "fold_left" fold_sum data;
make_bench "naive" naive_sum data;
make_bench "via array" array_sum data;
]
(* ตัวอย่างการใช้งาน *)
let benchmark () =
let ols = Analyze.ols ~r_square:true ~bootstrap:0
~predictors:[| Measure.run |] in
let instances = Instance.[ minor_allocated; major_allocated; monotonic_clock ] in
let cfg = Benchmark.cfg ~quota:(Time.second 1.0) ~kde:(Some 1000) () in
let raw = Benchmark.all cfg instances tests in
let results = List.map (fun i ->
Analyze.all ols i raw) instances
in
Analyze.merge ols instances results
let () =
let results = benchmark () in
let open Notty_unix in
let window = Bechamel_notty.Unit.create () in
List.iter (fun (_, result) ->
output_image (Bechamel_notty.Multiple.image_of_ols_results
~rect:{Bechamel_notty.w = 80; h = 1} ~predictor:Measure.run window result)
) (Hashtbl.fold (fun k v acc -> (k,v)::acc) results [])
ตัวอย่าง output:
mean std dev r² allocated
sum/fold_left 45.2 μs ± 0.8 μs 0.99 0 words
sum/naive 52.3 μs ± 2.1 μs 0.95 0 words
sum/via array 120.5 μs ± 3.2 μs 0.98 30 005 words
Performance checklist สำหรับ production code:
| Technique | เมื่อไหร่ใช้ | ผลลัพธ์ที่คาดหวัง |
|---|---|---|
[@inline always] บน hot function สั้น ๆ |
Function ถูกเรียกใน loop | ลด function call overhead 5–20% |
Bigarray แทน float array ใหญ่ ๆ |
Numerical computation | ลด GC pressure, off-heap |
unsafe_get/unsafe_set |
หลัง verify bounds แล้ว | ตัด bounds check 10–30% |
| Monomorphic compare | compare int, float, bytes | เร็วกว่า polymorphic = 2–5× |
| SIMD C stubs | Math-heavy loops | 2–4× speedup |
| Domainslib parallel_for | Independent loop iterations | scale ใกล้ #cores |
บทนี้ครอบคลุมการนำ OCaml 5 ไปใช้กับงานระบบจริง ตั้งแต่ I/O ระดับต่ำกับ kernel การสร้าง network service การ serialize ข้อมูลด้วย parser combinator การเชื่อมต่อฐานข้อมูลแบบ type-safe การสร้าง CLI tool ที่เป็นมิตรต่อผู้ใช้ ไปจนถึงการวัดและปรับแต่งประสิทธิภาพด้วยวิธีการทางสถิติ
หลักการสำคัญที่ควรจำ:
ส่วนถัดไป (ส่วนที่ 6) จะลงลึกเรื่อง Patterns สำหรับ Production Systems รวมถึง supervision tree, resource management, testing และ deployment