Working client-server components.

.gitignore

@@ -0,0 +1,3 @@
+/quicklisp/
+/.qlot/
+/src/bin/

README.rst

@@ -15,5 +15,9 @@ How to collect progress bars from remote machines
 Ideas
 -----
 
+* Make progress reporting nice, like tqdm does::
+
+     68%|██████▊   | 679/1000 [01:23<00:40,  7.99it/s]
+
 * Add a data source from like: https://github.com/Xfennec/progress
   to show data about file downloads and cp, mv progresses.

progressor.asd

@@ -1,4 +1,12 @@
 (defsystem progressor
   :class :package-inferred-system
+  :version "0.1.0"
+  :description "A client/server to store long running jobs progress state."
+  :homepage "https://github.com/40ants/progressor"
   :pathname "src"
-  :depends-on ("progressor/server"))
+  :defsystem-depends-on (:deploy)
+  :build-operation "deploy-op"
+  :build-pathname "progressor"
+  :entry-point "progressor/cli/main:main"
+  :depends-on ("progressor/server"
+               "progressor/cli/main"))

qlfile.lock

@@ -5,4 +5,4 @@
 ("ultralisp" .
  (:class qlot.source.ql:source-ql-all
   :initargs (:distribution "http://dist.ultralisp.org" :%version :latest)
-  :version "20190813133504"))
+  :version "20190930013505"))

src/cli/main.lisp

@@ -0,0 +1,36 @@
+(defpackage #:progressor/cli/main
+  (:use #:cl #:defmain)
+  (:import-from #:progressor/client
+                #:list-progresses)
+  (:import-from #:progressor/models
+                #:get-description
+                #:print-progress)
+  (:shadow #:list)
+  (:export
+   #:main))
+(in-package progressor/cli/main)
+
+
+(defcommand (main list) ()
+  (handler-case
+      (let ((progresses (list-progresses)))
+        (cond
+          (progresses
+           (loop for progress in progresses
+                 do (format *standard-output*
+                            "~A~%"
+                            (get-description progress))
+                    (print-progress progress :stream *standard-output*)
+                    (format *standard-output*
+                            "~%")))
+          (t (format t "No jobs.~%"))))
+    (usocket:connection-refused-error ()
+      (format *error-output* "Unable to connect to the server.")
+      (values 1))))
+
+
+(defcommand (main server) ()
+  (format t "TODO: implement a server command."))
+
+
+(defmain main (&subcommand))

src/client.lisp

@@ -0,0 +1,80 @@
+(defpackage #:progressor/client
+  (:use #:cl)
+  (:import-from #:jsonrpc
+                #:client-connect
+                #:make-client)
+  (:export
+   #:create-progress
+   #:list-progresses))
+(in-package progressor/client)
+
+
+(defun restore-lisp-object (type obj)
+  (apply #'make-instance
+         type
+         (loop for key being the hash-keys in obj
+                 using (hash-value value)
+               appending
+               (list (alexandria:make-keyword (string-upcase key))
+                     value))))
+
+
+(defun make-call (method &rest args)
+  "Makes an RPC call with keyword arguments."
+  (let ((client (make-client)))
+    (client-connect client
+                    :url "http://localhost:7890"
+                    :mode :tcp)
+    (jsonrpc:call client method (alexandria:plist-hash-table
+                                 (loop for (key value) on args by #'cddr
+                                       appending (list (symbol-name key)
+                                                       value))))))
+
+
+(defun create-progress (id &key total
+                             (current 0)
+                             description)
+  (check-type id string)
+
+  (when (string= id "")
+    (error "Id should be a non empty string"))
+
+  (restore-lisp-object
+   'progressor/models:progress
+   (make-call "create"
+              :id id
+              :total total
+              :current current
+              :description description)))
+
+
+(defun increment-progress (id &optional (value 1))
+  (check-type id string)
+
+  (when (string= id "")
+    (error "Id should be a non empty string"))
+
+  (restore-lisp-object
+   'progressor/models:progress
+   (make-call "increment"
+              :id id
+              :value value)))
+
+(defun delete-progress (id)
+  (check-type id string)
+
+  (when (string= id "")
+    (error "Id should be a non empty string"))
+
+  (make-call "delete"
+             :id id))
+
+
+(defun list-progresses ()
+  (mapcar (alexandria:curry #'restore-lisp-object
+                            'progressor/models:progress)
+          (make-call "list")))
+
+
+(defun clear-progresses ()
+  (make-call "clear"))

src/models.lisp

@@ -1,12 +1,30 @@
 (defpackage #:progressor/models
   (:use #:cl)
+  (:import-from #:local-time
+                #:now
+                #:adjust-timestamp
+                #:timestamp<=
+                #:timestamp>=)
   (:export
    #:make-progress
    #:increment
-   #:print-progress))
+   #:print-progress
+   #:get-id
+   #:get-description
+   #:get-total
+   #:get-current
+   #:progress
+   #:expired-p
+   #:get-ttl
+   #:get-last-update-at
+   #:get-default-ttl))
 (in-package progressor/models)
 
 
+(defun get-default-ttl ()
+  (* 10 60))
+
+
 (defclass progress ()
   ((id :type string
        :initarg :id
@@ -24,12 +42,28 @@
    (current :type integer
             :initarg :current
             :initform 0
-            :accessor get-current)))
+            :accessor get-current)
+   (last-update-at :type integer
+                   :documentation "A timestamp of last `increment' call."
+                   :initarg :last-update-at
+                   :initform (local-time:now)
+                   :accessor get-last-update-at)
+   (ttl :type integer
+        :documentation "A number of seconds after the `last-update-at' when a progress will be removed from the list."
+        :initarg :ttl
+        :initform (get-default-ttl)
+        :accessor get-ttl)))
 
 
 (defun make-progress (id &key total
-                              (current 0)
-                              description)
+                           (current 0)
+                           description
+                           (ttl (get-default-ttl)))
+  (check-type id string)
+
+  (when (string= id "")
+    (error "Id should be a non empty string"))
+
   (when (and total
              (<= total 0))
     (error "Total should be a positive integer or nil."))
@@ -38,10 +72,11 @@
                  :id id
                  :description description
                  :total total
-                 :current current))
+                 :current current
+                 :ttl ttl))
 
 
-(defun print-progress (progress &key (stream t)
+(defun print-progress (progress &key (stream *standard-output*)
                                      (width 40)
                                      (char #\=))
   (cond
@@ -50,13 +85,15 @@
                       (get-total progress)))
             (current-width (min (ceiling (* width ratio))
                                 width)))
+       (write-char #\[
+                   stream)
        (loop repeat current-width
              do (write-char char
                             stream))
        (loop repeat (- width current-width)
              do (write-char #\Space
                             stream))
-       (format stream " ~F%"
+       (format stream "] ~F%"
                (coerce (* ratio 100)
                        'float))))
     (t (format stream "~A"
@@ -76,4 +113,22 @@
 (defun increment (progress &optional (value 1))
   (incf (get-current progress)
         value)
+  (setf (get-last-update-at progress)
+        (local-time:now))
   progress)
+
+
+(defun expired-p (progress)
+  (timestamp<=
+   (adjust-timestamp (get-last-update-at progress)
+     (offset :sec (get-ttl progress)))
+   (now)))
+
+
+(defmethod yason:encode ((progress progress) &optional stream)
+  (yason:encode-plist
+   (list :|id| (get-id progress)
+         :|description| (get-description progress)
+         :|total| (get-total progress)
+         :|current| (get-current progress))
+   stream))