list.scm
| 1 | ;;; Nani Project website |
| 2 | ;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu> |
| 3 | ;;; |
| 4 | ;;; This file is part of the Nani Project website. |
| 5 | ;;; |
| 6 | ;;; The Nani Project website is free software; you can redistribute it and/or modify it |
| 7 | ;;; under the terms of the GNU Affero General Public License as published by |
| 8 | ;;; the Free Software Foundation; either version 3 of the License, or (at |
| 9 | ;;; your option) any later version. |
| 10 | ;;; |
| 11 | ;;; The Nani Project website is distributed in the hope that it will be useful, but |
| 12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU Affero General Public License for more details. |
| 15 | ;;; |
| 16 | ;;; You should have received a copy of the GNU Affero General Public License |
| 17 | ;;; along with the Nani Project website. If not, see <http://www.gnu.org/licenses/>. |
| 18 | |
| 19 | (use-modules (tools i18n)) |
| 20 | (use-modules (nani radk)) |
| 21 | (use-modules (nani jmdict serialize)) |
| 22 | (use-modules (nani wadoku pitch)) |
| 23 | (use-modules (gcrypt hash)) |
| 24 | (use-modules (ice-9 match)) |
| 25 | (use-modules (ice-9 format)) |
| 26 | (use-modules (ice-9 binary-ports)) |
| 27 | |
| 28 | (define* (description dico #:key (long? #f) (lang "en")) |
| 29 | (define radk-synopsis |
| 30 | `(_ "Radical to Kanji dictionary from the Electronic Dictionary Research and Development Group.")) |
| 31 | (define radk-description |
| 32 | `(_ "This dictionary allows you to enter kanji by selecting some of its |
| 33 | components. Tap the water component button on the bottom of the screen to |
| 34 | access the kanji selection by component view")) |
| 35 | |
| 36 | (define wadoku-synopsis |
| 37 | `(_ "Japanese/German dictionary from Wadoku.")) |
| 38 | (define wadoku-description |
| 39 | `(_ "This dictionary allows you to do searches on the main view of this app. |
| 40 | Failing to download on of these dictionaries will make the app unusable |
| 41 | as you can't search for anything. This dictionary can be searched for |
| 42 | by kanji, reading (kana) and by German translation.")) |
| 43 | |
| 44 | (define wadoku-pitch-synopsis |
| 45 | `(_ "Pitch accent dictionary from Wadoku.")) |
| 46 | (define wadoku-pitch-description |
| 47 | `(_ "This dictionary allows you to augment search results on the main view |
| 48 | with pitch accent (pronounciation) information. Japanese is not flat, |
| 49 | and this dictionary will add information that will help you pronounce |
| 50 | words better, with a standard Japanese pitch accent.")) |
| 51 | |
| 52 | (define (jmdict-synopsis lang) |
| 53 | (match lang |
| 54 | ("e" `(_ "Japanese/English dictionary from the Electronic Dictionary Research and Development Group.")) |
| 55 | ("dut" `(_ "Japanese/Dutch dictionary from the Electronic Dictionary Research and Development Group.")) |
| 56 | ("fre" `(_ "Japanese/French dictionary from the Electronic Dictionary Research and Development Group.")) |
| 57 | ("ger" `(_ "Japanese/German dictionary from the Electronic Dictionary Research and Development Group.")) |
| 58 | ("hun" `(_ "Japanese/Hungarian dictionary from the Electronic Dictionary Research and Development Group.")) |
| 59 | ("rus" `(_ "Japanese/Russian dictionary from the Electronic Dictionary Research and Development Group.")) |
| 60 | ("slv" `(_ "Japanese/Slovenian dictionary from the Electronic Dictionary Research and Development Group.")) |
| 61 | ("spa" `(_ "Japanese/Spanish dictionary from the Electronic Dictionary Research and Development Group.")) |
| 62 | ("swe" `(_ "Japanese/Swedish dictionary from the Electronic Dictionary Research and Development Group.")))) |
| 63 | (define (jmdict-description lang) |
| 64 | `(_ "This dictionary allows you to do searches on the main view of this app. |
| 65 | Failing to download one of these dictionaries will make the app unusable |
| 66 | as you can't search for anything. This dictionary can be searched for by |
| 67 | kanji, reading (kana) and by meaning in the languages you selected.")) |
| 68 | |
| 69 | (let* ((english |
| 70 | (cond |
| 71 | ((equal? (dico-type dico) "radk") |
| 72 | (if long? |
| 73 | radk-description |
| 74 | radk-synopsis)) |
| 75 | ((equal? (dico-type dico) "wadoku") |
| 76 | (if long? |
| 77 | wadoku-description |
| 78 | wadoku-synopsis)) |
| 79 | ((equal? (dico-type dico) "wadoku_pitch") |
| 80 | (if long? |
| 81 | wadoku-pitch-description |
| 82 | wadoku-pitch-synopsis)) |
| 83 | ((equal? (dico-type dico) "jmdict") |
| 84 | (let ((dico-lang (substring dico 7))) |
| 85 | (if long? |
| 86 | (jmdict-description dico-lang) |
| 87 | (jmdict-synopsis dico-lang)))))) |
| 88 | (translated (translate english lang))) |
| 89 | (if (and (equal? english translated) (not (equal? lang "en"))) |
| 90 | #f |
| 91 | translated))) |
| 92 | |
| 93 | (define (filesize file) |
| 94 | (stat:size (stat file))) |
| 95 | |
| 96 | (define (sha256 file) |
| 97 | (define hash (file-sha256 file)) |
| 98 | (apply |
| 99 | string-append |
| 100 | (map |
| 101 | (lambda (n) |
| 102 | (format #f "~2,'0x" n)) |
| 103 | (array->list hash)))) |
| 104 | |
| 105 | (define (dico-type file) |
| 106 | (cond |
| 107 | ((equal? file "radicals") "radk") |
| 108 | ((and (> (string-length file) 6) (equal? (substring file 0 6) "JMdict")) |
| 109 | "jmdict") |
| 110 | ((equal? file "wadoku_ger") "wadoku") |
| 111 | ((equal? file "wadoku_pitch") "wadoku_pitch"))) |
| 112 | |
| 113 | (define (entries file) |
| 114 | (cond |
| 115 | ((equal? (dico-type (dico-name file)) "radk") |
| 116 | (kanji-count file)) |
| 117 | ((member (dico-type (dico-name file)) '("jmdict" "wadoku")) |
| 118 | (jmdict-entry-count file)) |
| 119 | ((equal? (dico-type (dico-name file)) "wadoku_pitch") |
| 120 | (pitch-entry-count file)))) |
| 121 | |
| 122 | (define (dico-name file) |
| 123 | (basename file ".nani")) |
| 124 | |
| 125 | (match (command-line) |
| 126 | ((_ output dicos ...) |
| 127 | (with-output-to-file output |
| 128 | (lambda _ |
| 129 | (for-each |
| 130 | (lambda (dico) |
| 131 | (let* ((sha256 (sha256 dico)) |
| 132 | (size (filesize dico)) |
| 133 | (name (dico-name dico)) |
| 134 | (type (dico-type name)) |
| 135 | (entry-count (entries dico))) |
| 136 | (format #t "[~a]~%" name) |
| 137 | (for-each |
| 138 | (lambda (lang) |
| 139 | (let ((synopsis (description name #:lang lang)) |
| 140 | (description (description name #:lang lang #:long? #t))) |
| 141 | (when synopsis |
| 142 | (format #t "synopsis=~a=~a~%" lang synopsis)) |
| 143 | (when description |
| 144 | (format #t "description=~a=~a~%" lang description)))) |
| 145 | (filter (lambda (lang) (not (equal? lang ""))) languages)) |
| 146 | (format #t "sha256=~a~%" sha256) |
| 147 | (format #t "size=~a~%" size) |
| 148 | (format #t "type=~a~%" type) |
| 149 | (format #t "entries=~a~%" entry-count) |
| 150 | (format #t "url=~a~%" (string-append "https://nani.lepiller.eu/" dico)) |
| 151 | (format #t "~%"))) |
| 152 | dicos))))) |
| 153 |