Initial commit

src/scot/weft/i18n/core.clj

@@ -0,0 +1,161 @@
+(ns ^{:doc "Internationalisation."
+      :author "Simon Brooke"}
+  scot.weft.i18n.core
+  (:require [clojure.string :as cs]
+            [clojure.java.io :as io]
+            [instaparse.core :as insta]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; 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 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."
+  [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))
+                    (if (>= (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)))))
+
+
+(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."
+  [accept-language-header]
+  (reverse
+    (sort-by
+      :preference
+      (generate-accept-languages
+        (parse-accept-language-header accept-language-header)))))
+
+
+(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 fully-qualified path name of the directory in which
+  message files are stored.
+
+  Returns the name of an appropriate file if any is found, else nil."
+  [language-spec resource-path]
+  (cond
+    (and
+      (string? language-spec)
+      (.exists (io/file resource-path (str language-spec ".edn"))))
+    (.getAbsolutePath (io/file resource-path (str language-spec ".edn")))
+    (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."
+  [accept-language-header resource-path default-locale]
+  (read-string
+    (slurp
+      (or
+        (first
+          (remove
+            nil?
+            (map
+              #(find-language-file-name % resource-path)
+              (acceptable-languages accept-language-header))))
+        (str resource-path default-locale ".edn")))))
+
+
+(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."
+  (memoize raw-get-messages))
+
+
+
+