git.fiddlerwoaroof.com
util.lisp
991d0162
 (in-package :fwoar.cl-git)
 
657ab332
 (defmacro defclass+ (name (&rest super) &body (direct-slots &rest options))
   (let ((initargs (mapcan (lambda (slot)
                             (serapeum:unsplice
                              (make-symbol
                               (symbol-name
                                (getf (cdr slot)
                                      :initarg)))))
                           direct-slots)))
     `(progn (defclass ,name ,super
               ,direct-slots
               ,@options)
             (defun ,name (,@initargs)
               (fw.lu:new ',name ,@initargs)))))
 
991d0162
 (fw.lu:defun-ct batch-4 (bytes)
   (mapcar 'fwoar.bin-parser:be->int
           (serapeum:batches bytes 4)))
 
 (fw.lu:defun-ct batch-20 (bytes)
   (serapeum:batches bytes 20))
 
 (defmacro sym->plist (&rest syms)
   `(list ,@(loop for sym in syms
                  append (list (alexandria:make-keyword sym)
                               sym))))
 
 (defmacro inspect- (s form)
   `(let ((result ,form))
      (format ,s "~&~s (~{~s~^ ~})~%~4t~s~%"
              ',form
              ,(typecase form
                 (list `(list ',(car form) ,@(cdr form)))
                 (t `(list ,form)))
              result)
      result))
 
 (defun inspect-* (fn)
   (lambda (&rest args)
     (declare (dynamic-extent args))
     (inspect- *trace-output*
               (apply fn args))))
 
0b3ed859
 (defun partition (char string &key from-end (with-offset nil wo-p))
991d0162
   (let ((pos (position char string :from-end from-end)))
     (if pos
657ab332
         (if wo-p
0b3ed859
             (list (subseq string 0 (+ pos with-offset 1))
                   (subseq string (+ pos 1 with-offset)))
             (list (subseq string 0 pos)
                   (subseq string (1+ pos))))
a7c6e622
       (list string
             nil))))
991d0162
 
 (defun partition-subseq (subseq string &key from-end)
   (let ((pos (search subseq string :from-end from-end)))
     (if pos
a7c6e622
         (list (subseq string 0 pos)
               (subseq string (+ (length subseq) pos)))
       (list string
             nil))))
991d0162
 
 (serapeum:defalias ->sha-string
   (data-lens:<>1 (data-lens:over 'fwoar.bin-parser:byte-array-to-hex-string)
                  'batch-20))
2fb0a2fc
 
 (defun read-bytes (count format stream)
b7739814
   (let ((seq (make-array count :element-type 'fwoar.cl-git.types:octet)))
2fb0a2fc
     (read-sequence seq stream)
     (funcall format
              seq)))
 
 (defun sp-ob (ob-string)
   (partition #\null
              ob-string))
 
 (defun split-object (object-data)
   (destructuring-bind (head tail)
       (partition 0
                  object-data)
     (destructuring-bind (type length)
         (partition #\space
                    (babel:octets-to-string head :encoding :latin1))
       (values tail
               (list type
                     (parse-integer length))))))
 
b7739814
 (defmacro with-open-files* ((&rest bindings) &body body)
   `(uiop:nest ,@(mapcar (serapeum:op
                           `(with-open-file ,_1))
                         bindings)
               (progn
                 ,@body)))