coleslaw/plugins/incremental.lisp

plugins/incremental.lisp (3431 bytes)
1 (eval-when (:compile-toplevel :load-toplevel)
2   (ql:quickload 'cl-store))
3 
4 (defpackage :coleslaw-incremental
5   (:use :cl)
6   (:import-from :alexandria #:when-let)
7   (:import-from :coleslaw #:*config*
8                           #:content
9                           #:index
10                           #:discover
11                           #:get-updated-files
12                           #:find-content-by-path
13                           #:add-document
14                           #:delete-document
15                           ;; Private
16                           #:all-subclasses
17                           #:do-subclasses
18                           #:read-content
19                           #:construct
20                           #:rel-path
21                           #:repo
22                           #:update-content-metadata)
23   (:export #:enable))
24 
25 (in-package :coleslaw-incremental)
26 
27 ;; In contrast to the original incremental plans, full of shoving state into
28 ;; the right place by hand and avoiding writing pages to disk that hadn't
29 ;; changed, the new plan is to only avoid redundant parsing of content in
30 ;; the git repo. The rest of coleslaw's operation is "fast enough".
31 ;;
32 ;;   Prior to enabling the plugin a user must have a cl-store dump of the
33 ;;   database at ~/.coleslaw.db. There is a dump_db shell script in
34 ;;   examples to generate the database dump.
35 ;;
36 ;; We're gonna be a bit dirty here and monkey patch. The compilation model
37 ;; still isn't an "exposed" part of Coleslaw. After some experimentation maybe
38 ;; we'll settle on an interface.
39 
40 (defun coleslaw::load-content ()
41   (let ((db-file (rel-path (user-homedir-pathname) ".coleslaw.db")))
42     (setf coleslaw::*site* (cl-store:restore db-file))
43     (loop for (status path) in (get-updated-files)
44        for file-path = (rel-path (repo-dir *config*) path)
45        do (update-content status file-path))
46     (update-content-metadata)
47     ;; Discover's :before method will delete any possibly outdated indexes.
48     (do-subclasses (itype index)
49       (discover itype))
50     (cl-store:store coleslaw::*site* db-file)))
51 
52 (defun update-content (status path)
53   (cond ((string= "D" status) (process-change :deleted path))
54         ((string= "M" status) (process-change :modified path))
55         ((string= "A" status) (process-change :added path))))
56 
57 (defgeneric process-change (status path &key &allow-other-keys)
58   (:documentation "Updates the database as needed for the STATUS change to PATH.")
59   (:method :around (status path &key)
60     (let ((extension (pathname-type path))
61           (ctypes (all-subclasses (find-class 'content))))
62       ;; If the updated file's extension doesn't match one of our content types,
63       ;; we don't need to mess with it at all. Otherwise, since the class is
64       ;; annoyingly tricky to determine, pass it along.
65       (when-let (ctype (find extension ctypes :test #'class-name-p))
66         (call-next-method status path :ctype ctype)))))
67 
68 (defmethod process-change ((status (eql :deleted)) path &key)
69   (let ((old (find-content-by-path path)))
70     (delete-document old)))
71 
72 (defmethod process-change ((status (eql :modified)) path &key ctype)
73   (let ((old (find-content-by-path path))
74         (new (construct ctype (read-content path))))
75     (delete-document old)
76     (add-document new)))
77 
78 (defmethod process-change ((status (eql :added)) path &key ctype)
79   (let ((new (construct ctype (read-content path))))
80     (add-document new)))
81 
82 (defun enable ())