Source file `intl.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(*********************************************************************************)
(*                Stog                                                           *)
(*                                                                               *)
(*    Copyright (C) 2012-2015 INRIA All rights reserved.                         *)
(*    Author: Maxence Guesdon, INRIA Saclay                                      *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU General Public License as                    *)
(*    published by the Free Software Foundation, version 3 of the License.       *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the               *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public                  *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    As a special exception, you have permission to link this program           *)
(*    with the OCaml compiler and distribute executables, as long as you         *)
(*    follow the requirements of the GNU GPL in regard to all of the             *)
(*    software in the executable aside from the OCaml compiler.                  *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

open Types

type lang_abbrev = string

type lang_data = {
    days : string array; (* 7 *)
    months : string array; (* 12 *)
    string_of_date : date -> string;
    string_of_datetime : date -> string;
}

let int_of_weekday = function
  | `Sun -> 0
  | `Mon -> 1
  | `Tue -> 2
  | `Wed -> 3
  | `Thu -> 4
  | `Fri -> 5
  | `Sat -> 6

let french =
  let days =
    [| "dimanche" ; "lundi" ; "mardi" ; "mercredi" ;
       "jeudi" ; "vendredi" ; "samedi" |]
  in
  let months = [|
    "janvier" ; "février" ; "mars" ; "avril" ; "mai" ; "juin" ;
    "juillet" ; "août" ; "septembre" ; "octobre" ; "novembre" ; "décembre" |]
  in

  let string_of_date date =
    let ((y,m,d), _) = Date.to_date_time date in
    Printf.sprintf "%s %d %s %d"
      days.(int_of_weekday (Date.weekday date))
      d months.(m-1) y
  in
  let string_of_datetime date =
    let (_, ((h,mi,s), _)) = Date.to_date_time date in
    Printf.sprintf "%s à %dh%02d"
      (string_of_date date) h mi
  in
  { days; months; string_of_date ; string_of_datetime }

let english =
  let days =
    [| "Sunday" ; "Monday" ; "Tuesday" ; "Wednesday" ;
       "Thursday" ; "Friday" ; "Saturday" |]
  in
  let months = [|
    "January" ; "February" ; "March" ; "April" ; "May" ; "June" ;
    "July" ; "August" ; "September" ; "October" ; "November" ; "December" |]
  in
  let string_of_date date =
    let ((y,m,d), _) = Date.to_date_time date in
    Printf.sprintf "%s %d, %d"
      months.(m-1) d y
  in
  let string_of_datetime date =
    let (_, ((h,mi,s), _)) = Date.to_date_time date in
    Printf.sprintf "%s at %dh%02d"
      (string_of_date date) h mi
  in
  { days; months; string_of_date ; string_of_datetime }

let languages = ref Types.Str_map.empty;;

let register_lang abbrev data =
  languages := Types.Str_map.add abbrev data !languages;;

let () = register_lang "fr" french;;
let () = register_lang "en" english;;

let default_lang = ref english;;

let set_default_lang abbrev =
  try default_lang := Types.Str_map.find abbrev !languages
  with Not_found ->
      failwith (Printf.sprintf "Language %S not registered" abbrev)
;;

let data_of_lang =
  let warned = Hashtbl.create 10 in
  fun lang ->
    match lang with
    | None -> !default_lang
    | Some abbrev ->
        try Types.Str_map.find abbrev !languages
        with Not_found ->
            if not (Hashtbl.mem warned lang) then
              begin
                Printf.eprintf "date_of_lang: unknown lang %S, using default"
                abbrev;
                Hashtbl.add warned lang ();
              end;
            !default_lang

let get_month lang m =
  assert (m >= 1 && m <= 12);
  (data_of_lang lang).months.(m - 1)

let string_of_date lang d =
  (data_of_lang lang).string_of_date d
let string_of_datetime lang d =
  (data_of_lang lang).string_of_datetime d

let string_of_date_opt lang = function
  None -> ""
| Some d -> (data_of_lang lang).string_of_date d
;;

let string_of_datetime_opt lang = function
  None -> ""
| Some d -> (data_of_lang lang).string_of_datetime d
;;