Commit | Line | Data |
---|---|---|
554b30d2 JL |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu> | |
52b4524f | 3 | ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> |
554b30d2 JL |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | (define-module (guix build po) | |
21 | #:use-module (ice-9 match) | |
22 | #:use-module (ice-9 peg) | |
554b30d2 JL |
23 | #:use-module (ice-9 textual-ports) |
24 | #:export (read-po-file)) | |
25 | ||
26 | ;; A small parser for po files | |
27 | (define-peg-pattern po-file body (* (or comment entry whitespace))) | |
28 | (define-peg-pattern whitespace body (or " " "\t" "\n")) | |
29 | (define-peg-pattern comment-chr body (range #\space #\頋)) | |
30 | (define-peg-pattern comment none (and "#" (* comment-chr) "\n")) | |
31 | (define-peg-pattern entry all | |
32 | (and (ignore (* whitespace)) (ignore "msgid ") msgid | |
33 | (ignore (* whitespace)) (ignore "msgstr ") msgstr)) | |
34 | (define-peg-pattern escape body (or "\\\\" "\\\"" "\\n")) | |
35 | (define-peg-pattern str-chr body (or " " "!" (and (ignore "\\") "\"") | |
36 | "\\n" (and (ignore "\\") "\\") | |
37 | (range #\# #\頋))) | |
38 | (define-peg-pattern msgid all content) | |
39 | (define-peg-pattern msgstr all content) | |
40 | (define-peg-pattern content body | |
41 | (and (ignore "\"") (* str-chr) (ignore "\"") | |
42 | (? (and (ignore (* whitespace)) content)))) | |
43 | ||
52b4524f LC |
44 | (define (interpret-newline-escape str) |
45 | "Replace '\\n' sequences in STR with a newline character." | |
46 | (let loop ((str str) | |
47 | (result '())) | |
48 | (match (string-contains str "\\n") | |
49 | (#f (string-concatenate-reverse (cons str result))) | |
50 | (index | |
51 | (let ((prefix (string-take str index))) | |
52 | (loop (string-drop str (+ 2 index)) | |
53 | (append (list "\n" prefix) result))))))) | |
54 | ||
554b30d2 JL |
55 | (define (parse-tree->assoc parse-tree) |
56 | "Converts a po PARSE-TREE to an association list." | |
554b30d2 | 57 | (match parse-tree |
5837b3e4 LC |
58 | (() '()) |
59 | ((entry . parse-tree) | |
554b30d2 JL |
60 | (match entry |
61 | ((? string? entry) | |
62 | (parse-tree->assoc parse-tree)) | |
63 | ;; empty msgid | |
64 | (('entry ('msgid ('msgstr msgstr))) | |
65 | (parse-tree->assoc parse-tree)) | |
66 | ;; empty msgstr | |
67 | (('entry ('msgid msgid) 'msgstr) | |
68 | (parse-tree->assoc parse-tree)) | |
69 | (('entry ('msgid msgid) ('msgstr msgstr)) | |
52b4524f LC |
70 | (acons (interpret-newline-escape msgid) |
71 | (interpret-newline-escape msgstr) | |
554b30d2 JL |
72 | (parse-tree->assoc parse-tree))))))) |
73 | ||
74 | (define (read-po-file port) | |
75 | "Read a .po file from PORT and return an alist of msgid and msgstr." | |
76 | (let ((tree (peg:tree (match-pattern | |
77 | po-file | |
78 | (get-string-all port))))) | |
79 | (parse-tree->assoc tree))) |