commit baa1826e3d59609fde776e00317a4988c435953e
parent c21890d6a7d8b43ad3093e552c1a2c898faccf2e
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Sun, 14 Jan 2024 13:57:47 +0200
Spruce up the commands.
Diffstat:
6 files changed, 185 insertions(+), 61 deletions(-)
diff --git a/bin/rsv2scm.scm b/bin/rsv2scm.scm
@@ -1,30 +0,0 @@
-#!/usr/bin/guile \
---r7rs -e main -L . -s
-!#
-
-;;; Scheme implementation of RSV - Rows of String Values.
-;;; Copyright (C) 2024 Yuval Langer.
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-(import (scheme base)
- (scheme file)
- (scheme write)
- (rsv))
-
-(define (main args)
- (cond
- ((= (length args) 1)
- (write (read-rsv (current-input-port)))
- (newline))))
diff --git a/bin/scm2rsv.scm b/bin/scm2rsv.scm
@@ -1,31 +0,0 @@
-#!/usr/bin/guile \
---r7rs -e main -L . -s
-!#
-
-;;; Scheme implementation of RSV - Rows of String Values.
-;;; Copyright (C) 2024 Yuval Langer.
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-(import (scheme base)
- (scheme file)
- (scheme write)
- (rsv))
-
-(define (main args)
- (cond
- ((= (length args) 1)
- (let ((scm (read (current-input-port))))
- (write-rsv scm
- (current-output-port))))))
diff --git a/rsv/commands.scm b/rsv/commands.scm
@@ -0,0 +1,129 @@
+(define-library (rsv commands)
+ (import (scheme base)
+ (scheme cxr)
+ (scheme file)
+ (scheme read)
+ (scheme write)
+
+ (srfi srfi-41)
+
+ (rsv)
+ (rsv rows-streams)
+ (rsv version))
+ (export run-main
+ rsv2scm
+ rsv2scm-stream
+ scm2rsv)
+
+ (begin
+ (define (display-help args)
+ (let ((arg0 (car args)))
+ (display (string-append "Usage: "
+ arg0
+ " [OPTIONS]...
+
+Keywords:
+ -h, --help Print this help message.
+ -V, --version Display the version of "
+ arg0
+ " and exit.
+
+Send bug reports and questions to <yuval.langer@gmail.com>.
+"))))
+
+ (define (display-version args)
+ (let ((arg0 (car args)))
+ (display (string-append arg0
+ " version "
+ version
+ "
+Copyright (C) 2024 Yuval Langer
+License GPLv3+: GNU GPL version 3 or later
+<http://www.gnu.org/licenses/gpl.html>.
+This is free software: you are free to change and redistribute it.
+There is NO WARRANTY, to the extent permitted by law.
+"))))
+
+ (define (scm2rsv maybe-filename)
+ (write-rsv (read (file-or-current-input-port maybe-filename))
+ (current-output-port)))
+
+ (define (file-or-current-input-port maybe-filename)
+ (cond
+ ((null? maybe-filename)
+ (current-input-port))
+ (else
+ (open-input-file (car maybe-filename)))))
+
+ (define (rsv2scm-stream maybe-filename)
+ (let ((stream (port->rsv-row-stream (file-or-current-input-port maybe-filename))))
+ (let loop ((stream stream))
+ (cond
+ ((stream-null? stream)
+ '())
+ (else
+ (let ((row (stream-car stream)))
+ (write row)
+ (newline)
+ (loop (stream-cdr stream))))))))
+
+ (define (rsv2scm maybe-filename)
+ (write (read-rsv (file-or-current-input-port maybe-filename)))
+ (newline))
+
+ (define (run-main args command)
+ (let ((args-length (length args)))
+ (cond
+ ((= args-length 1)
+ (cond
+ ((eq? 'rsv2scm command)
+ (rsv2scm '()))
+ ((eq? 'scm2rsv command)
+ (scm2rsv '()))))
+ ((= args-length 2)
+ (let ((option (cadr args)))
+ (cond
+ ((or (equal? option "-V")
+ (equal? option "--version"))
+ (display-version args))
+ ((or (equal? option "-h")
+ (equal? option "--help"))
+ (display-help args))
+ ((or (equal? option "-s")
+ (equal? option "--stream"))
+ (cond
+ ((eq? 'rsv2scm command)
+ (rsv2scm-stream '()))
+ (else
+ (error "No stream option for:"
+ (car args)))))
+ ((eq? 'rsv2scm command)
+ (rsv2scm (list option)))
+ ((eq? 'scm2rsv command)
+ (scm2rsv (list option)))
+ (else
+ (error "Unknown commands:"
+ (cdr args))))))
+ ((= args-length 3)
+ (let ((option (cadr args))
+ (filename (caddr args)))
+ (cond
+ ((or (equal? option "-V")
+ (equal? option "--version"))
+ (display-version args))
+ ((or (equal? option "-h")
+ (equal? option "--help"))
+ (display-help args))
+ ((or (equal? option "-s")
+ (equal? option "--stream"))
+ (cond
+ ((eq? 'rsv2scm command)
+ (rsv2scm-stream (list filename)))
+ (else
+ (error "No stream option for:"
+ (car args)))))
+ (else
+ (error "Unknown commands:"
+ (cdr args))))))
+ (else
+ (error "Command does not accept more than one option.")))))))
diff --git a/rsv/version.scm b/rsv/version.scm
@@ -0,0 +1,4 @@
+(define-library (rsv version)
+ (import (scheme base))
+ (export version)
+ (begin (define version "0.1.0")))
diff --git a/rsv2scm.scm b/rsv2scm.scm
@@ -0,0 +1,26 @@
+#!/usr/bin/env -S guile --r7rs -e main -L . -s
+!#
+
+;;; Scheme implementation of RSV - Rows of String Values.
+;;; Copyright (C) 2024 Yuval Langer.
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+(import (scheme base)
+ (scheme file)
+ (scheme write)
+ (rsv commands))
+
+(define (main args)
+ (run-main args 'rsv2scm))
diff --git a/scm2rsv.scm b/scm2rsv.scm
@@ -0,0 +1,26 @@
+#!/usr/bin/env -S guile --r7rs -e main -L . -s
+!#
+
+;;; Scheme implementation of RSV - Rows of String Values.
+;;; Copyright (C) 2024 Yuval Langer.
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+(import (scheme base)
+ (scheme file)
+ (scheme write)
+ (rsv commands))
+
+(define (main args)
+ (run-main args 'scm2rsv))
