;;; The Inevitable Game
;;; Copyright © 2018 David Thompson <davet@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(define-module (engine assets)
  #:use-module (ice-9 ftw)
  #:use-module (ice-9 match)
  #:use-module (engine inotify)
  #:use-module (oop goops)
  #:use-module (srfi srfi-1)
  #:use-module (config)
  #:export (<asset>
            artifact
            file-name
            loader
            args
            watch-asset-directory
            reload-modified-assets
            asset-ref
            define-asset))

(define-class <asset> ()
  ;; class slots for asset cache and live reloading
  (inotify #:allocation #:class #:init-form #f)
  ;; file-name -> assets mapping
  (asset-map #:allocation #:class #:init-form (make-hash-table))
  ;; args -> artifact mapping
  (artifact-cache #:allocation #:class #:init-form (make-weak-value-hash-table))
  (watches #:allocation #:class #:init-form '())
  ;; instance slots
  (artifact #:accessor artifact #:init-form #f)
  (file-name #:getter file-name #:init-keyword #:file-name)
  (loader #:getter loader #:init-keyword #:loader)
  (loader-args #:getter loader-args #:init-form '()
               #:init-keyword #:loader-args)
  (watch #:accessor watch #:init-form #f))

(define (absolute-file-name file-name)
  (if (absolute-file-name? file-name)
      file-name
      (string-append %assets-root "/" file-name)))

(define-method (initialize (asset <asset>) args)
  (next-method)
  (slot-set! asset 'file-name (absolute-file-name (file-name asset)))
  (let* ((asset-map (class-slot-ref <asset> 'asset-map))
         ;; Using a weak key hash table instead of a list to keep
         ;; track of all the assets that are associated with a file.
         ;; This way, their presence in the cache won't save them from
         ;; the GC.
         (sub-table (or (hash-ref asset-map (file-name asset))
                        (let ((wt (make-weak-key-hash-table)))
                          (hash-set! asset-map (file-name asset) wt)
                          wt))))
    (hash-set! sub-table asset asset)))

(define (asset-inotify)
  (class-slot-ref <asset> 'inotify))

(define (asset-map)
  (class-slot-ref <asset> 'asset-map))

(define (artifact-cache)
  (class-slot-ref <asset> 'artifact-cache))

(define (asset-watches)
  (class-slot-ref <asset> 'watches))

(define (directory-watched? dir)
  (find (lambda (watch)
          (string=? (inotify-watch-file-name watch) dir))
        (asset-watches)))

(define (watch-recursively dir)
  (let ((inotify (asset-inotify)))
    (file-system-fold (const #t) ; enter?
                      (lambda (name stat result) result) ; leaf
                      (lambda (name stat result) ; down
                        (cons (inotify-add-watch! inotify name '(create close-write moved-to))
                              result))
                      (lambda (name stat result) result) ; up
                      (lambda (name stat result) result) ; skip
                      (lambda (name stat errno result) result) ; error
                      '()
                      dir)))

(define (watch-asset-directory dir)
  ;; Lazily activate inotify.
  (unless (asset-inotify)
    (class-slot-set! <asset> 'inotify (make-inotify)))
  (unless (directory-watched? dir)
    (class-slot-set! <asset> 'watches
                     (append (watch-recursively dir)
                             (asset-watches)))))

(define (reload-modified-assets)
  (let ((inotify (asset-inotify)))
    (when inotify
      (while (inotify-pending-events? inotify)
        (let* ((event (inotify-read-event inotify))
               (type (inotify-event-type event))
               (file-name (string-append (inotify-watch-file-name
                                          (inotify-event-watch event))
                                         "/"
                                         (inotify-event-file-name event)))
               (assets (hash-ref (asset-map) file-name)))
          (cond
           ((and assets (or (eq? type 'close-write) (eq? type 'moved-to)))
            ;; Expire everything from cache, then reload.
            (hash-for-each (lambda (key asset)
                             (expire-cached-artifact (cache-key asset)))
                           assets)
            (hash-for-each (lambda (key asset)
                             (load! asset))
                           assets))
           ;; ooh, a new directory to watch!
           ((eq? type 'create)
            (watch-recursively file-name))))))))

(define (cache-key asset)
  (list (loader asset) (file-name asset) (loader-args asset)))

(define (cache-artifact key artifact)
  (hash-set! (artifact-cache) key artifact))

(define (expire-cached-artifact key)
  (hash-remove! (artifact-cache) key))

(define (fetch-cached-artifact key)
  (hash-ref (artifact-cache) key))

(define (load-artifact cache-key loader file-name loader-args)
  (or (fetch-cached-artifact cache-key)
      (let ((artifact (apply loader file-name loader-args)))
        (cache-artifact cache-key artifact)
        artifact)))

(define (load! asset)
  (let ((thing (load-artifact (cache-key asset)
                              (loader asset)
                              (file-name asset)
                              (loader-args asset))))
    (set! (artifact asset) thing)
    thing))

(define-method (asset-ref (asset <asset>))
  (or (artifact asset) (load! asset)))

(define-method (asset-ref anything)
  anything)

(define-syntax-rule (define-asset name
                      (loader file-name loader-args ...))
  (define name
    (make <asset>
      #:file-name file-name
      #:loader loader
      #:loader-args (list loader-args ...))))