手紙の冒頭を書く方法を、コマンドラインで対話的に生成するOCamlスニペット usage: ocaml tegami.ml

tegami.ml

(* tegami.ml created by funatsu.fumiya *)

(* base functions *)
exception Not_Match;;

let rec print_list = function 
  [] -> ()
  | e::l -> print_int e ; print_string " " ; print_list l
let fail = -1 ;;
let puts = print_endline ;;
let put = print_string ;;
let i2s = string_of_int ;;
let rec ln i = if i>0 then (print_newline(); ln(i-1)) ;;
let s2i = int_of_string ;;
let flatten_count_from_list lst =
  List.map (fun lst -> List.length lst) lst;;
let l2s lst =
  let rec l2d_impl n s lst =
    let s_and = if s="" then "" else s ^ ",\n" in
    match lst with 
        [] -> s
      | car :: cdr -> l2d_impl (n+1) (s_and ^ (i2s n) ^ ") " ^ car) cdr in
    l2d_impl 1 "" lst ;;
let print_statement s = if s = "" then put "" else put ("『" ^ s ^ " … 』") ;;
let add_questions table lst = List.map (fun (key, value) -> Hashtbl.add table key value ) lst ;;

(* question base *)
let question answers nexts add_flag number statement  = (
  let ans_all = List.flatten answers in
  let ans_nums = flatten_count_from_list answers in (

    ln 2;
    put ("【 質問" ^ (i2s number) ^ " 】 ");
    print_statement statement;
    puts "";
    puts "-----------------------------";
    puts ( l2s(ans_all) ^ "\n" );

    let rec input s = (
      put (s ^ " => ");
      let rd = read_line() in
      let r = try (s2i rd) with
        Failure _ -> fail in
      if r > 0 && r <= List.length(ans_all) then r else input "(もう一度)" ) in
    let selected = input "(番号を入力)" in
    let rec next_answer nums_lst index n x = match nums_lst with
      car :: cdr -> if n <= x && x < car+n then index else next_answer cdr (index+1) (n+car) x
      | _ -> raise Not_Match in
    let next_index = next_answer ans_nums 0 1 selected in
    let st = if add_flag = true then (statement ^ (List.nth ans_all (selected-1))) else statement in
    (st, (List.nth nexts next_index), number+1)
  );
);;

(* phase function *)
let startmessage () = (
  ln 1; 
  puts "====  パーツの組み合わせで手紙を書く";
  puts "====    created by funatsu.fumiya";
);;

