;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Alex Vong ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (guix build clojure-utils) #:use-module (guix build utils) #:use-module (ice-9 ftw) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) #:use-module (srfi srfi-8) #:use-module (srfi srfi-26) #:export (@* @@* define-with-docs %doc-regex install-doc %source-dirs %test-dirs %compile-dir package-name->jar-names %tests? %test-include %test-exclude strip-1st-component %clojure-regex find-files* find-clojure-libs eval-with-clojure create-jar)) (define-syntax-rule (@* module name) "Like (@ MODULE NAME), but resolves at run time." (module-ref (resolve-interface 'module) 'name)) (define-syntax-rule (@@* module name) "Like (@@ MODULE NAME), but resolves at run time." (module-ref (resolve-module 'module) 'name)) (define-syntax-rule (define-with-docs name docs val) "Create top-level variable named NAME with doc string DOCS and value VAL." (begin (define name val) (set-object-property! name 'documentation docs))) (define-with-docs %doc-regex "Default regex for matching the base name of top-level documentation files." (format #f "(~a)|(\\.(html|markdown|md|txt)$)" (@@ (guix build guile-build-system) %documentation-file-regexp))) (define* (install-doc #:key doc-dirs (doc-regex %doc-regex) outputs #:allow-other-keys) "Install the following to the default documentation directory: 1. Top-level files with base name matching DOC-REGEX. 2. All files (recursively) inside DOC-DIRS. DOC-REGEX can be compiled or uncompiled." (let* ((out (assoc-ref outputs "out")) (doc (assoc-ref outputs "doc")) (name-ver (strip-store-file-name out)) (dest-dir (string-append (or doc out) "/share/doc/" name-ver "/")) (doc-regex* (if (string? doc-regex) (make-regexp doc-regex) doc-regex))) (for-each (cut install-file <> dest-dir) (remove (compose file-exists? (cut string-append dest-dir <>)) (scandir "./" (cut regexp-exec doc-regex* <>)))) (for-each (cut copy-recursively <> dest-dir) doc-dirs) #t)) (define-with-docs %source-dirs "A default list of source directories." '("src/")) (define-with-docs %test-dirs "A default list of test directories." '("test/")) (define-with-docs %compile-dir "Default directory for holding class files." "classes/") (define (package-name->jar-names name) "Given NAME, a package name like \"foo-0.9.1b\", return the list of default jar names: (\"foo-0.9.1b.jar\" \"foo.jar\")." (map (cut string-append <> ".jar") (list name (receive (base-name _) (package-name->name+version name) base-name)))) (define-with-docs %tests? "Enable tests by default." #t) (define-with-docs %test-include "A default list of symbols deciding what tests to include. Note that the exclude list has priority over the include list. The special keyword #:all represents all tests found under the test directories." '(#:all)) (define-with-docs %test-exclude "A default list of symbols deciding what tests to exclude. See the doc string of '%test-include' for more details." '()) (define-with-docs strip-1st-component "Similar to 'dirname', but strip the 1st component from path instead." (compose string-reverse dirname string-reverse)) (define-with-docs %clojure-regex "Default regex for matching the base name of clojure source files." "\\.cljc?$") (define (find-files* base-dir . args) "Similar to 'find-files', but with BASE-DIR stripped." (map strip-1st-component (with-directory-excursion base-dir (apply find-files "./" args)))) (define* (find-clojure-libs base-dir #:key (clojure-regex %clojure-regex)) "Return the list of clojure libraries found under BASE-DIR. CLOJURE-REGEX can be compiled or uncompiled." (define (relative-path->clojure-libs path) ;; FIXME: 'file-sans-extension' should be moved to (guix build utils) (let ((file-sans-extension (@@ (guix build guile-build-system) file-sans-extension))) (string->symbol (string-map (lambda (chr) (case chr ((#\/) #\.) ((#\_) #\-) (else chr))) (file-sans-extension path))))) (map relative-path->clojure-libs (find-files* base-dir clojure-regex))) (define (eval-with-clojure expr extra-paths) "Evaluate EXPR with clojure. EXPR must be a s-expression writable by guile and readable by clojure. For examples, '(require '[clojure.string]) will not work, because the guile writer converts brackets to parentheses. EXTRA-PATHS is a list of paths which will be appended to $CLASSPATH." (let* ((classpath (getenv "CLASSPATH")) (classpath* (string-join (cons classpath extra-paths) ":"))) (invoke "java" "-classpath" classpath* "clojure.main" "--eval" (object->string expr)))) (define (create-jar output-jar . dirs) "Create jar named OUTPUT-JAR from files found in DIRS." (apply invoke "jar" "cvf0M" output-jar (append-map (lambda (dir) (append-map (lambda (file) `("-C" ,dir ,file)) (find-files* dir))) dirs)))