├── .gitignore ├── tests ├── ja-jp │ └── aura.ftl ├── en-us │ ├── basic.ftl │ └── aura.ftl └── tests.lisp ├── CHANGELOG.md ├── .github └── workflows │ └── cl.yaml ├── fluent.asd ├── src ├── bench.lisp ├── types.lisp ├── disk.lisp ├── package.lisp ├── resolution.lisp └── parser.lisp └── README.org /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.fas 3 | vendored/ 4 | -------------------------------------------------------------------------------- /tests/ja-jp/aura.ftl: -------------------------------------------------------------------------------- 1 | sonzai-shinai = 大変! 2 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Fluent 2 | 3 | ## Unreleased 4 | 5 | ### Fixed 6 | 7 | - SBCL: Occasional issues involving `simple-base-string` in path components. 8 | 9 | ## 1.0.0 (2025-07-31) 10 | 11 | Initial release. 12 | -------------------------------------------------------------------------------- /tests/en-us/basic.ftl: -------------------------------------------------------------------------------- 1 | # Simple things are simple. 2 | hello-user = Hello, {$userName}! 3 | 4 | # Complex things are possible. 5 | shared-photos = 6 | {$userName} {$photoCount -> 7 | [one] added a new photo 8 | *[other] added {$photoCount} new photos 9 | } to {$userGender -> 10 | [male] his stream 11 | [female] her stream 12 | *[other] their stream 13 | }. 14 | 15 | -------------------------------------------------------------------------------- /.github/workflows/cl.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: [master] 4 | pull_request: 5 | 6 | jobs: 7 | test: 8 | runs-on: ubuntu-latest 9 | name: Unit Tests 10 | steps: 11 | - name: Clone the Project 12 | uses: actions/checkout@v4 13 | 14 | - name: Set up Common Lisp 15 | uses: fosskers/common-lisp@v1 16 | 17 | - name: Test 18 | run: | 19 | vend test 20 | -------------------------------------------------------------------------------- /fluent.asd: -------------------------------------------------------------------------------- 1 | (defsystem "fluent" 2 | :version "1.0.0" 3 | :author "Colin Woodbury " 4 | :license "MPL-2.0" 5 | :homepage "https://github.com/fosskers/fluent" 6 | :depends-on (:parcom :plurals :filepaths) 7 | :serial t 8 | :components ((:module "src" 9 | :components ((:file "package") 10 | (:file "types") 11 | (:file "resolution") 12 | (:file "parser") 13 | (:file "disk")))) 14 | :description "Software localisation via Mozilla's Project Fluent." 15 | :in-order-to ((test-op (test-op :fluent/tests)))) 16 | 17 | (defsystem "fluent/tests" 18 | :depends-on (:fluent :parcom :parachute) 19 | :components ((:module "tests" :components ((:file "tests")))) 20 | :perform (test-op (op c) (symbol-call :parachute :test :fluent/tests))) 21 | -------------------------------------------------------------------------------- /src/bench.lisp: -------------------------------------------------------------------------------- 1 | (in-package :fluent) 2 | 3 | (defun read-string-sequence (path) 4 | "Read the contents of a file into a string." 5 | (with-open-file (stream path :direction :input) 6 | (let ((data (make-string (file-length stream)))) 7 | (read-sequence data stream) 8 | data))) 9 | 10 | (defun read-string-vector (path) 11 | "Read the contents of a file into a string." 12 | (with-open-file (stream path :direction :input :element-type 'character) 13 | (let ((s (make-array 16 :element-type 'character :adjustable t :fill-pointer 0))) 14 | (loop :for c := (read-char stream nil :eof) 15 | :until (eq c :eof) 16 | :do (vector-push-extend c s)) 17 | s))) 18 | 19 | #+nil 20 | (let ((s (read-string #p"README.org"))) 21 | (schar s (1- (length s)))) 22 | 23 | #+nil 24 | (let ((s (uiop:read-file-string #p"README.org"))) 25 | (schar s (1- (length s)))) 26 | 27 | #+nil 28 | (let ((s #p"README.org")) 29 | (format t "--- UIOP ---~%") 30 | (time (dotimes (n 1000) 31 | (uiop:read-file-string s))) 32 | (format t "--- READ-SEQUENCE ---~%") 33 | (time (dotimes (n 1000) 34 | (read-string-sequence s))) 35 | (format t "--- VECTOR ---~%") 36 | (time (dotimes (n 1000) 37 | (read-string-vector s))) 38 | (format t "--- GOOD ---~%") 39 | (time (dotimes (n 1000) 40 | (read-string s)))) 41 | 42 | ;; CONCLUSION 43 | ;; 44 | ;; UIOP is about 2x-3x slower than the stream-based approach above. My original 45 | ;; implementation is "just wrong" w.r.t. non-ascii chars, so can't be used, even 46 | ;; though it is the fastest and most memory efficient. I've adopted the 47 | ;; stream-based approach. 48 | ;; 49 | ;; Also note that the stream approach yields a `(simple-array character (*))'! 50 | -------------------------------------------------------------------------------- /src/types.lisp: -------------------------------------------------------------------------------- 1 | ;;; Core types necessary for parsing and "resolution". 2 | 3 | (in-package :fluent) 4 | 5 | (deftype char-string () 6 | '(simple-array character (*))) 7 | 8 | (defstruct variable 9 | "An external value that we expect the user to provide at runtime." 10 | (name nil :type keyword)) 11 | 12 | (defstruct term 13 | "A reference to another static message in the localisation." 14 | (name nil :type string) 15 | (arg nil :type (or null keyword)) 16 | (val nil :type (or null string))) 17 | 18 | (defstruct numberf 19 | "The NUMBER function." 20 | (input nil :type keyword) 21 | (min-frac nil :type (or null fixnum)) 22 | (max-frac nil :type (or null fixnum)) 23 | ;; `:ordinal' is opt-in due to being a somewhat rare choice. 24 | (type :cardinal :type keyword)) 25 | 26 | (defstruct selection 27 | "Branching possibilities of a localisation depending on some input value." 28 | (input nil :type (or keyword numberf)) 29 | (branches nil :type list) 30 | (default nil :type branch)) 31 | 32 | (defstruct branch 33 | "A particular branch of a selection block." 34 | (term nil :type (or string plurals:category)) 35 | (line nil :type list) 36 | (default nil :type boolean)) 37 | 38 | (defstruct localisations 39 | "A body of localisation lines from a single language." 40 | (terms nil :type hash-table) 41 | (lines nil :type hash-table)) 42 | 43 | (defun fuse-localisations (a b) 44 | "Merge two localisations." 45 | (make-localisations :terms (merge-hash-tables! (localisations-terms a) 46 | (localisations-terms b)) 47 | :lines (merge-hash-tables! (localisations-lines a) 48 | (localisations-lines b)))) 49 | 50 | (defstruct fluent 51 | "A full localisation context, including all possible languages, the current 52 | expected locale, and the fallback locale." 53 | (locale nil :type keyword) 54 | (locale-lang nil :type keyword) 55 | (fallback nil :type keyword) 56 | (fallback-lang nil :type keyword) 57 | (locs nil :type hash-table)) 58 | 59 | (defun fluent (locs &key (locale :en-us) (fallback :en-us)) 60 | "Intelligently construct a `fluent' context." 61 | (make-fluent :locale locale 62 | :locale-lang (locale->lang locale) 63 | :fallback fallback 64 | :fallback-lang (locale->lang fallback) 65 | :locs locs)) 66 | 67 | (defun localisation->fluent (locs locale) 68 | "Construct a `fluent' context from a single collection of localisations." 69 | (let ((ht (make-hash-table :test #'eq :size 1))) 70 | (setf (gethash locale ht) locs) 71 | (fluent locs :locale locale :fallback locale))) 72 | -------------------------------------------------------------------------------- /src/disk.lisp: -------------------------------------------------------------------------------- 1 | ;;; A greater scheme for reading and parsing entire sets of `.ftl' files from 2 | ;;; disk, and collating them into a unified `fluent' type. 3 | ;;; 4 | ;;; Given an initial directory in which to locate localisation files, the logic 5 | ;;; here will interpret each subdirectory as a full language/country pair (e.g. 6 | ;;; hi-IN, "Hindi in India"), then scour that subdirectory for all `.ftl' files, 7 | ;;; parsing them and unifying them into a single localisation. A condition will 8 | ;;; be raised if clashing keys exist between different files. 9 | ;;; 10 | ;;; The result of this is a Hash Table of locales mapped to their 11 | ;;; `localisations'. 12 | 13 | (in-package :fluent) 14 | 15 | (defun all-directories (dir) 16 | "Find all subdirectories within a given parent directory." 17 | #+allegro 18 | (all-directories-allegro dir) 19 | #-allegro 20 | (let ((dirs (directory (f:ensure-directory (f:join dir "*"))))) 21 | #+abcl 22 | (unique-parents dirs) 23 | #+(not abcl) 24 | dirs)) 25 | 26 | #+nil 27 | (all-directories #p"/home/colin/code/haskell/aura/rust/aura-pm/i18n") 28 | 29 | #+allegro 30 | (defun all-directories-allegro (dir) 31 | "Logic specific to Allegro functionality, as its behaviour of `directory' does 32 | not match other implementations." 33 | (let ((dir (f:ensure-directory dir)) 34 | (dirs '())) 35 | (excl:map-over-directory 36 | (lambda (path) (when (and (f:directory? path) 37 | (not (equalp path dir))) 38 | (push path dirs))) 39 | dir 40 | :include-directories t 41 | :recurse nil) 42 | dirs)) 43 | 44 | ;; NOTE: 2025-07-31 This is only necessary for naughty compilers whose 45 | ;; `directory' implementation is naturally recursive (at least with respect to 46 | ;; `*') and can't be stopped. 47 | #+abcl 48 | (defun unique-parents (entries) 49 | "Given a list of files, determine their unique parent directories." 50 | (let ((ht (make-hash-table :test #'equal))) 51 | (dolist (entry entries) 52 | (let ((parent (f:parent entry))) 53 | (setf (gethash parent ht) t))) 54 | (loop :for key :being :the :hash-keys :of ht 55 | :collect key))) 56 | 57 | (defun ftl-files-in-dir (dir) 58 | "Yield all the `.ftl' files in a given directory." 59 | (directory (f:join dir "*.ftl"))) 60 | 61 | #+nil 62 | (ftl-files-in-dir #p"/home/colin/code/haskell/aura/rust/aura-pm/i18n/en-US") 63 | 64 | (defun dir->locale (dir) 65 | "Parse a locale keyword from a directory name." 66 | (parse-locale (clean-string (car (last (f:components dir)))))) 67 | 68 | #+nil 69 | (dir->locale (car (all-directories #p"/home/colin/code/haskell/aura/rust/aura-pm/i18n"))) 70 | 71 | (defun clean-string (s) 72 | "Ensure that the string is the right type for parsing." 73 | #+(or sbcl ecl) 74 | (elevate-string s) 75 | #-(or sbcl ecl) 76 | s) 77 | 78 | (defun localisations-in-dir (dir) 79 | "Given a directory filled with `.ftl' files, parse them all and fuse them 80 | into a single `localisation' type." 81 | (reduce (lambda (acc file) (fuse-localisations acc (parse (read-string file)))) 82 | (ftl-files-in-dir dir) 83 | :initial-value (make-localisations :terms (make-hash-table :test #'equal) 84 | :lines (make-hash-table :test #'equal)))) 85 | 86 | #+nil 87 | (localisations-in-dir #p"tests/data/") 88 | 89 | (defun read-all-localisations (dir) 90 | "Given a parent directory, read all per-locale localisations and form a Hash 91 | Table of locales paired to their specific `localisations'." 92 | (let ((ht (make-hash-table :test #'eq))) 93 | (dolist (sub (all-directories dir)) 94 | (setf (gethash (dir->locale sub) ht) 95 | (localisations-in-dir sub))) 96 | ht)) 97 | 98 | #+nil 99 | (read-all-localisations #p"/home/colin/code/haskell/aura/rust/aura-pm/i18n") 100 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage fluent 2 | (:use :cl) 3 | (:shadow #:variable #:number) 4 | (:import-from :parcom #:<*> #:<* #:*> #:<$) 5 | (:local-nicknames (#:p #:parcom) 6 | (#:f #:filepaths)) 7 | ;; --- Types --- ;; 8 | (:export #:fluent #:fluent-locale #:fluent-fallback #:fluent-locs) 9 | ;; --- Entry --- ;; 10 | (:export #:read-all-localisations #:parse #:resolve #:resolve-with) 11 | ;; --- Conditions --- ;; 12 | (:export #:missing-line #:unknown-locale #:missing-input) 13 | (:documentation "Software localisation via Mozilla's Project Fluent.")) 14 | 15 | (in-package :fluent) 16 | 17 | (defun string->keyword (s) 18 | (multiple-value-bind (kw _) (intern (string-upcase s) "KEYWORD") 19 | (declare (ignore _)) 20 | kw)) 21 | 22 | #+nil 23 | (string->keyword "hello") 24 | 25 | (define-condition missing-line (error) 26 | ((line :initarg :line :reader missing-line-line) 27 | (locale :initarg :locale :reader missing-line-locale) 28 | (fallback :initarg :fallback :reader missing-line-fallback)) 29 | (:documentation "A certain localisation couldn't be found in any language.") 30 | (:report (lambda (c stream) 31 | (format stream "The localisation '~a' could not be found.~%Locale: ~a~%Fallback: ~a" 32 | (missing-line-line c) 33 | (missing-line-locale c) 34 | (missing-line-fallback c))))) 35 | 36 | (define-condition unknown-locale (error) 37 | ((locale :initarg :locale :reader unknown-locale-locale)) 38 | (:documentation "The user attempted to resolve via an unknown locale.") 39 | (:report (lambda (c stream) 40 | (format stream "Unknown locale: ~a" (unknown-locale-locale c))))) 41 | 42 | (define-condition missing-input (error) 43 | ((expected :initarg :expected :reader missing-input-expected)) 44 | (:documentation "A certain arg was expected for a localisation line, but it wasn't given.") 45 | (:report (lambda (c stream) 46 | (format stream "Missing localisation argument: ~a" (missing-input-expected c))))) 47 | 48 | (defun get-input (col k) 49 | "Extra error handling around a `getf' call." 50 | (let ((v (getf col k))) 51 | (cond (v v) 52 | (t (error 'missing-input :expected k))))) 53 | 54 | (declaim (ftype (function ((or string pathname)) (simple-array character (*))) read-string)) 55 | (defun read-string (path) 56 | "Read the contents of a file into a string." 57 | (with-open-file (stream path :direction :input :element-type 'character) 58 | (with-output-to-string (out) 59 | (loop :for c := (read-char stream nil :eof) 60 | :until (eq c :eof) 61 | :do (write-char c out))))) 62 | 63 | #+nil 64 | (read-string #p"tests/data/basic.ftl") 65 | 66 | (declaim (ftype (function (hash-table hash-table) hash-table) merge-hash-tables!)) 67 | (defun merge-hash-tables! (a b) 68 | "Merge the elements of a second Hash Table into the first one. If a given key 69 | exists in both Hash Tables, the value of the second will be kept." 70 | (maphash (lambda (k v) (setf (gethash k a) v)) b) 71 | a) 72 | 73 | #+nil 74 | (let ((a (make-hash-table :test #'eq)) 75 | (b (make-hash-table :test #'eq))) 76 | (setf (gethash :a a) 1) 77 | (setf (gethash :b a) 2) 78 | (setf (gethash :c b) 3) 79 | (setf (gethash :d b) 4) 80 | (merge-hash-table! a b)) 81 | 82 | (declaim (ftype (function (char-string) keyword) parse-locale)) 83 | (defun parse-locale (s) 84 | "Parse a full locale (e.g. hi-IN) from a string into a keyword." 85 | (p:parse (p:pmap #'string->keyword 86 | (p:recognize (*> #'letters (p:opt (*> (p:char #\-) #'letters))))) 87 | s)) 88 | 89 | #+nil 90 | (parse-locale "hi-IN") 91 | #+nil 92 | (parse-locale "eo") 93 | 94 | (defun letters (offset) 95 | "Some letters." 96 | (funcall (p:take-while1 #'p:ascii-letter?) offset)) 97 | 98 | #+nil 99 | (p:parse #'letters "hi-IN") 100 | 101 | (declaim (ftype (function (keyword) keyword) locale->lang)) 102 | (defun locale->lang (locale) 103 | "Extract the language portion of a locale. So, the `en' in `en-US'." 104 | (p:parse (p:pmap #'string->keyword (p:recognize #'letters)) 105 | #+(or sbcl ecl) 106 | (elevate-string (symbol-name locale)) 107 | #-(or sbcl ecl) 108 | (symbol-name locale))) 109 | 110 | #+nil 111 | (locale->lang (parse-locale "hi-IN")) 112 | 113 | (defun elevate-string (base) 114 | "Forced workaround involving `simple-base-string' stupidity." 115 | (let ((simple (make-array (length base) :element-type 'character))) 116 | (replace simple base))) 117 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+title: Fluent 2 | 3 | This is a Common Lisp implementation of [[https://projectfluent.org/][Fluent]], a modern localisation system. 4 | 5 | See also Fluent's [[https://projectfluent.org/fluent/guide/index.html][Syntax Guide]]. 6 | 7 | With Fluent, localisations are defined in per-language =.ftl= files as key-value 8 | pairs. Many localisations are just simple lookups: 9 | 10 | #+begin_example 11 | check-start = Validating your system. 12 | #+end_example 13 | 14 | But Fluent's strength is in the ability to inject values into the line, as well 15 | as perform "selections" based on grammatical rules and plural categories: 16 | 17 | #+begin_example 18 | check-pconf-pacnew-old = { $path } is older than its .pacnew by { $days -> 19 | [one] 1 day. 20 | *[many] {$days} days. 21 | } 22 | #+end_example 23 | 24 | #+begin_src lisp :exports both 25 | (in-package :fluent) 26 | (let* ((loc (parse (uiop:read-file-string "tests/data/aura.ftl"))) 27 | (ctx (localisation->fluent loc :en))) 28 | (resolve ctx "check-pconf-pacnew-old" :path "pacman.conf" :days 1)) 29 | #+end_src 30 | 31 | #+RESULTS: 32 | : pacman.conf is older than its .pacnew by 1 day. 33 | 34 | Per-locale plural rules are provided by the [[https://github.com/fosskers/plurals][plurals]] library. 35 | 36 | * Table of Contents :TOC_5_gh:noexport: 37 | - [[#compatibility][Compatibility]] 38 | - [[#usage][Usage]] 39 | - [[#reading-localisations-from-disk][Reading localisations from disk]] 40 | - [[#localisation-lookups][Localisation lookups]] 41 | - [[#fallback][Fallback]] 42 | - [[#limitations][Limitations]] 43 | 44 | * Compatibility 45 | 46 | | Compiler | Status | 47 | |-----------+--------| 48 | | SBCL | ✅ | 49 | | ECL | ✅ | 50 | | CMUCL | ✅ | 51 | | ABCL | ✅ | 52 | | Clasp | ✅ | 53 | | CCL | ✅ | 54 | | Clisp | ❌ | 55 | |-----------+--------| 56 | | Allegro | ✅ | 57 | | LispWorks | ❓ | 58 | 59 | * Usage 60 | 61 | The examples below use =(in-package :fluent)= for brevity, but it's assumed you'll 62 | use a nickname in your own code, perhaps =f=. 63 | 64 | ** Reading localisations from disk 65 | 66 | Your localisation files must have the extension =.ftl= and be separated into 67 | different subdirectories by their locale: 68 | 69 | #+begin_example 70 | i18n 71 | ├── ar-SA 72 | │   └── your-project.ftl 73 | ├── bn-BD 74 | │   └── your-project.ftl 75 | ├── cs-CZ 76 | │   └── your-project.ftl 77 | ├── de-DE 78 | │   └── your-project.ftl 79 | ├── en-US 80 | │   └── your-project.ftl 81 | #+end_example 82 | 83 | Each subdirectory can contain as many =.ftl= files as is convenient to you; their 84 | contents will be fused when read. 85 | 86 | #+begin_src lisp :exports both 87 | (in-package :fluent) 88 | (fluent (read-all-localisations #p"i18n")) 89 | #+end_src 90 | 91 | #+RESULTS: 92 | : #S(FLUENT 93 | : :LOCALE :EN-US 94 | : :LOCALE-LANG :EN 95 | : :FALLBACK :EN-US 96 | : :FALLBACK-LANG :EN 97 | : :LOCS #) 98 | 99 | As you can see, you pass a parent directory (=i18n/= here), and all =.ftl= files are 100 | automatically detected. 101 | 102 | ** Localisation lookups 103 | 104 | Once you have a fully formed =fluent= context, you can perform localisation 105 | lookups. Input args into the localisation line are passed as keyword arguments. 106 | For example, the following message: 107 | 108 | #+begin_example 109 | check-pconf-pacnew-old = { $path } is older than its .pacnew by { $days -> 110 | [one] 1 day. 111 | *[many] {$days} days. 112 | } 113 | #+end_example 114 | 115 | can be resolved like so: 116 | 117 | #+begin_src lisp :exports both 118 | (in-package :fluent) 119 | (let* ((ctx (fluent (read-all-localisations #p"tests")))) 120 | (resolve ctx "check-pconf-pacnew-old" :path "pacman.conf" :days 1)) 121 | #+end_src 122 | 123 | #+RESULTS: 124 | : pacman.conf is older than its .pacnew by 1 day. 125 | 126 | A condition will be raised if: 127 | 128 | - The requested locale doesn't exist in the =fluent= context. 129 | - The requested localisation line doesn't exist in the locale. 130 | - Expected line inputs were missing (e.g. the =path= and =days= args above). 131 | 132 | ** Fallback 133 | 134 | A "fallback locale" was mentioned above, which can be set when you first create 135 | a =fluent= context: 136 | 137 | #+begin_src lisp :exports both 138 | (in-package :fluent) 139 | (let* ((ctx (fluent (read-all-localisations #p"tests") :fallback :ja-jp))) 140 | (resolve ctx "sonzai-shinai")) 141 | #+end_src 142 | 143 | #+RESULTS: 144 | : 大変! 145 | 146 | In this case, the line =sonzai-shinai= had no localisation within the default 147 | =:en-us= locale, so it defaulted to looking within the Japanese locale. More than 148 | likely English will be your fallback, with your initial =:locale= being some other 149 | localisation target, as in: 150 | 151 | #+begin_src lisp :exports both 152 | (in-package :fluent) 153 | (fluent (read-all-localisations #p"tests") :locale :ja-jp :fallback :en-us) 154 | #+end_src 155 | 156 | #+RESULTS: 157 | : #S(FLUENT 158 | : :LOCALE :JA-JP 159 | : :LOCALE-LANG :JA 160 | : :FALLBACK :EN-US 161 | : :FALLBACK-LANG :EN 162 | : :LOCS #) 163 | 164 | You are free to mutate this =fluent= struct at runtime or call =resolve-with= 165 | directly to match a user's locale settings in a more dynamic way. For instance, 166 | if they change language settings within your app after opening it. 167 | 168 | * Limitations 169 | 170 | - Gap lines in multiline text are not supported. 171 | - Preservation of clever indenting in multiline text is not supported. 172 | - For the =NUMBER= function, only the =minimumFractionDigits=, 173 | =maximumFractionDigits=, and =type= arguments are supported. 174 | - The =DATETIME= function has not been implementation. 175 | - Attributes are not available, so the following is not possible: 176 | 177 | #+begin_example 178 | -brand-name = Aurora 179 | .gender = feminine 180 | 181 | update-successful = 182 | { -brand-name.gender -> 183 | [masculine] { -brand-name } został zaktualizowany. 184 | [feminine] { -brand-name } została zaktualizowana. 185 | *[other] Program { -brand-name } został zaktualizowany. 186 | } 187 | #+end_example 188 | -------------------------------------------------------------------------------- /tests/tests.lisp: -------------------------------------------------------------------------------- 1 | (defpackage fluent/tests 2 | (:use :cl :parachute) 3 | (:local-nicknames (#:f #:fluent) 4 | (#:p #:parcom))) 5 | 6 | (in-package :fluent/tests) 7 | 8 | (define-test parsing) 9 | 10 | (define-test parsing-placeables 11 | :parent parsing 12 | (is equalp (f::make-variable :name :foo) 13 | (p:parse #'f::variable "{ $foo }")) 14 | (is equalp (f::make-variable :name :foo) 15 | (p:parse #'f::variable "{$foo}")) 16 | (is equalp (f::make-term :name "foo") 17 | (p:parse #'f::term "{ -foo }")) 18 | (is equalp (f::make-term :name "foo") 19 | (p:parse #'f::term "{-foo}")) 20 | (is equal "}" (p:parse #'f::quoted "{\"}\"}")) 21 | (finish (p:parse #'f::placeable "{ NUMBER($ratio, minimumFractionDigits: 2) }")) 22 | (finish (p:parse (p:<* #'f::term #'p:eof) "{ -https(host: \"example.com\") }"))) 23 | 24 | (define-test parsing-plaintext 25 | :parent parsing 26 | (is equal '("this is a" "multiline string") (p:parse #'f::entry "this is a 27 | multiline string")) 28 | (is equal '("this has" "more than" "two lines") (p:parse #'f::entry "this has 29 | more than 30 | two lines"))) 31 | 32 | #+nil 33 | (define-test parsing-ideally-passes-but-doesnt 34 | :parent parsing 35 | ;; By the spec, that extra newline in between should be preserved. 36 | (fail (p:parse #'f::entry "this has 37 | an extra 38 | 39 | blank line!"))) 40 | 41 | (define-test parsing-pairs 42 | :parent parsing 43 | (finish (p:parse (p:<* #'f::pair #'p:eof) "dpi-ratio = Your DPI ratio is { NUMBER($ratio, minimumFractionDigits: 2)}"))) 44 | 45 | (define-test parsing-files 46 | :parent parsing 47 | (let ((s (f::read-string #p"tests/en-us/basic.ftl"))) 48 | (finish (f:parse s))) 49 | (let ((l (f:fluent (f:read-all-localisations #p"tests")))) 50 | (is equal "Validating your system." (f:resolve l "check-start")) 51 | (fail (f:resolve l "check-env-exec")) 52 | (is equal "emacs installed and executable?" (f:resolve l "check-env-exec" :exec "emacs")) 53 | (is equal "Fix: Update your foo.ftl to include Spanish." (f:resolve l "check-env-lang-fix" :file "foo.ftl" :lang "Spanish")) 54 | (is equal "pacman.conf is older than its .pacnew by 1 day." (f:resolve l "check-pconf-pacnew-old" :path "pacman.conf" :days 1)) 55 | (is equal "pacman.conf is older than its .pacnew by 27 days." (f:resolve l "check-pconf-pacnew-old" :path "pacman.conf" :days 27)))) 56 | 57 | (define-test parsing-minor-things 58 | :parent parsing 59 | (is eq :photocount (p:parse #'f::dollared "$photoCount")) 60 | (is eq :other (p:parse #'f::category "other")) 61 | (is eq :few (p:parse #'f::branch-selection-term "[few]")) 62 | (is equal "male" (p:parse #'f::branch-selection-term "[male]")) 63 | (is equal "1" (p:parse #'f::branch-selection-term "[1]")) 64 | (is equal "1.0" (p:parse #'f::branch-selection-term "[1.0]"))) 65 | 66 | (define-test parsing-selections 67 | :parent parsing 68 | (let* ((def (f::make-branch :term :other 69 | :line (list "added " (f::make-variable :name :photocount) " new photos") 70 | :default t)) 71 | (sel (f::make-selection :input :photocount 72 | :branches (list (f::make-branch :term :one 73 | :line (list "added a new photo") 74 | :default nil) 75 | def) 76 | :default def))) 77 | (is equalp sel (p:parse #'f::selection "{$photoCount -> 78 | [one] added a new photo 79 | *[other] added {$photoCount} new photos 80 | }"))) 81 | (finish (p:parse (p:<* #'f::selection #'p:eof) "{ NUMBER($score, minimumFractionDigits: 1) -> 82 | [0.0] You scored zero points. What happened? 83 | *[other] You scored { NUMBER($score, minimumFractionDigits: 1) } points. 84 | }"))) 85 | 86 | (define-test functions) 87 | 88 | (define-test number 89 | :parent functions 90 | (is equal "1" (f::resolve-number (f::make-numberf :input :foo :min-frac 0) 1)) 91 | (is equal "1.0" (f::resolve-number (f::make-numberf :input :foo :min-frac 0) 1.0)) 92 | (is equal "1.123" (f::resolve-number (f::make-numberf :input :foo :min-frac 0) 1.123)) 93 | (is equal "1.000" (f::resolve-number (f::make-numberf :input :foo :min-frac 3) 1)) 94 | (is equal "1.000" (f::resolve-number (f::make-numberf :input :foo :min-frac 3) 1.0)) 95 | (is equal "1.123" (f::resolve-number (f::make-numberf :input :foo :min-frac 2) 1.123)) 96 | (is equal "1" (f::resolve-number (f::make-numberf :input :foo :max-frac 0) 1)) 97 | (is equal "1" (f::resolve-number (f::make-numberf :input :foo :max-frac 0) 1.0)) 98 | (is equal "1.0" (f::resolve-number (f::make-numberf :input :foo :max-frac 1) 1.02)) 99 | (is equal "1.02" (f::resolve-number (f::make-numberf :input :foo :max-frac 2) 1.02)) 100 | (is equal "1.02" (f::resolve-number (f::make-numberf :input :foo :max-frac 2) 1.023))) 101 | 102 | (define-test resolution) 103 | 104 | (define-test type-selection 105 | :parent resolution 106 | (let ((sel (p:parse (p:<* #'f::selection #'p:eof) "{ NUMBER($pos, type: \"ordinal\") -> 107 | [1] You finished first! 108 | [one] You finished {$pos}st 109 | [two] You finished {$pos}nd 110 | [few] You finished {$pos}rd 111 | *[other] You finished {$pos}th 112 | }"))) 113 | (is equal "You finished first!" (f::resolve-selection :en (make-hash-table) sel '(:pos 1))) 114 | (is equal "You finished 2nd" (f::resolve-selection :en (make-hash-table) sel '(:pos 2))))) 115 | 116 | (define-test terms 117 | :parent resolution 118 | (let ((terms (f::localisations-terms (f:parse "-brand-name = Firefox"))) 119 | (line (p:parse #'f::entry "About { -brand-name }."))) 120 | (is equal "About Firefox." (f::resolve-line :en terms line '()))) 121 | (let ((terms (f::localisations-terms (f:parse "-https = https://{ $host }"))) 122 | (line (p:parse (p:<* #'f::entry #'p:eof) "Visit { -https(host: \"example.com\") } for more info."))) 123 | (is equal "Visit https://example.com for more info." (f::resolve-line :en terms line '()))) 124 | (let ((terms (f::localisations-terms (f:parse "-brand-name = 125 | { $case -> 126 | *[nominative] Firefox 127 | [locative] Firefoksie 128 | }"))) 129 | (line0 (p:parse (p:<* #'f::entry #'p:eof) "Informacje o { -brand-name(case: \"locative\") }")) 130 | (line1 (p:parse (p:<* #'f::entry #'p:eof) "{ -brand-name } został pomyślnie zaktualizowany."))) 131 | (is equal "Informacje o Firefoksie" (f::resolve-line :en terms line0 '())) 132 | (is equal "Firefox został pomyślnie zaktualizowany." (f::resolve-line :en terms line1 '())))) 133 | -------------------------------------------------------------------------------- /src/resolution.lisp: -------------------------------------------------------------------------------- 1 | ;;; Logic for resolving a given particular localisation. 2 | 3 | (in-package :fluent) 4 | 5 | (defmacro resolve (ctx tag &rest inputs) 6 | "Find a localisation line by name and fully resolve it via some input args." 7 | `(resolve-with ,ctx (fluent-locale ,ctx) (fluent-locale-lang ,ctx) ,tag ,@inputs)) 8 | 9 | #+nil 10 | (let ((c (fluent (read-all-localisations #p"tests")))) 11 | (resolve c "check-pconf-pacnew-old" :path "pacman.conf" :days 1)) 12 | 13 | (declaim (ftype (function (fluent keyword keyword string &rest t) string) resolve-with)) 14 | (defun resolve-with (ctx locale lang tag &rest inputs) 15 | "Find a localisation line via some explicit locale." 16 | (let ((loc (gethash locale (fluent-locs ctx)))) 17 | (unless loc 18 | (error 'unknown-locale :locale locale)) 19 | (let ((line (gethash tag (localisations-lines loc)))) 20 | (cond ((and (not line) 21 | (eq locale (fluent-fallback ctx))) 22 | (error 'missing-line :line tag 23 | :locale locale 24 | :fallback (fluent-fallback ctx))) 25 | ((not line) (resolve-with ctx (fluent-fallback ctx) (fluent-fallback-lang ctx) tag inputs)) 26 | (t (resolve-line lang (localisations-terms loc) line inputs)))))) 27 | 28 | (declaim (ftype (function (numberf real) string) resolve-number)) 29 | (defun resolve-number (f n) 30 | "Evaluate a NUMBER function." 31 | (let ((min (numberf-min-frac f)) 32 | (max (numberf-max-frac f))) 33 | (cond (min (cond ((zerop min) (format nil "~a" n)) 34 | (t (multiple-value-bind (_ rem) (floor n) 35 | (declare (ignore _)) 36 | (multiple-value-bind (_ rem) (floor (* rem 10 min)) 37 | (declare (ignore _)) 38 | (cond ((> rem 0) (format nil "~f" n)) 39 | (t (format nil "~,vf" min n)))))))) 40 | (max (multiple-value-bind (int rem) (floor n) 41 | (cond ((zerop max) (format nil "~d" int)) 42 | (t (multiple-value-bind (_ rem) (floor (* rem 10 max)) 43 | (declare (ignore _)) 44 | (cond ((> rem 0) (format nil "~,vf" max n)) 45 | (t (format nil "~f" n)))))))) 46 | (t (format nil "~a" n))))) 47 | 48 | #+nil 49 | (resolve-number (make-numberf :input :foo :max-frac 2) 1.123) 50 | 51 | (declaim (ftype (function (keyword hash-table list list) string) resolve-line)) 52 | (defun resolve-line (locale terms line inputs) 53 | "Completely resolve some localisation line into a single string." 54 | (format nil "~{~a~}" 55 | (reduce 56 | (lambda (chunk acc) 57 | (let ((next (etypecase chunk 58 | (string chunk) 59 | (variable (get-input inputs (variable-name chunk))) 60 | ;; Since the term line itself can contains inputs, we 61 | ;; need to recursively resolve. 62 | (term (let ((ins (cond ((not (term-arg chunk)) '()) 63 | (t (list (term-arg chunk) (term-val chunk)))))) 64 | (resolve-line locale terms (gethash (term-name chunk) terms) ins))) 65 | (numberf (resolve-number chunk (get-input inputs (numberf-input chunk)))) 66 | (selection (resolve-selection locale terms chunk inputs))))) 67 | (cons next acc))) 68 | line 69 | :initial-value '() 70 | :from-end t))) 71 | 72 | #+nil 73 | (let ((terms (localisations-terms (parse "-brand-name = Firefox"))) 74 | (line (p:parse #'entry "About { -brand-name }."))) 75 | (resolve-line :en terms line '())) 76 | 77 | #+nil 78 | (let ((terms (localisations-terms (parse "-https = https://{ $host }"))) 79 | (line (p:parse (<* #'entry #'p:eof) "Visit { -https(host: \"example.com\") } for more information."))) 80 | (resolve-line :en terms line '())) 81 | 82 | (defun resolve-selection (locale terms sel inputs) 83 | "Choose the correct localisation line and resolve it." 84 | (let* ((in (selection-input sel)) 85 | (val (getf inputs (etypecase in 86 | (keyword in) 87 | (numberf (numberf-input in))))) 88 | (line (branch-line (find-branch locale sel val)))) 89 | (resolve-line locale terms line inputs))) 90 | 91 | (defun find-branch (locale sel val) 92 | "Find a localisation branch whose condition/term matches the incoming value." 93 | (let ((found (etypecase val 94 | (real (let* ((inp (selection-input sel)) 95 | (s (etypecase inp 96 | (keyword (format nil "~a" val)) 97 | (numberf (resolve-number inp val)))) 98 | (cat (cond ((and (numberf-p inp) 99 | (eq :ordinal (numberf-type inp))) 100 | (plurals:ordinal locale s)) 101 | (t (plurals:cardinal locale s))))) 102 | (find-if (lambda (branch) 103 | (let ((term (branch-term branch))) 104 | (etypecase term 105 | (plurals:category (eq cat term)) 106 | (t (equal s term))))) 107 | (selection-branches sel)))) 108 | (string (find-if (lambda (branch) (equal val (branch-term branch))) 109 | (selection-branches sel))) 110 | ;; For when a usually "parameterized term" actually had no 111 | ;; associated argument, and so there is actually no value for 112 | ;; each branch selector to compare against. 113 | ;; 114 | ;; There are potentially other ways a nil could find its way 115 | ;; down here, but I still want to keep this as an `etypecase' 116 | ;; to avoid other type-related surprises. 117 | (null nil)))) 118 | (cond ((not found) (selection-default sel)) 119 | (t found)))) 120 | 121 | #+nil 122 | (let ((sel (p:parse #'selection "{ NUMBER($score, minimumFractionDigits: 1) -> 123 | [0.0] You scored zero points. What happened? 124 | *[other] You scored { NUMBER($score, minimumFractionDigits: 1) } points. 125 | }"))) 126 | (resolve-selection :en (make-hash-table) sel '(:score 1))) 127 | 128 | #+nil 129 | (let ((sel (p:parse #'selection "{ NUMBER($pos, type: \"ordinal\") -> 130 | [1] You finished first! 131 | [one] You finished {$pos}st 132 | [two] You finished {$pos}nd 133 | [few] You finished {$pos}rd 134 | *[other] You finished {$pos}th 135 | }"))) 136 | (resolve-selection :en (make-hash-table) sel '(:pos 1))) 137 | -------------------------------------------------------------------------------- /tests/en-us/aura.ftl: -------------------------------------------------------------------------------- 1 | language-name = English 2 | 3 | # AUR Packages (-A) 4 | A-install-deps = Determining dependencies... 5 | A-install-repo-pkgs = Repository dependencies: 6 | A-install-aur-pkgs = AUR packages: 7 | A-install-path-comp = Failed to extract final component of: { $path } 8 | A-install-ignored = { $file } is marked "ignored". Install anyway? 9 | 10 | A-build-prep = Preparing build directories... 11 | A-build-pkg = Building { $pkg }... 12 | A-build-diff = Display diffs of build files? 13 | A-build-hotedit-pkgbuild = Edit the PKGBUILD? 14 | A-build-hotedit-install = Edit the .install file? 15 | A-build-fail = Package failed to build, citing: 16 | A-build-e-pkgctl = Building within an isolated chroot failed. 17 | A-build-e-makepkg = makepkg failed. 18 | A-build-e-edit = Failed to edit: { $file } 19 | A-build-e-tarball = Failed to move: { $file } 20 | A-build-e-filename = Failed to extract filename from: { $file } 21 | A-build-e-copies = Failed to copy build files. 22 | A-build-e-perm = Failed to set file permissions for: { $dir } 23 | A-build-pkglist = Failed to determine makepkg output paths from: { $dir } 24 | A-build-pull = Failed to pull latest commits - you may be building an old version! 25 | A-build-continue = Continue building other packages? 26 | 27 | A-i-repo = Repository 28 | A-i-version = Version 29 | A-i-status = AUR Status 30 | A-i-maintainer = Maintainer 31 | A-i-proj-url = Project URL 32 | A-i-aur-url = AUR URL 33 | A-i-license = License 34 | A-i-group = Groups 35 | A-i-provides = Provides 36 | A-i-depends = Depends On 37 | A-i-make = Make Deps 38 | A-i-opt = Optional Deps 39 | A-i-check = Check Deps 40 | A-i-votes = Votes 41 | A-i-pop = Popularity 42 | A-i-desc = Description 43 | A-i-keywords = Keywords 44 | A-i-submitted = Submitted 45 | A-i-updated = Updated 46 | 47 | A-u-fetch-info = Fetching package information... 48 | A-u-comparing = Comparing package versions... 49 | A-u-no-upgrades = No AUR package upgrades necessary. 50 | A-u-to-upgrade = AUR packages to upgrade: 51 | A-u-git = VCS packages to rebuild: 52 | 53 | A-w = Cloning { $package }... 54 | 55 | A-y-refreshing = Refreshing local clones of known AUR packages... 56 | A-y-pulling = Pulling latest commits 57 | 58 | # Snapshots (-B) 59 | B-saved = Saved package state. 60 | B-clean = Remove stale snapshots? 61 | B-none = No usable snapshots found. 62 | B-select = Select a snapshot to restore: 63 | 64 | # Cache (-C) 65 | C-size = Current cache size: { $size } 66 | 67 | C-b-file = { $target } already exists and is not a directory. 68 | C-b-nonempty = Target { $target } exists but is not empty! 69 | C-b-target = Backing up cache to { $target } 70 | C-b-curr = Failed to read current directory. 71 | 72 | C-i-latest = Latest 73 | C-i-created = Created 74 | C-i-installed = installed 75 | C-i-sig = Signature 76 | C-i-size = Tarball Size 77 | C-i-avail = Available Versions 78 | 79 | C-c-keep = { $pkgs } of each package file will be kept. The rest will be deleted. 80 | C-c-freed = { $bytes } freed. 81 | 82 | C-downgrade-which = What version of { $pkg } do you want? 83 | 84 | C-y-no-work = Package cache already synchronized. 85 | C-t-invalids = Removing invalid package tarballs. 86 | 87 | # Logs (-L) 88 | L-first = First Install 89 | L-upgrades = Upgrades 90 | L-recent = Recent Actions 91 | L-search-err = Searching your logs via { $cmd } failed. 92 | L-view-err = Failed to open your ALPM log. 93 | 94 | # Opening Pages (open) 95 | open-err = Failed to open { $url }. 96 | 97 | # System Statistics (stats) 98 | stats-local = Failed to load language data. 99 | stats-host = Host 100 | stats-user = User 101 | stats-distro = Distribution 102 | stats-editor = Editor 103 | stats-pkgs = Installed packages 104 | stats-aura-cache = Aura Package Cache 105 | stats-pacman-cache = Pacman Package Cache 106 | stats-aura-build = Aura Build Cache 107 | stats-tmp = /tmp Directory 108 | 109 | # System Validation (check) 110 | check-start = Validating your system. 111 | check-missing-exec = Fix: Please install { $exec } and/or ensure it's on your PATH. 112 | check-env = Environment 113 | check-env-editor = EDITOR variable set? 114 | check-env-editor-exec = EDITOR value ({ $exec }) is executable? 115 | check-env-editor-vi = Backup editor vi is executable? 116 | check-env-exec = { $exec } installed and executable? 117 | check-env-lang = { $cmd } contains LANG value? ({ $lang }) 118 | check-env-lang-fix = Fix: Update your { $file } to include { $lang }. 119 | check-env-lang-fix2 = Fix: Set your LANG variable! 120 | check-env-lang-known = Aura is localised to your LANG? 121 | check-env-java-bin = Java tooling installed? 122 | check-env-java-bin-fix = Fix: Considering installing { $pkg }. 123 | check-env-java-set = Java environment set? 124 | check-env-java-set-fix = Fix: See { $cmd }. 125 | check-pconf = Pacman Configuration (/etc/pacman.conf) 126 | check-pconf-par = Parallel downloads activated? 127 | check-pconf-par-fix = Fix: { $setting } is off, or set to 1. Set { $set } for faster tarball fetching. 128 | check-pconf-ignores = No overlapping ignored packages? 129 | check-pconf-ignores-fix = The following packages are ignored in both pacman.conf and aura.toml: { $pkgs } 130 | check-pconf-pacnew = All .pacnew files accounted for? 131 | check-pconf-pacnew-broken = Error: Call to { $fd } utterly failed. 132 | 133 | check-pconf-pacnew-old = { $path } is older than its .pacnew by { $days -> 134 | [one] 1 day. 135 | *[many] {$days} days. 136 | } 137 | 138 | check-aconf = Aura Configuration 139 | check-aconf-aura-exists = Aura config file exists? 140 | check-aconf-aura-exists-fix = Fix: Consider { $cmd } 141 | check-aconf-aura-parse = Aura config file can be parsed? 142 | check-aconf-old-dirs = No old Aura directories exist? 143 | check-aconf-old-conf = No old Aura config files exist? 144 | check-mconf = Makepkg Configuration ({ $path }) 145 | check-mconf-packager = PACKAGER set? 146 | check-mconf-packager-fix = Fix: Set { $cmd } within { $path } 147 | check-snapshots = Package Snapshots 148 | check-snapshot-usable = All snapshots have corresponding tarballs? 149 | check-snapshot-usable-fix = Fix: You can remove old/unusable snapshots with { $command } 150 | check-cache = Package Tarball Caches 151 | check-cache-exists = All specified caches exist? 152 | check-cache-tarballs = All tarballs valid? 153 | check-cache-tarballs-fix = Fix: You can remove invalid tarballs with { $command } 154 | check-cache-missing = Every installed official package has a tarball? 155 | check-cache-missing-fix = Fix: You can download missing official tarballs with { $command } 156 | check-cache-missing-for = Every installed AUR package has a tarball? 157 | check-cache-missing-for-fix = Fix: View the missing packages with { $cmd } and reinstall them manually. 158 | check-pkgs = Package Status 159 | check-pkgs-old = All explicitly installed, non-dep packages are up to date? 160 | check-pkgs-old-warn = { $pkg } was last updated { $days } ago. 161 | check-pkgs-empty = All package clones are populated? 162 | check-pkgs-empty-fix = Fix: Delete the following directories. 163 | 164 | # Thanks 165 | thanks-you = Thank you for using Aura. 166 | thanks-colin = Aura by Colin Woodbury, 2012 - 2024 167 | thanks-pacman = Thank you to the Pacman and Arch Linux teams for providing a solid foundation. 168 | thanks-everyone = Thank you to Aura's contributors, donators, and users. 169 | thanks-logo = Aura's logo by Cristiano Vitorino. 170 | thanks-translators = Aura is localised by: 171 | 172 | # Configuration (conf) 173 | conf-toml-err = Failed to serialize current config. 174 | 175 | # Dependencies (deps) 176 | deps-io = Failed to generate the dependency image. 177 | 178 | # Runtime Environment 179 | env-missing-editor = Provided EDITOR is not on the PATH. 180 | env-pconf = Failed to parse your pacman.conf file. 181 | 182 | # Pacman Calls 183 | pacman-external = A call to pacman utterly failed. 184 | pacman-u = A call to pacman -U failed. 185 | pacman-s = A call to pacman -S failed. 186 | pacman-misc = A call to pacman gave a non-zero exit code. 187 | 188 | # Aura-specific Directories 189 | dir-mkdir = Failed to create the directory: { $dir }. 190 | dir-home = Unable to determine Aura's config directory. 191 | dir-cache = Unable to determine Aura's cache directory. 192 | 193 | # Dependency Resolution 194 | dep-exist = The package { $pkg } does not exist. 195 | dep-exist-par = The dependency { $pkg } of { $par } does not exist. 196 | dep-graph = The dependency graph was somehow malformed. 197 | dep-cycle = Dependency cycle detected: { $cycle } 198 | dep-multi = There were multiple errors during dependency resolution. 199 | 200 | # Git Operations 201 | git-diff = A git diff failed for: { $file } 202 | git-hash = Reading a git hash into Rust failed. 203 | git-pull = A git pull failed: { $dir } 204 | git-clone = A git clone failed: { $dir } 205 | git-io = Calling git somehow failed. 206 | 207 | # Faur Calls 208 | faur-fetch = Calling the metadata server utterly failed: { $pkg } 209 | faur-unknown = Unknown package: { $pkg } 210 | faur-too-many = More results returned from Faur than expected: { $pkg } 211 | 212 | # Common Errors 213 | err-alpm = Failed to open ALPM handle. 214 | err-config-path = Failed to determine the path to Aura's config file. 215 | err-curl = A CURL transaction failed: { $err } 216 | err-file-del = Failed to delete: { $file } 217 | err-file-open = Failed to open file handle to: { $file } 218 | err-file-write = Failed to write file: { $file } 219 | err-json-decode = Failed to decode JSON from: { $url } 220 | err-json-write = Failed to write JSON to: { $file } 221 | err-mutex = A mutex was poisoned. 222 | err-pool-create = Failed to create an ALPM connection pool. 223 | err-pool-get = Failed to get an ALPM handle from the connection pool. 224 | err-read-dir = Failed to read directory: { $dir } 225 | err-srcinfo = Failed to parse .SRCINFO: { $file } 226 | err-sudo = Running Aura with sudo is not necessary. 227 | err-time-conv = Failed to convert a timestamp. 228 | err-time-format = Failed to format a time string. 229 | err-user-input = Failed to get user input. 230 | err-utf8 = A UTF-8 conversion failed. 231 | err-write = Somehow failed to write to stdout. 232 | 233 | # Common Fields 234 | common-yes = Yes 235 | common-no = No 236 | common-name = Name 237 | common-done = Done. 238 | common-no-packages = No packages specified. 239 | common-no-work = Nothing to do. 240 | common-cancelled = Action cancelled. 241 | common-replace = You can delete { $old } in favour of { $new }. 242 | 243 | # Misc. 244 | proceed = Proceed? 245 | proceed-affirmative = y 246 | proceed-affirmative-alt = Y 247 | proceed-negative = n 248 | -------------------------------------------------------------------------------- /src/parser.lisp: -------------------------------------------------------------------------------- 1 | ;;; Imagined usage: 2 | ;;; 3 | ;;; > (render ctx "hello-user" :userName "Colin") 4 | ;;; ;; => "Hello, Colin!" 5 | ;;; 6 | ;;; where the `ctx' is the entire parsed localisation context, initialized to a 7 | ;;; specific language. 8 | ;;; 9 | ;;; Out of Scope: 10 | ;;; - Handling country-based number formatting. 11 | 12 | (in-package :fluent) 13 | 14 | ;; --- Static Parsers --- ;; 15 | 16 | (defparameter +comment+ (*> (p:char #\#) (p:consume (lambda (c) (not (eql c #\newline)))))) 17 | (defparameter +skip-space+ (p:consume (lambda (c) (equal c #\space)))) 18 | (defparameter +skip-all-space+ (p:consume #'p:space?)) 19 | (defparameter +skip-comments+ (p:skip (*> +comment+ +skip-all-space+))) 20 | (defparameter +skip-junk+ (*> +skip-all-space+ +skip-comments+)) 21 | (defparameter +equal+ (p:char #\=)) 22 | (defparameter +dash+ (p:char #\-)) 23 | (defparameter +brace-open+ (p:char #\{)) 24 | (defparameter +brace-close+ (p:char #\})) 25 | (defparameter +bracket-open+ (p:char #\[)) 26 | (defparameter +bracket-close+ (p:char #\])) 27 | (defparameter +paren-open+ (p:char #\()) 28 | (defparameter +paren-close+ (p:char #\))) 29 | (defparameter +dollar+ (p:char #\$)) 30 | (defparameter +space+ (p:char #\space)) 31 | (defparameter +quote+ (p:char #\")) 32 | (defparameter +asterisk+ (p:char #\*)) 33 | (defparameter +comma+ (p:char #\,)) 34 | (defparameter +colon+ (p:char #\:)) 35 | 36 | ;; --- Entry --- ;; 37 | 38 | (defun parse (s) 39 | "Parse a given string into a collated set of localisations." 40 | (let ((pairs (p:parse (*> +skip-junk+ 41 | (<* (p:sep-end1 +skip-junk+ #'pair) 42 | #'p:eof)) 43 | s)) 44 | (terms (make-hash-table :test #'equal :size 16)) 45 | (lines (make-hash-table :test #'equal :size 64))) 46 | (dolist (pair pairs) 47 | (destructuring-bind ((type name) line) pair 48 | (case type 49 | (:term (setf (gethash name terms) line)) 50 | (:line (setf (gethash name lines) line))))) 51 | (make-localisations :terms terms :lines lines))) 52 | 53 | #+nil 54 | (parse "language-name = English") 55 | #+nil 56 | (parse (uiop:read-file-string #p"tests/data/basic.ftl")) 57 | 58 | ;; --- Parsers --- ;; 59 | 60 | ;; NOTE: "The syntax should allow good error recovery: an error in one message 61 | ;; should not break the whole file. The parser should resume normal parsing as 62 | ;; soon as possible and with as few losses as possible." 63 | (defun pair (offset) 64 | "A single localisation pair." 65 | (funcall (<*> (<* #'key 66 | +skip-space+ 67 | +equal+ 68 | +skip-all-space+) 69 | #'entry) 70 | offset)) 71 | 72 | #+nil 73 | (p:parse #'pair "dpi-ratio = Your DPI ratio is { NUMBER($ratio, minimumFractionDigits: 2)}") 74 | #+nil 75 | (p:parse #'pair "about = About { -brand-name }.") 76 | 77 | (defun key (offset) 78 | "Either a term key or a normal line key." 79 | (p:fmap (lambda (list) 80 | (destructuring-bind (dash? name) list 81 | (cond (dash? (list :term name)) 82 | (t (list :line name))))) 83 | (funcall (<*> (p:opt +dash+) 84 | (p:take-while1 (lambda (c) (not (eql c #\space))))) 85 | offset))) 86 | 87 | #+nil 88 | (p:parse #'key "-brand") 89 | #+nil 90 | (p:parse #'key "about") 91 | 92 | ;; NOTE: No support for smart detection of differed indenting from line to line. 93 | ;; All leading whitespace is stripped. 94 | (defun entry (offset) 95 | "Many lines." 96 | (p:fmap (lambda (lists) (apply #'append lists)) 97 | (funcall (p:sep-end1 (*> #'p:newline +space+ +skip-space+) #'line) 98 | offset))) 99 | 100 | #+nil 101 | (entry (p:in "Failed to edit: { $file }!")) 102 | 103 | (defun line (offset) 104 | "A single line of a potentially multiline text group." 105 | (funcall (p:many1 (p:alt #'placeable 106 | (p:take-while1 (lambda (c) 107 | (not (or (eql c #\newline) 108 | (eql c #\{))))))) 109 | offset)) 110 | 111 | #+nil 112 | (line (p:in "Failed to edit: { $file }!")) 113 | 114 | #+nil 115 | (line (p:in "Placing a { term } here!")) 116 | 117 | (defun placeable (offset) 118 | "Something within curly braces." 119 | (funcall (p:alt #'variable #'quoted #'term #'funky #'selection) offset)) 120 | 121 | #+nil 122 | (placeable (p:in "{ $foo }")) 123 | 124 | (defun variable (offset) 125 | "Parse a variable chunk." 126 | (p:fmap (lambda (s) (make-variable :name (string->keyword s))) 127 | (funcall (p:between (*> +brace-open+ +skip-space+) 128 | #'dollared 129 | (*> +skip-space+ +brace-close+)) 130 | offset))) 131 | 132 | (defun term (offset) 133 | "Parse a single, swappable term." 134 | (p:fmap (lambda (list) 135 | (destructuring-bind (name args) list 136 | (cond ((not args) (make-term :name name)) 137 | (t (destructuring-bind (arg val) args 138 | (make-term :name name 139 | :arg (string->keyword arg) 140 | :val val)))))) 141 | (funcall (p:between (*> +brace-open+ +skip-space+ +dash+) 142 | (<*> (p:take-while1 (lambda (c) 143 | (not (or (eql c #\space) 144 | (eql c #\newline) 145 | (eql c #\}) 146 | (eql c #\())))) 147 | (p:opt (p:between +paren-open+ 148 | (<*> (p:take-while1 (lambda (c) 149 | (not (or (eql c #\space) 150 | (eql c #\newline) 151 | (eql c #\:))))) 152 | (*> +colon+ 153 | +skip-space+ 154 | #'quoted-string)) 155 | +paren-close+))) 156 | (*> +skip-space+ +brace-close+)) 157 | offset))) 158 | 159 | #+nil 160 | (p:parse #'term "{ -brand-name }") 161 | #+nil 162 | (p:parse #'term "{ -https(host: \"example.com\") }") 163 | 164 | (defun quoted-string (offset) 165 | (funcall (p:between +quote+ 166 | (p:take-while1 (lambda (c) 167 | (not (or (eql c #\newline) 168 | (eql c #\"))))) 169 | +quote+) 170 | offset)) 171 | 172 | #+nil 173 | (p:parse #'quoted-string "\"hello\"") 174 | 175 | ;; NOTE: Unicode escaping is not supported. Just use the raw character itself. 176 | (defun quoted (offset) 177 | "Parse special, quoted characters." 178 | (funcall (p:between (*> +brace-open+ +skip-space+) 179 | (p:between +quote+ 180 | (p:take-while1 (lambda (c) 181 | (not (or (eql c #\") 182 | (eql c #\newline))))) 183 | +quote+) 184 | (*> +skip-space+ +brace-close+)) 185 | offset)) 186 | 187 | #+nil 188 | (quoted (p:in "{ \"}\" }")) 189 | 190 | (defun dollared (offset) 191 | "Parse a variable name as a keyword." 192 | (p:fmap #'string->keyword 193 | (funcall (*> +dollar+ 194 | (p:take-while1 (lambda (c) 195 | (not (or (eql c #\space) 196 | (eql c #\newline) 197 | (eql c #\}) 198 | (eql c #\,)))))) 199 | offset))) 200 | 201 | #+nil 202 | (p:parse #'dollared "$photoCount") 203 | 204 | (defun funky (offset) 205 | "Parse a function call placeable." 206 | (funcall (p:between (*> +brace-open+ +skip-space+) 207 | #'func 208 | (*> +skip-space+ +brace-close+)) 209 | offset)) 210 | 211 | #+nil 212 | (p:parse #'funky "{ NUMBER($ratio, minimumFractionDigits: 2) }") 213 | 214 | (defun selection (offset) 215 | "Parse a multi-condition selection block." 216 | (p:fmap (lambda (list) 217 | (destructuring-bind (var branches) list 218 | (let ((default (find-if #'branch-default branches))) 219 | (make-selection :input var 220 | :branches branches 221 | :default default)))) 222 | (funcall (p:between (*> +brace-open+ +skip-space+) 223 | (<*> (p:alt #'dollared #'func) 224 | (*> +skip-space+ 225 | (p:string "->") 226 | +skip-all-space+ 227 | (p:sep-end1 +skip-all-space+ #'branch))) 228 | (*> +skip-all-space+ +brace-close+)) 229 | offset))) 230 | 231 | #+nil 232 | (p:parse #'selection "{$photoCount -> 233 | [one] added a new photo 234 | *[other] added {$photoCount} new photos 235 | }") 236 | 237 | (defun branch (offset) 238 | "Parse a single localisation choice." 239 | (p:fmap (lambda (list) 240 | (destructuring-bind (default selector line) list 241 | (make-branch :term selector 242 | :line line 243 | :default default))) 244 | (funcall (<*> (p:opt (<$ t +asterisk+)) 245 | #'branch-selection-term 246 | (*> +skip-space+ #'line)) 247 | offset))) 248 | 249 | #+nil 250 | (branch (p:in "[male] his stream")) 251 | #+nil 252 | (branch (p:in "*[other] added {$photoCount} new photos")) 253 | 254 | (defun branch-selection-term (offset) 255 | "Parse a value that can appear between []." 256 | (funcall (p:between +bracket-open+ 257 | (p:alt #'category 258 | (p:take-while1 (lambda (c) 259 | (not (or (eql c #\]) 260 | (eql c #\newline)))))) 261 | +bracket-close+) 262 | offset)) 263 | 264 | #+nil 265 | (branch-selection-term (p:in "[male] his stream")) 266 | #+nil 267 | (branch-selection-term (p:in "[one] added a new photo")) 268 | 269 | (defun category (offset) 270 | (funcall (p:alt (<$ :zero (p:string "zero")) 271 | (<$ :one (p:string "one")) 272 | (<$ :two (p:string "two")) 273 | (<$ :few (p:string "few")) 274 | (<$ :many (p:string "many")) 275 | (<$ :other (p:string "other"))) 276 | offset)) 277 | 278 | #+nil 279 | (category (p:in "few")) 280 | 281 | (defun func (offset) 282 | ;; TODO: 2025-06-13 Eventually add DATETIME. 283 | (funcall #'number offset)) 284 | 285 | ;; NOTE: 2025-06-13 For me at this moment, supporting all the formatting options 286 | ;; for every language is out of scope. I will start with English defaults and 287 | ;; add extra support, piecemeal, as localisations are added to downstream 288 | ;; programs. 289 | ;; 290 | ;; Further, at the moment, only certain formatting options are available as 291 | ;; match my immediate needs. 292 | (defun number (offset) 293 | (p:fmap (lambda (list) 294 | (destructuring-bind (input (op val)) list 295 | (case op 296 | (:min-frac (make-numberf :input input :min-frac val)) 297 | (:max-frac (make-numberf :input input :max-frac val)) 298 | (:type (make-numberf :input input :type val))))) 299 | (funcall (*> (p:string "NUMBER") 300 | (p:between +paren-open+ 301 | (<*> #'dollared 302 | (p:opt (*> +comma+ 303 | +skip-space+ 304 | #'number-option))) 305 | +paren-close+)) 306 | offset))) 307 | 308 | #+nil 309 | (p:parse #'number "NUMBER($ratio, minimumFractionDigits: 2)") 310 | #+nil 311 | (p:parse #'number "NUMBER($ratio, type: \"ordinal\")") 312 | 313 | (defun number-option (offset) 314 | (funcall (p:alt #'min-frac #'max-frac #'plural-type) offset)) 315 | 316 | #+nil 317 | (p:parse #'number-option "minimumFractionDigits: 2") 318 | 319 | (defun min-frac (offset) 320 | (p:fmap (lambda (n) (list :min-frac n)) 321 | (funcall (*> (p:string "minimumFractionDigits") 322 | +colon+ 323 | +skip-space+ 324 | #'p:unsigned) 325 | offset))) 326 | 327 | (defun max-frac (offset) 328 | (p:fmap (lambda (n) (list :max-frac n)) 329 | (funcall (*> (p:string "maximumFractionDigits") 330 | +colon+ 331 | +skip-space+ 332 | #'p:unsigned) 333 | offset))) 334 | 335 | (defun plural-type (offset) 336 | (p:fmap (lambda (kw) (list :type kw)) 337 | (funcall (*> (p:string "type") 338 | +colon+ 339 | +skip-space+ 340 | (p:between +quote+ 341 | (p:alt (<$ :ordinal (p:string "ordinal")) 342 | (<$ :cardinal (p:string "cardinal"))) 343 | +quote+)) 344 | offset))) 345 | --------------------------------------------------------------------------------