photo-store/photo-store.lisp

(in-package #:photo-store)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (restas::register-pkgmodule-traits 'photo-store)
  (restas:reconnect-all-routes))


;; photos: id | album_id | filename | size | taken | width | height | lat | lon
;; albums: id | parent_id | path | date | name | description | cover_id | accessibility

(defun imagep (path)
  (equal (string-downcase (pathname-type path)) "jpg"))

(defun dirname (directory)
  (car (last (pathname-directory directory))))

(defun guess-album-title (directory photos)
  (declare (ignore photos))
  (dirname directory))

(defvar *album-path-format*
  '(:year "/" :year "-" (:month 2) "-" (:day 2) "-" :name "/"))

(defun guess-album-path (directory photos)
  (let ((from (reduce #'local-time:timestamp-minimum photos :key (agetter :created-at)))
        (format (sublis `((:name . ,(dirname directory)))
                        *album-path-format*)))
    (local-time:format-timestring nil from :format format)))

(defun middle (seq)
  (elt seq (/ (length seq) 2)))

(defun load-album (directory)
  (let ((photos (mapcar 'load-photo-info (remove-if-not 'imagep (uiop:directory-files directory)))))
    (when photos
      (list (cons :title (guess-album-title directory photos))
            (cons :path (guess-album-path directory photos))
            (cons :cover (middle photos))
            (cons :photos photos)))))

(defun load-albums-from-dir (directory)
  (remove-if #'null (list* (load-album directory)
                           (loop for subdir in (uiop:subdirectories directory)
                              append (load-albums-from-dir subdir)))))

(defvar *path-url-mapping* nil "alist of path-2-url mapping")
(defun map-path (path)
  (loop for (base-path . base-url) in *path-url-mapping*
     for rel-path = (uiop:subpathp path base-path)
     when rel-path do (return (concatenate 'string base-url (namestring rel-path)))
     finally (error "Can't map path ~S" path)))

(defun photo-item (info)
  `((:src . ,(map-path (aget :path info)))
    (:title . ,(aget :name info))
    (:w . ,(first (aget :dim info)))
    (:h . ,(second (aget :dim info)))))

(defun album-item (album)
  `((:title . ,(aget :title album))
    (:cover . ,(photo-item (aget :cover album)))
    (:path . ,(namestring (aget :path album)))
    (:photos . ,(mapcar 'photo-item (aget :photos album)))))

(restas:define-route main ("")
  (asdf:system-relative-pathname :photo-store "index.html"))

;; Assets file path
(defparameter *assets-path*
  (asdf:system-relative-pathname :photo-store "assets/"))

(restas:define-route assets/css ("css/:file" :content-type "text/css")  
  (merge-pathnames file *assets-path*))

(restas:define-route assets/js ("js/:file" :content-type "application/x-javascript")
  (merge-pathnames file *assets-path*))

(defun json (object)
  (json:encode-json-to-string object))

(defvar *incoming-path* nil "Path for incoming photos")
(restas:define-route incoming ("incoming/"
                               :content-type "application/json")
  (json (mapcar 'album-item (load-albums-from-dir *incoming-path*))))

(defun start (&key (address "0.0.0.0") (port 8800))
  (restas:start '#:photo-store :address address :port port))