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

(defclass asdf-user::file-string (asdf:cl-source-file)
  ((package :initarg :package
            :reader string-package
            :initform (error "must have a package"))
   (extension :initarg :extension
              :reader string-extension
              :initform (error "must have a extension"))))

(defclass generate-lisp-op (asdf:downward-operation)
  ())
(defmethod asdf:component-depends-on ((o asdf:compile-op) (component asdf-user::file-string))
  `((generate-lisp-op ,component) ,@(call-next-method)))

(defvar *empty-package* (make-package (symbol-name (gensym)) :use ()))
(defmethod asdf:perform ((op generate-lisp-op) (c asdf-user::file-string))
  (let* ((lisp-file (car (asdf:input-files 'asdf:load-source-op
                                           c)))
         (file-string (merge-pathnames (make-pathname :type (string-extension c))
                                       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 ,(string-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
                             ,(alexandria:read-file-into-string file-string))
                          str)))
              (format nil "~a:~a"
                      (string-package c)
                      :+data+))
             s))
    (values)))