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
                                           `(defvar #:~a
                                              (funcall ,(json-transform c)
                                                       (yason:parse
                                                        ,(alexandria:read-file-into-string json-file))))
                                           str)))
                                      (format nil "~a:~a"
                                              (json-package c)
                                              :+data+))
             s))
    (values)))