bournish: Extend 'rm' command.

* guix/build/bournish.scm (rm-command): New procedure.
(%commands): Use it.
* tests/bournish.scm: Add tests for "rm" and "rm -r".
master
Ricardo Wurmus 2017-01-25 20:52:27 +01:00
parent 2f977d92d3
commit 0db2ff65e7
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
2 changed files with 22 additions and 1 deletions

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -105,6 +106,14 @@ characters."
((@ (guix build utils) dump-port) port (current-output-port)) ((@ (guix build utils) dump-port) port (current-output-port))
*unspecified*))) *unspecified*)))
(define (rm-command . args)
"Emit code for the 'rm' command."
(cond ((member "-r" args)
`(for-each (@ (guix build utils) delete-file-recursively)
(list ,@(delete "-r" args))))
(else
`(for-each delete-file (list ,@args)))))
(define (lines+chars port) (define (lines+chars port)
"Return the number of lines and number of chars read from PORT." "Return the number of lines and number of chars read from PORT."
(let loop ((lines 0) (chars 0)) (let loop ((lines 0) (chars 0))
@ -194,7 +203,7 @@ commands such as 'ls' and 'cd'; it lacks globbing, pipes---everything.\n"))
`(("echo" ,(lambda strings `(list ,@strings))) `(("echo" ,(lambda strings `(list ,@strings)))
("cd" ,(lambda (dir) `(chdir ,dir))) ("cd" ,(lambda (dir) `(chdir ,dir)))
("pwd" ,(lambda () `(getcwd))) ("pwd" ,(lambda () `(getcwd)))
("rm" ,(lambda (file) `(delete-file ,file))) ("rm" ,rm-command)
("cp" ,(lambda (source dest) `(copy-file ,source ,dest))) ("cp" ,(lambda (source dest) `(copy-file ,source ,dest)))
("help" ,help-command) ("help" ,help-command)
("ls" ,ls-command) ("ls" ,ls-command)

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -38,5 +39,16 @@
(read-and-compile (open-input-string "cd /foo\npwd\nls") (read-and-compile (open-input-string "cd /foo\npwd\nls")
#:from %bournish-language #:to 'scheme)) #:from %bournish-language #:to 'scheme))
(test-equal "rm"
'(for-each delete-file (list "foo" "bar"))
(read-and-compile (open-input-string "rm foo bar\n")
#:from %bournish-language #:to 'scheme))
(test-equal "rm -r"
'(for-each (@ (guix build utils) delete-file-recursively)
(list "/foo" "/bar"))
(read-and-compile (open-input-string "rm -r /foo /bar\n")
#:from %bournish-language #:to 'scheme))
(test-end "bournish") (test-end "bournish")