001 (ns ^{:doc "Internationalisation."
002 :author "Simon Brooke"}
003 scot.weft.i18n.core
004 (:require [clojure.java.io :as io]
005 [clojure.pprint :refer [pprint]]
006 [clojure.string :refer [join]]
007 [instaparse.core :as insta]
008 [taoensso.timbre :as timbre]
009 [trptr.java-wrapper.locale :as locale])
010 (:import [clojure.lang Keyword]))
011
012 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
013 ;;;;
014 ;;;; scot.weft.i18n: a simple internationalisation library for Clojure.
015 ;;;;
016 ;;;; This library is distributed under the Eclipse Licence in the hope
017 ;;;; that it may be useful, but without guarantee.
018 ;;;;
019 ;;;; Copyright (C) 2017 Simon Brooke
020 ;;;;
021 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
022
023 (def ^:dynamic *resource-path*
024 "The default path within the resources space on which translation files
025 will be sought. Deprecated, prefer `(:resource-path *config*)`."
026 "i18n")
027
028 (def ^:dynamic *default-language*
029 "The default language to seek. Deprecated, prefer `(:default-language *config*)`."
030 (-> (locale/get-default) locale/to-language-tag))
031
032 (def ^:dynamic *config*
033 "Extensible configuration for i18n."
034 {:default-language (-> (locale/get-default) locale/to-language-tag)
035 :resource-path "i18n"})
036
037 (def accept-language-grammar
038 "Grammar for `Accept-Language` headers"
039 "HEADER := SPECIFIER | SPECIFIERS;
040 SPECIFIERS:= SPECIFIER | SPECIFIER SPEC-SEP SPECIFIERS;
041 SPEC-SEP := #',\\s*';
042 SPECIFIER := LANGUAGE-TAG | LANGUAGE-TAG Q-SEP Q-VALUE;
043 LANGUAGE-TAG := PRIMARY-TAG | PRIMARY-TAG '-' SUB-TAGS;
044 PRIMARY-TAG := #'[a-zA-Z]+';
045 SUB-TAGS := SUB-TAG | SUB-TAG '-' SUB-TAGS;
046 SUB-TAG := #'[a-zA-Z0-9]+';
047 Q-SEP := #';\\s*q='
048 Q-VALUE := '1' | #'0.[0-9]+';")
049
050 (def parse-accept-language-header
051 "Parse an `Accept-Language` header"
052 (insta/parser accept-language-grammar))
053
054 (defn generate-accept-languages
055 "From a `parse-tree` generated by the `language-specifier-grammar`, generate
056 a list of maps each having a `:language` key, a `:preference` key and a
057 `:qualifier` key."
058 {:doc/format :markdown}
059 [parse-tree]
060 (if
061 (nil? parse-tree)
062 nil
063 (case
064 (first parse-tree)
065 :HEADER (generate-accept-languages (second parse-tree))
066 :SPECIFIERS (cons
067 (generate-accept-languages (second parse-tree))
068 (when (>= (count parse-tree) 3)
069 (generate-accept-languages (nth parse-tree 3))))
070 :SPEC-SEP nil
071 :SPECIFIER (assoc
072 (generate-accept-languages (second parse-tree))
073 :preference
074 (if
075 (>= (count parse-tree) 3)
076 (generate-accept-languages (nth parse-tree 3))
077 1))
078 :LANGUAGE-TAG (if
079 (>= (count parse-tree) 3)
080 (assoc
081 (generate-accept-languages (second parse-tree))
082 :qualifier
083 (generate-accept-languages (nth parse-tree 3)))
084 (generate-accept-languages (second parse-tree)))
085 :PRIMARY-TAG {:language (second parse-tree) :qualifier "*"}
086 :SUB-TAGS (if
087 (>= (count parse-tree) 3)
088 (str
089 (generate-accept-languages (second parse-tree))
090 "-"
091 (generate-accept-languages (nth parse-tree 3)))
092 (generate-accept-languages (second parse-tree)))
093 :SUB-TAG (second parse-tree)
094 :Q-SEP nil
095 :Q-VALUE (read-string (second parse-tree))
096 ;; default
097 (do
098 (timbre/error "Unable to parse header.")
099 nil))))
100
101 (defn acceptable-languages
102 "Generate an ordered list of acceptable languages, most-preferred first.
103
104 * `accept-language-header` should be the value of an RFC2616 `Accept-Language` header.
105
106 Returns a list of maps as generated by `generate-accept-languages`, in descending order
107 of preference."
108 {:doc/format :markdown}
109 [accept-language-header]
110 (let [parse-tree (parse-accept-language-header accept-language-header)]
111 (if (vector? parse-tree)
112 (reverse
113 (sort-by
114 :preference
115 (generate-accept-languages
116 parse-tree)))
117 (timbre/error "Failed to parse Accept-Language header '" accept-language-header "':\n" (str parse-tree)))))
118
119
120 (defn slurp-resource
121 "Slurp the resource of this name and return its contents as a string; but if it doesn't
122 exist log the fact and return nil, rather than throwing an exception."
123 [name]
124 (try
125 (slurp (io/resource name))
126 (catch Exception _
127 (timbre/warn (str "Resource at " name " does not exist."))
128 nil)))
129
130
131 (defn find-language-file-name
132 "Find the name of a messages file on this resource path which matches this `language-spec`.
133
134 * `language-spec` should be either a map as generated by `generate-accept-languages`, or
135 else a string;
136 * `resource-path` should be the path name of the directory in which message files are stored,
137 within the resources on the classpath.
138
139 Returns the name of an appropriate file if any is found, else nil."
140 {:doc/format :markdown}
141 [language-spec resource-path]
142 (let [file-path (when
143 (string? language-spec)
144 (join
145 java.io.File/separator
146 [resource-path (str language-spec ".edn")]))
147 contents (when file-path (slurp-resource file-path))]
148 (cond
149 contents
150 file-path
151 (map? language-spec)
152 (or
153 (find-language-file-name
154 (str (:language language-spec) "-" (:qualifier language-spec))
155 resource-path)
156 (find-language-file-name
157 (:language language-spec)
158 resource-path)))))
159
160
161 (defn raw-get-messages
162 "Return the most acceptable messages collection we have given this `accept-language-header`.
163 Do not use this function directly, use the memoized variant `get-messages`, as performance
164 will be very much better.
165
166 * `accept-language-header` should be the value of an RFC2616 `Accept-Language` header;
167 * `resource-path` should be the fully-qualified path name of the directory in which
168 message files are stored;
169 * `default-locale` should be a locale specifier to use if no acceptable locale can be
170 identified.
171
172 Returns a map of message keys to strings; if no useable file is found, returns nil."
173 {:doc/format :markdown}
174 [^String accept-language-header ^String resource-path ^String default-locale]
175 (let [file-paths (remove
176 empty?
177 (map
178 #(find-language-file-name % resource-path)
179 (acceptable-languages accept-language-header)))
180 default-path (join java.io.File/separator
181 [resource-path
182 (str default-locale ".edn")])
183 paths (concat file-paths (list default-path))
184 text (first
185 (remove empty?
186 (map
187 slurp-resource
188 paths)))]
189 (if text
190 (try
191 (read-string text)
192 (catch Exception any
193 (timbre/error "Failed to load internationalisation because "
194 (.getName (.getClass any))
195 (.getMessage any))
196 nil))
197 ;; else
198 (doall
199 (timbre/error "No valid i18n files found, not even default. Tried" paths)
200 nil))))
201
202 (def get-messages
203 "Return the most acceptable messages collection we have given this `accept-language-header`
204
205 * `accept-language-header` should be the value of an RFC2616 `Accept-Language` header;
206 * `resource-path` should be the fully-qualified path name of the directory in which
207 message files are stored;
208 * `default-locale` should be a locale specifier to use if no acceptable locale can be
209 identified.
210
211 Returns a map of message keys to strings.; if no useable file is found, returns nil."
212 (memoize raw-get-messages))
213
214 (def get-message
215 "Return the message keyed by this `token` from the most acceptable messages collection
216 we have given this `accept-language-header`, if passed, or the current default language
217 otherwise. If no message is found, return the token.
218
219 * `token` should be a clojure keyword identifying the message to be retrieved;
220 * `accept-language-header` should be the value of an RFC2616 `Accept-Language` header;
221 * `resource-path` should be the fully-qualified path name of the directory in which
222 message files are stored;
223 * `default-locale` should be a locale specifier to use if no acceptable locale can be
224 identified."
225 (fn ([^Keyword token ^String accept-language-header ^String resource-path ^String default-locale]
226 (let [message (token (get-messages accept-language-header resource-path default-locale))]
227 (or message (name token))))
228 ([^Keyword token ^String accept-language-header]
229 (get-message token
230 accept-language-header
231 (or (:resource-path *config*) *resource-path*)
232 (or (:default-language *config*) *default-language*)))
233 ([^Keyword token]
234 (get-message token
235 (or (:default-language *config*) *default-language*)))))