131 lines
5.3 KiB
Common Lisp
131 lines
5.3 KiB
Common Lisp
(in-package :lspack)
|
|
|
|
(defparameter *default-author* "")
|
|
(defparameter *default-license* nil)
|
|
(defparameter *default-pathname* "src")
|
|
(defparameter *default-version* "0.0.0")
|
|
|
|
(defclass <project> ()
|
|
((root :initarg :project-root
|
|
:accessor project-root
|
|
:type pathname)
|
|
(name :initarg :project-name
|
|
:accessor project-name
|
|
:initform ""
|
|
:type string)
|
|
(author :initarg :project-author
|
|
:accessor project-author
|
|
:initform *default-author*
|
|
:type string)
|
|
(description :initarg :project-description
|
|
:accessor project-description
|
|
:initform ""
|
|
:type string)
|
|
(license :initarg :project-license
|
|
:accessor project-license
|
|
:initform *default-license*
|
|
:type (or keyword null))
|
|
(version :initarg :project-version
|
|
:accessor project-version
|
|
:initform *default-version*
|
|
:type string)
|
|
(pathname :initarg :project-pathname
|
|
:accessor project-pathname
|
|
:initform *default-pathname*
|
|
:type string)))
|
|
|
|
(defmethod project-defsystem-write ((project <project>) stream)
|
|
(with-slots (name author description license version pathname)
|
|
project
|
|
(fresh-line stream)
|
|
(write-char #\( stream)
|
|
(format stream "defsystem ~S" name)
|
|
(format stream "~& :author ~S" author)
|
|
(format stream "~& :description ~S" description)
|
|
(format stream "~& :license ~S" license)
|
|
(format stream "~& :version ~S" version)
|
|
(unless (null pathname)
|
|
(format stream "~& :pathname ~S" pathname))
|
|
(format stream "~& :components ((:file \"package\"))")
|
|
(write-char #\) stream)
|
|
(terpri stream)))
|
|
|
|
(defmethod project-defsystem-pathname ((project <project>))
|
|
(uiop:merge-pathnames* (uiop:make-pathname* :name (project-name project)
|
|
:type "asd")
|
|
(project-root project)))
|
|
|
|
(defmethod project-defsystem-create ((project <project>))
|
|
(let ((path (project-defsystem-pathname project)))
|
|
(with-open-file (out path :direction :output
|
|
:if-exists :supersede
|
|
:if-does-not-exist :create)
|
|
(project-defsystem-write project out))
|
|
(format *error-output* "~&Created ~S~%" path)))
|
|
|
|
(defmethod project-ensure-root ((project <project>))
|
|
(with-slots (root) project
|
|
(ensure-directories-exist (uiop:physicalize-pathname root))
|
|
(format *error-output* "~&Starting project at ~S~%" root)))
|
|
|
|
(defmethod project-source-pathname ((project <project>))
|
|
(uiop:merge-pathnames* (uiop:ensure-directory-pathname (project-pathname project))
|
|
(project-root project)))
|
|
|
|
(defmethod project-ensure-source-directory ((project <project>))
|
|
(with-slots (pathname) project
|
|
(let ((src (project-source-pathname project)))
|
|
(format *error-output* "~&Source directory: ~S" src)
|
|
(unless (string= pathname "")
|
|
(ensure-directories-exist (uiop:physicalize-pathname src))
|
|
(format *error-output* " created.~%")))))
|
|
|
|
(defmethod project-write-notice ((project <project>) stream)
|
|
(uiop:if-let ((notice (get-notice (project-license project))))
|
|
(uiop:if-let ((writer (license-ensure-writer notice t)))
|
|
(funcall writer project stream))))
|
|
|
|
(defmethod project-create-package ((project <project>))
|
|
(with-slots (root name pathname) project
|
|
(let ((path (uiop:merge-pathnames* (uiop:make-pathname* :name "package"
|
|
:type "lisp")
|
|
(project-source-pathname project))))
|
|
(with-open-file (out path :direction :output
|
|
:if-exists :supersede
|
|
:if-does-not-exist :create)
|
|
(project-write-notice project out)
|
|
(format out "~&(defpackage :~a~% (:use :cl))~%" name))
|
|
(format *error-output* "~&Created ~S~%" path))))
|
|
|
|
(defmethod project-license-create ((project <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>))
|
|
(project-ensure-root project)
|
|
(project-defsystem-create project)
|
|
(project-license-create project)
|
|
(project-ensure-source-directory project)
|
|
(project-create-package project))
|
|
|
|
(defun start (name project-root &key (author *default-author*) (description "") (license *default-license*))
|
|
"Intended to be called interactively by the user at the repl"
|
|
(let ((project (make-instance
|
|
'<project>
|
|
:project-root (uiop:ensure-directory-pathname project-root)
|
|
:project-name name
|
|
:project-author author
|
|
:project-description description
|
|
:project-license license)))
|
|
(project-start project)))
|
|
|