feat: add next, new, and consume functions

6 files changed, 106 insertions, 36 deletions

diff --git a/reading-heap.scm b/reading-heap.scm
index 48ad8eb..a7e3044 100755
--- a/reading-heap.scm
+++ b/reading-heap.scm
@@ -67,6 +67,8 @@
 	     (priorities (map media-priority media))
 	     (heap (fold heap-insert 'E priorities media)))
 	(server-setup (option-ref options 'service-socket))
-	(rh-receive heap)))))
+	(rh-receive heap
+		    (option-ref options 'media-library)
+		    (string-append (option-ref options 'media-library) "/archive/"))))))
 
 (main (command-line))
diff --git a/reading-heap/client.scm b/reading-heap/client.scm
deleted file mode 100644
index 92eb72b..0000000
--- a/reading-heap/client.scm
+++ /dev/null
@@ -1,18 +0,0 @@
-(define-module (reading-heap client))
-
-(use-modules (simple-zmq))
-
-(define context (zmq-create-context))
-(define client-socket (zmq-create-socket context ZMQ_REQ))
-
-(zmq-connect client-socket (string-append "ipc://"
-					  (or (getenv "XDG_RUNTIME_DIR")
-					      "/tmp")
-					  "/reading-zmq"))
-  
-(define (rh-client-receive)
-  (zmq-send client-socket "next")
-  (let ((msg (zmq-receive-bytevector client-socket 100)))
-    (display (bv->string msg))))
-
-(export rh-client-receive)
diff --git a/reading-heap/heap.scm b/reading-heap/heap.scm
index 770b055..2dcf2f7 100644
--- a/reading-heap/heap.scm
+++ b/reading-heap/heap.scm
@@ -1,4 +1,5 @@
 (define-module (reading-heap heap)
+  #:export (heap-empty?)
   #:export (heap-insert)
   #:export (heap-get-min)
   #:export (heap-delete-min)
diff --git a/reading-heap/media.scm b/reading-heap/media.scm
index ec5ee92..a4ffad4 100644
--- a/reading-heap/media.scm
+++ b/reading-heap/media.scm
@@ -28,7 +28,7 @@
 
 (define (filetree->media-list dirname)
   (define (enter? name stat result)
-    (not (member (basename name) '(".git" ".svn"))))
+    (not (member (basename name) '(".git" ".svn" "archive"))))
   (define (leaf name stat result)
     (cons (file->media name) result))
   (define (down name stat result) result)
diff --git a/reading-heap/zmq.scm b/reading-heap/zmq.scm
index 208ed75..65cf60e 100644
--- a/reading-heap/zmq.scm
+++ b/reading-heap/zmq.scm
@@ -11,11 +11,38 @@
 (define (server-setup sock)
   (zmq-bind-socket server-socket sock))
 
-(define (rh-receive heap)
-  (let ((command (zmq-receive server-socket 65335)))
-    (display command)
-    (zmq-send server-socket (media->json (heap-get-min heap))))
-  (rh-receive heap))
+(define (rh-receive heap write-location archive-location)
+  (let ((command (zmq-receive server-socket 1500)))
+    (cond ((string= command "next")
+	   (cond ((heap-empty? heap)
+		  (zmq-send server-socket "no media in queue"))
+		 (#t (zmq-send server-socket (media->json (heap-get-min heap)))))
+	   (rh-receive heap write-location archive-location))
+	  ((string= command "new")
+	   (zmq-send server-socket "ok")
+	   (let* ((media-raw (zmq-receive server-socket 1500))
+		  (media-data (json->media media-raw))
+		  (heap-new (heap-insert (media-priority media-data) media-data heap)))
+	     (call-with-output-file (string-append write-location
+						   "/"
+						   (media-title media-data))
+	       (lambda (port)
+		 (display media-raw port)))
+	     (zmq-send server-socket "ok")
+	     (rh-receive heap-new write-location archive-location)))
+	  ((string= command "consume")
+	   (let ((media (cond ((heap-empty? heap) "no media in queue")
+			      (#t (heap-get-min heap))))
+		 (heap-new (cond ((heap-empty? heap) heap)
+				 (#t (heap-delete-min heap)))))
+	     (rename-file (string-append write-location
+					 "/"
+					 (media-title media))
+			  (string-append archive-location
+					 "/"
+					 (media-title media)))
+	     (zmq-send server-socket "ok")
+	     (rh-receive heap-new write-location archive-location))))))
 
 (export rh-receive
 	server-setup)
diff --git a/scripts/rh-client.scm.in b/scripts/rh-client.scm.in
index d81acc4..64dfde6 100755
--- a/scripts/rh-client.scm.in
+++ b/scripts/rh-client.scm.in
@@ -1,12 +1,11 @@
 #!/usr/bin/env guile
 !#
-(define-module (reading-heap client))
-
 (use-modules (simple-zmq)
 	     (config)
 	     (config api)
 	     (config parser sexp)
-	     (config licenses))
+	     (config licenses)
+	     (json))
 
 (define config
   (configuration
@@ -27,12 +26,43 @@
       (test boolean?)
       (character #f))
      (switch
+      (name 'title)
+      (synopsis "title of the new media")
+      (default "Foundation Trilogy")
+      (test string?)
+      (character #t))
+     (switch
+      (name 'author)
+      (synopsis "author of the new media")
+      (default "Isaac Asimov")
+      (test string?)
+      (character #t))
+     (switch
+      (name 'location)
+      (synopsis "location of the new media")
+      (default "https://openlibrary.org/books/OL20930675M/The_foundation_trilogy")
+      (test string?)
+      (character #t))
+     (switch
+      (name 'priority)
+      (synopsis "priority of the new media")
+      (default "1")
+      (test string?)
+      (character #t))))
+   (subcommands
+    (list
+     (configuration
       (name 'next)
       (synopsis "get the next media to consume")
-      (default #f)
-      (test boolean?)
-      (character #t))
-     ))
+      (wanted '((keywords . (service-socket)))))
+     (configuration
+      (name 'new)
+      (synopsis "add new media to the heap")
+      (wanted '((keywords . (service-socket title author location priority)))))
+     (configuration
+      (name 'consume)
+      (synopsis "remove the next media from the heap")
+      (wanted '((keywords . (service-socket)))))))
    (directory (list (in-home ".reading-heap/")
 		    (path (given
 			   (string-append (or (getenv "XDG_CONFIG_HOME")
@@ -51,15 +81,43 @@
   
 (define (rh-client-next)
   (zmq-send client-socket "next")
-  (let ((msg (zmq-receive-bytevector client-socket 65335)))
+  (let ((msg (zmq-receive-bytevector client-socket 1500)))
     (display (bv->string msg))))
 
+(define (rh-client-new json)
+  (zmq-send client-socket "new")
+  (zmq-receive client-socket 1500)
+  (zmq-send client-socket json)
+  (display (zmq-receive client-socket 1500))
+  (zmq-send client-socket "next")
+  (display (zmq-receive client-socket 1500)))
+
+(define (rh-client-consumed)
+  (zmq-send client-socket "consume")
+  (display (zmq-receive client-socket 1500)))
+
+(define (json-from-args priority title author location)
+  (scm->json-string `(("priority" . ,priority)
+		      ("title" . ,title)
+		      ("author" . ,author)
+		      ("location" . ,location))))
+
 (define (main cmd-line)
   (let ((options (getopt-config-auto cmd-line config)))
     (when (option-ref options 'write)
       (options-write options))
-    (when (option-ref options 'next)
-      (client-setup (option-ref options 'service-socket))
-      (rh-client-next))))
+    (cond ((string=? (cadr (full-command options)) "next")
+	   (client-setup (option-ref options 'service-socket))
+	   (rh-client-next))
+	  ((string=? (cadr (full-command options)) "new")
+	   (client-setup (option-ref options 'service-socket))
+	   (rh-client-new (json-from-args (string->number (option-ref options 'priority))
+					  (option-ref options 'title)
+					  (option-ref options 'author)
+					  (option-ref options 'location))))
+	  ((string=? (cadr (full-command options)) "consume")
+	   (client-setup (option-ref options 'service-socket))
+	   (rh-client-consumed))
+	  (#t (emit-help options)))))
 
 (main (command-line))