ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-06 23:16: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
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -105,6 +106,14 @@ (define (cat-command file)
((@ (guix build utils) dump-port) port (current-output-port))
*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)
"Return the number of lines and number of chars read from PORT."
(let loop ((lines 0) (chars 0))
@ -194,7 +203,7 @@ (define %commands
`(("echo" ,(lambda strings `(list ,@strings)))
("cd" ,(lambda (dir) `(chdir ,dir)))
("pwd" ,(lambda () `(getcwd)))
("rm" ,(lambda (file) `(delete-file ,file)))
("rm" ,rm-command)
("cp" ,(lambda (source dest) `(copy-file ,source ,dest)))
("help" ,help-command)
("ls" ,ls-command)

12
tests/bournish.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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")
#: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")