summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorEfraim Flashner <efraim@flashner.co.il>2016-05-22 14:56:06 +0300
committerLudovic Courtès <ludo@gnu.org>2016-06-23 10:27:02 +0200
commitbae06364c16d7e36bc17e636637f9943855bf0df (patch)
tree5d8b43ec7322b6fd4ddc689bcc221a60941de961 /guix
parent125af57e09a00d861d4e9bf73f36a08296218f8c (diff)
bournish: Add 'wc' command.
* guix/build/bournish.scm (lines+chars, file-exists?*, wc-print) (wc-l-print, wc-c-print, wc-command, wc-command-implementation) (wc-l-command-implementation, wc-c-command-implementation): New procedures. (%commands): Add 'wc'. Co-authored-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'guix')
-rw-r--r--guix/build/bournish.scm62
1 files changed, 61 insertions, 1 deletions
diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm
index 1f17e0a22d..928bef5b9e 100644
--- a/guix/build/bournish.scm
+++ b/guix/build/bournish.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,6 +26,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 ftw)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (%bournish-language))
@@ -103,6 +105,63 @@ characters."
((@ (guix build utils) dump-port) port (current-output-port))
*unspecified*)))
+(define (lines+chars port)
+ "Return the number of lines and number of chars read from PORT."
+ (let loop ((lines 0) (chars 0))
+ (match (read-char port)
+ ((? eof-object?) ;done!
+ (values lines chars))
+ (#\newline ;recurse
+ (loop (1+ lines) (1+ chars)))
+ (_ ;recurse
+ (loop lines (1+ chars))))))
+
+(define (file-exists?* file)
+ "Like 'file-exists?' but emits a warning if FILE is not accessible."
+ (catch 'system-error
+ (lambda ()
+ (stat file))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (format (current-error-port) "~a: ~a~%"
+ file (strerror errno))
+ #f))))
+
+(define (wc-print file)
+ (let-values (((lines chars)
+ (call-with-input-file file lines+chars)))
+ (format #t "~a ~a ~a~%" lines chars file)))
+
+(define (wc-l-print file)
+ (let-values (((lines chars)
+ (call-with-input-file file lines+chars)))
+ (format #t "~a ~a~%" lines file)))
+
+(define (wc-c-print file)
+ (let-values (((lines chars)
+ (call-with-input-file file lines+chars)))
+ (format #t "~a ~a~%" chars file)))
+
+(define (wc-command-implementation . files)
+ (for-each wc-print (filter file-exists?* files)))
+
+(define (wc-l-command-implementation . files)
+ (for-each wc-l-print (filter file-exists?* files)))
+
+(define (wc-c-command-implementation . files)
+ (for-each wc-c-print (filter file-exists?* files)))
+
+(define (wc-command . args)
+ "Emit code for the 'wc' command."
+ (cond ((member "-l" args)
+ `((@@ (guix build bournish) wc-l-command-implementation)
+ ,@(delete "-l" args)))
+ ((member "-c" args)
+ `((@@ (guix build bournish) wc-c-command-implementation)
+ ,@(delete "-c" args)))
+ (else
+ `((@@ (guix build bournish) wc-command-implementation) ,@args))))
+
(define (help-command . _)
(display "\
Hello, this is Bournish, a minimal Bourne-like shell in Guile!
@@ -129,7 +188,8 @@ commands such as 'ls' and 'cd'; it lacks globbing, pipes---everything.\n"))
("help" ,help-command)
("ls" ,ls-command)
("which" ,which-command)
- ("cat" ,cat-command)))
+ ("cat" ,cat-command)
+ ("wc" ,wc-command)))
(define (read-bournish port env)
"Read a Bournish expression from PORT, and return the corresponding Scheme