unicode substring of OCaml for application layer

cwn経由でextlibにUTF8.substringが定義されたと知り、じゃあオレオレな実装からサヨナラできるかな、と思って試してみましたが、

assert_equal (UTF8.substring "hoge" 0 5) "hoge"

は残念ながら "out of range" という例外で終わってしまう……

extlibのsubstringは、LLなsubstringとは違い、境界を超えるような値の定義を許さないみたいです。

でもこれだと、常に利用者が境界値のチェックを義務付けられるわけで、アプリケーション側からは使いにくいかなあと。

だって、例外を捕まえるにしても out of rangeってだけじゃ、どういう風に溢れたのかわからないですし。

substring "hoge" 0 100 で溢れるのも、substring "hoge" 100 1で溢れるのも、同じ例外ですよね。

でもLLな感覚のsubstringなら、前者は"hoge"を返したいし、後者は空文字を返したい。

というわけで、以下がjingooでの実装です（jingoo/jg_utils.mlより抜粋）。

open ExtLib

let rec substring base count str =
  let len = UTF8.length str in
  if base >= len || count = 0 then
    ""
  else if base = 0 && count >= len then
    str
  else if base < 0 then
    substring (len + base) count str
  else if base + count >= len then
    let lp = UTF8.nth str base in
    let rp = UTF8.next str (UTF8.last str) in
    String.sub str lp (rp - lp)
  else
    let lp = UTF8.nth str base in
    let rp = UTF8.nth str (base + count) in
    String.sub str lp (rp - lp)

振る舞い方はこんなです。

assert_equal (substring  0  0)  "hoge"  ""
assert_equal (substring  0  1)  "hoge"  "h"
assert_equal (substring  0  4)  "hoge"  "hoge"
assert_equal (substring  0  5)  "hoge"  "hoge"
assert_equal (substring  1  1)  "hoge"  "o"
assert_equal (substring  2  1)  "hoge"  "g"
assert_equal (substring  3  1)  "hoge"  "e"
assert_equal (substring  4  1)  "hoge"  ""
assert_equal (substring  5  0)  "hoge"  ""
assert_equal (substring  5  1)  "hoge"  ""

(** negative base *)
assert_equal (substring  (-1)  1)  "hoge"  "e"
assert_equal (substring  (-2)  1)  "hoge"  "g"
assert_equal (substring  (-3)  1)  "hoge"  "o"
assert_equal (substring  (-4)  1)  "hoge"  "h"
assert_equal (substring  (-4)  2)  "hoge"  "ho"
assert_equal (substring  (-4)  3)  "hoge"  "hog"
assert_equal (substring  (-4)  4)  "hoge"  "hoge"
assert_equal (substring  (-4)  5)  "hoge"  "hoge"
assert_equal (substring  (-5)  1)  "hoge"  "e"

jingooの更新（white space controll用のシンタックス追加、およびスレッド版パッケージの分離）

ほぼjinja2互換なocaml template engineであるところのjingooなのですが、久しぶりにいくつかの修正を加えました。

1. {%- と -%} のサポート（white space controll）
2. マルチスレッドバージョンとノーマルバーションのパッケージを分離

1.{%- と -%}のサポート(white space controll)

{%-は、このマーク「以前」にある空白改行を削除し、-%} は、このマーク「以後」にある空白改行を削除するためのシンタックスです。

参考：http://jinja.pocoo.org/docs/templates/#whitespace-control

だから例えば

aaa
{% for i in [1,2,3] -%}
{{i}}
{% endfor -%}
bbb

とすれば、

aaa
1
2
3
bbb

と出力するし、

aaa
{%- for i in [1,2,3] -%}
{{i}}
{%- endfor -%}
bbb

とすれば、

aaa123bbb

と一切の改行空白が無い表示が出力されます。

これでまた一歩、jinja2に近づいたかな……

マルチスレッドバージョンとのパッケージ分離

次にマルチスレッド対応パッケージを分離したことについてですが、今まではスレッドを使わないプログラムでもコンパイル時に「-thread」というコマンドラインオプションを強要してました。

これがスレッドを使わないプログラムでjingooをリンクしたい人にとって不満だったらしく、これに対応した形です。

今後は「-thread」をつけなかったときはjingoo.cm[x]aがリンクされ、つけたときはjingoo.threads.cm[x]aがリンクされるようになります。

OCamlでObject-relational mapping(ORM)みたいなやつ

ocormは表題の件をなんとなく実現するライブラリです。

https://github.com/tategakibunko/ocorm

ocormが提供するMakeRelationMapファンクターの定義はこのようなものです。

module MakeRelationMap (F:FieldMap)(S:Schema):RelationMap with type t = F.t

このファンクターは、スキーマの定義モジュール(Schema)と、データ型の変換モジュール(FieldMap)を受け取り、次のことをするモジュールを生成します。

• (string, string) listを、FieldMapが定義するオブジェクトに変換
• (string, string) listを、Schemaが定義する制約に基づいてバリデーション

Schemaモジュールの定義

こんな風に定義します。

