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:
;;;
;;; 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:

14
potato/exceptions.scm
View File

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

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

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