diff --git a/docs-autobuilder.asd b/docs-autobuilder.asd new file mode 100644 index 0000000..efe653a --- /dev/null +++ b/docs-autobuilder.asd @@ -0,0 +1,14 @@ +(defsystem "docs-autobuilder" + :class :package-inferred-system + :author "Alexander Artemenko" + :license "Unlicense" + :pathname "src" + :description "A wrapper which watches on filesystem and runs DOCS-BUILDER automatically." + :homepage "https://40ants.com/docs-builder" + :bug-tracker "https://github.com/40ants/docs-builder/issues" + :source-control (:git "https://github.com/40ants/docs-builder") + :depends-on ("docs-autobuilder/autobuilder")) + + +(asdf:register-system-packages "lack-app-file" '("LACK.APP.FILE")) +(asdf:register-system-packages "lack" '("LACK.COMPONENT")) diff --git a/src/autobuilder.lisp b/src/autobuilder.lisp new file mode 100644 index 0000000..827973e --- /dev/null +++ b/src/autobuilder.lisp @@ -0,0 +1,142 @@ +(uiop:define-package #:docs-autobuilder + (:use #:cl) + (:import-from #:lack.component) + (:import-from #:lack.app.file) + (:import-from #:usocket) + (:import-from #:clack) + (:import-from #:bordeaux-threads) + (:import-from #:docs-builder) + (:import-from #:fs-watcher) + (:import-from #:trivial-open-browser + #:open-browser) + (:export #:build + #:stop)) +(in-package #:docs-autobuilder) + + +(defvar *app* nil) + +(defvar *server* nil) + +(defvar *thread* nil) + + +(defun port-available-p (port interface) + (handler-case (let ((socket (usocket:socket-listen interface port :reuse-address t))) + (usocket:socket-close socket)) + (usocket:address-in-use-error (e) (declare (ignore e)) nil))) + + +(defun available-port (interface) + "Return a port number not in use from 8000 to 60000." + (loop for port from 8000 upto 60000 + if (port-available-p port interface) + return port)) + + +(defun serve-docs (root env) + (let* ((path-info (string-left-trim (list #\/) + (getf env :path-info))) + (path (if (uiop:directory-pathname-p path-info) + (merge-pathnames "index.html" path-info) + path-info)) + (full-path (merge-pathnames path root))) + (if (probe-file full-path) + (lack.component:call (make-instance 'lack.app.file:lack-app-file + :root root + :file path) + env) + (list 404 + (list :content-type "text/plain") + (list (format nil "File ~A not found." + full-path)))))) + + +(defun make-app (root) + (flet ((docs-server-app (env) + (serve-docs root env))) + #'docs-server-app)) + + +(defun in-subdir-p (root file) + (let ((root (namestring root)) + (file (namestring file))) + (and (> (length file) + (length root)) + (string-equal root + (subseq file 0 (length root)))))) + + +(defun build (system &key in-thread port (interface "localhost")) + (when *server* + (error "Server already running.")) + + (let* ((system-path (asdf:system-relative-pathname system "./")) + (docs-path (handler-bind ((docs-builder:documentation-has-problems + (lambda (c) + (let ((restart (find-restart 'continue c))) + (when restart + (invoke-restart restart)))))) + (docs-builder:build system))) + (port (or port + (available-port interface))) + (app (make-app docs-path)) + (server (progn + (log:info "Starting Clack server to serve docs from ~A" docs-path) + (clack:clackup app + :port port + :address interface))) + (url (format nil "http://~A:~A/" + interface port))) + (open-browser url) + + (labels ((build-system (changed-file) + (cond + ((or (in-subdir-p docs-path changed-file) + (string-equal (pathname-name changed-file) + "README") + (string-equal (pathname-name changed-file) + "ChangeLog")) + (log:debug "File ~A was changed, but it is in the documentation folder, skipping docs build step." + changed-file)) + (t + (log:info "File ~A was changed. Rebuilding the docs of ~A system." + changed-file system) + (handler-case + (progn + (ql:quickload system) + (docs-builder:build system)) + (docs-builder:documentation-has-problems (c) + (log:error "Unable to build docs for ~A system. ~A" + system c)) + (error () + (log:error "Unable to build docs for ~A system." + system)))))) + (run-docs-autobuilder () + (fs-watcher:watch system-path #'build-system))) + (cond + (in-thread + (setf *app* app) + (setf *server* server) + (setf *thread* + (bordeaux-threads:make-thread #'run-docs-autobuilder + :name (format nil "Docs Autobuilder for ~A: ~A" + system url)))) + (t + (unwind-protect + (run-docs-autobuilder) + (clack:stop server)))) + + (values)))) + + +(defun stop () + (when *server* + (clack:stop *server*) + (setf *server* nil + *app* nil)) + (when *thread* + (when (bordeaux-threads:thread-alive-p *thread*) + (bordeaux-threads:destroy-thread *thread*)) + (setf *thread* nil)) + (values))