-
Notifications
You must be signed in to change notification settings - Fork 0
/
core.clj
235 lines (210 loc) · 9.04 KB
/
core.clj
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
(ns ^{:doc "Internationalisation."
:author "Simon Brooke"}
scot.weft.i18n.core
(:require [clojure.java.io :as io]
[clojure.pprint :refer [pprint]]
[clojure.string :refer [join]]
[instaparse.core :as insta]
[taoensso.timbre :as timbre]
[trptr.java-wrapper.locale :as locale])
(:import [clojure.lang Keyword]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; scot.weft.i18n: a simple internationalisation library for Clojure.
;;;;
;;;; This library is distributed under the Eclipse Licence in the hope
;;;; that it may be useful, but without guarantee.
;;;;
;;;; Copyright (C) 2017 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:dynamic *resource-path*
"The default path within the resources space on which translation files
will be sought. Deprecated, prefer `(:resource-path *config*)`."
"i18n")
(def ^:dynamic *default-language*
"The default language to seek. Deprecated, prefer `(:default-language *config*)`."
(-> (locale/get-default) locale/to-language-tag))
(def ^:dynamic *config*
"Extensible configuration for i18n."
{:default-language (-> (locale/get-default) locale/to-language-tag)
:resource-path "i18n"})
(def accept-language-grammar
"Grammar for `Accept-Language` headers"
"HEADER := SPECIFIER | SPECIFIERS;
SPECIFIERS:= SPECIFIER | SPECIFIER SPEC-SEP SPECIFIERS;
SPEC-SEP := #',\\s*';
SPECIFIER := LANGUAGE-TAG | LANGUAGE-TAG Q-SEP Q-VALUE;
LANGUAGE-TAG := PRIMARY-TAG | PRIMARY-TAG '-' SUB-TAGS;
PRIMARY-TAG := #'[a-zA-Z]+';
SUB-TAGS := SUB-TAG | SUB-TAG '-' SUB-TAGS;
SUB-TAG := #'[a-zA-Z0-9]+';
Q-SEP := #';\\s*q='
Q-VALUE := '1' | #'0.[0-9]+';")
(def parse-accept-language-header
"Parse an `Accept-Language` header"
(insta/parser accept-language-grammar))
(defn generate-accept-languages
"From a `parse-tree` generated by the `language-specifier-grammar`, generate
a list of maps each having a `:language` key, a `:preference` key and a
`:qualifier` key."
{:doc/format :markdown}
[parse-tree]
(if
(nil? parse-tree)
nil
(case
(first parse-tree)
:HEADER (generate-accept-languages (second parse-tree))
:SPECIFIERS (cons
(generate-accept-languages (second parse-tree))
(when (>= (count parse-tree) 3)
(generate-accept-languages (nth parse-tree 3))))
:SPEC-SEP nil
:SPECIFIER (assoc
(generate-accept-languages (second parse-tree))
:preference
(if
(>= (count parse-tree) 3)
(generate-accept-languages (nth parse-tree 3))
1))
:LANGUAGE-TAG (if
(>= (count parse-tree) 3)
(assoc
(generate-accept-languages (second parse-tree))
:qualifier
(generate-accept-languages (nth parse-tree 3)))
(generate-accept-languages (second parse-tree)))
:PRIMARY-TAG {:language (second parse-tree) :qualifier "*"}
:SUB-TAGS (if
(>= (count parse-tree) 3)
(str
(generate-accept-languages (second parse-tree))
"-"
(generate-accept-languages (nth parse-tree 3)))
(generate-accept-languages (second parse-tree)))
:SUB-TAG (second parse-tree)
:Q-SEP nil
:Q-VALUE (read-string (second parse-tree))
;; default
(do
(timbre/error "Unable to parse header.")
nil))))
(defn acceptable-languages
"Generate an ordered list of acceptable languages, most-preferred first.
* `accept-language-header` should be the value of an RFC2616 `Accept-Language` header.
Returns a list of maps as generated by `generate-accept-languages`, in descending order
of preference."
{:doc/format :markdown}
[accept-language-header]
(let [parse-tree (parse-accept-language-header accept-language-header)]
(if (vector? parse-tree)
(reverse
(sort-by
:preference
(generate-accept-languages
parse-tree)))
(timbre/error "Failed to parse Accept-Language header '" accept-language-header "':\n" (str parse-tree)))))
(defn slurp-resource
"Slurp the resource of this name and return its contents as a string; but if it doesn't
exist log the fact and return nil, rather than throwing an exception."
[name]
(try
(slurp (io/resource name))
(catch Exception _
(timbre/warn (str "Resource at " name " does not exist."))
nil)))
(defn find-language-file-name
"Find the name of a messages file on this resource path which matches this `language-spec`.
* `language-spec` should be either a map as generated by `generate-accept-languages`, or
else a string;
* `resource-path` should be the path name of the directory in which message files are stored,
within the resources on the classpath.
Returns the name of an appropriate file if any is found, else nil."
{:doc/format :markdown}
[language-spec resource-path]
(let [file-path (when
(string? language-spec)
(join
java.io.File/separator
[resource-path (str language-spec ".edn")]))
contents (when file-path (slurp-resource file-path))]
(cond
contents
file-path
(map? language-spec)
(or
(find-language-file-name
(str (:language language-spec) "-" (:qualifier language-spec))
resource-path)
(find-language-file-name
(:language language-spec)
resource-path)))))
(defn raw-get-messages
"Return the most acceptable messages collection we have given this `accept-language-header`.
Do not use this function directly, use the memoized variant `get-messages`, as performance
will be very much better.
* `accept-language-header` should be the value of an RFC2616 `Accept-Language` header;
* `resource-path` should be the fully-qualified path name of the directory in which
message files are stored;
* `default-locale` should be a locale specifier to use if no acceptable locale can be
identified.
Returns a map of message keys to strings; if no useable file is found, returns nil."
{:doc/format :markdown}
[^String accept-language-header ^String resource-path ^String default-locale]
(let [file-paths (remove
empty?
(map
#(find-language-file-name % resource-path)
(acceptable-languages accept-language-header)))
default-path (join java.io.File/separator
[resource-path
(str default-locale ".edn")])
paths (concat file-paths (list default-path))
text (first
(remove empty?
(map
slurp-resource
paths)))]
(if text
(try
(read-string text)
(catch Exception any
(timbre/error "Failed to load internationalisation because "
(.getName (.getClass any))
(.getMessage any))
nil))
;; else
(doall
(timbre/error "No valid i18n files found, not even default. Tried" paths)
nil))))
(def get-messages
"Return the most acceptable messages collection we have given this `accept-language-header`
* `accept-language-header` should be the value of an RFC2616 `Accept-Language` header;
* `resource-path` should be the fully-qualified path name of the directory in which
message files are stored;
* `default-locale` should be a locale specifier to use if no acceptable locale can be
identified.
Returns a map of message keys to strings.; if no useable file is found, returns nil."
(memoize raw-get-messages))
(def get-message
"Return the message keyed by this `token` from the most acceptable messages collection
we have given this `accept-language-header`, if passed, or the current default language
otherwise. If no message is found, return the token.
* `token` should be a clojure keyword identifying the message to be retrieved;
* `accept-language-header` should be the value of an RFC2616 `Accept-Language` header;
* `resource-path` should be the fully-qualified path name of the directory in which
message files are stored;
* `default-locale` should be a locale specifier to use if no acceptable locale can be
identified."
(fn ([^Keyword token ^String accept-language-header ^String resource-path ^String default-locale]
(let [message (token (get-messages accept-language-header resource-path default-locale))]
(or message (name token))))
([^Keyword token ^String accept-language-header]
(get-message token
accept-language-header
(or (:resource-path *config*) *resource-path*)
(or (:default-language *config*) *default-language*)))
([^Keyword token]
(get-message token
(or (:default-language *config*) *default-language*)))))