diff --git a/data/mit.txt b/data/mit.txt new file mode 100644 index 0000000..98db38b --- /dev/null +++ b/data/mit.txt @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) {{current-year}} {{project-author}} + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/lspack.asd b/lspack.asd index c599aa1..6960c19 100644 --- a/lspack.asd +++ b/lspack.asd @@ -1,8 +1,12 @@ -(asdf:defsystem "lspack" +(defsystem "lspack" :author "Emre Akan" :description "Quickstart Common Lisp projects" :license "GPL-3.0" :version "0.0.1" + :depends-on ("uiop") :pathname "src/" + :serial t :components ((:file "package") + (:file "util") + (:file "license") (:file "starter"))) diff --git a/src/license.lisp b/src/license.lisp new file mode 100644 index 0000000..142832c --- /dev/null +++ b/src/license.lisp @@ -0,0 +1,109 @@ +(in-package :lspack) + +(defparameter *licenses* (make-hash-table)) +(defparameter *license-default-filename* "LICENSE") + +(defclass () + ((template-name :initarg :license-template-name + :accessor license-template-name) + (file-name :initarg :license-file-name + :accessor license-file-name + :initform *license-default-filename*) + (writer :initform nil + :accessor license-writer))) + +(defun get-license (key) + (gethash key *licenses*)) + +(eval-always + (defun set-license (key value) + (setf (gethash key *licenses*) value))) + +(eval-always + (defmacro deflicense (keys template-name &optional file-name) + (let ((sym (gensym "LICENSE"))) + `(let ((,sym (make-instance ' + :license-template-name ,template-name + ,@(unless (null file-name) + `(:license-file-name file-name))))) + ,@(loop for key in (uiop:ensure-list keys) + collect `(set-license ,key ,sym)))))) + +(deflicense :mit "mit.txt") + +(defmethod license-find-template ((license )) + (with-slots (template-name) license + (or (uiop:file-exists-p + (asdf:system-relative-pathname + :lspack + (uiop:merge-pathnames* template-name #P"data/"))) + (uiop:file-exists-p + (uiop:xdg-data-home #P"lspack/data/" template-name))))) + +(defmethod license-read-template ((license )) + (uiop:if-let ((name (license-find-template license))) + (uiop:read-file-string name))) + +(defun template-find-args (template) + (loop with i = 0 + while (< i (length template)) + for arg = (uiop:if-let ((begin (search "{{" template :start2 i))) + (uiop:if-let ((end (search "}}" template :start2 begin))) + (prog1 (list (subseq template (+ begin 2) end) begin (+ end 2)) + (setf i (+ end 2))))) + while arg + collect arg)) + +(defparameter *template-args* (make-hash-table :test 'equal)) + +(defun define-template-arg (argument-name expander) + (setf (gethash argument-name *template-args*) expander)) + +(defun get-arg-expander (arg) + (gethash arg *template-args*)) + +(define-template-arg "current-year" + (lambda (p s) + (declare (ignore p)) + `(format ,s "~D" (get-current-year)))) + +(define-template-arg "project-author" + (lambda (p s) + `(format ,s "~A" (project-author ,p)))) + +(defun generate-argument-writer (arg project-sym stream-sym) + (uiop:if-let ((arg-expander (get-arg-expander arg))) + (funcall arg-expander project-sym stream-sym))) + +(defun generate-writer-body (args project-sym template-sym stream-sym + &optional (prev-end 0)) + (if (null args) + `((write-string ,template-sym ,stream-sym :start ,prev-end)) + (let ((arg (car args))) + (destructuring-bind (name begin end) arg + (cons `(write-string ,template-sym ,stream-sym :start ,prev-end + :end ,begin) + (cons (generate-argument-writer name project-sym stream-sym) + (generate-writer-body (cdr args) project-sym template-sym + stream-sym end))))))) + +(defun template-generate-writer (template-string) + (let ((args (template-find-args template-string)) + (template-sym (gensym "TEMPLATE")) + (project-sym (gensym "PROJECT")) + (stream-sym (gensym "STREAM"))) + `(lambda (,project-sym ,stream-sym) + (let ((,template-sym ,template-string)) + ,@(generate-writer-body args project-sym template-sym stream-sym))))) + +(defmethod license-generate-writer ((license )) + (uiop:if-let (template (license-read-template license)) + (setf (license-writer license) + (compile nil (template-generate-writer template))))) + +(defmethod license-ensure-writer ((license )) + (with-slots (writer) license + (if (functionp writer) + writer + (license-generate-writer license)))) + diff --git a/src/starter.lisp b/src/starter.lisp index 60688d1..b0df32d 100644 --- a/src/starter.lisp +++ b/src/starter.lisp @@ -1,8 +1,8 @@ (in-package :lspack) (defparameter *default-author* "") -(defparameter *default-license* "") -(defparameter *default-pathname* "") +(defparameter *default-license* nil) +(defparameter *default-pathname* "src") (defparameter *default-version* "0.0.0") (defclass () @@ -24,7 +24,7 @@ (license :initarg :project-license :accessor project-license :initform *default-license* - :type string) + :type (or keyword null)) (version :initarg :project-version :accessor project-version :initform *default-version* @@ -40,14 +40,14 @@ :project-name "my-project" :project-author "name" :project-description "a project" - :project-pathname "")) + :project-license :mit)) (defmethod project-defsystem-write ((project ) stream) (with-slots (name author description license version pathname) project (fresh-line stream) (write-char #\( stream) - (format stream "asdf:defsystem ~S" name) + (format stream "defsystem ~S" name) (format stream "~& :author ~S" author) (format stream "~& :description ~S" description) (format stream "~& :license ~S" license) @@ -99,9 +99,23 @@ (format out "(defpackage :~a~% (:use :cl))~%" name)) (format *error-output* "~&Created ~S" path)))) +(defmethod project-license-create ((project )) + (let ((license (get-license (project-license project)))) + (unless (null license) + (let ((writer (license-ensure-writer license)) + (license-file (uiop:merge-pathnames* (license-file-name license) + (project-root project)))) + (unless (null writer) + (with-open-file (out license-file :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (funcall writer project out)) + (format *error-output* "~&Created ~S" license-file)))))) + (defmethod project-start ((project )) (project-ensure-root project) (project-defsystem-create project) + (project-license-create project) (project-ensure-source-directory project) (project-create-package project)) diff --git a/src/util.lisp b/src/util.lisp new file mode 100644 index 0000000..0d9451f --- /dev/null +++ b/src/util.lisp @@ -0,0 +1,9 @@ +(in-package :lspack) + +(defmacro eval-always (&body body) + `(eval-when (:compile-toplevel :load-toplevel :execute) + ,@body)) + +(defun get-current-year () + (let ((now (get-universal-time))) + (nth-value 5 (decode-universal-time now))))