ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

bournish: Extend 'rm' command.

Browse source 
* guix/build/bournish.scm (rm-command): New procedure.
(%commands): Use it.
* tests/bournish.scm: Add tests for "rm" and "rm -r".
This commit is contained in:
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
Show stats Download patch file Download diff file Expand all files Collapse all files

11
guix/build/bournish.scm
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 @@ (define (cat-command file)
((@ (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 @@ (define %commands
`(("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)

12
tests/bournish.scm
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 @@ (define-module (test-bournish)
(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")