(* questions *)
let table = Hashtbl.create 1024;; 
let init_table () = (
  let q = question in
  add_questions table [
    ("entry", q [["慶賀の挨拶"]; ["日頃の感謝を伝える挨拶"]; ["相手の安否を尋ねる挨拶"]; ["自分の安否を伝える挨拶"]; ["ご無沙汰の挨拶"]] ["keiga"; "higoro"; "anpi"; "myanpi"; "gobusata"] false);
    
    ("keiga", q [["[会社へ宛てた手紙]"]; ["[人へ宛てた手紙]"]] ["keiga_s1"; "keiga_s2"] false);
    ("keiga_s1", q [["貴社";"御社";"貴行"];] ["keiga_niha1"] true);
    ("keiga_s2", q [["皆様";"先生";"貴殿";"尊台"]] ["keiga_niha2"] true);
    ("keiga_niha1", q [["には"; "におかれましては"; ""]] ["keiga_masumasu1"] true);
    ("keiga_niha2", q [["には"; "におかれましては"]] ["keiga_masumasu2"] true);
    ("keiga_masumasu1", q [["ますます";"いよいよ";"一層"]] ["keiga_hannei"] true);
    ("keiga_masumasu2", q [["ますます";"いよいよ";"一層";""]] ["keiga_katsuyaku"] true);
    ("keiga_katsuyaku", q [["ご活躍";"ご清祥";"ご健勝";"ご壮健"]] ["keiga_nokototo2"] true);
    ("keiga_hannei", q [["ご隆盛";"ご隆昌";"ご清栄"]] ["keiga_nokototo2"] true);
    ("keiga_nokototo1", q [["のことと"];["の由";"の趣";"の段";"の御事";"のご様子"]] ["keiga_zonjimasu"; "keiga_oyorokobi"] true);
    ("keiga_nokototo2", q [["のことと";"の由";"の趣";"の段";"の御事";"のご様子"]] ["keiga_oyorokobi"] true);
    ("keiga_oyorokobi", q [["お慶び申し上げます";"大慶に存じます";"慶賀いたします";"慶賀の至りに存じます";"何よりと存じます"]] ["end"] true);

    ("higoro", q [["平素は";"日頃は";"過般は";"過日は";"先日は";"先般は";"先だっては"]] ["higoro_iroiro"] true);
    ("higoro_iroiro", q [["いろいろと";"何かと";"格別の";"並ならぬ"]] ["higoro_osewa"] true);
    ("higoro_osewa", q [["ご厚情";"ご高誼";"ご高配";"ご愛顧";"ご指導";"ご鞭撻"];["お世話になり";"ご心配をいただき"]] ["higoro_tamawari";"higoro_arigato"] true);
    ("higoro_tamawari", q [["を賜り";"をあずかり"]] ["higoro_arigato"] true);
    ("higoro_arigato", q [["（誠に）ありがとうございます";"（厚く）御礼申し上げます";"（深く）感謝しております";"深謝申し上げます"]] ["end"] true);
    
    ("anpi", q [["皆様";"皆々様";"ご家族様";"ご家族の皆様方"]] ["anpi_niha"] true);
    ("anpi_niha", q [["には";"におかれましては"]] ["anpi_ikaga"] true);
    ("anpi_ikaga", q [["その後"];["いかがお過ごしですか。";"いかがお暮らしでしょうか。";"お変わりございませんか。";"お元気でお過ごしでしょうか。"];["ますます";"いよいよ"]] ["anpi_katsuyaku";"anpi_sonogo";"anpi_katsuyaku"] true);
    ("anpi_sonogo", q [["その後"]] ["anpi_katsuyaku"] true);
    ("anpi_katsuyaku", q [["ご活躍";"お元気";"ご清祥";"ご壮健";"ご隆盛";"ご隆昌";"ご清栄";"ご健勝"]] ["anpi_no"] true);
    ("anpi_no", q [["の由";"の段";"の趣";"のことと承り";"のことと拝察いたし"];["のことと存じます";"のことと拝察致します"]] ["anpi_kokoro"; "end"] true);
    ("anpi_kokoro", q [["心から";"心より"]] ["anpi_moushiage"] true);
    ("anpi_moushiage", q [["お慶び申し上げます";"何よりと存じ上げます";"大慶に存じます";"慶賀いたします";"慶賀の至りに存じます"]] ["end"] true);

    ("myanpi", q [["私事ではございますが、";"私事で恐縮ですが、"]] ["myanpi_okage"] true);
    ("myanpi_okage", q [["おかげさまで私も";"おかげさまで当方"];["おかげさまで私ども";"おかげさまで家族"]] ["myanpi_aikawarazu";"myanpi_mina"] true);
    ("myanpi_mina", q [["一同";"いずれも";"皆"]] ["myanpi_aikawarazu"] true);
    ("myanpi_aikawarazu", q [["相変わらず";""]] ["myanpi_genki"] true);
    ("myanpi_genki", q [["元気にしております";"無事暮らしております";"健康な毎日を過ごしております";"元気で働いております"]] ["myanpi_anshin"] true);
    ("myanpi_anshin", q [["から、ご安心ください";"ので、他事ながらご休心ください";"ので、何卒ご放念ください"]] ["end"] true);

    ("gobusata", q [["平素は";"日頃は";"長らく";"ついつい";"久しく"]] ["gobusata_gobu"] true);
    ("gobusata_gobu", q [["ご無沙汰";"ご無音"]] ["gobusata_itashi"] true);
    ("gobusata_itashi", q [["いたしまして";"に打ち過ぎ";"の段";"のみにて"]] ["gobusata_taihen"] true);
    ("gobusata_taihen", q [["（大変）申し訳ございません。";"（誠に）恐縮に存じます。"]] ["gobusata_ashikarazu"] true);
    ("gobusata_ashikarazu", q [["あしからずご海容くださいませ";"（何卒）ご容赦ください";"（何卒）お許し下さい"]] ["end"] true);

    ("end", (fun n st -> (puts ("-----------------------------\n\n\n << 完成 >>\n- - - - - - - - - - - - - - - - - - - - - - - - - - - - -\n『" ^ st ^ "』\n- - - - - - - - - - - - - - - - - - - - - - - - - - - - -\n\n"); raise End_of_file (* end *))));
    ]
);;

(* entry point *)
let main () = (
  init_table();
  startmessage();

  let q = ref (Hashtbl.find table "entry") in
  let i = ref 1 in
  let st = ref "" in 
  while true do
    let (stat, index, num) = (!q !i !st) in
    q := (Hashtbl.find table index);
    i := num ;
    st := stat ;
  done
);;

main() ;;