(ql:quickload '(:plump
                :lquery
                :serapeum
                :alexandria
                :flexi-streams
                :chipz
                :babel
                :net.didierverna.clon))

(in-package #:org.shirakumo.plump.parser)
(define-tag-dispatcher (script *tag-dispatchers* *html-tags*)
    (name)
  (string-equal name "script")
  (let* ((closing (consume))
         (attrs
           (if (char= closing #\ )
               (prog1 (read-attributes) (setf closing (consume)))
               (make-attribute-map))))
    (case closing
      (#\/ (advance) (make-element *root* "script" :attributes attrs))
      (#\>
       (let ((*root* (make-fulltext-element *root* "script" :attributes attrs)))
         (make-text-node *root*
                         (consume-until
                          (make-matcher
                           (or (is "</script>") (is "</SCRIPT>")))))
         (advance-n 9)
         *root*)))))

(in-package :cl-user)
(defpackage :ct-transform
  (:use :cl :lquery :serapeum :alexandria :net.didierverna.clon))
(in-package :ct-transform)

(defvar *version* "0.001")
(defsynopsis (:postfix "FILE")
    (group (:header "Generic options")
           (flag :short-name "v" :long-name "version"
                 :description "Show the program version")
           (flag :short-name "h" :long-name "help"
                 :description "Show this help")))


(defvar *txt* nil "The parsed HTML")
(defvar *fn* nil "The file to be pulled in")
(defvar *lookup-table* (make-hash-table :test 'equalp))

;; (uiop:directory-files "." (uiop:merge-pathnames* (make-pathname :type "bz2") uiop:*wild-file*))

(defun call-with-decompressed-text (fn cb &optional (encoding :iso-8859-1))
  (with-input-from-file (s fn :element-type '(unsigned-byte 8))
    (let* ((decompressing-stream (chipz:make-decompressing-stream 'chipz:bzip2 s))
           (flexi-stream (flexi-streams:make-flexi-stream decompressing-stream :external-format encoding)))
      (unwind-protect (funcall cb flexi-stream)
        (close flexi-stream)
        (close decompressing-stream)))))

(defun lookup-ref (p q a &rest r)
  (gethash (format nil "~aq.~da.~d~{~a~}" (string-upcase p) q a r)
           *lookup-table*))

(defun translate-book-ref (ref)
  (string-case ref
    ("" :st)
    ("CG" :scg)
    (t (make-keyword ref))))

(defun normalize-ref (ref)
  (destructuring-bind (book . ref) (split-sequence #\, ref)
    (if ref
        (setf ref (string-join ref ","))
        (setf ref book
              book ""))
    (values (string-join (split-sequence #\space ref
                                         :remove-empty-subseqs t))
            (translate-book-ref (remove-if-not #'upper-case-p
                                               (string-capitalize book))))))


(defun help ())
(defun show-version ()
  (format t "~&~a~%" *version*))

(declaim (ftype (function () nil) to-top))
(defun to-top ())
(defmacro mark-start (&body body)
  (with-gensyms (start)
    `(tagbody
        ,start
        (flet ((to-top () (go ,start)))
          ,@body))))

(defun transform-ct-main ()
  (make-context)
  (mark-start
   (restart-case
       (cond
         ((getopt :long-name "help") (help))
         ((getopt :long-name "version") (show-version))
         (t (let ((file (car (remainder)))
                  (ofile (cadr (remainder)))
                  (*package* (find-package 'ct-transform)))
              (lquery:initialize (call-with-decompressed-text file #'plump:parse))
              (map 'list
                   (op (destructuring-bind (ref el) _
                         (setf (gethash (multiple-value-list (normalize-ref ref))
                                        *lookup-table*)
                               (plump:text el))))
                   ($ "p[title]" (combine (attr :title) (node))))

              (let ((*print-case* :downcase))
                (alexandria:with-output-to-file (*standard-output* ofile)
                  (loop for (ref book) being the hash-keys in *lookup-table* using (hash-value text)
                        do (print `(ref ,book ,ref
                                        ,text)))))
              ;; (alexandria:with-input-from-file (s *fn* :external-format :iso-8859-1)
              ;;   (setf *txt* (plump:parse s)))

              ;; (uiop:directory-files "." (uiop:merge-pathnames* (make-pathname :type "bz2") uiop:*wild-file*))
              ;; (car *)
              ;; (plump:parse *)
              ;; (lquery:initialize *)
              ;; ($ "p[title]" (combine (attr :title)
              ;;          (text)))

              )))
     (retry () (to-top))
     (abort ()))))

(defun make-executable ()
  (dump "transform-ct" transform-ct-main
        :compression 8
        :purify t))