Quality Assurance, Audit and Tags #14
3
pmake
3
pmake
@ -1,3 +0,0 @@
|
||||
#!/usr/bin/env sh
|
||||
exec guile -L . -e '(@ (pmake main) main)' -s "$0" "$@"
|
||||
!#
|
20
pman
Executable file
20
pman
Executable file
@ -0,0 +1,20 @@
|
||||
#!/usr/bin/env sh
|
||||
# shellcheck shell=sh # Written to comply with IEEE Std 1003.1-2017 (POSIX)
|
||||
# The Project Manager ("pman") -- GNU Guile-based solution for project management
|
||||
# Copyright (C) 2022 Jacob Hrbek <kreyren@rixotstudio.cz>
|
||||
#
|
||||
# This file is Free/Libre Open-Source Software; you may copy, redistribute and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 2 of the License, or (at your option) any later version.
|
||||
# This file 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 this project. If not, see <http://www.gnu.org/licenses>
|
||||
#
|
||||
# This file incorporates work covered by the following copyright and permission notice:
|
||||
#
|
||||
# Copyright (C) 2017-2021 Mike Gran <spk121@yahoo.com>
|
||||
#
|
||||
# Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
|
||||
exec guile -L . -e '(@ (pmake main) main)' -s "$0" "$@"
|
||||
!#
|
@ -20,11 +20,10 @@
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; 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>.
|
||||
;;; Backend for the `pman` 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:
|
||||
|
||||
;; FIXME-QA(Krey): Is this even needed?
|
||||
;; Declare exit codes
|
||||
(define EXIT_SUCCESS 0)
|
||||
(define EXIT_NOT_UP_TO_DATE 1)
|
@ -16,13 +16,11 @@
|
||||
|
||||
|
||||
(define-module (potato builtins)
|
||||
#:export (builtin-makevars
|
||||
; builtin-rules
|
||||
))
|
||||
#:export (builtin-makevars))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; Declaration of the built-in functionality such as variables and helper rules
|
||||
;;; Dedicated to the declaration of built-in functionality such as variables, rules, tasks, etc..
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
@ -43,43 +41,4 @@
|
||||
("GUILD" . "guild")
|
||||
("GFLAGS" . "-W2")))
|
||||
|
||||
;; FIXME(Krey): This was commented out by the original author and it's use needs to be abstracted and re-implemented
|
||||
#;(define builtin-rules
|
||||
`((".c"
|
||||
""
|
||||
(,~ ,($ CC) ,($ CFLAGS) ,($ LDFLAGS) "-o" ,$@ ,$<))
|
||||
(".f"
|
||||
""
|
||||
(,~ ,($ FC) ,($ FFLAGS) ,($ LDFLAGS) "-o" ,$@ ,$<))
|
||||
(".sh"
|
||||
""
|
||||
(,~ "cp" ,$< ,$@)
|
||||
(,~ "chmod a+x" ,$@))
|
||||
(".c"
|
||||
".o"
|
||||
(,~ ,($ CC) ,($ CFLAGS) -c ,$<))
|
||||
(".f"
|
||||
".o"
|
||||
(,~ ,($ FC) ,($ FFLAGS) -c ,$<))
|
||||
(".y"
|
||||
".o"
|
||||
(,~ ,($ YACC) ,($ YFLAGS) ,$<))
|
||||
(".l"
|
||||
".o"
|
||||
(,~ ,($ LEX) ,($ LFLAGS) ,$<)
|
||||
(,~ ,($ CC) ,($ CFLAGS) "-c" lex.yy.c)
|
||||
"rm -f lex.yy.c"
|
||||
(,~ "mv lex.yy.o" ,$@))
|
||||
(".y"
|
||||
".c"
|
||||
(,~ ,($ YACC) ,($ YFLAGS) ,$<)
|
||||
(,~ "mv y.tab.c" ,$@))
|
||||
(".l"
|
||||
".c"
|
||||
(,~ ,($ LEX) ,($ LDFLAGS) ,$<)
|
||||
("mv lex.yy.c" ,$@))
|
||||
(".scm"
|
||||
".go"
|
||||
(,~ ,($ GUILD) "compile" ,($ GFLAGS) ,$<))))
|
||||
|
||||
;;; builtins.scm ends here
|
@ -14,7 +14,7 @@
|
||||
;;;
|
||||
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE
|
||||
|
||||
-(define-module (potato exceptions)
|
||||
(define-module (potato exceptions)
|
||||
#:use-module (ice-9 exceptions)
|
||||
#:export (bad-key-type
|
||||
bad-value-type
|
||||
@ -22,30 +22,44 @@
|
||||
invalid-macro
|
||||
not-a-regular-file
|
||||
not-a-procedure
|
||||
no-read-access-to-file
|
||||
))
|
||||
no-read-access-to-file))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; Dedicated to handling 'exceptions' as in termination of the program
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
;; FIXME-QA(Krey): This code is using 'bad' which is hard to understand without context, thus should be changed on 'unexpected'
|
||||
|
||||
(define (make-bad-key-type origin irritants)
|
||||
"Exception used when bad key is parsed to 'make' functionality"
|
||||
(make-exception
|
||||
(make-programming-error)
|
||||
(make-exception-with-origin origin)
|
||||
;; FIXME-TRANSLATE(Krey)
|
||||
(make-exception-with-message "Wrong type for key. Expecting string or procedure.")
|
||||
(make-exception-with-irritants irritants)))
|
||||
|
||||
(define (bad-key-type origin irritant)
|
||||
"Generic exception for unexpected key"
|
||||
(raise-exception (make-bad-key-type origin irritant)))
|
||||
|
||||
(define (make-bad-value-type origin irritants)
|
||||
"Exception for unexpected value in the 'make' functionality"
|
||||
(make-exception
|
||||
(make-programming-error)
|
||||
(make-exception-with-origin origin)
|
||||
;; FIXME-TRANSLATE(Krey)
|
||||
(make-exception-with-message "Wrong type for value. Expecting string or procedure.")
|
||||
(make-exception-with-irritants irritants)))
|
||||
|
||||
(define (bad-value-type origin irritant)
|
||||
"Generic exception for unexpected value"
|
||||
(raise-exception (make-bad-value-type origin irritant)))
|
||||
|
||||
(define (make-bad-proc-output origin irritants)
|
||||
"Exception for unexpected process output in 'make' functionality"
|
||||
(make-exception
|
||||
(make-programming-error)
|
||||
(make-exception-with-origin origin)
|
||||
@ -53,9 +67,11 @@
|
||||
(make-exception-with-irritants irritants)))
|
||||
|
||||
(define (bad-proc-output origin irritant)
|
||||
"Generic exception for unexpected process output"
|
||||
(raise-exception (make-bad-proc-output origin irritant)))
|
||||
|
||||
(define (make-invalid-macro origin irritants)
|
||||
"Exception for invalid macro in 'make' functionality"
|
||||
(make-exception
|
||||
(make-programming-error)
|
||||
(make-exception-with-origin origin)
|
||||
@ -63,9 +79,11 @@
|
||||
(make-exception-with-irritants irritants)))
|
||||
|
||||
(define (invalid-macro origin irritant)
|
||||
"Generic exception for invalid macro"
|
||||
(raise-exception (make-invalid-macro origin irritant)))
|
||||
|
||||
(define (make-not-a-regular-file origin irritants)
|
||||
"Exception for not regular file in 'make' functionality"
|
||||
(make-exception
|
||||
(make-programming-error)
|
||||
(make-exception-with-origin origin)
|
||||
@ -73,9 +91,11 @@
|
||||
(make-exception-with-irritants irritants)))
|
||||
|
||||
(define (not-a-regular-file origin irritant)
|
||||
"Generic exception for when regular file is not parsed"
|
||||
(raise-exception (make-not-a-regular-file origin irritant)))
|
||||
|
||||
(define (make-not-a-procedure origin irritants)
|
||||
"Exception for when regular file is not parsed in the 'make' functionality"
|
||||
(make-exception
|
||||
(make-programming-error)
|
||||
(make-exception-with-origin origin)
|
||||
@ -83,9 +103,11 @@
|
||||
(make-exception-with-irritants irritants)))
|
||||
|
||||
(define (not-a-procedure origin irritant)
|
||||
"Generic exception for when procedure is not parsed"
|
||||
(raise-exception (make-not-a-procedure origin irritant)))
|
||||
|
||||
(define (make-no-read-access-to-file origin irritants)
|
||||
"Exception for when we don't have the expected read access to the file in 'make' functionality"
|
||||
(make-exception
|
||||
(make-programming-error)
|
||||
(make-exception-with-origin origin)
|
||||
@ -93,4 +115,7 @@
|
||||
(make-exception-with-irritants irritants)))
|
||||
|
||||
(define (no-read-access-to-file origin irritant)
|
||||
"Generic exception for when we don't have the excepted read access to the file"
|
||||
(raise-exception (make-no-read-access-to-file origin irritant)))
|
||||
|
||||
;;; exceptions.scm end here
|
@ -29,7 +29,6 @@
|
||||
#:re-export (%suffix-rules
|
||||
lazy-assign ?=
|
||||
assign :=
|
||||
;; WTF(Krey): Why is the 'Q' here?
|
||||
reference $ Q
|
||||
reference-func $$
|
||||
target-rule :
|
||||
@ -47,26 +46,21 @@
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; TBD
|
||||
;;; Entry file to the project, designed for handling the functionality
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
;; FIXME-QA(Krey): This file includes debugging utilities that should be exported into a standalone library to make this software more maintainable
|
||||
;; FIXME-QA(Krey): Needs refactor
|
||||
|
||||
;; FIXME-QA(Krey): Why is this here?
|
||||
;; 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 :=
|
||||
;; ref $
|
||||
;; target-rule :
|
||||
;; suffix-rule ->
|
||||
;; compose ~
|
||||
;; ))
|
||||
|
||||
;; FIXME-DOCS(Krey): Lacks context
|
||||
;;; Asynchronous events.
|
||||
;;; SIGHUP, SIGTERM, SIGINT and SIGQUIT remove the current target
|
||||
;;; unless that target is a directory or the target is a prerequisite
|
||||
@ -88,27 +82,31 @@
|
||||
;;; If the -t option was specified, make shall write to standard
|
||||
;;; output a message for each file that was touched.
|
||||
|
||||
;;; Output handlers
|
||||
;;; These handlers are designed to be used for debug management
|
||||
;; Verbosity is 0 = silent, 1 = terse, 2 = default, 3 = verbose
|
||||
(define %verbosity 2)
|
||||
;; WTF(Krey)
|
||||
;; WTF(Krey): Option to set verbose output and %verbosity defining the "deepness" of output?
|
||||
(define %opt-verbose #f)
|
||||
;; WTF(Krey)
|
||||
;; WTF(Krey): Option to ignore errors?
|
||||
(define %opt-ignore-errors #f)
|
||||
;; WTF(Krey)
|
||||
;; WTF(Krey): Option to continue on errors?
|
||||
(define %opt-continue-on-error #f)
|
||||
;; WTF(Krey)
|
||||
;; WTF(Krey): Generic definition of targets for appending?
|
||||
(define %targets '())
|
||||
;; WTF(Krey)
|
||||
;; WTF(Krey): No idea
|
||||
(define %initialized #f)
|
||||
|
||||
;; Output handlers
|
||||
(define (critical spec . args)
|
||||
"Output to handle 'cricital' output messages"
|
||||
(apply format (append (list #t spec) args)))
|
||||
;; FIXME-QA(Krey): The 'print' is too generic, should we rename it?
|
||||
(define (print spec . args)
|
||||
"Output to handle printing of output. Only works when verbosity is set to 2 and higher"
|
||||
(when (>= %verbosity 2)
|
||||
(apply format (append (list #t spec) args))))
|
||||
(define (debug spec . args)
|
||||
"Output to handle level 3 debug messages"
|
||||
(when (>= %verbosity 3)
|
||||
(apply format (append (list #t spec) args))))
|
||||
|
||||
@ -127,6 +125,7 @@
|
||||
|
||||
;; FIXME-QA(Krey): This is calling `format` multiple times to print one line which is resource inefficient
|
||||
(define (display-help-and-exit argv0)
|
||||
"Function used to output help message and exit"
|
||||
(format #t "~A [-hvqVeEbn] [KEY=VALUE ...] [targets ...]~%" argv0)
|
||||
(format #t " -h, --help print help and exit~%")
|
||||
(format #t " -v, --version print version and exit~%")
|
||||
@ -148,11 +147,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))
|
||||
|
||||
;; FIXME-QA(Krey): Why is this accepting input?
|
||||
(define (display-version-and-exit argv0)
|
||||
"Procedure to output the project version and exit"
|
||||
"Function to output the project version and exit"
|
||||
(format #t "~a~%" argv0)
|
||||
(format #t " using potato make~a~%" %version)
|
||||
(exit 0))
|
||||
@ -173,8 +172,7 @@ of pairs of KEY VAL"
|
||||
lst))
|
||||
|
||||
(define (parse-targets lst)
|
||||
"Search the list for strings that don't have equals signs, and
|
||||
return them in a list."
|
||||
"Search the list for strings that don't have equals signs, and return them in a list."
|
||||
(filter-map
|
||||
(lambda (str)
|
||||
(if (string-index str #\=)
|
||||
@ -184,13 +182,7 @@ return them in a list."
|
||||
|
||||
(define* (initialize #:optional
|
||||
(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
|
||||
expected to be a list of strings that are command-line
|
||||
arguments."
|
||||
|
||||
;; If left unset, assume user want all the command line arguments.
|
||||
"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 expected to be a list of strings that are command-line arguments." ;; If left unset, assume user want all the command line arguments.
|
||||
(when (not arguments)
|
||||
(set! arguments (command-line)))
|
||||
;; If the user has set it to '(), expecting a null environment, add
|
||||
@ -284,9 +276,7 @@ arguments."
|
||||
%opt-no-execution
|
||||
%verbosity
|
||||
%opt-ascii)
|
||||
(set! %initialized #t)
|
||||
%targets
|
||||
)))
|
||||
(set! %initialized #t) %targets)))
|
||||
|
||||
(define* (execute #:key (targets '()))
|
||||
"This function runs build actions. TARGETS, if provided, is a list
|
@ -27,34 +27,54 @@
|
||||
assign :=
|
||||
reference $ Q
|
||||
reference-func $$
|
||||
dump-makevars
|
||||
))
|
||||
dump-makevars))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; Used to handle the 'makevars' functionality meaning assigning and managing environmental variables into variables used by guile
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
;; Defines the priority level
|
||||
;; There are five priority levels
|
||||
;; 1. defined - in the script itself
|
||||
;; 2. command-line
|
||||
;; 3. makeflags - in the MAKEFLAGS environment variable
|
||||
;; 4. env - specified in the environment
|
||||
;; 5. built-in - one of the built-in macros
|
||||
|
||||
;;
|
||||
;; The lower priority level always win, unless the '-e' flag was set
|
||||
;; If the '-e' flag is set level 1 doesn't override level 3 and 4.
|
||||
(define %level-name '("unknown"
|
||||
"script"
|
||||
"command-line"
|
||||
"makeflags"
|
||||
"environment"
|
||||
"built-in"))
|
||||
|
||||
(define %level-name '("unknown" "script" "command-line" "makeflags" "environment" "built-in"))
|
||||
|
||||
;; WTF(Krey): No fucking idea.. something with ASCII? If ASCII is supported?
|
||||
(define %ascii? #f)
|
||||
|
||||
;; WTF(Krey)
|
||||
(define %makevars (make-hash-table))
|
||||
|
||||
;; WTF(Krey)
|
||||
(define %elevate-environment? #f)
|
||||
|
||||
;; WTF(Krey)
|
||||
(define %strict #f)
|
||||
|
||||
;; WTF(Krey)
|
||||
(define %verbose? #t)
|
||||
|
||||
;; WTF(Krey)
|
||||
(define (debug spec . args)
|
||||
"Output to handle debugging messages"
|
||||
(when %verbose?
|
||||
(apply format (append (list #t spec) args))))
|
||||
|
||||
|
||||
(define (split-at-equals str)
|
||||
"Splits the string at the first equals sign, ignoring
|
||||
later equals signs."
|
||||
"Splits the string at the first equals sign, ignoring later equals signs."
|
||||
(let ((idx (string-index str #\=)))
|
||||
(if (and idx (> idx 0))
|
||||
(cons (substring str 0 idx)
|
||||
@ -100,8 +120,7 @@ priority."
|
||||
*unspecified*)
|
||||
|
||||
(define (makevars-add-keyvals keyvals)
|
||||
"Adds any suitable macros passed in from the command line, which
|
||||
here are expected to be a list of key / val string pairs."
|
||||
"Adds any suitable macros passed in from the command line, which here are expected to be a list of key / val string pairs."
|
||||
(for-each
|
||||
(lambda (entry)
|
||||
(let ((key (car entry))
|
||||
@ -112,8 +131,7 @@ here are expected to be a list of key / val string pairs."
|
||||
keyvals))
|
||||
|
||||
(define (makevars-add-makeflags)
|
||||
"Adds any suitable environment variables found in the MAKEFLAGS
|
||||
environment variable to the macro store"
|
||||
"Adds any suitable environment variables found in the MAKEFLAGS environment variable to the macro store"
|
||||
(let ((makeflags (getenv "MAKEFLAGS")))
|
||||
(when makeflags
|
||||
(for-each
|
||||
@ -128,8 +146,7 @@ environment variable to the macro store"
|
||||
(string-split makeflags #\space)))))
|
||||
|
||||
(define (makevars-add-environment)
|
||||
"Adds any suitable environment variables to the macro store, but not
|
||||
the value of MAKEFLAGS or SHELL."
|
||||
"Adds any suitable environment variables to the macro store, but not the value of MAKEFLAGS or SHELL."
|
||||
(for-each
|
||||
(lambda (entry)
|
||||
(let* ((keyval (split-at-equals entry))
|
||||
@ -147,6 +164,7 @@ the value of MAKEFLAGS or SHELL."
|
||||
(makevars-set (car keyval) (cdr keyval) 5))
|
||||
builtin-makevars))
|
||||
|
||||
;; FIXME-DOCS(Krey)
|
||||
(define (print-makevar key)
|
||||
(let ((val (hash-ref %makevars key)))
|
||||
(let ((keyval-string
|
||||
@ -240,6 +258,7 @@ the value of MAKEFLAGS or SHELL."
|
||||
(newline)))))
|
||||
keyvals))))
|
||||
|
||||
;; FIXME-DOCS(Krey)
|
||||
(define (initialize-makevars keyvals
|
||||
environment?
|
||||
elevate-environment?
|
0
src/potato/zz-README.org~
Normal file
0
src/potato/zz-README.org~
Normal file
1
src/zz-README.org
Normal file
1
src/zz-README.org
Normal file
@ -0,0 +1 @@
|
||||
Source code of the project
|
Loading…
Reference in New Issue
Block a user