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>
This commit is contained in:
parent
125af57e09
commit
bae06364c1
|
@ -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 © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -25,6 +26,7 @@
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:export (%bournish-language))
|
#:export (%bournish-language))
|
||||||
|
|
||||||
|
@ -103,6 +105,63 @@ characters."
|
||||||
((@ (guix build utils) dump-port) port (current-output-port))
|
((@ (guix build utils) dump-port) port (current-output-port))
|
||||||
*unspecified*)))
|
*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 . _)
|
(define (help-command . _)
|
||||||
(display "\
|
(display "\
|
||||||
Hello, this is Bournish, a minimal Bourne-like shell in Guile!
|
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)
|
("help" ,help-command)
|
||||||
("ls" ,ls-command)
|
("ls" ,ls-command)
|
||||||
("which" ,which-command)
|
("which" ,which-command)
|
||||||
("cat" ,cat-command)))
|
("cat" ,cat-command)
|
||||||
|
("wc" ,wc-command)))
|
||||||
|
|
||||||
(define (read-bournish port env)
|
(define (read-bournish port env)
|
||||||
"Read a Bournish expression from PORT, and return the corresponding Scheme
|
"Read a Bournish expression from PORT, and return the corresponding Scheme
|
||||||
|
|
Loading…
Reference in New Issue