kreyren/pman
1
0
Fork 0
Code Issues 16 Pull Requests 2 Releases Activity

Sync

Browse Source 
Signed-off-by: Jacob Hrbek <kreyren@rixotstudio.cz>
This commit is contained in:
Jacob Hrbek 2022-08-28 20:02:07 +02:00
parent 3a0ae9a00f
commit 0bc136cf3a
Signed by: kreyren
GPG Key ID: 667F0DAFAF09BA2B
4 changed files with 143 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
make/main.scm
View File

@ -14,7 +14,7 @@
;;; Commentary: ;;; Commentary:
;;; ;;;
;;; This file is designed to process the command line arguments using the standardized 'getopts-long' as described in the GNU Guile reference manual <https://www.gnu.org/software/guile/manual/html_node/getopt_002dlong.html>. ;;; Backend for the `pmake` command to process the command line arguments using the standardized 'getopts-long' as described in the GNU Guile reference manual <https://www.gnu.org/software/guile/manual/html_node/getopt_002dlong.html>.
;;; ;;;
;;; Code: ;;; Code:

14
potato/exceptions.scm
View File

@ -1,13 +1,13 @@
-(define-module (potato exceptions) -(define-module (potato exceptions)
#:use-module (ice-9 exceptions) #:use-module (ice-9 exceptions)
#:export (bad-key-type #:export (bad-key-type
bad-value-type bad-value-type
bad-proc-output bad-proc-output
invalid-macro invalid-macro
not-a-regular-file not-a-regular-file
not-a-procedure not-a-procedure
no-read-access-to-file no-read-access-to-file
)) ))
(define (make-bad-key-type origin irritants) (define (make-bad-key-type origin irritants)
(make-exception (make-exception

242
potato/make.scm
View File

@ -1,3 +1,13 @@
;;; The Project Manager ("pman") -- GNU Guile-based solution for project management
;;; Copyright (C) 2021 Mike Gran <spk121@yahoo.com>
;;; Copyright (C) 2022 Jacob Hrbek <kreyren@rixotstudio.cz>
;;;
;;; The Project Manager is a Free/Libre Open-Source Software; you can redistribute it and/or modify it under the terms of the MIT License as published by the Massachusetts Institute of Technology
;;;
;;; This project 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 MIT License for more details.
;;;
;;; You should have received a copy of the MIT License along with the project. If not, see <https://mit-license.org>.
(define-module (potato make) (define-module (potato make)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 exceptions) #:use-module (ice-9 exceptions)
@ -9,30 +19,39 @@
#:use-module (potato makevars) #:use-module (potato makevars)
#:use-module (potato rules) #:use-module (potato rules)
#:use-module (potato text) #:use-module (potato text)
#:export (initialize #:export (initialize execute)
execute)
#:re-export (%suffix-rules #:re-export (%suffix-rules
lazy-assign ?= lazy-assign ?=
assign := assign :=
reference $ Q ;; WTF(Krey): Why is the 'Q' here?
reference-func $$ reference $ Q
target-rule : reference-func $$
suffix-rule -> target-rule :
target-name $@ suffix-rule ->
target-basename $* target-name $@
newer-prerequisites $? $$? target-basename $*
prerequisites $^ $$^ newer-prerequisites $? $$?
primary-prerequisite $< prerequisites $^ $$^
string-compose ~ primary-prerequisite $<
silent-compose ~@ string-compose ~
always-execute-compose ~+ silent-compose ~@
ignore-error-compose ~- always-execute-compose ~+
install-alternate-system-driver ignore-error-compose ~-
)) install-alternate-system-driver))
;;; Commentary:
;;;
;;; TBD
;;;
;;; Code:
;; Project version
(define %version "1.0") (define %version "1.0")
;; WTF(Krey)
(define %debug-argv0 #f) (define %debug-argv0 #f)
;; WTF(Krey): Was commented out by the original author.. no idea why
;; #:re-export ( ;; #:re-export (
;; lazy-assign ?= ;; lazy-assign ?=
;; assign := ;; assign :=
@ -42,37 +61,44 @@
;; compose ~ ;; compose ~
;; )) ;; ))
;; Asynchronous events. ;;; Asynchronous events.
;; SIGHUP, SIGTERM, SIGINT and SIGQUIT remove the current target ;;; SIGHUP, SIGTERM, SIGINT and SIGQUIT remove the current target
;; unless that target is a directory or the target is a prerequisite ;;; unless that target is a directory or the target is a prerequisite
;; of .PRECIOUS or the -n, -q, or -p option was specified. This ;;; of .PRECIOUS or the -n, -q, or -p option was specified. This
;; deletion shall be reported to the error port, then the default for ;;; deletion shall be reported to the error port, then the default for
;; that action will continue. ;;; that action will continue.
;; .SILENT ;;; .SILENT
;; The utility shall write all commands to the standard output unless ;;; The utility shall write all commands to the standard output unless
;; the -s option was specified, the command is prefixed with +, or ;;; the -s option was specified, the command is prefixed with +, or
;; .SILENT has the current target as a prerequisite or has no pre ;;; .SILENT has the current target as a prerequisite or has no pre
;; requisites. ;;; requisites.
;; Nothing to be done ;;; Nothing to be done
;; If make was invoked but found no work to do, it shall write a ;;; If make was invoked but found no work to do, it shall write a
;; message to standard output that no action was taken ;;; message to standard output that no action was taken
;; File Touched ;;; File Touched
;; If the -t option was specified, make shall write to standard ;;; If the -t option was specified, make shall write to standard
;; output a message for each file that was touched. ;;; output a message for each file that was touched.
;; Verbosity is 0 = silent, 1 = terse, 2 = default, 3 = verbose ;; Verbosity is 0 = silent, 1 = terse, 2 = default, 3 = verbose
(define %verbosity 2) (define %verbosity 2)
;; WTF(Krey)
(define %opt-verbose #f) (define %opt-verbose #f)
;; WTF(Krey)
(define %opt-ignore-errors #f) (define %opt-ignore-errors #f)
;; WTF(Krey)
(define %opt-continue-on-error #f) (define %opt-continue-on-error #f)
;; WTF(Krey)
(define %targets '()) (define %targets '())
;; WTF(Krey)
(define %initialized #f) (define %initialized #f)
;; Output handlers
(define (critical spec . args) (define (critical spec . args)
(apply format (append (list #t spec) args))) (apply format (append (list #t spec) args)))
;; FIXME-QA(Krey): The 'print' is too generic, should we rename it?
(define (print spec . args) (define (print spec . args)
(when (>= %verbosity 2) (when (>= %verbosity 2)
(apply format (append (list #t spec) args)))) (apply format (append (list #t spec) args))))
@ -91,15 +117,15 @@
(continue-on-error (single-char #\k) (value #f)) (continue-on-error (single-char #\k) (value #f))
(no-execution (single-char #\n) (value #f)) (no-execution (single-char #\n) (value #f))
(ascii (single-char #\A) (value #f)) (ascii (single-char #\A) (value #f))
(strict (single-char #\S) (value #f)) (strict (single-char #\S) (value #f))))
))
;; FIXME-QA(Krey): This is calling `format` multiple times to print one line which is resource inefficient
(define (display-help-and-exit argv0) (define (display-help-and-exit argv0)
(format #t "~A [-hvqVeEbn] [KEY=VALUE ...] [targets ...]~%" argv0) (format #t "~A [-hvqVeEbn] [KEY=VALUE ...] [targets ...]~%" argv0)
(format #t " -h, --help print help and exit~%") (format #t " -h, --help print help and exit~%")
(format #t " -v, --version print version and exit~%") (format #t " -v, --version print version and exit~%")
(format #t " -V 0..3, --verbosity=0..3~%") (format #t " -V 0..3, --verbosity=0..3~%")
(format #t " set output level from 0=silent to 3=verbose~%") (format #t " set output level from 0=silent to 3=verbose~%")
(format #t " -e, --environment use environment variables~%") (format #t " -e, --environment use environment variables~%")
(format #t " -E, --elevate-environment~%") (format #t " -E, --elevate-environment~%")
(format #t " use environment variables and let~%") (format #t " use environment variables and let~%")
@ -116,9 +142,11 @@
(format #t " ASCII only output and no colors~%") (format #t " ASCII only output and no colors~%")
(format #t " -S, --strict~%") (format #t " -S, --strict~%")
(format #t " causes some behaviours to throw errors~%") (format #t " causes some behaviours to throw errors~%")
;; FIXME-QA(Krey): 'exit'? It should be using 'throw'
(exit 0)) (exit 0))
(define (display-version-and-exit argv0) (define (display-version-and-exit argv0)
"Procedure to output the project version and exit"
(format #t "~a~%" argv0) (format #t "~a~%" argv0)
(format #t " using potato make~a~%" %version) (format #t " using potato make~a~%" %version)
(exit 0)) (exit 0))
@ -130,12 +158,12 @@ of pairs of KEY VAL"
(lambda (str) (lambda (str)
(let ((tok (string-split str #\=))) (let ((tok (string-split str #\=)))
(cond (cond
((= 1 (length tok)) ((= 1 (length tok))
#f) #f)
((= 2 (length tok)) ((= 2 (length tok))
(cons (car tok) (cadr tok))) (cons (car tok) (cadr tok)))
(else (else
(invalid-macro "parse-macros" str))))) (invalid-macro "parse-macros" str)))))
lst)) lst))
(define (parse-targets lst) (define (parse-targets lst)
@ -144,12 +172,12 @@ return them in a list."
(filter-map (filter-map
(lambda (str) (lambda (str)
(if (string-index str #\=) (if (string-index str #\=)
#f #f
str)) str))
lst)) lst))
(define* (initialize #:optional (define* (initialize #:optional
(arguments #f)) (arguments #f))
"Set up the options, rules, and makevars. If ARGUMENTS "Set up the options, rules, and makevars. If ARGUMENTS
is not set, it will use options, makevars, and targets as is not set, it will use options, makevars, and targets as
specified by the command line. If it is set, it is specified by the command line. If it is set, it is
@ -166,14 +194,14 @@ arguments."
;; We start of with the --help and --version command-line arguments. ;; We start of with the --help and --version command-line arguments.
(let ((options (getopt-long arguments option-spec)) (let ((options (getopt-long arguments option-spec))
(%opt-builtins #f) (%opt-builtins #f)
(%opt-environment #f) (%opt-environment #f)
(%opt-elevate-environment #f) (%opt-elevate-environment #f)
(%opt-no-errors #f) (%opt-no-errors #f)
(%opt-continue-on-error #f) (%opt-continue-on-error #f)
(%opt-no-execution #f) (%opt-no-execution #f)
(%opt-ascii #f) (%opt-ascii #f)
(%opt-strict #f)) (%opt-strict #f))
(when (option-ref options 'help #f) (when (option-ref options 'help #f)
(display-help-and-exit (car arguments))) (display-help-and-exit (car arguments)))
(when (option-ref options 'version #f) (when (option-ref options 'version #f)
@ -188,32 +216,32 @@ arguments."
;; command-line options to override MAKEFLAGS options. ;; command-line options to override MAKEFLAGS options.
(when %opt-environment (when %opt-environment
(let ((mf (getenv "MAKEFLAGS"))) (let ((mf (getenv "MAKEFLAGS")))
(when mf (when mf
(let ((tokens (string-tokenize mf))) (let ((tokens (string-tokenize mf)))
(when (member "silent" tokens) (when (member "silent" tokens)
(set! %verbosity 0)) (set! %verbosity 0))
(when (member "terse" tokens) (when (member "terse" tokens)
(set! %verbosity 1)) (set! %verbosity 1))
(when (member "verbose" tokens) (when (member "verbose" tokens)
(set! %verbosity 3)) (set! %verbosity 3))
(when (member "builtins" tokens) (when (member "builtins" tokens)
(set! %opt-builtins #t)) (set! %opt-builtins #t))
(when (member "ascii" tokens) (when (member "ascii" tokens)
(set! %opt-ascii #t)) (set! %opt-ascii #t))
(when (member "ignore-errors" tokens) (when (member "ignore-errors" tokens)
(set! %opt-ignore-errors #t)) (set! %opt-ignore-errors #t))
(when (member "continue-on-error" tokens) (when (member "continue-on-error" tokens)
(set! %opt-continue-on-error #t)) (set! %opt-continue-on-error #t))
(when (member "strict" tokens) (when (member "strict" tokens)
(set! %opt-strict #t)) (set! %opt-strict #t))
(when (member "no-execution" tokens) (when (member "no-execution" tokens)
(set! %opt-no-execution #t)))))) (set! %opt-no-execution #t))))))
;; Now the bulk of the command-line options. ;; Now the bulk of the command-line options.
(when (option-ref options 'verbosity #f) (when (option-ref options 'verbosity #f)
(let ((verbosity (string->number (option-ref options 'verbosity #f)))) (let ((verbosity (string->number (option-ref options 'verbosity #f))))
(when verbosity (when verbosity
(set! %verbosity verbosity)))) (set! %verbosity verbosity))))
(when (option-ref options 'builtins #f) (when (option-ref options 'builtins #f)
(set! %opt-builtins #t)) (set! %opt-builtins #t))
(when (option-ref options 'elevate-environment #f) (when (option-ref options 'elevate-environment #f)
@ -234,22 +262,22 @@ arguments."
(let ((extra (option-ref options '() '()))) (let ((extra (option-ref options '() '())))
(initialize-text %opt-ascii) (initialize-text %opt-ascii)
(initialize-makevars (parse-macros extra) (initialize-makevars (parse-macros extra)
%opt-environment %opt-environment
%opt-elevate-environment %opt-elevate-environment
%opt-builtins %opt-builtins
%opt-strict %opt-strict
%verbosity %verbosity
%opt-ascii) %opt-ascii)
;; The remaining command-line words are the build targets that ;; The remaining command-line words are the build targets that
;; we're going to tackle. ;; we're going to tackle.
(set! %targets (parse-targets extra)) (set! %targets (parse-targets extra))
(initialize-rules %targets (initialize-rules %targets
%opt-builtins %opt-builtins
%opt-ignore-errors %opt-ignore-errors
%opt-continue-on-error %opt-continue-on-error
%opt-no-execution %opt-no-execution
%verbosity %verbosity
%opt-ascii) %opt-ascii)
(set! %initialized #t) (set! %initialized #t)
%targets %targets
))) )))
@ -269,27 +297,27 @@ targets listed on the parsed command-line are used."
(debug "No build target was explicitely specified.~%") (debug "No build target was explicitely specified.~%")
(let ((rule (first-target-rule-name))) (let ((rule (first-target-rule-name)))
(if rule (if rule
(begin (begin
(debug "Using first rule ~a~A~a as the build target.~%" (lquo) rule (rquo)) (debug "Using first rule ~a~A~a as the build target.~%" (lquo) rule (rquo))
(set! targets (list rule))) (set! targets (list rule)))
;; else ;; else
(debug "There are no target rules in the recipe.~%")))) (debug "There are no target rules in the recipe.~%"))))
;; Build each target in order. ;; Build each target in order.
(when (not (null? targets)) (when (not (null? targets))
(let loop ((target (car targets)) (let loop ((target (car targets))
(rest (cdr targets))) (rest (cdr targets)))
(if (not (build target)) (if (not (build target))
(begin (begin
(print "The recipe for “~A” has failed.~%" target) (print "The recipe for “~A” has failed.~%" target)
#f) #f)
;; else ;; else
(begin (begin
(print "The recipe “~A” finished successfully.~%" target) (print "The recipe “~A” finished successfully.~%" target)
(if (not (null? rest)) (if (not (null? rest))
(loop (car rest) (cdr rest)) (loop (car rest) (cdr rest))
;; True if all targets are built successfully. ;; True if all targets are built successfully.
#t)))))) #t))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; make.scm ends here

0
potato/zz-README.org~ Normal file
View File