git.fiddlerwoaroof.com
utils/ct-sexp.lisp
5e6d4108
 #!/Users/edwlan/sbcl-m1/bin/sbcl --script
3997a732
 
51e6bf17
 #-noscript
3997a732
 (load "~/quicklisp/setup.lisp")
51e6bf17
 #-noscript
 (ql:quickload '(:lquery
                 :fwoar-lisputils
                 :alexandria
                 :net.didierverna.clon))
3997a732
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (require :uiop))
 
 (defpackage :fwoar.ct->sexp
   (:use :cl)
   (:local-nicknames (:clon :net.didierverna.clon))
   (:export ))
 (in-package :fwoar.ct->sexp)
 
 (defparameter *args*
   (uiop:command-line-arguments))
 
 (defun extract-refs (work root)
   (lquery:$
51e6bf17
    (inline root)
    "p[title]"
    (combine (attr "title")
             "a:first-child")
    (map-apply (lambda (ref sibling)
                 (let* ((sibling (elt sibling 0))
                        (parent (plump:parent sibling))
                        (text (progn (plump:remove-child sibling)
                                     (plump:text parent))))
5e6d4108
                   (princ "> ")
                   (princ (plump:text sibling))
                   (princ " ")
                   (princ ref)
                   (terpri)
51e6bf17
                   (list 'ref
                         work
                         (serapeum:string-join
                          (fwoar.string-utils:split " "
                                                    ref)
                          "")
                         text))))))
3997a732
 
 (defun serialize-refs (out-fn refs)
51e6bf17
   (alexandria:with-output-to-file (s out-fn
                                      :if-exists :append
                                      :if-does-not-exist :create)
3997a732
     (let ((*print-case* :downcase))
       (map nil
            (lambda (ref)
              (prin1 ref s)
              (fresh-line s))
            refs))))
 
 (defun translate (in out)
   (let ((root (plump:parse in))
         (out-path (parse-namestring out)))
     (serialize-refs out
                     (extract-refs (alexandria:make-keyword
                                    (string-upcase (pathname-name out-path)))
                                   root))))
 
 (defparameter *synopsis*
51e6bf17
   (net.didierverna.clon:defsynopsis (:postfix "OUT FILES...")
     (flag :short-name "h" :long-name "help"
           :description "Get help")))
3997a732
 
 (defun main ()
   (net.didierverna.clon:make-context :synopsis *synopsis*)
51e6bf17
 
3997a732
   (let ((*package* (find-package :fwoar.ct->sexp)))
     (destructuring-bind (out . files) (net.didierverna.clon:remainder)
       (format *error-output*
               "OUT: ~s~%FILES: ~s~%"
               out files)
       (map nil
            (lambda (file)
              (format *error-output* "PROCESSING FILE: ~s~%" file)
              (translate (parse-namestring file)
                         out))
            files))))
 
51e6bf17
 #-noscript
3997a732
 (net.didierverna.clon:dump (merge-pathnames "bin/ct-sexp"
                                             (user-homedir-pathname))
                            main)