coleslaw/src/content.lisp - Recently Written

src/content.lisp (4488 bytes)
1 (in-package :coleslaw)
2 
3 ;; Tagging
4 
5 (defclass tag ()
6   ((name :initarg :name :reader tag-name)
7    (slug :initarg :slug :reader tag-slug)
8    (url  :initarg :url)))
9 
10 (defmethod initialize-instance :after ((tag tag) &key)
11   (with-slots (url slug) tag
12     (setf url (compute-url nil slug 'tag-index))))
13 
14 (defun make-tag (str)
15   "Takes a string and returns a TAG instance with a name and slug."
16   (let ((trimmed (string-trim " " str)))
17     (make-instance 'tag :name trimmed :slug (slugify trimmed))))
18 
19 (defun tag-slug= (a b)
20   "Test if the slugs for tag A and B are equal."
21   (string= (tag-slug a) (tag-slug b)))
22 
23 ;; Slugs
24 
25 (defun slug-char-p (char &key (allowed-chars (list #\- #\~)))
26   "Determine if CHAR is a valid slug (i.e. URL) character."
27   ;; use the first char of the general unicode category as kind of
28   ;; hyper general category
29   (let ((cat (char (cl-unicode:general-category char) 0))
30         (allowed-cats (list #\L #\N))) ; allowed Unicode categories in URLs
31         (cond
32           ((member cat allowed-cats)   t)
33           ((member char allowed-chars) t)
34           (t nil))))
35 
36 (defun unicode-space-p (char)
37   "Determine if CHAR is a kind of whitespace by unicode category means."
38   (char= (char (cl-unicode:general-category char) 0) #\Z))
39 
40 (defun slugify (string)
41   "Return a version of STRING suitable for use as a URL."
42   (let ((slugified (remove-if-not #'slug-char-p
43                                   (substitute-if #\- #'unicode-space-p string))))
44 	  (if (zerop (length slugified))
45         (error "Post title '~a' does not contain characters suitable for a slug!" string )
46         slugified)))
47 
48 ;; Content Types
49 
50 (defclass content ()
51   ((url  :initarg :url  :reader page-url)
52    (date :initarg :date :reader content-date)
53    (file :initarg :file :reader content-file)
54    (tags :initarg :tags :reader content-tags)
55    (text :initarg :text :reader content-text))
56   (:default-initargs :tags nil :date nil))
57 
58 (defmethod initialize-instance :after ((object content) &key)
59   (with-slots (tags) object
60     (when (stringp tags)
61       (setf tags (mapcar #'make-tag (cl-ppcre:split "," tags))))))
62 
63 (defun parse-initarg (line)
64   "Given a metadata header, LINE, parse an initarg name/value pair from it."
65   (let ((name (string-upcase (subseq line 0 (position #\: line))))
66         (match (nth-value 1 (scan-to-strings "[a-zA-Z]+:\\s+(.*)" line))))
67     (when match
68       (list (make-keyword name) (aref match 0)))))
69 
70 (defun parse-metadata (stream)
71   "Given a STREAM, parse metadata from it or signal an appropriate condition."
72   (flet ((get-next-line (input)
73            (string-trim '(#\Space #\Return #\Newline #\Tab) (read-line input nil))))
74     (unless (string= (get-next-line stream) (separator *config*))
75       (error "The file, ~a, lacks the expected header: ~a" (file-namestring stream) (separator *config*)))
76     (loop for line = (get-next-line stream)
77        until (string= line (separator *config*))
78        appending (parse-initarg line))))
79 
80 (defun read-content (file)
81   "Returns a plist of metadata from FILE with :text holding the content."
82   (flet ((slurp-remainder (stream)
83            (let ((seq (make-string (- (file-length stream)
84                                       (file-position stream)))))
85              (read-sequence seq stream)
86              (remove #\Nul seq))))
87     (with-open-file (in file :external-format :utf-8)
88       (let ((metadata (parse-metadata in))
89             (content (slurp-remainder in))
90             (filepath (enough-namestring file (repo-dir *config*))))
91         (append metadata (list :text content :file filepath))))))
92 
93 ;; Helper Functions
94 
95 (defun tag-p (tag obj)
96   "Test if OBJ is tagged with TAG."
97   (let ((tag (if (typep tag 'tag) tag (make-tag tag))))
98     (member tag (content-tags obj) :test #'tag-slug=)))
99 
100 (defun month-p (month obj)
101   "Test if OBJ was written in MONTH."
102   (search month (content-date obj)))
103 
104 (defun by-date (content)
105   "Sort CONTENT in reverse chronological order."
106   (sort content #'string> :key #'content-date))
107 
108 (defun find-content-by-path (path)
109   "Find the CONTENT corresponding to the file at PATH."
110   (find path (find-all 'content) :key #'content-file :test #'string=))
111 
112 (defgeneric render-text (text format)
113   (:documentation "Render TEXT of the given FORMAT to HTML for display.")
114   (:method (text (format (eql :html)))
115     text)
116   (:method (text (format (eql :md)))
117     (let ((3bmd-code-blocks:*code-blocks* t))
118       (with-output-to-string (str)
119         (3bmd:parse-string-and-print-to-stream text str)))))