Parse calendar months, days, quarters and day-periods

chronogram-cldr-parser.lisp

@@ -2,9 +2,82 @@
 
 (defpackage #:chronogram-cldr-parser
  (:use #:cl #:esrap)
+ (:local-nicknames (:jzon :com.inuoe.jzon))
  (:export #:parse-cldr))
 
 (in-package #:chronogram-cldr-parser)
 
-(defun parse-cldr (contents)
- 'test)
+(defun clss-select-first (selector node)
+ (let ((results (clss:select selector node)))
+ (when (plusp (length results))
+ (elt results 0))))
+
+(defmacro defun-process-entities (entity selector value-form)
+ (let ((sym (intern (string-upcase entity))))
+ (alexandria:with-gensyms (entity-type)
+ `(defun ,(intern (concatenate 'string "PROCESS-" (string-upcase entity)))
+ (entity-parent)
+ (jzon:with-object*
+ (loop :for ,sym :across (clss:select ,selector entity-parent)
+ :for ,entity-type := (plump:get-attribute ,sym "type")
+ :when ,entity-type
+ :do (progn
+ (jzon:write-key* ,entity-type)
+ ,value-form)))))))
+
+;; Months
+(defun-process-entities month "month"
+ (jzon:write-value* (plump:text month)))
+(defun-process-entities month-width "monthWidth"
+ (process-month month-width))
+(defun-process-entities month-context "months > monthContext"
+ (process-month-width month-context))
+
+;; Days
+(defun-process-entities day "day"
+ (jzon:write-value* (plump:text day)))
+(defun-process-entities day-width "dayWidth"
+ (process-day day-width))
+(defun-process-entities day-context "days > dayContext"
+ (process-day-width day-context))
+
+;; Quarters
+(defun-process-entities quarter "quarter"
+ (jzon:write-value* (plump:text quarter)))
+(defun-process-entities quarter-width "quarterWidth"
+ (process-quarter quarter-width))
+(defun-process-entities quarter-context "quarters > quarterContext"
+ (process-quarter-width quarter-context))
+
+;; Day periods
+(defun-process-entities day-period "dayPeriod"
+ (jzon:write-value* (plump:text day-period)))
+(defun-process-entities day-period-width "dayPeriodWidth"
+ (process-day-period day-period-width))
+(defun-process-entities day-period-context "dayPeriods > dayPeriodContext"
+ (process-day-period-width day-period-context))
+
+;; Calendars
+
+(defun-process-entities calendar "ldml > dates > calendars > calendar"
+ (jzon:with-object*
+ (jzon:write-key* "months")
+ (process-month-context calendar)
+
+ (jzon:write-key* "days")
+ (process-day-context calendar)
+
+ (jzon:write-key* "quarters")
+ (process-quarter-context calendar)
+
+ (jzon:write-key* "day-periods")
+ (process-day-period-context calendar)))
+
+(defun parse-cldr (contents out-stream)
+ (let ((root (plump:parse contents)))
+ (jzon:with-writer* (:stream out-stream :pretty nil)
+ (jzon:with-object*
+ (jzon:write-key* "calendars")
+ (process-calendar root)))))
+
+

chronogram-dist.lisp

@@ -15,21 +15,52 @@
  (format nil "https://github.com/unicode-org/cldr/archive/refs/tags/~a.zip" tag))
 
 (defun make-chronogram-info (contents dist-dir name)
- (with-open-file (stream (format nil "~a~a.lisp" dist-dir name)
+ (with-open-file (stream (format nil "~a~a.json" dist-dir name)
  :direction :output
  :if-exists :supersede
  :if-does-not-exist :create)
  (let ((*package* (find-package 'chronogram-cldr-parser)))
- (format stream "~s~%" (chronogram-cldr-parser:parse-cldr contents)))))
+ (chronogram-cldr-parser:parse-cldr contents
+ stream))))
 
 (defun make-dist (&optional force-download)
  (let* ((system (asdf:find-system 'chronogram t))
  (dist-dir (asdf:system-relative-pathname system "chronogram-dist/"))
- (tz-submodule-available
+ (cldr-submodule-available
  (uiop:file-exists-p
- (asdf:system-relative-pathname system "cldr/LICENSE")))
- (tag (when (or force-download (not tz-submodule-available))
- (get-cldr-release-tag system))))
+ (asdf:system-relative-pathname system "cldr/unicode-license.txt")))
+ (tag (when (or force-download (not cldr-submodule-available))
+ (get-cldr-release-tag system)))
+ (names '("en" "de" "hu" "ko")))
  (ensure-directories-exist dist-dir)
- ;; DUMMY
- (make-chronogram-info "" dist-dir "test")))
+ (if tag
+ (uiop:with-temporary-file (:stream s)
+ (format t "Downloading cldr release ~a... " tag)
+ (force-output)
+ (let ((bytes (dex:get (get-archive-url tag))))
+ (write-sequence bytes s)
+ (finish-output s))
+ (format t "DONE~%")
+ (zip:with-zipfile (f s)
+ (loop :for name :in names
+ :for entry := (zip:get-zipfile-entry
+ (format nil "cldr-~a/~a" tag name) f)
+ :do (format t "Writing ~a~a.json... " dist-dir name)
+ :do (force-output)
+ :do (make-chronogram-info
+ (babel:octets-to-string (zip:zipfile-entry-contents entry)
+ :encoding :utf-8)
+ dist-dir
+ name)
+ :do (format t "DONE~%"))))
+ (loop :with cldr-dir := (asdf:system-relative-pathname system "cldr/")
+ :for name :in names
+ :do (format t "Writing ~a~a.json... " dist-dir name)
+ :do (force-output)
+ :do (make-chronogram-info
+ (uiop:read-file-string (format nil "~a/common/main/~a.xml"
+ cldr-dir
+ name))
+ dist-dir
+ name)
+ :do (format t "DONE~%")))))

chronogram.asd

@@ -12,7 +12,8 @@
  :depends-on (#:alexandria
  #:esrap
  #:plump
- #:clss)
+ #:clss
+ #:com.inuoe.jzon)
  :components ((:file "chronogram-cldr-parser")))
 
 (asdf:defsystem #:chronogram/test