nani/website/tools/list.scm

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 kanji radk))
21
(use-modules (nani result result))
22
(use-modules (nani pitch 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 one 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 (pronunciation) 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 jibiki-synopsis
53
    `(_ "Japanese/French dictionary from the Jibiki project."))
54
  (define jibiki-description
55
    `(_ "This dictionary allows you to do searches on the main view of this app.
56
	Failing to download one of these dictionaries will make the app unusable
57
	as you can't search for anything.  This dictionary can be searched for
58
	by kanji, reading (kana) and by French translation."))
59
60
  (define (jmdict-synopsis lang)
61
    (match lang
62
      ("e" `(_ "Japanese/English dictionary from the Electronic Dictionary Research and Development Group."))
63
      ("dut" `(_ "Japanese/Dutch dictionary from the Electronic Dictionary Research and Development Group."))
64
      ("fre" `(_ "Japanese/French dictionary from the Electronic Dictionary Research and Development Group."))
65
      ("ger" `(_ "Japanese/German dictionary from the Electronic Dictionary Research and Development Group."))
66
      ("hun" `(_ "Japanese/Hungarian dictionary from the Electronic Dictionary Research and Development Group."))
67
      ("rus" `(_ "Japanese/Russian dictionary from the Electronic Dictionary Research and Development Group."))
68
      ("slv" `(_ "Japanese/Slovenian dictionary from the Electronic Dictionary Research and Development Group."))
69
      ("spa" `(_ "Japanese/Spanish dictionary from the Electronic Dictionary Research and Development Group."))
70
      ("swe" `(_ "Japanese/Swedish dictionary from the Electronic Dictionary Research and Development Group."))))
71
  (define (jmdict-description lang)
72
    `(_ "This dictionary allows you to do searches on the main view of this app.
73
        Failing to download one of these dictionaries will make the app unusable
74
        as you can't search for anything.  This dictionary can be searched for by
75
        kanji, reading (kana) and by meaning in the languages you selected."))
76
77
  (let* ((english
78
          (cond
79
            ((equal? (dico-type dico) "radk")
80
             (if long?
81
                 radk-description
82
                 radk-synopsis))
83
            ((equal? (dico-type dico) "wadoku")
84
             (if long?
85
                 wadoku-description
86
                 wadoku-synopsis))
87
            ((equal? (dico-type dico) "wadoku_pitch")
88
             (if long?
89
                 wadoku-pitch-description
90
                 wadoku-pitch-synopsis))
91
            ((equal? (dico-type dico) "jibiki")
92
             (if long?
93
                 jibiki-description
94
                 jibiki-synopsis))
95
            ((equal? (dico-type dico) "jmdict")
96
             (let ((dico-lang (substring dico 7)))
97
               (if long?
98
                   (jmdict-description dico-lang)
99
                   (jmdict-synopsis dico-lang))))))
100
         (translated (translate english lang)))
101
    (if (and (equal? english translated) (not (equal? lang "en")))
102
        #f
103
        translated)))
104
105
(define (filesize file)
106
  (stat:size (stat file)))
107
108
(define (sha256 file)
109
  (define hash (file-sha256 file))
110
  (apply
111
    string-append
112
    (map
113
      (lambda (n)
114
        (format #f "~2,'0x" n))
115
      (array->list hash))))
116
117
(define (dico-type file)
118
  (cond
119
    ((equal? file "radicals") "radk")
120
    ((and (> (string-length file) 6) (equal? (substring file 0 6) "JMdict"))
121
     "jmdict")
122
    ((equal? file "jibiki_fre") "jibiki")
123
    ((equal? file "wadoku_ger") "wadoku")
124
    ((equal? file "wadoku_pitch") "wadoku_pitch")))
125
126
(define (entries file)
127
  (cond
128
    ((equal? (dico-type (dico-name file)) "radk")
129
     (kanji-count file))
130
    ((member (dico-type (dico-name file)) '("jmdict" "wadoku" "jibiki"))
131
     (dictionary-entry-count file))
132
    ((equal? (dico-type (dico-name file)) "wadoku_pitch")
133
     (pitch-entry-count file))))
134
135
(define (dico-name file)
136
  (basename file ".nani"))
137
138
(match (command-line)
139
  ((_ output dicos ...)
140
   (with-output-to-file output
141
     (lambda _
142
       (for-each
143
         (lambda (dico)
144
           (let* ((sha256 (sha256 dico))
145
                  (size (filesize dico))
146
                  (name (dico-name dico))
147
                  (type (dico-type name))
148
                  (entry-count (entries dico)))
149
             (format #t "[~a]~%" name)
150
             (for-each
151
               (lambda (lang)
152
                 (let ((synopsis (description name #:lang lang))
153
                       (description (description name #:lang lang #:long? #t)))
154
                   (when synopsis
155
                     (format #t "synopsis=~a=~a~%" lang synopsis))
156
                   (when description
157
                     (format #t "description=~a=~a~%" lang description))))
158
               (filter (lambda (lang) (not (equal? lang ""))) languages))
159
             (format #t "sha256=~a~%" sha256)
160
             (format #t "size=~a~%" size)
161
             (format #t "type=~a~%" type)
162
             (format #t "entries=~a~%" entry-count)
163
             (format #t "url=~a~%" (string-append "https://nani.lepiller.eu/" dico))
164
             (format #t "~%")))
165
         dicos)))))
166