git.fiddlerwoaroof.com
Raw Blame History
(defpackage :fwoar.json-file
  (:use :cl )
  (:export json))
(in-package :fwoar.json-file)

(defclass json (asdf:cl-source-file)
  ((package :initarg :package
            :reader json-package
            :initform (error "must have a package"))
   (transform :initarg :transform
              :reader json-transform
              :initform ''identity)))
(defclass generate-lisp-op (asdf:downward-operation)
  ())
(defmethod asdf:component-depends-on ((o asdf:compile-op) (component json))
  (format t "~&...~%")
  `((generate-lisp-op ,component) ,@(call-next-method)))

(defvar *ht-pprint-dispatch* (copy-pprint-dispatch *print-pprint-dispatch*))
(defvar *empty-package* (make-package (symbol-name (gensym)) :use ()))
(defmethod asdf:perform ((op generate-lisp-op) (c json))
  (let* ((lisp-file (car (asdf:input-files 'asdf:load-source-op
                                           c)))
         (json-file (merge-pathnames (make-pathname :type "json")
                                     lisp-file))
         (*package* *empty-package*)
         (*print-pretty* t)
         (*print-case* :upcase))
    (alexandria:with-output-to-file (s lisp-file
                                       :if-exists :supersede
                                       :if-does-not-exist :create)
      (pprint `(defpackage ,(json-package c) (:use) (:export :+data+))
              s)
      (fresh-line s)
      (princ (serapeum:string-replace
              "#:~A"
              (with-output-to-string (str)
                (let ((*print-readably* t))
                  (pprint
                   `(defparameter #:~a
                      (funcall ,(json-transform c)
                               (let ((yason:*parse-json-null-as-keyword* t)
                                     (yason:*parse-json-arrays-as-vectors* t)
                                     (yason:*parse-json-booleans-as-symbols* t))
                                 (yason:parse
                                  ,(alexandria:read-file-into-string json-file)))))
                   str)))
              (format nil "~a:~a"
                      (json-package c)
                      :+data+))
             s))
    (values)))