module User = struct
  let table_name = "user"
  let props = [
    ("id", PrimaryKeyProperty);
    ("name", StringProperty [NotNull; MinLength 3; MaxLength 16]);
    ("point", IntProperty [NotNull; Default (`Int 0)]);
  ]
end

フィールド名と属性のセットをpropsにセット。属性定義には、制約を付けることができます。

FieldMapモジュールの定義

例としてjson-wheelライブラリの定義するJson_type.tに変換する処理を定義してみます。

module JsonFieldMap = struct
  type t = Json_type.t
  let null = Json_type.Null
  let map_value prop value =
    match prop with
      | PrimaryKeyProperty -> Json_type.Int (int_of_string value)
      | StringProperty _ -> Json_type.String value
      | TextProperty _ -> Json_type.String value
      | IntProperty _ -> Json_type.Int (int_of_string value)
      | FloatProperty _ -> Json_type.Float (float_of_string value)
      | BooleanProperty _ -> Json_type.Bool (value = "t")
  let map_alist alist = Json_type.Object alist
  let map_list lst =  Json_type.Array lst
end

null/int/string/float/list/alistといった属性を、自分が変換したいオブジェクトにマッピングする処理を記述します（alistは属性リスト）。

ちなみに上の変換処理ですが、本当はもう少し厳密に変換したほうが良いと思います（空文字だったらどうする？とか）。

MakeRelationMapファンクター

これら二つのモジュールをMakeRelationMapに渡すと、UserテーブルをJSONに変換したり、バリデーションしたりできるモジュールが手に入ります。

module UserMap = MakeRelationMap(JsonFieldMap)(User)

オブジェクト変換

JSONに変換するには、UserMap.objectifyを使います。

let table_row = [("id", "1"); ("name", "taro"); ("point", "100")] in
let json = UserMap.objectify table_row in (** Json_type.t が取得できる *)
Json_io.string_of_json json

=> {"id":1, "name":"taro", "point":100}

バリデーション

データをバリデーションするには、UserMap.validateを使います。

(** nameには3文字以上、16文字以下の制約が付いている *)
UserMap.validate [("id", "1"); ("name", "a"); ("point", "100")]
=> exception: name is too short(min 3, max 16)

jingooオブジェクトを出力させる

schemaの定義と変換のモジュールが別々に定義できるので、例えばjingooのテンプレートに渡せるオブジェクトを作りたい場合は、JsonFieldMapモジュールを、こんな感じのモジュールに差し替えるだけで対応できます。

open Jg_types

module JingooFieldMap = struct
  type t = tvalue
  let null = Tnull
  let map_value property value =
    match property with
      | PrimaryKeyProperty -> Tint (int_of_string value)
      | StringProperty _ -> Tstr value
      | TextProperty _ -> Tstr value
      | IntProperty _ -> Tint (int_of_string value)
      | FloatProperty _ -> Tfloat (float_of_string value)
      | BooleanProperty _ -> Tbool (value="t")
  let map_alist alist =
    let hash = Hashtbl.create (List.length alist) in
    Thash (List.fold_left (fun h (n,v) -> Hashtbl.add h n v; h) hash alist)
  let map_list rows = Tlist rows
end

(** jingooのオブジェクトに変換するモジュール *)
module UserMap2 = MakeRelationMap(JingooFieldMap)(User)

ORM……なのか？

……ご覧の通り、ORMといってもActiveRecordみたいにSQLに関わる部分まで抽象化しているわけではなく、あくまでSQL呼び出しの結果が(string, string) list で取得できたとして、それを特定のオブジェクトに変換したり、ついでにバリデーションしたりっていう仕事をするためのライブラリです。

ocamlのネットワークライブラリでfile_descrリークするものが多い理由

ocamlの通信系ライブラリでUnix.open_connectionを使っているライブラリは、Unix.shutdown_connectionを呼ぶだけで切断処理を終わらせているものが多いなあと思いました。

最近さわったredis用のclient libraryとmemcached用のclient libraryはどっちもそういう感じでした。

redis用のライブラリに至っては、サーバーにQUITコマンドを送るだけで終わらせていたりとか。

結果、CLOSE_WAITなsocketが無限に増え続け、いつしかウェブサーバーが起動しなくなったりとかします。

Unix.shutdown_connectionは、名前から想像できるように、内部でsocketのshutdownが呼ばれているわけですが、そもそもshutdownってのはhalf closeと呼ばれていて、「こちら側は終了するつもりですよ」と相手方に教え、相手に先にcloseさせてから、こちらをcloseする前段階として呼び出すものです。

それでこちらのsocket file_descrがcloseされるわけではないので、shutdownだけで終わらせてると、接続するたびに閉じられないfile_descrが増え続けることになります。

で、OSが開くことの出来るファイルハンドルの数には限りがあるので、それが限界を突破した時、ウェブサーバーがエラーログのfileを開くことが出来なくて起動不可な状態になってたり……とかは、割と良くあるパターンです。

じゃあどうやってcloseするかというと、shutodown後に受信用ソケットを0が返るまで読み続け、Unix.close socketするだけ。

でもOCaml標準ライブラリのUnix.open_connectionは、socketのin_channelとout_channelのタプルを返すだけで、socketそのものを返さないので、そうやってsocketを隠蔽しているからには、in_channelを受け取るshutdown_connectionという関数が内部で全てよろしくやってくれるように見えなくもないのですが……

unix.mlの内部を見るとこうなっています。

let shutdown_connection inchan =
  shutdown (descr_of_in_channel inchan) SHUTDOWN_SEND

shutdownと付いているのだから当たり前なのですが、half closeしているだけです。

この後にUnix.closeする処理を付け加えるのは、アプリケーション作成者の責任というわけですね……

書くなら（ブロッキングする処理ですが）こんな感じでしょうか。

let close_connection inchan =
  let buffer = String.create 256 in
  let rec safe_close sock =
    if Unix.read sock buffer 0 256 = 0 then
      Unix.close sock
    else
      safe_close sock in
  safe_close (Unix.descr_of_in_channel inchan)

もちろんshutdownした後に呼ぶ関数です。