;;; Nani Project website

;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>

;;;

;;; This file is part of the Nani Project website.

;;;

;;; The Nani Project website is free software; you can redistribute it and/or modify it

;;; under the terms of the GNU Affero General Public License as published by

;;; the Free Software Foundation; either version 3 of the License, or (at

;;; your option) any later version.

;;;

;;; The Nani Project website is distributed in the hope that it will be useful, but

;;; WITHOUT ANY WARRANTY; without even the implied warranty of

;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

;;; GNU Affero General Public License for more details.

;;;

;;; You should have received a copy of the GNU Affero General Public License

;;; along with the Nani Project website.  If not, see <http://www.gnu.org/licenses/>.

(use-modules (tools i18n))

(use-modules (nani kanji kanjidic))

(use-modules ((nani kanji radk) #:prefix radk:))

(use-modules (nani kanji kanjivg))

(use-modules (nani result result))

(use-modules (nani pitch pitch))

(use-modules (gcrypt hash))

(use-modules (ice-9 match))

(use-modules (ice-9 format))

(use-modules (ice-9 binary-ports))

(define* (description dico #:key (long? #f) (lang "en"))

  (define radk-synopsis

    `(_ "Radical to Kanji dictionary from the Electronic Dictionary Research and Development Group."))

  (define radk-description

    `(_ "This dictionary allows you to enter kanji by selecting some of its

    components.  Tap the water component button on the bottom of the screen to

    access the kanji selection by component view"))

  (define ksvg-synopsis

    `(_ "Kanji writing visual help by the Kanjivg project."))

  (define ksvg-description

    `(_ "This dictionary allows you to see how a kanji is written, what it is

composed of, and the order in which strokes are written."))

  (define wadoku-synopsis

    `(_ "Japanese/German dictionary from Wadoku."))

  (define wadoku-description

    `(_ "This dictionary allows you to do searches on the main view of this app.

        Failing to download one of these dictionaries will make the app unusable

        as you can't search for anything.  This dictionary can be searched for

        by kanji, reading (kana) and by German translation."))

  (define wadoku-pitch-synopsis

    `(_ "Pitch accent dictionary from Wadoku."))

  (define wadoku-pitch-description

    `(_ "This dictionary allows you to augment search results on the main view

         with pitch accent (pronunciation) information.  Japanese is not flat,

         and this dictionary will add information that will help you pronounce

         words better, with a standard Japanese pitch accent."))

  (define jibiki-synopsis

    `(_ "Japanese/French dictionary from the Jibiki project."))

  (define jibiki-description

    `(_ "This dictionary allows you to do searches on the main view of this app.

	Failing to download one of these dictionaries will make the app unusable

	as you can't search for anything.  This dictionary can be searched for

	by kanji, reading (kana) and by French translation."))

  (define (jmdict-synopsis lang)

    (match lang

      ("e" `(_ "Japanese/English dictionary from the Electronic Dictionary Research and Development Group."))

      ("dut" `(_ "Japanese/Dutch dictionary from the Electronic Dictionary Research and Development Group."))

      ("fre" `(_ "Japanese/French dictionary from the Electronic Dictionary Research and Development Group."))

      ("ger" `(_ "Japanese/German dictionary from the Electronic Dictionary Research and Development Group."))

      ("hun" `(_ "Japanese/Hungarian dictionary from the Electronic Dictionary Research and Development Group."))

      ("rus" `(_ "Japanese/Russian dictionary from the Electronic Dictionary Research and Development Group."))

      ("slv" `(_ "Japanese/Slovenian dictionary from the Electronic Dictionary Research and Development Group."))

      ("spa" `(_ "Japanese/Spanish dictionary from the Electronic Dictionary Research and Development Group."))

      ("swe" `(_ "Japanese/Swedish dictionary from the Electronic Dictionary Research and Development Group."))))

  (define (jmdict-description lang)

    `(_ "This dictionary allows you to do searches on the main view of this app.

        Failing to download one of these dictionaries will make the app unusable

        as you can't search for anything.  This dictionary can be searched for by

        kanji, reading (kana) and by meaning in the languages you selected."))

  (define (kanjidic-synopsis lang)

    (match lang

      ("en" `(_ "Kanji dictionary with English meanings."))

      ("es" `(_ "Kanji dictionary with Spanish meanings."))

      ("fr" `(_ "Kanji dictionary with French meanings."))

      ("pt" `(_ "Kanji dictionary with Portuguese meanings."))))

  (define (kanjidic-description lang)

    `(_ "This dictionary allows you to search for kanji and view kanji information

        such as number of strokes, pronunciations and meanings."))

  (let* ((english

          (cond

            ((equal? (dico-type dico) "radk")

             (if long?

                 radk-description

                 radk-synopsis))

            ((equal? (dico-type dico) "ksvg")

             (if long?

                 ksvg-description

                 ksvg-synopsis))

            ((equal? (dico-type dico) "kanjidic")

             (let ((dico-lang (substring dico 9)))

               (if long?

                   (kanjidic-description dico-lang)

                   (kanjidic-synopsis dico-lang))))

            ((equal? (dico-type dico) "wadoku")

             (if long?

                 wadoku-description

                 wadoku-synopsis))

            ((equal? (dico-type dico) "wadoku_pitch")

             (if long?

                 wadoku-pitch-description

                 wadoku-pitch-synopsis))

            ((equal? (dico-type dico) "jibiki")

             (if long?

                 jibiki-description

                 jibiki-synopsis))

            ((equal? (dico-type dico) "jmdict")

             (let ((dico-lang (substring dico 7)))

               (if long?

                   (jmdict-description dico-lang)

                   (jmdict-synopsis dico-lang))))))

         (translated (translate english lang)))

    (if (and (equal? english translated) (not (equal? lang "en")))

        #f

        translated)))

(define (filesize file)

  (stat:size (stat file)))

(define (sha256 file)

  (define hash (file-sha256 file))

  (apply

    string-append

    (map

      (lambda (n)

        (format #f "~2,'0x" n))

      (array->list hash))))

(define (dico-type file)

  (cond

    ((equal? file "radicals") "radk")

    ((equal? file "kanjivg") "ksvg")

    ((and (> (string-length file) 8) (equal? (substring file 0 8) "kanjidic"))

     "kanjidic")

    ((and (> (string-length file) 6) (equal? (substring file 0 6) "JMdict"))

     "jmdict")

    ((equal? file "jibiki_fre") "jibiki")

    ((equal? file "wadoku_ger") "wadoku")

    ((equal? file "wadoku_pitch") "wadoku_pitch")))

(define (entries file)

  (cond

    ((equal? (dico-type (dico-name file)) "radk")

     (radk:kanji-count file))

    ((equal? (dico-type (dico-name file)) "ksvg")

     (kanjivg-entry-count file))

    ((equal? (dico-type (dico-name file)) "kanjidic")

     (kanjidic-entry-count file))

    ((member (dico-type (dico-name file)) '("jmdict" "wadoku" "jibiki"))

     (dictionary-entry-count file))

    ((equal? (dico-type (dico-name file)) "wadoku_pitch")

     (pitch-entry-count file))))

(define (dico-name file)

  (basename file ".nani"))

(define (dico-lang name)

  (cond

    ((equal? name "radicals") "")

    ((equal? name "kanjivg") "")

    ((equal? name "wadoku_pitch") "")

    ((and (> (string-length name) 8) (equal? (substring name 0 8) "kanjidic"))

     (substring name 9))

    ((and (> (string-length name) 6) (equal? (substring name 0 6) "JMdict"))

     (let ((lang (substring name 7)))

       (match lang

         ("e" "en")

         ("dut" "nl")

         ("fre" "fr")

         ("ger" "de")

         ("hun" "hu")

         ("rus" "ru")

         ("slv" "sl")

         ("spa" "es")

         ("swe" "sv"))))

    ((equal? name "jibiki_fre") "fr")

    ((equal? name "wadoku_ger") "de")))

(match (command-line)

  ((_ output dicos ...)

   (with-output-to-file output

     (lambda _

       (for-each

         (lambda (dico)

           (let* ((sha256 (sha256 dico))

                  (size (filesize dico))

                  (name (dico-name dico))

                  (lang (dico-lang name))

                  (type (dico-type name))

                  (entry-count (entries dico)))

             (format #t "[~a]~%" name)

             (for-each

               (lambda (lang)

                 (let ((synopsis (description name #:lang lang))

                       (description (description name #:lang lang #:long? #t)))

                   (when synopsis

                     (format #t "synopsis=~a=~a~%" lang synopsis))

                   (when description

                     (format #t "description=~a=~a~%" lang description))))

               (filter (lambda (lang) (not (equal? lang ""))) languages))

             (format #t "lang=~a~%" lang)

             (format #t "sha256=~a~%" sha256)

             (format #t "size=~a~%" size)

             (format #t "type=~a~%" type)

             (format #t "entries=~a~%" entry-count)

             (format #t "url=~a~%" (string-append "https://nani.lepiller.eu/" dico))

             (format #t "~%")))

         dicos)))))