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 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 imagep (path)
  (equal (string-downcase (pathname-type path)) "jpg"))

(defun directory-images (directory)
  (remove-if-not 'imagep (uiop:directory-files directory)))

(defun load-album (directory)
  (let ((photos (mapcar 'load-photo-info (directory-images directory))))
    (when photos
      (list (cons :title (guess-album-title directory photos))
            (cons :path directory)
            (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 &optional incoming)
  `((:src . ,(map-path (aget :path info)))
    ,@(when incoming (list (cons :path (namestring (aget :path info)))))
    (:w . ,(first (aget :dim info)))
    (:h . ,(second (aget :dim info)))))

(defun album-item (album &optional incoming)
  `((:title . ,(aget :title album))
    (:cover . ,(photo-item (aget :cover album)))
    ,@(when incoming (list (cons :path (namestring (aget :path album)))
                           (cons :dest (guess-album-path (aget :path album)
                                                         (aget :photos album)))))
    (:photos . ,(mapcar #'(lambda (p) (photo-item p incoming)) (aget :photos album)))))

(defun other-images (directory images)
  (remove-if #'(lambda (img) (member img images :test #'equal))
             (directory-images directory)))

(defun directories (files)
  (delete-duplicates (mapcar #'uiop:pathname-directory-pathname files) :test #'equal))

(defun move-file-to (file dest)
  (uiop:rename-file-overwriting-target
   file (uiop:make-pathname* :defaults file :directory (pathname-directory dest))))

(defun move-images-with-folders (files dest)
  (labels ((move (files dest)
             (dolist (f files)
               (move-file-to f dest))))
    (let ((dirs (directories files)))
      (ensure-directories-exist dest)
      (move files dest)
      ;; Move all non-image files from original folders if no images left there
      (dolist (dir dirs)
        (unless (other-images dir files)
          (move (uiop:directory-files dir) dest)
          (uiop:delete-empty-directory dir))))))

(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*))))

(defvar *photo-storage-path* nil "Destination storage path")

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