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."
026 "i18n")
027
028 (def ^:dynamic *default-language*
029 "The default language to seek."
030 (-> (locale/get-default) locale/to-language-tag))
031
032 (def accept-language-grammar
033 "Grammar for `Accept-Language` headers"
034 "HEADER := SPECIFIER | SPECIFIERS;
035 SPECIFIERS:= SPECIFIER | SPECIFIER SPEC-SEP SPECIFIERS;
036 SPEC-SEP := #',\\s*';
037 SPECIFIER := LANGUAGE-TAG | LANGUAGE-TAG Q-SEP Q-VALUE;
038 LANGUAGE-TAG := PRIMARY-TAG | PRIMARY-TAG '-' SUB-TAGS;
039 PRIMARY-TAG := #'[a-zA-Z]+';
040 SUB-TAGS := SUB-TAG | SUB-TAG '-' SUB-TAGS;
041 SUB-TAG := #'[a-zA-Z0-9]+';
042 Q-SEP := #';\\s*q='
043 Q-VALUE := '1' | #'0.[0-9]+';")
044
045 (def parse-accept-language-header
046 "Parse an `Accept-Language` header"
047 (insta/parser accept-language-grammar))
048
049 (defn generate-accept-languages
050 "From a `parse-tree` generated by the `language-specifier-grammar`, generate
051 a list of maps each having a `:language` key, a `:preference` key and a
052 `:qualifier` key."
053 {:doc/format :markdown}
054 [parse-tree]
055 (if
056 (nil? parse-tree)
057 nil
058 (case
059 (first parse-tree)
060 :HEADER (generate-accept-languages (second parse-tree))
061 :SPECIFIERS (cons
062 (generate-accept-languages (second parse-tree))
063 (when (>= (count parse-tree) 3)
064 (generate-accept-languages (nth parse-tree 3))))
065 :SPEC-SEP nil
066 :SPECIFIER (assoc
067 (generate-accept-languages (second parse-tree))
068 :preference
069 (if
070 (>= (count parse-tree) 3)
071 (generate-accept-languages (nth parse-tree 3))
072 1))
073 :LANGUAGE-TAG (if
074 (>= (count parse-tree) 3)
075 (assoc
076 (generate-accept-languages (second parse-tree))
077 :qualifier
078 (generate-accept-languages (nth parse-tree 3)))
079 (generate-accept-languages (second parse-tree)))
080 :PRIMARY-TAG {:language (second parse-tree) :qualifier "*"}
081 :SUB-TAGS (if
082 (>= (count parse-tree) 3)
083 (str
084 (generate-accept-languages (second parse-tree))
085 "-"
086 (generate-accept-languages (nth parse-tree 3)))
087 (generate-accept-languages (second parse-tree)))
088 :SUB-TAG (second parse-tree)
089 :Q-SEP nil
090 :Q-VALUE (read-string (second parse-tree))
091 ;; default
092 (do
093 (timbre/error "Unable to parse header.")
094 nil))))
095
096 (defn acceptable-languages
097 "Generate an ordered list of acceptable languages, most-preferred first.
098
099 * `accept-language-header` should be the value of an RFC2616 `Accept-Language` header.
100
101 Returns a list of maps as generated by `generate-accept-languages`, in descending order
102 of preference."
103 {:doc/format :markdown}
104 [accept-language-header]
105 (let [parse-tree (parse-accept-language-header accept-language-header)]
106 (if (vector? parse-tree)
107 (reverse
108 (sort-by
109 :preference
110 (generate-accept-languages
111 parse-tree)))
112 (timbre/error "Failed to parse Accept-Language header '" accept-language-header "':\n" (str parse-tree)))))
113
114
115 (defn slurp-resource
116 "Slurp the resource of this name and return its contents as a string; but if it doesn't
117 exist log the fact and return nil, rather than throwing an exception."
118 [name]
119 (try
120 (slurp (io/resource name))
121 (catch Exception _
122 (timbre/error (str "Resource at " name " does not exist."))
123 nil)))
124
125
126 (defn find-language-file-name
127 "Find the name of a messages file on this resource path which matches this `language-spec`.
128
129 * `language-spec` should be either a map as generated by `generate-accept-languages`, or
130 else a string;
131 * `resource-path` should be the path name of the directory in which message files are stored,
132 within the resources on the classpath.
133
134 Returns the name of an appropriate file if any is found, else nil."
135 {:doc/format :markdown}
136 [language-spec resource-path]
137 (let [file-path (when
138 (string? language-spec)
139 (join
140 java.io.File/separator
141 [resource-path (str language-spec ".edn")]))
142 contents (when file-path (slurp-resource file-path))]
143 (cond
144 contents
145 file-path
146 (map? language-spec)
147 (or
148 (find-language-file-name
149 (str (:language language-spec) "-" (:qualifier language-spec))
150 resource-path)
151 (find-language-file-name
152 (:language language-spec)
153 resource-path)))))
154
155
156 (defn raw-get-messages
157 "Return the most acceptable messages collection we have given this `accept-language-header`.
158 Do not use this function directly, use the memoized variant `get-messages`, as performance
159 will be very much better.
160
161 * `accept-language-header` should be the value of an RFC2616 `Accept-Language` header;
162 * `resource-path` should be the fully-qualified path name of the directory in which
163 message files are stored;
164 * `default-locale` should be a locale specifier to use if no acceptable locale can be
165 identified.
166
167 Returns a map of message keys to strings; if no useable file is found, returns nil."
168 {:doc/format :markdown}
169 [^String accept-language-header ^String resource-path ^String default-locale]
170 (let [file-path (first
171 (remove
172 nil?
173 (map
174 #(find-language-file-name % resource-path)
175 (acceptable-languages accept-language-header))))]
176 (timbre/debug (str "Found i18n file at '" file-path "'"))
177 (try
178 (read-string
179 (slurp-resource
180 (or
181 file-path
182 (join java.io.File/separator
183 [resource-path
184 (str default-locale ".edn")]))))
185 (catch Exception any
186 (timbre/error (str "Failed to load internationalisation because " (.getMessage any)))
187 nil))))
188
189 (def get-messages
190 "Return the most acceptable messages collection we have given this `accept-language-header`
191
192 * `accept-language-header` should be the value of an RFC2616 `Accept-Language` header;
193 * `resource-path` should be the fully-qualified path name of the directory in which
194 message files are stored;
195 * `default-locale` should be a locale specifier to use if no acceptable locale can be
196 identified.
197
198 Returns a map of message keys to strings.; if no useable file is found, returns nil."
199 (memoize raw-get-messages))
200
201 (def get-message
202 "Return the message keyed by this `token` from the most acceptable messages collection
203 we have given this `accept-language-header`.
204
205 * `token` should be a clojure keyword identifying the message to be retrieved;
206 * `accept-language-header` should be the value of an RFC2616 `Accept-Language` header;
207 * `resource-path` should be the fully-qualified path name of the directory in which
208 message files are stored;
209 * `default-locale` should be a locale specifier to use if no acceptable locale can be
210 identified."
211 (fn ([^Keyword token ^String accept-language-header ^String resource-path ^String default-locale]
212 ((get-messages accept-language-header resource-path default-locale) token))
213 ([^Keyword token ^String accept-language-header]
214 (get-message token accept-language-header *resource-path* *default-language*))
215 ([^Keyword token]
216 (get-message token nil *resource-path* *default-language*))))