From d534f9303738e2bd39b666645d11dc3cf5e1c85a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simen=20Endsj=C3=B8?= Date: Fri, 1 Mar 2024 16:27:19 +0100 Subject: [PATCH] Initial commit --- .github/workflows/tests.yaml | 30 ++++ .gitignore | 18 ++ CHANGELOG.org | 22 +++ LICENSE | 201 +++++++++++++++++++++++ README.org | 192 ++++++++++++++++++++++ VERSION | 1 + sijo-version.asd | 24 +++ src/packages.lisp | 11 ++ src/sequence.lisp | 50 ++++++ src/version.lisp | 307 +++++++++++++++++++++++++++++++++++ tests/version.lisp | 24 +++ 11 files changed, 880 insertions(+) create mode 100644 .github/workflows/tests.yaml create mode 100644 .gitignore create mode 100644 CHANGELOG.org create mode 100644 LICENSE create mode 100644 README.org create mode 100644 VERSION create mode 100644 sijo-version.asd create mode 100644 src/packages.lisp create mode 100644 src/sequence.lisp create mode 100644 src/version.lisp create mode 100644 tests/version.lisp diff --git a/.github/workflows/tests.yaml b/.github/workflows/tests.yaml new file mode 100644 index 0000000..effacfb --- /dev/null +++ b/.github/workflows/tests.yaml @@ -0,0 +1,30 @@ +on: [push] +jobs: + tests: + strategy: + matrix: + os: + - ubuntu-latest + # - macos-latest + # - windows-latest + lisp: + - sbcl-bin + # - ecl + # - ccl-bin + # - abcl-bin + # - clasp-bin + # - cmu-bin + # - clisp-head + runs-on: ${{ matrix.os }} + env: + LISP: ${{ matrix.lisp }} + steps: + - uses: actions/checkout@v4 + - uses: 40ants/setup-lisp@v4 + with: + asdf-system: sijo-version + qlfile-template: | + dist ultralisp http://dist.ultralisp.org + - uses: 40ants/run-tests@v2 + with: + asdf-system: sijo-version/tests diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..67ede59 --- /dev/null +++ b/.gitignore @@ -0,0 +1,18 @@ +*.FASL +*.fas +*.fasl +*.lisp-temp +*.dfsl +*.pfsl +*.d64fsl +*.p64fsl +*.lx64fsl +*.lx32fsl +*.dx64fsl +*.dx32fsl +*.fx64fsl +*.fx32fsl +*.sx64fsl +*.sx32fsl +*.wx64fsl +*.wx32fsl diff --git a/CHANGELOG.org b/CHANGELOG.org new file mode 100644 index 0000000..07568a2 --- /dev/null +++ b/CHANGELOG.org @@ -0,0 +1,22 @@ +* Changelog +All notable changes to this project will be documented in this file. + +The format is based on [[https://keepachangelog.com/en/1.1.0][Keep a Changelog]], and this project *DOES NOT* adhere to [[https://semver.org/spec/v2.0.0.html][Semantic +Versioning]]. + +** 0.1.0 - 2024-03-11 +*** Added +- ~version~ :: construct a semantic version +- ~version-file-line-0~ :: fetches the first line from the =VERSION= file +- ~version-file-line-1~ :: fetches the second line from the =VERSION= file +- ~system-version~ :: the =:version= field from system we're calculating + the version from +- ~current-time~ :: current time +- ~git-non-main-branch~ :: git branch if it's the non-main/non-master branch +- ~git-current-branch~ :: current git branch +- ~git-current-commit~ :: current git commit +*** Changed +*** Deprecated +*** Removed +*** Fixed +*** Security diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..8eab285 --- /dev/null +++ b/LICENSE @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright 2024 Simen Endsjø + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/README.org b/README.org new file mode 100644 index 0000000..8295844 --- /dev/null +++ b/README.org @@ -0,0 +1,192 @@ +Semantic version for your systems. Opinionated defaults, but flexible. + +See [[file:CHANGELOG.org][CHANGELOG]]. + +* Installation +Clone repository +#+begin_src bash :eval never +git clone git@github.com:simendsjo/sijo-version.git ~/quicklisp/local-projects/sijo-version +#+end_src + +* Use +Load library +#+begin_src lisp :exports code +(ql:quickload :sijo-version) +#+end_src + +#+RESULTS: +| :SIJO-VERSION | + +Call ~version~ to get a calculated semver version. + +#+begin_src lisp :exports both :eval never +(sijo-version:version) +#+end_src + +#+RESULTS: +: 0.1.0-0.dev.27+prototype.7aeedb4d32927e19a5e9ed406ac5735db0fd20dd.20240301145715Z + +When supplying the values manually, those will be used instead + +#+begin_src lisp :exports both +(sijo-version:version :version "1.2.3" :pre-release nil :build-metadata nil) +#+end_src + +#+RESULTS: +: 1.2.3 + +#+begin_src lisp :exports both +(sijo-version:version :version "1.2.3" :pre-release "some-prerelease" :build-metadata nil) +#+end_src + +#+RESULTS: +: 1.2.3-some-prerelease + +#+begin_src lisp :exports both +(sijo-version:version :version "1.2.3" :pre-release "some-prerelease" :build-metadata "some-build-info") +#+end_src + +#+RESULTS: +: 1.2.3-some-prerelease+some-build-info + +* Documentation for ~version~ + +Warning: This is bound to get out of date, so look at the documentation in the source. + +#+begin_src lisp :exports results +(setf (cdr (assoc 'slynk:*string-elision-length* slynk:*slynk-pprint-bindings*)) nil) +(documentation 'sijo-version:version 'function) +#+end_src + +#+RESULTS: +#+begin_example +Construct a semantic version (https://semver.org/) + +Note that minimal effort is made validating or sanitizing the input, so the user +is able to construct an incorrect semantic version e.g. by supplying too many +components to :VERSION. Some sanitizing is done by dropping invalid characters. + +Calling `version' will construct a default semantic version based on the VERSION +file, ./.git/HEAD and the current time. + +If no VERSION file exists, the asdf components :VERSION will be used for the +version number. + +If no version is found, 0.0.0 is used as the version. + +The VERSION file should contain the version number in the first line, and an +optional pre-release tag in the second line. If no pre-release tag exist in the +file, the default is to add the git branch name iff it's not the main/master +branch. + +VERSION, PRE-RELEASE and BUILD-METADATA is evaluated by `%eval-spec' into a +dotted string, and has the following semantics: +- `string' :: use as-is - it's the canonical form +- `list' ('if as first element) :: call `%eval-spec' on the second element. If + true, return `%eval-spec' of the third element, otherwise return `%eval-spec' + of the fourth element. +- `list' ('when as first element) :: call `%eval-spec' on the second element. If + true, return `%eval-spec' of the third element, otherwise return nil. +- `list' ('unless as first element) :: call `%eval-spec' on the second element. If + false, return `%eval-spec' of the third element, otherwise return nil. +- `list' ('or as first element) :: call `%eval-spec' on second element. If + non-nil, return it, otherwise evaluate next element. If there are no more + elements, return nil. +- `list' ('and as first element) :: call `%eval-spec' on subsequent elements, + remove nulls, and join with "-" as the separator. +- `list' :: call `%eval-spec' on each element, remove nulls, and join with "." as a separator. +- `function' :: call function pass result to `%eval-spec' +- `symbol' :: if `fboundp', call function and pass result to `%eval-spec'. If + `boundp' call `%eval-spec' on `symbol-value'. Otherwise call `%eval-spec' on + the `symbol-name'. +- `atom' :: convert to a string + +ROOT is the root folder where the VERSION file and .git directory is located. +The value is evaluated by `%guess-root', and several different forms is +accepted: +- `pathname' :: use as-is - it's the canonical form +- `asdf:system' :: `asdf:system-relative-pathname' is used as the root +- `package' :: try to load a system with the same name as `package-name'. If no + system is found, `*default-pathname-defaults*' is used. +- `null' :: we guess given `*package*' instead +- `string' :: try to load a system, if missing interpret the input as a `pathname' instead +- `symbol' :: try to guess using the symbol as the system name + +Examples: + +`(version)' +"0.1+main.748e8897a233ddbc26a959bd14a97acb0ef5b895.20240301152751Z" + +You can specify the system it should fetch information from directly using `:root' + +`(version :root :sijo-version)' +"0.1+main.748e8897a233ddbc26a959bd14a97acb0ef5b895.20240301152751Z" + +You can remove the use of extra build metadata + +`(version :build-metadata nil)' +"0.1-some-prerelease" + +You can specify the exact version and pre-release tag to use instead of looking in VERSION + +>> (version :version "0.1" :pre-release nil :build-metadata nil) +"0.1" + +>> (version :version "0.1" :pre-release "pre" :build-metadata nil) +"0.1-pre" + +>> (version :version "0.1" :pre-release nil :build-metadata "build") +"0.1+build" + +>> (version :version "0.1" :pre-release "pre" :build-metadata "build") +"0.1-pre+build" +#+end_example + +* Troubleshooting +** Component "some-package" not found +~version~ tries to find out what the current system is by looking at +~(package-name *package*)~. If you're calling ~version~ from a package not named +the same as a system, it will fail. + +#+begin_src lisp :exports both :eval never +(in-package :common-lisp-user) +(sijo-version:version) +#+end_src + +#+RESULTS: +: Component "common-lisp-user" not found +: [Condition of type ASDF/FIND-COMPONENT:MISSING-COMPONENT] + +In that case, you need to set ~:system~ yourself: + +#+begin_src lisp :exports both :eval never +(in-package :common-lisp-user) +(sijo-version:version :system :my-system) +#+end_src + +#+RESULTS: +: 0.1+main.7aeedb4d32927e19a5e9ed406ac5735db0fd20dd.20240301151319Z + +** Using =VERSION= in ~defsystem~ +ASDF can read use the version from your =VERSION= file directly with the +following syntax: + +#+begin_src lisp :eval never +(defsystem :my-system + ;; ... + :version (:read-file-line "VERSION" :at 0)) +#+end_src + +* Versioning +** =VERSION= file +The file should include =major.minor.patch= on the first line, and an optional +=pre-release= tag on the second line. + +** Build information +The system assumes the project is using =git= by default, and will construct +build information as follows: =branch.commit.timestamp= + +- =branch= is the current branch by reading =.git/HEAD= +- =commit= is the current commit in =.git/HEAD= or by following the ref there +- =timestamp= is a timestamp when calling the ~version~ function in the + =yyyyMMddHHmmssZ= format diff --git a/VERSION b/VERSION new file mode 100644 index 0000000..6e8bf73 --- /dev/null +++ b/VERSION @@ -0,0 +1 @@ +0.1.0 diff --git a/sijo-version.asd b/sijo-version.asd new file mode 100644 index 0000000..5b74b9f --- /dev/null +++ b/sijo-version.asd @@ -0,0 +1,24 @@ +(defsystem :sijo-version + :depends-on () + :in-order-to ((test-op (test-op :sijo-version/tests))) + :version (:read-file-line "VERSION" :at 0) + :serial t + :pathname "src/" + :components ((:file "packages") + (:file "sequence") + (:file "version"))) + +(defsystem :sijo-version/tests + :depends-on (#:sijo-version + #:str + #:lisp-unit2 + #:sijo-doctest) + :perform (test-op (o c) + (eval (read-from-string " + (lisp-unit2:with-summary () + (lisp-unit2:run-tests + :package :sijo-version/tests + :name :sijo-version))"))) + :serial t + :pathname "tests/" + :components ((:file "version"))) diff --git a/src/packages.lisp b/src/packages.lisp new file mode 100644 index 0000000..7ac04c2 --- /dev/null +++ b/src/packages.lisp @@ -0,0 +1,11 @@ +(defpackage :sijo-version + (:use #:cl) + (:export #:version + ;; Helpers for constructing the semver + #:version-file-line-0 + #:version-file-line-1 + #:system-version + #:current-time + #:git-non-main-branch + #:git-current-branch + #:git-current-commit)) diff --git a/src/sequence.lisp b/src/sequence.lisp new file mode 100644 index 0000000..384d900 --- /dev/null +++ b/src/sequence.lisp @@ -0,0 +1,50 @@ +;; These functions is to avoid a dependency on the str library. +(in-package :sijo-version) + +(defun split (needle haystack &aux result) + (when (eql 0 (length needle)) + (return-from split (list haystack))) + (do ((pos (search needle haystack) (search needle haystack))) + ((null pos) (if haystack + (nreverse (cons haystack result)) + (nreverse result))) + (setf result (cons (subseq haystack 0 pos) result)) + (setf haystack (subseq haystack (+ pos (length needle)))))) + +(defun intersperse (separator seq &aux result) + (do ((rest seq (subseq rest 1))) + ((or (null rest) (eql 0 (length rest))) (nreverse result)) + (push (elt rest 0) result) + (when (subseq rest 1) + (push separator result)))) + +(defun concat (sequence) + (let ((first (first sequence))) + (typecase first + (string (apply #'concatenate 'string sequence)) + (array + ;; It might have a specific length, but we want a variable length as the result + (apply #'concatenate (append (subseq (type-of first) 0 2) '((*))) sequence)) + (t (apply #'concatenate (type-of first) sequence))))) + +(defun join (separator sequence) + (concat (intersperse separator sequence))) + +(defun remove-all (needle haystack) + (concat (split needle haystack))) + +(defun replace-all (old new haystack) + (join new (split old haystack))) + +(defun starts-with (prefix sequence &key (test #'eql)) + (unless sequence + (return-from starts-with nil)) + (let ((prefix-length (length prefix))) + (if (> prefix-length (length sequence)) + (return-from starts-with nil)) + (eql 0 (search prefix sequence :test test :end2 prefix-length)))) + +(defun without-prefix (prefix sequence &key (test #'eql)) + (if (starts-with prefix sequence :test test) + (values (subseq sequence (length prefix)) t) + (values sequence nil))) diff --git a/src/version.lisp b/src/version.lisp new file mode 100644 index 0000000..0083925 --- /dev/null +++ b/src/version.lisp @@ -0,0 +1,307 @@ +(in-package :sijo-version) + +(defparameter *root* nil) +(defparameter *system* nil) + +(defun %guess-system (root) + (etypecase root + (null nil) + (asdf:system root) + (pathname + (if (string-equal (pathname-type root) "asd") + (handler-case (progn (asdf:load-asd root) + (asdf:find-system (string-downcase (pathname-name root)))) + (error () + nil)) + (let ((asd-files (uiop:directory-files root "*.asd"))) + (if asd-files + (%guess-system (car asd-files)) + nil)))) + (package + ;; System with same name? + (handler-case (asdf:find-system (string-downcase (package-name root))) + (error () + nil))) + (string + ;; System name? + (handler-case (asdf:find-system (string-downcase root)) + ;; Filename? + (asdf:load-system-definition-error () + (%guess-system (uiop:parse-native-namestring root))))) + (symbol + (handler-case (asdf:find-system root) + (error () + nil))))) + +(defun %guess-root (root) + (etypecase root + (null + (%guess-root *package*)) + (pathname + root) + (asdf:system + (asdf:system-relative-pathname root "")) + (package + (handler-case (%guess-root (asdf:find-system (string-downcase (package-name root)))) + (asdf:missing-component () + *default-pathname-defaults*))) + (string + (handler-case (asdf:find-system (string-downcase root)) + ;; Treat as path + (error () + (uiop:parse-native-namestring root)))) + (symbol + (handler-case (%guess-root (asdf:find-system root)) + (error () + *default-pathname-defaults*))))) + +(defmacro %with-root (root &body body) + (let ((value (gensym "WITH-ROOT-"))) + `(let* ((,value ,root) + (*root* (%guess-root ,value)) + (*system* (%guess-system ,value))) + ,@body))) + +(defun %version (version pre-release build-metadata) + (let ((version (or version "0.0.0")) + (pre-release (if pre-release + (format nil "-~a" pre-release) + "")) + (build-metadata (if build-metadata + (format nil "+~a" build-metadata) + ""))) + (format nil "~a~a~a" version pre-release build-metadata))) + +(defun %filename (filename) + (merge-pathnames filename (%guess-root *root*))) + +(defun %existing-file (filename) + (probe-file (%filename filename))) + +(defun %git-head () + (let ((git-head (%existing-file ".git/HEAD"))) + (when git-head + (uiop:read-file-line git-head)))) + +(defun %git-ref (ref) + (let ((git-ref (%existing-file (format nil ".git/~a" ref)))) + (when git-ref + (uiop:read-file-line git-ref)))) + +(defun git-current-branch () + "Return the current git branch, or nil if not found." + (let ((git-head (%git-head))) + (multiple-value-bind (ref ref?) (without-prefix "ref: " git-head) + (if ref? + (car (last (split "/" ref))) + nil)))) + +(defun git-current-commit () + "Return the current git commit, or nil if not found." + (let ((git-head (%git-head))) + (multiple-value-bind (ref ref?) (without-prefix "ref: " git-head) + (if ref? + (%git-ref ref) + ref)))) + +(defun %semver-identifier-char-p (char) + (find char "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-" :test #'eql)) + +(defun %eval-spec (spec) + "See `version' for documentation." + (etypecase spec + (null nil) + (string (let* ((spec (remove-if-not + ;; Remove invalid characters. We allow dot as people + ;; might pass a dot-separated identifier instead of a + ;; list. + (lambda (char) + (or (eql char #\.) + (%semver-identifier-char-p char))) + spec)) + ;; Identifiers shouldn't start or end with separators + (spec (string-trim ".-" spec)) + ;; Avoid empty parts, e.g. "a..b" or "a--b" + (spec (replace-all "--" "-" spec)) + (spec (replace-all ".." "." spec))) + (if (zerop (length spec)) + nil + spec))) + (list (cond + ((eq 'quote (car spec)) + (%eval-spec (prin1-to-string (cdr spec)))) + ((eq 'or (car spec)) + (labels ((run (test rest) + (let ((result (%eval-spec test))) + (cond + (result result) + (rest (run (car rest) (cdr rest))) + (t nil))))) + (run (cadr spec) (cddr spec)))) + ((eq 'and (car spec)) + (let ((values (remove-if #'null (mapcar #'%eval-spec (cdr spec))))) + (if values + (%eval-spec (join "-" values)) + nil))) + ((eq 'if (car spec)) + (cond + ((> (length spec) 4) (error "Too many arguments to `if'")) + ((< (length spec) 3) (error "Too few arguments to `if'"))) + (if (%eval-spec (cadr spec)) + (%eval-spec (caddr spec)) + (%eval-spec (cadddr spec)))) + ((eq 'when (car spec)) + (cond + ((> (length spec) 3) (error "Too many arguments to `when'")) + ((< (length spec) 2) (error "Too few arguments to `when'"))) + (when (%eval-spec (cadr spec)) + (%eval-spec (caddr spec)))) + ((eq 'unless (car spec)) + (cond + ((> (length spec) 3) (error "Too many arguments to `unless'")) + ((< (length spec) 2) (error "Too few arguments to `unless'"))) + (unless (%eval-spec (cadr spec)) + (%eval-spec (caddr spec)))) + (t + (let ((values (remove-if #'null (mapcar #'%eval-spec spec)))) + (if values + (%eval-spec (join "." values)) + nil))))) + (function (%eval-spec (funcall spec))) + (symbol (%eval-spec (cond + ((keywordp spec) (symbol-name spec)) + ((fboundp spec) (funcall spec)) + ((eq 't spec) "T") + ((boundp spec) (symbol-value spec)) + (t (symbol-name spec))))) + (atom (%eval-spec (prin1-to-string spec))))) + +(defun %version-file () + (%existing-file "VERSION")) + +(defun version-file-line-0 () + "Return the first line of the VERSION file, or nil if it doesn't exist." + (let ((file (%version-file))) + (when file + (first (uiop:read-file-lines file))))) + +(defun system-version () + "Return the :VERSION from the asdf system `*system*' or nil if it doesn't +exist." + (and *system* (asdf:component-version *system*))) + +(defun version-file-line-1 () + "Return the second line of the VERSION file, or nil if it doesn't exist." + (let ((file (%version-file))) + (when file + (second (uiop:read-file-lines file))))) + +(defun git-non-main-branch () + "Git branch name when not main or master." + (let ((branch (git-current-branch))) + (if (member branch '("main" "master") :test #'string-equal) + nil + branch))) + +(defun current-time () + "Return the current time as \"yyyyMMddHHmmssZ\"" + (multiple-value-bind (second minute hour date month year day daylight-p zone) (decode-universal-time (get-universal-time) 0) + (declare (ignore day daylight-p zone)) + (format nil "~4,'0d~2,'0d~2,'0d~2,'0d~2,'0d~2,'0dZ" year month date hour minute second))) + +(defparameter *default-version* '(or version-file-line-0 system-version)) +(defparameter *default-pre-release* '(or version-file-line-1 (when git-non-main-branch (and git-current-branch git-current-commit)))) +(defparameter *default-build-metadata* '(git-current-branch git-current-commit current-time)) + +(defun version (&key (version *default-version*) + (pre-release *default-pre-release*) + (build-metadata *default-build-metadata*) + (root *root*)) + "Construct a semantic version (https://semver.org/) + +Note that minimal effort is made validating or sanitizing the input, so the user +is able to construct an incorrect semantic version e.g. by supplying too many +components to :VERSION. Some sanitizing is done by dropping invalid characters. + +See the package `cl-semver' for a package which parses, validates and compares +semantic version identifiers. + +Calling `version' will construct a default semantic version based on the VERSION +file, ./.git/HEAD and the current time. + +If no VERSION file exists, the asdf components :VERSION will be used for the +version number. + +If no version is found, 0.0.0 is used as the version. + +The VERSION file should contain the version number in the first line, and an +optional pre-release tag in the second line. If no pre-release tag exist in the +file, it defaults to the git branch name iff it's not the main/master branch. + +VERSION, PRE-RELEASE and BUILD-METADATA is evaluated by `%eval-spec' into a +dotted string, and has the following semantics: +- `string' :: use as-is - it's the canonical form. Some basic sanitizing is done + by removing some invalid characters. +- `list' ('if as first element) :: call `%eval-spec' on the second element. If + true, return `%eval-spec' of the third element, otherwise return `%eval-spec' + of the fourth element. +- `list' ('when as first element) :: call `%eval-spec' on the second element. If + true, return `%eval-spec' of the third element, otherwise return nil. +- `list' ('unless as first element) :: call `%eval-spec' on the second element. If + false, return `%eval-spec' of the third element, otherwise return nil. +- `list' ('or as first element) :: call `%eval-spec' on second element. If + non-nil, return it, otherwise evaluate next element. If there are no more + elements, return nil. +- `list' ('and as first element) :: call `%eval-spec' on subsequent elements, + remove nulls, and join with \"-\" as the separator. +- `list' :: call `%eval-spec' on each element, remove nulls, and join with \".\" + as a separator. +- `function' :: call function pass result to `%eval-spec' +- `symbol' :: if `fboundp', call function and pass result to `%eval-spec'. If + `boundp' call `%eval-spec' on `symbol-value'. Otherwise call `%eval-spec' on + the `symbol-name'. +- `atom' :: convert to a string + +ROOT is the root folder where the VERSION file and .git directory is located. +The value is evaluated by `%guess-root', and several different forms is +accepted: +- `pathname' :: use as-is - it's the canonical form +- `asdf:system' :: `asdf:system-relative-pathname' is used as the root +- `package' :: try to load a system with the same name as `package-name'. If no + system is found, `*default-pathname-defaults*' is used. +- `null' :: we guess given `*package*' instead +- `string' :: try to load a system, if missing interpret the input as a `pathname' instead +- `symbol' :: try to guess using the symbol as the system name + +Examples: + +`(version)' +\"0.1+main.748e8897a233ddbc26a959bd14a97acb0ef5b895.20240301152751Z\" + +You can specify the system it should fetch information from directly using `:root' + +`(version :root :sijo-version)' +\"0.1+main.748e8897a233ddbc26a959bd14a97acb0ef5b895.20240301152751Z\" + +You can remove the use of extra build metadata + +`(version :build-metadata nil)' +\"0.1-some-prerelease\" + +You can specify the exact version and pre-release tag to use instead of looking in VERSION + +>> (version :version \"0.1\" :pre-release nil :build-metadata nil) +\"0.1\" + +>> (version :version \"0.1\" :pre-release \"pre\" :build-metadata nil) +\"0.1-pre\" + +>> (version :version \"0.1\" :pre-release nil :build-metadata \"build\") +\"0.1+build\" + +>> (version :version \"0.1\" :pre-release \"pre\" :build-metadata \"build\") +\"0.1-pre+build\"" + (%with-root root + (%version (%eval-spec version) + (%eval-spec pre-release) + (%eval-spec build-metadata)))) diff --git a/tests/version.lisp b/tests/version.lisp new file mode 100644 index 0000000..89be138 --- /dev/null +++ b/tests/version.lisp @@ -0,0 +1,24 @@ +(defpackage :sijo-version/tests + (:use #:cl #:lisp-unit2) + (:local-nicknames (:version :sijo-version))) + +(in-package :sijo-version/tests) + +(define-test version () + ;; Doctests + (multiple-value-bind (failed passed) (sijo-doctest:test-package :sijo-version) + (assert-eql 0 failed) + (assert-true (> passed 0))) + ;; Default build-metadata + (let* ((build (version:version :version "" :pre-release nil :root :sijo-version)) + (fields (str:split "." (str:replace-first "0.0.0+" "" build))) + (branch (first fields)) + (commit (second fields)) + (timestamp (third fields))) + (assert-true (str:starts-with? "0.0.0+" build)) + (assert-eql 3 (length fields)) + (assert-false (str:empty? branch)) + (assert-false (str:empty? commit)) + (assert-string= "" (string-trim "0123456789abcdef" commit)) + (assert-string= "Z" (string-trim "0123456789" timestamp)) + (assert-true (str:ends-with? "Z" timestamp))))