Setup-lisp action was factored out into a separate repository.
This commit is contained in:
Alexander Artemenko
parent
d165824162
commit
5b8a4ddf32
18 changed files with 1 additions and 1071 deletions
52
.github/actions/build-docs/action.yml
vendored
52
.github/actions/build-docs/action.yml
vendored
|
|
@ -1,52 +0,0 @@
|
|||
name: 'Build Docs'
|
||||
|
||||
inputs:
|
||||
asdf-system:
|
||||
description: 'ASDF system to build system for'
|
||||
required: true
|
||||
qlfile-template:
|
||||
description: "Djula template for qlfile. All environment variables are available in it's context"
|
||||
required: false
|
||||
ngrok-auth-token:
|
||||
description: "A token to debug processes."
|
||||
required: false
|
||||
|
||||
runs:
|
||||
using: composite
|
||||
steps:
|
||||
- name: Install Documentation Builder
|
||||
shell: bash
|
||||
run: |
|
||||
echo ::group::Install Documentation Builder
|
||||
|
||||
echo 'github docs-builder 40ants/docs-builder' >> qlfile
|
||||
echo 'github ngrok 40ants/ngrok' >> qlfile
|
||||
|
||||
qlot update
|
||||
|
||||
qlot exec ros install docs-builder
|
||||
qlot exec ros install ngrok
|
||||
echo ::endgroup::
|
||||
- name: Build Docs
|
||||
id: build-docs
|
||||
shell: bash
|
||||
run: |
|
||||
set -Eeuo pipefail
|
||||
echo ::group::Build Docs
|
||||
|
||||
build-docs ${{ inputs.asdf-system }} output.dir
|
||||
|
||||
echo ::endgroup::
|
||||
|
||||
- name: Upload Docs
|
||||
shell: bash
|
||||
run: |
|
||||
set -Eeuo pipefail
|
||||
echo ::group::Upload Docs
|
||||
|
||||
${{ github.action_path }}/upload.ros "$(cat output.dir)"
|
||||
|
||||
echo ::endgroup::
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ github.token }}
|
||||
NGROK_AUTH_TOKEN: ${{ inputs.ngrok-auth-token }}
|
||||
247
.github/actions/build-docs/upload.ros
vendored
247
.github/actions/build-docs/upload.ros
vendored
|
|
@ -1,247 +0,0 @@
|
|||
#!/bin/sh
|
||||
#|-*- mode:lisp -*-|#
|
||||
#|
|
||||
exec ros -Q -- $0 "$@"
|
||||
|#
|
||||
(progn ;;init forms
|
||||
(ros:ensure-asdf)
|
||||
#+quicklisp
|
||||
(ql:quickload '(log4cl
|
||||
ngrok/slynk)
|
||||
:silent t))
|
||||
|
||||
(defpackage :ros.script.upload
|
||||
(:use :cl))
|
||||
(in-package :ros.script.upload)
|
||||
|
||||
|
||||
(defvar *current-dir*)
|
||||
|
||||
|
||||
(define-condition unable-to-proceed (simple-error)
|
||||
((message :initarg :message
|
||||
:reader get-message))
|
||||
(:report (lambda (condition stream)
|
||||
(format stream (get-message condition)))))
|
||||
|
||||
|
||||
(define-condition subprocess-error-with-output (uiop::subprocess-error)
|
||||
((stdout :initarg :stdout :reader subprocess-error-stdout)
|
||||
(stderr :initarg :stderr :reader subprocess-error-stderr))
|
||||
(:report (lambda (condition stream)
|
||||
(format stream "Subprocess ~@[~S~% ~]~@[with command ~S~% ~]exited with error~@[ code ~D ~]~@[~%STDOUT:~% ~S~]~@[~%STDERR:~% ~S~]"
|
||||
(uiop:subprocess-error-process condition)
|
||||
(uiop:subprocess-error-command condition)
|
||||
(uiop:subprocess-error-code condition)
|
||||
(subprocess-error-stdout condition)
|
||||
(subprocess-error-stderr condition)))))
|
||||
|
||||
|
||||
(defun run (command &key (raise t))
|
||||
"Runs command and returns it's stdout stderr and code.
|
||||
|
||||
If there was an error, raises subprocess-error-with-output, but this
|
||||
behaviour could be overriden by keyword argument ``:raise t``."
|
||||
|
||||
(multiple-value-bind (stdout stderr code)
|
||||
(uiop:run-program command
|
||||
:output '(:string :stripped t)
|
||||
:error-output '(:string :stripped t)
|
||||
:ignore-error-status t)
|
||||
|
||||
(when (and raise
|
||||
(not (eql code 0)))
|
||||
(error 'subprocess-error-with-output
|
||||
:stdout stdout
|
||||
:stderr stderr
|
||||
:code code
|
||||
:command command))
|
||||
(values stdout stderr code)))
|
||||
|
||||
|
||||
(defun gh-pages-repository-initialized-p (docs-dir)
|
||||
"Checks if repository for documentation already initialized"
|
||||
(uiop:directory-exists-p (uiop:merge-pathnames* #P".git/"
|
||||
docs-dir)))
|
||||
|
||||
|
||||
(defun git (&rest commands)
|
||||
"Calls git command in gh-pages repository."
|
||||
|
||||
(uiop:with-current-directory (*current-dir*)
|
||||
(let ((command (apply #'concatenate 'string
|
||||
"git "
|
||||
commands)))
|
||||
|
||||
(log:info "Running" command "in" *current-dir*)
|
||||
(run command))))
|
||||
|
||||
|
||||
(defun git-repository-was-changed-p ()
|
||||
;; Here we only interested in entries which are starting from 1 (changed in porcelain v2 format).
|
||||
;; And not in qlfile and qlfile.lock.
|
||||
;; The "cat" at the end is to make 0 status code if there is no changed files.
|
||||
;; Because we only want an output from grep.
|
||||
(> (length (git "status --porcelain=v2 | grep '^1' | grep -v -e qlfile | cat"))
|
||||
0))
|
||||
|
||||
|
||||
(defun get-git-upstream ()
|
||||
;; taken from http://stackoverflow.com/a/9753364/70293
|
||||
(let ((upstream (run "git rev-parse --abbrev-ref --symbolic-full-name @{u}" :raise nil)))
|
||||
(when (> (length upstream)
|
||||
0)
|
||||
(subseq upstream
|
||||
0
|
||||
(search "/" upstream)))))
|
||||
|
||||
|
||||
(defun get-origin-to-push ()
|
||||
(cond
|
||||
;; If we are running inside github actions
|
||||
((uiop:getenv "GITHUB_ACTIONS")
|
||||
(unless (uiop:getenv "GITHUB_TOKEN")
|
||||
(error 'unable-to-proceed
|
||||
:message "Please, provide GITHUB_TOKEN environment variable."))
|
||||
(format nil "https://~A:~A@github.com/~A"
|
||||
(uiop:getenv "GITHUB_ACTOR")
|
||||
(uiop:getenv "GITHUB_TOKEN")
|
||||
(uiop:getenv "GITHUB_REPOSITORY")))
|
||||
;; otherwise make it from travis secret token and repo slug
|
||||
((uiop:getenv "TRAVIS_REPO_SLUG")
|
||||
(let ((repo-slug (uiop:getenv "TRAVIS_REPO_SLUG"))
|
||||
(repo-token (uiop:getenv "GH_REPO_TOKEN")))
|
||||
|
||||
(unless (and repo-slug repo-token)
|
||||
(error 'unable-to-proceed
|
||||
:message "Current branch does not track any upstream and there is no TRAVIS_REPO_SLUG and GH_REPO_TOKEN env variables. Where to push gh-pages branch?"))
|
||||
|
||||
(format nil "https://~A@github.com/~A"
|
||||
repo-token
|
||||
repo-slug)))
|
||||
;; If there is already some remote upstream, then use it
|
||||
(t
|
||||
(let ((upstream (get-git-upstream)))
|
||||
(cond
|
||||
(upstream
|
||||
(run (concatenate 'string "git remote get-url " upstream)))
|
||||
(t
|
||||
(log:error "Unable to guess correct upstream URL")
|
||||
(values nil)))))))
|
||||
|
||||
|
||||
(defun push-gh-pages (docs-dir)
|
||||
(log:info "Pushing changes to gh-pages branch")
|
||||
|
||||
(let ((*current-dir* docs-dir))
|
||||
|
||||
(unless (gh-pages-repository-initialized-p docs-dir)
|
||||
(git "init")
|
||||
|
||||
(git "remote add origin "
|
||||
(get-origin-to-push)))
|
||||
|
||||
(git "add .")
|
||||
|
||||
(cond
|
||||
((git-repository-was-changed-p)
|
||||
(when (uiop:getenv "GITHUB_ACTIONS")
|
||||
(git "config --global user.name \"github-actions[bot]\"")
|
||||
(git "config --global user.email \"actions@github.com\""))
|
||||
(git "commit -m 'Update docs'")
|
||||
|
||||
(git "push --force origin master:gh-pages"))
|
||||
;; or
|
||||
(t (log:info "Everything is up to date."))))
|
||||
(values))
|
||||
|
||||
|
||||
(defun push-local-changes ()
|
||||
"Some documentation builders, like MGL-PAX,
|
||||
can update README file as well. In this case, we need
|
||||
to push the file into the current branch of the repository."
|
||||
(let ((*current-dir* (probe-file #P"")))
|
||||
(macrolet ((if-there-are-changes (&body body)
|
||||
`(cond
|
||||
((git-repository-was-changed-p)
|
||||
(log:info "Pushing local changes to the repository")
|
||||
,@body)
|
||||
(t
|
||||
(log:info "There is no local changes.")))))
|
||||
(flet ((make-commit ()
|
||||
(git "add -u")
|
||||
|
||||
;; We don't want to commit changes to qlfile,
|
||||
;; because documentation builders might change them:
|
||||
(git "reset qlfile*")
|
||||
|
||||
(when (uiop:getenv "GITHUB_ACTIONS")
|
||||
|
||||
(git "config --global user.name \"github-actions[bot]\"")
|
||||
(git "config --global user.email \"actions@github.com\""))
|
||||
|
||||
(git "commit -m 'Update docs'")))
|
||||
(cond
|
||||
((uiop:getenv "GITHUB_HEAD_REF")
|
||||
(let ((ref (uiop:getenv "GITHUB_HEAD_REF")))
|
||||
|
||||
;; Inside github action we are running on
|
||||
;; detached commit. Github takes last commit
|
||||
;; from the "master" branch and merges
|
||||
;; a branch from pull-request settings.
|
||||
;;
|
||||
;; To push changes back, we need to change
|
||||
;; our HEAD back to the pull-request's reference:
|
||||
(git "checkout " ref)
|
||||
;; Here we need to check again if
|
||||
(if-there-are-changes
|
||||
(make-commit)
|
||||
(git "remote add upstream "
|
||||
(get-origin-to-push))
|
||||
(git "push upstream HEAD:" ref))))
|
||||
(t
|
||||
(if-there-are-changes
|
||||
(make-commit)
|
||||
(git "push")))))))
|
||||
(values))
|
||||
|
||||
|
||||
(defun main (&rest argv)
|
||||
(log:info "Uploading documentation")
|
||||
|
||||
(unless argv
|
||||
(log:error "Please, specify a directory with HTML docs.")
|
||||
(uiop:quit 1))
|
||||
|
||||
(let ((docs-dir (uiop:parse-unix-namestring (first argv)
|
||||
:ensure-directory t)))
|
||||
|
||||
(handler-bind ((error (lambda (condition)
|
||||
(uiop:print-condition-backtrace condition :stream *error-output*)
|
||||
(uiop:quit 1))))
|
||||
(unless (probe-file docs-dir)
|
||||
(log:error "Directory \"~A not found"
|
||||
docs-dir)
|
||||
(uiop:quit 1))
|
||||
|
||||
(uiop:with-output-file (s (uiop:merge-pathnames* #P".nojekyll"
|
||||
docs-dir)
|
||||
:if-exists :overwrite)
|
||||
(declare (ignorable s)))
|
||||
|
||||
(unless (string= (or (uiop:getenv "NGROK_AUTH_TOKEN")
|
||||
;; If var is not given, uiop will return NIL,
|
||||
;; but inside github action, not required arguments
|
||||
;; are empty strings and env var will be empty string.
|
||||
"")
|
||||
"")
|
||||
(let ((url (ngrok/slynk:start 4005)))
|
||||
(when url
|
||||
(log:info "Waiting for connection to ~A" url)
|
||||
(log:info "do touch ~~/continue to let process continue" )
|
||||
(loop
|
||||
until (probe-file "~/continue")
|
||||
do (sleep 5)))))
|
||||
|
||||
(push-gh-pages docs-dir)
|
||||
(push-local-changes))))
|
||||
19
.github/actions/run-tests/action.yml
vendored
19
.github/actions/run-tests/action.yml
vendored
|
|
@ -1,19 +0,0 @@
|
|||
name: 'Test Common Lisp System'
|
||||
|
||||
inputs:
|
||||
asdf-system:
|
||||
description: 'ASDF system to install and test'
|
||||
required: true
|
||||
run-tests:
|
||||
description: A command to run tests
|
||||
required: false
|
||||
|
||||
runs:
|
||||
using: composite
|
||||
steps:
|
||||
- name: Run Tests
|
||||
shell: bash
|
||||
run: |
|
||||
${{ github.action_path }}/run-tests.ros ${{ inputs.asdf-system }} <<EOF
|
||||
${{ inputs.run-tests }}
|
||||
EOF
|
||||
89
.github/actions/run-tests/run-tests.ros
vendored
89
.github/actions/run-tests/run-tests.ros
vendored
|
|
@ -1,89 +0,0 @@
|
|||
#!/bin/sh
|
||||
#|-*- mode:lisp -*-|#
|
||||
#|
|
||||
exec ros -Q -L sbcl-bin -- $0 "$@"
|
||||
|#
|
||||
(progn ;;init forms
|
||||
(ros:ensure-asdf)
|
||||
#+quicklisp(ql:quickload '(trivial-backtrace)
|
||||
:silent t))
|
||||
|
||||
(declaim (optimize (debug 3) (safety 3)
|
||||
(speed 0) (space 0)))
|
||||
|
||||
(defpackage :ros.script.run-tests
|
||||
(:use :cl))
|
||||
(in-package :ros.script.run-tests)
|
||||
|
||||
|
||||
(defparameter *test-system-name-templates*
|
||||
'("~A-test"
|
||||
"~A-tests"
|
||||
"~A/test"
|
||||
"~A/tests"
|
||||
"~A"))
|
||||
|
||||
|
||||
(defun guess-test-system-name (primary-system-name)
|
||||
(check-type primary-system-name string)
|
||||
(loop for template in *test-system-name-templates*
|
||||
for system-name = (format nil template
|
||||
primary-system-name)
|
||||
for asd-file = (format nil "~A.asd"
|
||||
system-name)
|
||||
when (probe-file asd-file)
|
||||
do (return system-name)))
|
||||
|
||||
|
||||
(defun run-tests (primary-system-name)
|
||||
"Default tests runner searches appropriate system's name and calls ASDF:TEST-SYSTEM.
|
||||
|
||||
If ASDF:TEST-SYSTEM does not signal error condition, test run considered successful.
|
||||
|
||||
Before call to the ASDF:TEST-SYSTEM we do QL:QUICKLOAD, to be sure that all dependencies
|
||||
are downloaded."
|
||||
(check-type primary-system-name string)
|
||||
|
||||
(let ((test-system-name
|
||||
(guess-test-system-name primary-system-name)))
|
||||
(ql:quickload test-system-name
|
||||
:silent t)
|
||||
;; ASDF:TEST-SYSTEM always returns T
|
||||
(asdf:test-system test-system-name)))
|
||||
|
||||
|
||||
(defun main (&rest args)
|
||||
(let ((system (first args)))
|
||||
(format t "::group::Running tests for ASDF system ~S~%"
|
||||
(or system
|
||||
""))
|
||||
|
||||
(unwind-protect
|
||||
(handler-bind
|
||||
((error (lambda (condition)
|
||||
(trivial-backtrace:print-backtrace condition)
|
||||
(uiop:quit 3))))
|
||||
(when (or (null system)
|
||||
(string= system ""))
|
||||
(format *error-output*
|
||||
"Please specify ASDF system as a first argument.~%")
|
||||
(uiop:quit 1))
|
||||
|
||||
(let* ((user-script (uiop:slurp-stream-forms *standard-input*))
|
||||
(result
|
||||
(cond
|
||||
(user-script
|
||||
(loop with form-results
|
||||
for form in user-script
|
||||
do (setf form-results
|
||||
(eval form))
|
||||
finally (return form-results)))
|
||||
;; default tests runner
|
||||
(t
|
||||
(run-tests system)))))
|
||||
(unless result
|
||||
(uiop:quit 2))))
|
||||
(format t "::endgroup::~%"))))
|
||||
|
||||
|
||||
;;; vim: set ft=lisp lisp:
|
||||
|
|
@ -2,30 +2,7 @@
|
|||
ChangeLog
|
||||
===========
|
||||
|
||||
0.4.0 (2019-07-19)
|
||||
==================
|
||||
|
||||
Now cl-info is able to work without Quicklisp client.
|
||||
|
||||
Also:
|
||||
|
||||
* ``make-cl-info`` was renamed to ``get-cl-info``.
|
||||
* ``make-system-info`` was renamed to ``get-system-info``.
|
||||
|
||||
0.3.0 (2018-06-17)
|
||||
==================
|
||||
|
||||
Fixed handling of ``ASDF/PLAN:SYSTEM-OUT-OF-DATE`` error, when
|
||||
displaying information about installed systems.
|
||||
|
||||
Added normal README with examples.
|
||||
|
||||
0.2.0 (2018-06-04)
|
||||
==================
|
||||
|
||||
System now explicitly requires ASDF >= 3.1.
|
||||
|
||||
0.1.0 (2018-06-03)
|
||||
1.0.0 (2021-01-07)
|
||||
==================
|
||||
|
||||
Initial version.
|
||||
|
|
|
|||
|
|
@ -1,6 +0,0 @@
|
|||
(defsystem example-docs
|
||||
:build-operation build-docs-op
|
||||
:build-pathname "docs/build/"
|
||||
:class :package-inferred-system
|
||||
:pathname "docs/source/"
|
||||
:depends-on ("example-docs/docs"))
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
(defsystem cl-info-test
|
||||
:author ""
|
||||
:license ""
|
||||
:class :package-inferred-system
|
||||
:pathname "t"
|
||||
:depends-on ("hamcrest"
|
||||
"cl-info-test/core")
|
||||
:description "Test system for cl-info"
|
||||
|
||||
:perform (test-op (op c)
|
||||
(unless (symbol-call :rove :run c)
|
||||
(error "Tests failed"))))
|
||||
27
cl-info.asd
27
cl-info.asd
|
|
@ -1,27 +0,0 @@
|
|||
#-asdf3.1 (error "cl-info requires ASDF 3.1")
|
||||
(defsystem cl-info
|
||||
:version (:read-file-form "version.lisp-expr")
|
||||
:author "Alexander Artemenko"
|
||||
:license "BSD"
|
||||
:class :package-inferred-system
|
||||
:pathname "src"
|
||||
:depends-on ("cl-info/core")
|
||||
:description "A helper to an answer a question about OS, Lisp and Everything."
|
||||
:long-description
|
||||
#.(with-open-file (stream (merge-pathnames
|
||||
#p"README.rst"
|
||||
(or *load-pathname* *compile-file-pathname*))
|
||||
:if-does-not-exist nil
|
||||
:direction :input)
|
||||
(when stream
|
||||
(let ((seq (make-array (file-length stream)
|
||||
:element-type 'character
|
||||
:fill-pointer t)))
|
||||
(setf (fill-pointer seq)
|
||||
(read-sequence seq stream))
|
||||
seq)))
|
||||
:perform (compile-op :before (o c)
|
||||
#+ros.installing
|
||||
(roswell:roswell '("install" "40ants/defmain")))
|
||||
:in-order-to ((test-op (test-op cl-info-test))))
|
||||
|
||||
|
|
@ -1,163 +0,0 @@
|
|||
#!/bin/sh
|
||||
#|-*- mode:lisp -*-|#
|
||||
#| <Put a one-line description here>
|
||||
exec ros -Q -- $0 "$@"
|
||||
|#
|
||||
(progn ;;init forms
|
||||
(ros:ensure-asdf)
|
||||
#+quicklisp
|
||||
(ql:quickload '(log4cl
|
||||
example-docs)
|
||||
:silent t))
|
||||
|
||||
(defpackage :script.build-docs
|
||||
(:use :cl))
|
||||
(in-package :script.build-docs)
|
||||
|
||||
|
||||
(define-condition unable-to-proceed (simple-error)
|
||||
((message :initarg :message
|
||||
:reader get-message))
|
||||
(:report (lambda (condition stream)
|
||||
(format stream (get-message condition)))))
|
||||
|
||||
|
||||
(define-condition subprocess-error-with-output (uiop::subprocess-error)
|
||||
((stdout :initarg :stdout :reader subprocess-error-stdout)
|
||||
(stderr :initarg :stderr :reader subprocess-error-stderr))
|
||||
(:report (lambda (condition stream)
|
||||
(format stream "Subprocess ~@[~S~% ~]~@[with command ~S~% ~]exited with error~@[ code ~D ~]~@[ and this text at stderr:~% ~S~]"
|
||||
(uiop:subprocess-error-process condition)
|
||||
(uiop:subprocess-error-command condition)
|
||||
(uiop:subprocess-error-code condition)
|
||||
(subprocess-error-stderr condition))
|
||||
)))
|
||||
|
||||
(defun run (command &key (raise t))
|
||||
"Runs command and returns it's stdout stderr and code.
|
||||
|
||||
If there was an error, raises subprocess-error-with-output, but this
|
||||
behaviour could be overriden by keyword argument ``:raise t``."
|
||||
|
||||
(multiple-value-bind (stdout stderr code)
|
||||
(uiop:run-program command
|
||||
:output '(:string :stripped t)
|
||||
:error-output '(:string :stripped t)
|
||||
:ignore-error-status t)
|
||||
|
||||
(when (and raise
|
||||
(not (eql code 0)))
|
||||
(error 'subprocess-error-with-output
|
||||
:stdout stdout
|
||||
:stderr stderr
|
||||
:code code
|
||||
:command command))
|
||||
(values stdout stderr code)))
|
||||
|
||||
|
||||
(defun build-docs ()
|
||||
(log:info "Building documentation in ./docs/")
|
||||
|
||||
(example-docs:build-docs)
|
||||
|
||||
(uiop:with-output-file (s "docs/build/.nojekyll" :if-exists :overwrite)
|
||||
(declare (ignorable s))))
|
||||
|
||||
|
||||
(defun gh-pages-repository-initialized-p ()
|
||||
"Checks if repository for documentation already initialized"
|
||||
(uiop:directory-exists-p "docs/build/.git"))
|
||||
|
||||
|
||||
(defun git (&rest commands)
|
||||
"Calls git command in gh-pages repository."
|
||||
|
||||
(let ((directory "docs/build/"))
|
||||
(uiop:with-current-directory (directory)
|
||||
(let ((command (apply #'concatenate 'string
|
||||
"git "
|
||||
commands)))
|
||||
|
||||
(log:info "Running" command "in" directory)
|
||||
(run command)))))
|
||||
|
||||
|
||||
(defun git-repository-was-changed-p ()
|
||||
;; if git status returns something, then repository have uncommitted changes
|
||||
(> (length (git "status --porcelain"))
|
||||
0))
|
||||
|
||||
|
||||
(defun get-git-upstream ()
|
||||
;; taken from http://stackoverflow.com/a/9753364/70293
|
||||
(let ((upstream (run "git rev-parse --abbrev-ref --symbolic-full-name @{u}" :raise nil)))
|
||||
(when (> (length upstream)
|
||||
0)
|
||||
(subseq upstream
|
||||
0
|
||||
(search "/" upstream)))))
|
||||
|
||||
|
||||
(defun get-origin-to-push ()
|
||||
(let ((upstream (get-git-upstream)))
|
||||
|
||||
(cond
|
||||
(upstream
|
||||
;; If there is already some remote upstream, then use it
|
||||
(run (concatenate 'string "git remote get-url " upstream)))
|
||||
;; If we are running inside github actions
|
||||
((uiop:getenv "GITHUB_ACTIONS")
|
||||
(unless (uiop:getenv "GITHUB_TOKEN")
|
||||
(error 'unable-to-proceed
|
||||
:message "Please, provide GITHUB_TOKEN environment variable."))
|
||||
(format nil "https://~A:~A@github.com/~A"
|
||||
(uiop:getenv "GITHUB_ACTOR")
|
||||
(uiop:getenv "GITHUB_TOKEN")
|
||||
(uiop:getenv "GITHUB_REPOSITORY")))
|
||||
;; otherwise make it from travis secret token and repo slug
|
||||
(t
|
||||
(let ((repo-slug (uiop:getenv "TRAVIS_REPO_SLUG"))
|
||||
(repo-token (uiop:getenv "GH_REPO_TOKEN")))
|
||||
|
||||
(unless (and repo-slug repo-token)
|
||||
(error 'unable-to-proceed
|
||||
:message "Current branch does not track any upstream and there is no TRAVIS_REPO_SLUG and GH_REPO_TOKEN env variables. Where to push gh-pages branch?"))
|
||||
|
||||
(format nil "https://~A@github.com/~A"
|
||||
repo-token
|
||||
repo-slug))))))
|
||||
|
||||
|
||||
(defun push-gh-pages ()
|
||||
(log:info "Pushing changes to gh-pages branch")
|
||||
|
||||
(unless (gh-pages-repository-initialized-p)
|
||||
(git "init")
|
||||
|
||||
(git "remote add origin "
|
||||
(get-origin-to-push)))
|
||||
|
||||
(git "add .")
|
||||
|
||||
(cond
|
||||
((git-repository-was-changed-p)
|
||||
(when (uiop:getenv "GITHUB_ACTIONS")
|
||||
(git "config --global user.name \"github-actions[bot]\"")
|
||||
(git "config --global user.email \"actions@github.com\""))
|
||||
(git "commit -m 'Update docs'")
|
||||
|
||||
(git "push --force origin master:gh-pages"))
|
||||
;; or
|
||||
(t (log:info "Everything is up to date."))))
|
||||
|
||||
|
||||
(defun main (&rest argv)
|
||||
(declare (ignorable argv))
|
||||
(log:config :debug)
|
||||
(log:info "Building documentation")
|
||||
|
||||
(handler-bind ((error (lambda (condition)
|
||||
(uiop:print-condition-backtrace condition :stream *error-output*)
|
||||
(uiop:quit 1))))
|
||||
(build-docs)
|
||||
(push-gh-pages)))
|
||||
|
|
@ -1,168 +0,0 @@
|
|||
(defpackage #:example-docs/docs
|
||||
(:nicknames #:example-docs)
|
||||
(:use #:cl)
|
||||
(:import-from #:mgl-pax
|
||||
#:section
|
||||
#:defsection)
|
||||
(:import-from #:example/app
|
||||
#:@app)
|
||||
(:import-from #:example/utils
|
||||
#:@utils)
|
||||
(:export
|
||||
#:build-docs))
|
||||
(in-package example-docs/docs)
|
||||
|
||||
|
||||
(defsection @index (:title "Example of MGL-PAX Common Lisp Documentation Builder")
|
||||
"
|
||||
This is small library includes a few functions with docstrings and a documentation
|
||||
for the system and all included packages.
|
||||
|
||||
The purpose is to demonstrate core features of the
|
||||
[MGL-PAX](http://melisgl.github.io/mgl-pax/) documentation builder.
|
||||
|
||||
This repository is part of the <https://github.com/cl-doc-systems> organization,
|
||||
created to compare different Common Lisp documentation systems.
|
||||
|
||||
The goal is make it easier for CL software developers to choose proper
|
||||
documentation system and to improve docs in their software!
|
||||
|
||||
Resulting documentation can be viewed here:
|
||||
|
||||
<https://cl-doc-systems.github.io/mgl-pax/>
|
||||
|
||||
The repository can be used as a template for new libraries if you've choosen `MGL-PAX`
|
||||
for documenting your library.
|
||||
|
||||
Let's review features, provided by `MGL-PAX`.
|
||||
|
||||
"
|
||||
(@pros-n-cons section)
|
||||
(@how-to-build section)
|
||||
(@handwritten section)
|
||||
(@autogenerated section)
|
||||
(@packages section))
|
||||
|
||||
|
||||
(defsection @pros-n-cons (:title "Pros & Cons of PAX")
|
||||
(@pros section)
|
||||
(@cons section))
|
||||
|
||||
|
||||
(defsection @pros (:title "Pros")
|
||||
"
|
||||
* Markdown is widely used markup format and PAX uses it everywhere.
|
||||
* Cross-referencing works like a charm and you can reference different
|
||||
types of objects using [Locatives](http://melisgl.github.io/mgl-pax/#x-28MGL-PAX-3A-40MGL-PAX-LOCATIVES-AND-REFERENCES-20MGL-PAX-3ASECTION-29).
|
||||
* New types of documentation objects can be defined in Common Lisp using CLOS.
|
||||
Here is [an example](http://melisgl.github.io/mgl-pax/#x-28MGL-PAX-3AREFERENCE-LOCATIVE-20-28MGL-PAX-3AREADER-20MGL-PAX-3AREFERENCE-29-29).
|
||||
* Emacs/SLIME integration and ability to jump to a xref objects using M-.
|
||||
* Ability to generate Markdown README files as well as HTML.
|
||||
* It is possible to link documentation and sources on the GitHub.
|
||||
* Docstrings deindentation allows to format code nicely.
|
||||
* You can generation docs for a multiple ASDF systems with cross-referencing.
|
||||
* Autoexports all documented symbols. No need to enumerate them in `defpackage` form.
|
||||
* There is a nice default HTML theme.
|
||||
* No external tools like Sphinx. Everything is in Common Lisp.
|
||||
")
|
||||
|
||||
|
||||
(defsection @cons (:title "Cons")
|
||||
"
|
||||
* Markdown format may be somewhat limited and probably it can be non-trivial or not possible
|
||||
to extend it in some rare cases.
|
||||
* The recommended way to mix documentation section with code leads to
|
||||
the runtime dependency from PAX and all it's dependencies. But you
|
||||
might define documentation as a separate ASDF system.
|
||||
* PAX does not notifies you if some references are missing or there are unused sections.
|
||||
These mistakes can be catched automatically.
|
||||
* It is inconvenient to write Markdown in docstrings. Is there any way
|
||||
to teach Emacs to use markdown minor mode for documentation strings?
|
||||
* There is no magically autogenerated reference API. See @AUTOGENERATED.
|
||||
|
||||
But if you prefer another way, it should be easy to write a function which
|
||||
will collect external symbols and generate a MGL-PAX:SECTION object for them.
|
||||
")
|
||||
|
||||
|
||||
(defsection @how-to-build (:title "How to build the documentation")
|
||||
"
|
||||
MGL-PAX has a number of ways for generation of the docs. But most probably,
|
||||
you'll need only toplevel helpers described in it's section
|
||||
[Generating Documentation](http://melisgl.github.io/mgl-pax/#toc-7-generating-documentation).
|
||||
|
||||
These helpers is able to generate README and HTML docs for an ASDF system.
|
||||
|
||||
This example defines it's own wrapper EXAMPLE-DOCS:BUILD-DOCS:
|
||||
"
|
||||
(build-docs function)
|
||||
|
||||
"
|
||||
It is as simple, as:
|
||||
|
||||
|
||||
```
|
||||
(defun build-docs ()
|
||||
(mgl-pax:update-asdf-system-readmes @index :example)
|
||||
|
||||
(mgl-pax:update-asdf-system-html-docs @index :example
|
||||
:target-dir \"docs/build/\"))
|
||||
```
|
||||
|
||||
This function is used by docs/scripts/build.ros file to generate documentation from GitHub Actions.
|
||||
Or can be called from the REPL.
|
||||
")
|
||||
|
||||
|
||||
(defsection @handwritten (:title "Handwritten Documentation")
|
||||
"
|
||||
I think the ability to write a large pieces of documentation which aren't bound to
|
||||
a function, class or module is an important feature. This way you can tell the user
|
||||
about some toplevel abstractions and give a bird eye view on the library or system.
|
||||
|
||||
For example, handwritten parts of the documentation can provide some code snippets
|
||||
to demonstrate the ways, how to use the library:
|
||||
|
||||
```
|
||||
(loop repeat 42
|
||||
collect (foo \"bar\" 100500))
|
||||
```
|
||||
|
||||
And when you are talking about some function or class, you can reference it.
|
||||
For example, if I'm talking about the FOO function, I can reference it like this
|
||||
`[example/app:foo][function]` and it will appear in the code as
|
||||
the link [example/app:foo]. In most cases you can omit square brakets and just
|
||||
capitalize symbol name.
|
||||
|
||||
Comparing MGL-PAX to Coo (here is it's [example project](https://cl-doc-systems.github.io/coo/),
|
||||
I'd prefer the PAX, because it's ability to mix handwriten sections with documentation extracted
|
||||
from docstrings.
|
||||
|
||||
")
|
||||
|
||||
|
||||
(defsection @autogenerated (:title "Autogenerated API Reference")
|
||||
"
|
||||
There is no magically autogenerated reference API. Idea of PAX is that you
|
||||
write docs manually and reference documented symbols. They are automatically
|
||||
exported and this way you library's external API should be documented.
|
||||
|
||||
But if you prefer another way, it should be easy to write a function which
|
||||
will collect external symbols and generate a MGL-PAX:SECTION object for them.
|
||||
")
|
||||
|
||||
(defsection @packages (:title "Packages")
|
||||
(@app section)
|
||||
(@utils section))
|
||||
|
||||
|
||||
(defun build-docs ()
|
||||
(mgl-pax:update-asdf-system-readmes @index :example)
|
||||
|
||||
(mgl-pax:update-asdf-system-html-docs
|
||||
@index :example
|
||||
:target-dir "docs/build/"
|
||||
:pages `((:objects (,example-docs:@index)
|
||||
:source-uri-fn ,(pax:make-github-source-uri-fn
|
||||
:example
|
||||
"https://github.com/cl-doc-systems/mgl-pax")))))
|
||||
2
qlfile
2
qlfile
|
|
@ -1,2 +0,0 @@
|
|||
dist ultralisp http://dist.ultralisp.org
|
||||
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
("quicklisp" .
|
||||
(:class qlot/source/dist:source-dist
|
||||
:initargs (:distribution "http://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest)
|
||||
:version "2021-01-24"))
|
||||
("ultralisp" .
|
||||
(:class qlot/source/dist:source-dist
|
||||
:initargs (:distribution "http://dist.ultralisp.org" :%version :latest)
|
||||
:version "20210206084500"))
|
||||
|
|
@ -1,38 +0,0 @@
|
|||
#!/bin/sh
|
||||
#|-*- mode:lisp -*-|#
|
||||
#|
|
||||
exec ros -Q -- $0 "$@"
|
||||
|#
|
||||
(progn ;;init forms
|
||||
(ros:ensure-asdf)
|
||||
#+quicklisp (ql:quickload '(cl-info
|
||||
defmain)
|
||||
:silent t))
|
||||
|
||||
(defpackage :ros.script.cl-info
|
||||
(:use :cl)
|
||||
(:import-from #:cl-info/core
|
||||
#:get-cl-info
|
||||
#:get-system-info)
|
||||
(:import-from #:defmain
|
||||
#:defmain))
|
||||
(in-package :ros.script.cl-info)
|
||||
|
||||
|
||||
(defmain main ((version "Show program version and exit."
|
||||
:flag t)
|
||||
&rest system)
|
||||
"Show information about Lisp implementation and given systems. Useful when collecting information for bugreports."
|
||||
|
||||
(when version
|
||||
(let* ((system (asdf:find-system :cl-info))
|
||||
(version (asdf:component-version system)))
|
||||
(format t "Version: ~A~%" version)
|
||||
(uiop:quit 0)))
|
||||
|
||||
(princ (get-cl-info))
|
||||
|
||||
(loop for system-name in system
|
||||
do (princ (get-system-info system-name))))
|
||||
|
||||
;;; vim: set ft=lisp lisp:
|
||||
195
src/core.lisp
195
src/core.lisp
|
|
@ -1,195 +0,0 @@
|
|||
(defpackage #:cl-info
|
||||
(:nicknames #:cl-info/core)
|
||||
(:use #:cl)
|
||||
(:import-from #:mgl-pax-minimal
|
||||
#:defsection
|
||||
#:reader)
|
||||
(:export #:cl-info
|
||||
#:get-cl-info
|
||||
#:get-system-info))
|
||||
(in-package cl-info/core)
|
||||
|
||||
|
||||
(defsection @index (:title "CL-INFO - Common Lisp Environment Reporter")
|
||||
"
|
||||
[](https://github.com/40ants/cl-info/actions)
|
||||
|
||||
This is a small utility, useful to display information about you Common
|
||||
Lisp environment. You might want to call it in the CI pipeline or
|
||||
to use it when rendering a crash report in some client applications.
|
||||
|
||||
Usage from Common Lisp
|
||||
======================
|
||||
|
||||
It's main entry point is CL-INFO:GET-CL-INFO function. It returns an object with
|
||||
customized PRINT-OBJECT method. You can use it to output debug
|
||||
information in your programs.
|
||||
|
||||
CL-INFO collects inforrmation about OS, Lisp Implementation, ASDF, installed
|
||||
Quicklisp distributions:
|
||||
|
||||
CL-USER> (cl-info:get-cl-info)
|
||||
OS: Darwin 15.6.0
|
||||
Lisp: SBCL 1.4.8
|
||||
ASDF: 3.3.1.1
|
||||
QL: ceramic github-e0d905187946f8f2358f7b05e1ce87b302e34312
|
||||
cl-prevalence github-c163c227ed85d430b82cb1e3502f72d4f88e3cfa
|
||||
log4cl-json github-c4f786e252d89a45372186aaf32fb8e8736b444b
|
||||
log4cl github-6a857b0b41c030a8a3b04096205e221baaa1755f
|
||||
quicklisp 2018-04-30
|
||||
slynk github-3314cf8c3021cb758e0e30fe3ece54accf1dcf3d
|
||||
weblocks-lass github-1b043afbf2f3e84e495dfeae5e63fe67a435019f
|
||||
weblocks-parenscript github-8ef4ca2f837403a05c4e9b92dcf1c41771d16f17
|
||||
weblocks-ui github-5afdf238534d70edc2447d0bc8bc63da8e35999f
|
||||
weblocks-websocket github-b098db7f179dce3bfb045afd4e35e7cc868893f0
|
||||
weblocks github-282483f97d6ca351265ebfebb017867c295d01ad
|
||||
websocket-driver github-a3046b11dfb9803ac3bff7734dd017390c2b54bb
|
||||
CL-USER>
|
||||
|
||||
Also, you can gather information about separate systems using CL-INFO:GET-SYSTEM-INFO
|
||||
function:
|
||||
|
||||
CL-USER> (cl-info:get-system-info :hamcrest)
|
||||
System: HAMCREST 0.4.2
|
||||
/Users/art/common-lisp/cl-hamcrest/src/
|
||||
|
||||
|
||||
Usage From Command-line
|
||||
=======================
|
||||
|
||||
Also, you can use CL-INFO as a command-line utility. It is useful to
|
||||
output information about common lisp environment running on CI server.
|
||||
|
||||
Here is how to do it:
|
||||
|
||||
```shell
|
||||
# Here we use a Roswell, to install utility
|
||||
[art@art-osx:~]% ros install 40ants/cl-info
|
||||
|
||||
# And now request information about lisp and some systems
|
||||
[art@art-osx:~]% cl-info weblocks clack jonathan some-other-system
|
||||
OS: Darwin 15.6.0
|
||||
Lisp: Clozure Common Lisp Version 1.11.5/v1.11.5 (DarwinX8664)
|
||||
ASDF: 3.3.1.1
|
||||
QL: org.borodust.bodge 20180214223017
|
||||
quicklisp 2017-10-23
|
||||
System: weblocks 0.31.1
|
||||
/Users/art/common-lisp/weblocks/src/
|
||||
System: clack 2.0.0
|
||||
/Users/art/common-lisp/clack/
|
||||
System: jonathan 0.1
|
||||
/Users/art/.roswell/lisp/quicklisp/dists/quicklisp/software/jonathan-20170630-git/
|
||||
System: some-other-system is not available
|
||||
```
|
||||
|
||||
API Reference
|
||||
=============
|
||||
"
|
||||
(get-cl-info function)
|
||||
(get-system-info function)
|
||||
|
||||
(cl-info class)
|
||||
(get-asdf-version (reader cl-info))
|
||||
|
||||
(system-info class))
|
||||
|
||||
|
||||
(defclass cl-info ()
|
||||
((asdf-version :initform (asdf:asdf-version)
|
||||
:reader get-asdf-version
|
||||
:documentation "Returns ASDF version.")
|
||||
(lisp-type :initform (lisp-implementation-type)
|
||||
:reader get-lisp-type)
|
||||
(lisp-version :initform (lisp-implementation-version)
|
||||
:reader get-lisp-version)
|
||||
(software-type :initform (software-type)
|
||||
:reader get-software-type)
|
||||
(software-version :initform (software-version)
|
||||
:reader get-software-version)
|
||||
#+quicklisp
|
||||
(ql-dists :initform (ql-dist:all-dists)
|
||||
:reader get-ql-dists)))
|
||||
|
||||
|
||||
#-quicklisp
|
||||
(defun get-ql-dists (obj)
|
||||
nil)
|
||||
|
||||
|
||||
(defclass system-info ()
|
||||
((name :initarg :name
|
||||
:reader get-name)
|
||||
(version :initarg :version
|
||||
:reader get-version)
|
||||
(path :initarg :path
|
||||
:reader get-path)
|
||||
(absent :initarg :absent
|
||||
:initform nil
|
||||
:reader absent-p)))
|
||||
|
||||
|
||||
(defmethod print-object ((info cl-info) stream)
|
||||
(format stream
|
||||
"OS: ~A ~A
|
||||
Lisp: ~A ~A
|
||||
ASDF: ~A
|
||||
"
|
||||
(get-software-type info)
|
||||
(get-software-version info)
|
||||
(get-lisp-type info)
|
||||
(get-lisp-version info)
|
||||
(get-asdf-version info))
|
||||
#-quicklisp
|
||||
(format stream
|
||||
"QL: is not available~%")
|
||||
#+quicklisp
|
||||
(format stream
|
||||
"QL: ~{~A~^~%~}~%"
|
||||
(loop for dist in (get-ql-dists info)
|
||||
for idx upfrom 0
|
||||
collect (format nil "~:[~; ~]~A ~A"
|
||||
(> idx 0)
|
||||
(ql-dist:name dist)
|
||||
(ql-dist:version dist)))))
|
||||
|
||||
|
||||
(defmethod print-object ((info system-info) stream)
|
||||
(if (absent-p info)
|
||||
(format stream
|
||||
"System: ~A is not available~%"
|
||||
(get-name info))
|
||||
(format stream
|
||||
"System: ~A ~A
|
||||
~A~%"
|
||||
(get-name info)
|
||||
(get-version info)
|
||||
(get-path info))))
|
||||
|
||||
|
||||
(defun get-cl-info ()
|
||||
"Returns information about lisp implementation, asdf and quicklisp."
|
||||
(make-instance 'cl-info))
|
||||
|
||||
|
||||
(defun get-system-info (system-name)
|
||||
(let ((system (block search-for-system
|
||||
(handler-bind ((asdf:missing-component
|
||||
(lambda (c)
|
||||
(declare (ignorable c))
|
||||
(return-from search-for-system nil)))
|
||||
(asdf:system-out-of-date
|
||||
(lambda (c)
|
||||
(declare (ignorable c))
|
||||
(invoke-restart 'continue))))
|
||||
(asdf:find-system system-name)))))
|
||||
|
||||
(if system
|
||||
(make-instance 'system-info
|
||||
:name system-name
|
||||
:version (asdf:component-version system)
|
||||
:path (asdf:component-pathname system))
|
||||
(make-instance 'system-info
|
||||
:name system-name
|
||||
:absent t
|
||||
:version nil
|
||||
:path nil))))
|
||||
20
t/core.lisp
20
t/core.lisp
|
|
@ -1,20 +0,0 @@
|
|||
(defpackage #:cl-info-test/core
|
||||
(:use #:cl)
|
||||
(:import-from #:cl-info)
|
||||
(:import-from #:hamcrest/rove
|
||||
#:contains
|
||||
#:assert-that)
|
||||
(:import-from #:rove
|
||||
#:testing
|
||||
#:deftest))
|
||||
(in-package cl-info-test/core)
|
||||
|
||||
|
||||
(defun foo (a b)
|
||||
(list a b))
|
||||
|
||||
|
||||
(deftest test-some-staff
|
||||
(testing "Replace this test with real staff."
|
||||
(assert-that (foo 1 2)
|
||||
(contains 1 2))))
|
||||
|
|
@ -1 +0,0 @@
|
|||
"0.4.0"
|
||||
Loading…
Reference in a new issue