git.fiddlerwoaroof.com
stream-provider.lisp
114a2b3d
 (afa-user:define-package :stream-provider
   (:use :fw.lu)
   (:export
    #:get-stream-for
    #:stream-provider
    #:string-provider
    #:file-provider
    #:stream-key
    #:root
    #:streams
    #:with-storage-stream))
 (cl:in-package :stream-provider)
 
 (defclass stream-provider ()
   ())
 
 (defvar *store-root* *default-pathname-defaults*)
 
 (defgeneric stream-key (provider item)
   (:documentation "return a key for an item: must be able to be compared with EQUAL
 
 If you override on provider, make sure to CALL-NEXT-METHOD"))
 
 (defgeneric get-stream-for (provider streamable &rest extra-args)
   (:documentation "get a stream for a given streamable object"))
 
 (defgeneric root (provider)
   (:documentation "get the base path for the streams"))
 
 
 (defclass string-provider (stream-provider)
   ((%streams :reader streams :initform (make-hash-table :test 'equal))))
 
 (defmethod root ((provider string-provider))
   #p"/")
 
 (defmethod stream-key :around (provider item)
   (let ((key (call-next-method)))
     (check-type key (or string pathname))
     (uiop:enough-pathname key (root provider))))
 
 (defmethod get-stream-for ((provider string-provider) streamable &rest extra-args)
   (declare (ignore extra-args))
   (with-accessors* (streams) provider
     (vector-update-stream:make-update-stream 
      (setf (gethash (stream-key provider streamable) streams)
            (make-array 10 :adjustable t :fill-pointer 0)))))
 
 (defclass file-provider (stream-provider)
   ((%root :initarg :root :initform (error "need a root for a file-provider") :reader root)
    (%if-exists :initarg :if-exists :initform :supersede :reader if-exists)))
 
 (defmethod get-stream-for ((provider file-provider) streamable &rest extra-args)
   (declare (ignore extra-args))
   (with-accessors* (if-exists root) provider
     (let ((stream-key (merge-pathnames (stream-key provider streamable)
                                        root)))
       (when (eql if-exists :if-exists)
         (ensure-directories-exist stream-key))
       (open stream-key :direction :output :if-exists if-exists
             :element-type 'octet))))
 
 (defmacro with-storage-stream ((stream-sym object provider &rest extra-args) &body body)
   (once-only (object)
     `(let ((,stream-sym (flexi-streams:make-flexi-stream (get-stream-for ,provider ,object ,@extra-args)
                                                          :external-format :utf-8)))
        (unwind-protect (progn ,@body)
          (close ,stream-sym)))))