■

さっき、osiireさんから何やら面白そうなサンプルを頂いた。

http://d.hatena.ne.jp/komamitsu/20091126/1259244177#c1259320508

Mysql moduleの関数の型が思い出せず、パッと見では良く分からなかったのでコメントとかをつけてみて動かしてみた。

#use "topfind"
#require "mysql"

open Mysql
open Printf

(* 末尾再帰版に修正 on 2009-12-01 *)
let unfold f init =
  let rec loop l x =
    match f x with        (* 下記 select の (a) か (b) *)
      Some (a, b) -> loop (a :: l) b  (* (b) の v をリスト化 *)
    | None -> l
  in
  loop [] init

let select db sql make_row =
  let r = exec db sql in  (* result *)
  let col = column r in   (* key:string -> row:string option array -> 
                             string option *)
  let rec f r =
    match fetch r with    (* string option array option *)
      None -> None        (* (a) *)
    | Some x ->           (* string option array *)
        match make_row (col ~row:x) with   
     (* match make_row (key:string -> string option) with *)
          None -> f r     (* fetchしたけどお目当てのカラムは空, 
                             次のレコードをfetchしにいく *)
        | Some v -> Some (v, r)  
                          (* (b) お目当てのカラムに値あり, 
                                 その値とresultをtuppleに *)
  in
  unfold f r

let _ =
  let db = quick_connect ~host:"hogeserver" ~user:"hogeuser"
             ~password:"hogehoge" ~database:"hogedb" ()
  in
  let r = select db "SELECT * FROM stocks LIMIT 3"
            (fun row -> row ~key:"code") in
  r

として、対話モードで…

# #use "hoge.ml";;
- : unit = ()
Findlib has been successfully loaded. Additional directives:
  :
  :
val unfold : ('a -> ('b * 'a) option) -> 'a -> 'b list = <fun>
val select :
  Mysql.dbd ->
  string -> ((key:string -> string option) -> 'a option) -> 'a list = <fun>
- : string list = ["1301"; "1305"; "1306"]
#

関数 unfold と f の行き来が優雅ですなぁ。