Eliomで入力値検査 (2)

OCaml

(Ocsigenは Webサーバーの名前なので フレームワークの名前 Eliom で呼ぶことにした)
昨日の記事で、

  • 入力値バリデーションに失敗して元のページに戻るとテキストが消えてしまう問題

について書いた． 重要な機能が欠けている気がするのだが、こんなことでせっかくのEliomをやめたくない．というわけで，OcsigenのMLに質問してみている．
その間何もしないのは何なので，フォームのテキストボックスにリクエストパラメータから入力値を補完するバージョンのget_formを書いた． 昨日のプログラムの get_form を get_form' に置き換えれば使える．．
相変わらず超しょぼい例で恐縮ですが，こんな感じで入力値検査に失敗した場合でもフィールドに値が残る．

実装

  • 単に，フォームのDOM木をトラバースする． XHTML.M.elt は直接触れないので， toelt で XML.elt に変換してからトラバースし，tot で XHTML.M.elt に戻す．
  1. value属性がないinputタグを見つけたら
  2. リクエストパラメータからそのname属性の値を取り出し，value属性として追加する

こんだけ．

ソース

OCamlでちゃんとプログラムを書いた経験が少ないのでえらく時間がかかった．もっとうまく書きたい．

open Eliom_predefmod.Xhtml (* get_form, *)
open Eliom_sessions (* get_get_params *)
open XHTML.M (* tot, toelt *)

let astypeof (a:'a) (b:'a) : 'a = a
let id x = x

let get_form' ?https ?a ~service ~sp ?hostname ?port ?fragment body = 
  let form = 
    get_form
      ?https:https 
      ?a:a 
      ~service:service 
      ~sp:sp 
      ?hostname:hostname 
      ?port:port 
      ?fragment:fragment body in
  let rq = get_get_params sp in
  let setvalues''' attrs = 
    let hasattr name attr = XML.attrib_name attr = name in
    if List.exists (hasattr "value") attrs then attrs
    else 
      try match List.find (hasattr "name") attrs with attr -> 
	let nam = XML.attrib_value_to_string id attr in
	let nam' = String.sub nam 1 (String.length nam-2) in (* strip '\"' *)
	  (match List.assoc nam' rq with str -> XML.string_attrib "value" str ::attrs)
      with Not_found -> attrs in 
  let setvalues' elt attrs =
    if elt="input" then (elt,setvalues''' attrs)
    else (elt,attrs) in
  let rec setvalues = function
      XML.Element (elt,attr,child) -> 
	let (elt,attr) = setvalues' elt attr in XML.Element (elt,attr,List.map setvalues child)
    | XML.BlockElement (elt,attr,child) -> 
	let (elt,attr) = setvalues' elt attr in XML.BlockElement (elt,attr,List.map setvalues child)
    | XML.SemiBlockElement (elt,attr,child) ->
	let (elt,attr) = setvalues' elt attr in XML.SemiBlockElement (elt,attr,List.map setvalues child)
    | XML.Leaf (elt,attr) -> 
	let (elt,attr) = setvalues' elt attr in XML.Leaf (elt,attr)
    | XML.Node (elt,attr,child) -> 
	let (elt,attr) = setvalues' elt attr in XML.Node (elt,attr,List.map setvalues child)
    | e -> e in
    astypeof (tot (setvalues (toelt form))) form