util: fixes and improvements

core/core.lisp

@@ -46,7 +46,8 @@
 
 (defvar *root* nil)
 
-(defclass base-context ())
+(defclass base-context ()
+  ())
 
 (defclass context () 
    ((config :reader config :initarg :config)
@@ -97,7 +98,7 @@
     (cond 
       ((do-actions ctx msg) t)
       ((do-actions ctx msg #'default-actions) t)
-      (t (log:warn "handle-message: no action selected for ~s" msg)))))
+      (t (util:lgw "no action selected" msg)))))
 
 (defun do-actions (ctx msg &optional (acts #'actions))
   (let ((hdlrs (select msg (funcall acts ctx))))
@@ -115,7 +116,7 @@
              (new-msg (message:create `(:scopes :echo ,@(cddr h))
                                       :data (shape:data msg))))
         (send sndr new-msg))
-      (log:warn "sender missing: ~s" msg))))
+      (util:lgw "sender missing" msg))))
 
 (defun do-print (ctx msg)
   (declare (ignore ctx))

shape/shape.lisp

@@ -24,7 +24,7 @@
   (print-fields rec stream 'head 'data))
 
 (defun print-fields (rec stream &rest fields)
-  (let ((fm (util:make-vars-format fields nil)))
+  (let ((fm (util:make-vars-format fields)))
     (print-unreadable-object (rec stream :type t)
       (apply #'format stream fm (mapcar #'(lambda (x) (funcall x rec)) fields)))))
 
@@ -37,7 +37,7 @@
 (defun head-plist (rec)
   (let (pl (hv (head rec)))
     (dolist (hf (head-fields rec))
-      (setf pl (cons hf (cons (util:keyword-to-string (pop hv)) pl))))
+      (setf pl (cons hf (cons (util:from-keyword (pop hv)) pl))))
     pl))
 
 (defun data-value (rec key)

util/util.lisp

@@ -4,10 +4,10 @@
   (:use :common-lisp)
   (:local-nicknames (:b64 :qbase64))
   #+sbcl (:import-from :sb-ext #:add-package-local-nickname)
-  (:export #:make-vars-format #:lg #:lgd #:lgi
+  (:export #:make-vars-format #:lg #:lgd #:lgi #:lgw
            #:from-unix-time #:to-unix-time
            #:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
-           #:flatten-str #:to-keyword #:keyword-to-string #:to-integer #:to-string
+           #:flatten-str #:from-keyword #:to-keyword #:to-integer #:to-string
            #:from-bytes #:to-bytes #:b64-decode #:b64-encode #:from-b64 #:to-b64
            #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
            #:relative-path #:runtime-path #:system-path
@@ -17,7 +17,7 @@
 
 ;;;; formatting and logging shortcuts
 
-(defun make-vars-format (vars info)
+(defun make-vars-format (vars &optional info)
   (let ((prefix (if info (format nil "~a: " info) "")))
     (format nil "~a~{~(~a~): ~~S ~}" prefix vars)))
 
@@ -28,6 +28,7 @@
 
 (defmacro lgd (&rest vars) `(lg :debug nil ,@vars))
 (defmacro lgi (&rest vars) `(lg :info nil ,@vars))
+(defmacro lgw (info &rest vars) `(lg :warn ,info ,@vars))
 
 ;;;; date and time manipulations
 
@@ -70,9 +71,6 @@
     (mapcar (lambda (x) (str:trim x)) 
             (str:lines s))))
 
-(defun keyword-to-string (k)
-  (if k (string-downcase k) ""))
-
 (defun to-string (k &key (sep " ") lower-case)
   (let ((pattern (if lower-case "~(~a~)" "~a")))
     (if (atom k)
@@ -82,6 +80,9 @@
 (defun to-integer (k)
   (parse-integer (string k)))
 
+(defun from-keyword (k)
+  (if k (string-downcase k) ""))
+
 (defun to-keyword (s)
   (if (string= s "")
     nil

web/jwt.lisp

@@ -19,8 +19,8 @@
   (let* ((exp (util:to-unix-time (+ (get-universal-time) ttl)))
          (payload (util:to-b64 
                     (format nil *payload-format* 
-                            (util:keyword-to-string subject)
-                            (util:keyword-to-string name) exp)
+                            (util:from-keyword subject)
+                            (util:from-keyword name) exp)
                     :scheme :uri))
          (data (str:join "." (list *header* payload)))
          (sig (crypt:sign data secret)))