02/02: bournish: Add 'wc' command.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit bae06364c16d7e36bc17e636637f9943855bf0df
Author: Efraim Flashner <address@hidden>
Date:   Sun May 22 14:56:06 2016 +0300

    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 <address@hidden>
---
 guix/build/bournish.scm |   62 ++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 61 insertions(+), 1 deletion(-)

diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm
index 1f17e0a..928bef5 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 <address@hidden>
+;;; Copyright © 2016 Efraim Flashner <address@hidden>
 ;;;
 ;;; 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