123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141 |
- ;;;; Copyright (c) 2020 Farooq Karimi Zadeh <fkz@riseup.net>
- ;;;; It's under ISC license.
- (ql:quickload :str)
- (ql:quickload :3bmd)
- (ql:quickload :3bmd-ext-code-blocks)
- (ql:quickload :cl-ppcre)
- (setf 3bmd:*smart-quotes* t)
- (setf 3bmd-code-blocks:*code-blocks* t)
- (defun convert-to-html (md)
- (with-output-to-string (stream)
- (3bmd:parse-string-and-print-to-stream md stream)))
- (defun get-title (html)
- (let ((start (search "<h3>" html))
- (end (search "</h3>" html)))
- (subseq html (+ start 4) end)))
- (defun get-summary (html)
- (let ((start (search "<p>" html))
- (end (search "</p>" html)))
- (subseq html (+ start 3) end)))
- (defun markdown? (path)
- (equalp "md" (pathname-type path)))
- (defun make-link (path name)
- (str:concat "<a href='" path "'>" name "</a>"))
- (defun join-links (links)
- (str:join " | " links))
- (defun replace-multi (s &rest olds-news)
- (loop for old-new in olds-news
- do (setf s (str:replace-all (first old-new) (second old-new) s)))
- s)
- (defun find-summary-template (html)
- (first
- (cl-ppcre:all-matches-as-strings
- "(\\$\\$FOREACH\\$\\$(\\n(\\s*((?!\\$\\$END\\$\\$).)*\\n?)*)\\$\\$END\\\$\\$)"
- html)))
- (defun extract-index-post-template (html)
- (replace-multi (find-summary-template html)
- (list "$$FOREACH$$" "")
- (list "$$END$$" "")))
- (defun fobil ()
- (let* ((posts (uiop:directory-files #P"./posts/"))
- (pages (uiop:directory-files #P"./pages/"))
- (post-template (uiop:read-file-string #P"./templates/post.html"))
- (page-template (uiop:read-file-string #P"./templates/page.html"))
- (index-template (uiop:read-file-string #P"./templates/index.html"))
- (post-summary-template (extract-index-post-template
- index-template))
- (pages-html (loop for page in pages
- when (markdown? page)
- collect (convert-to-html
- (uiop:read-file-string page))))
- (posts-html (loop for post in posts
- when (markdown? post)
- collect (convert-to-html
- (uiop:read-file-string post))))
- (pages-names (loop for page in pages
- collect (str:concat
- (pathname-name page)
- ".html")))
- (pages-titles (loop for page-html in pages-html
- collect (get-title page-html)))
- (posts-titles (loop for post-html in posts-html
- collect (get-title post-html)))
- (index-posts "")
- (links-for-index '())
- (links-for-posts '())
- (links-for-pages '())
- (posts-names (loop for post in posts
- collect (str:concat
- (pathname-name post)
- ".html"))))
- (ensure-directories-exist "./out/")
- (ensure-directories-exist "./out/pages/")
- (ensure-directories-exist "./out/posts/")
- (loop for page-name in pages-names
- for page-title in pages-titles
- do
- (push
- (make-link (str:concat "./" page-name) page-title)
- links-for-pages)
- (push
- (make-link (str:concat "../pages/" page-name) page-title)
- links-for-posts)
- (push
- (make-link (str:concat "./pages/" page-name) page-title)
- links-for-index))
- (loop for page-name in pages-names
- for page-html in pages-html
- for page-title in pages-titles
- with links = (join-links links-for-pages)
- do (str:to-file
- (str:concat "./out/pages/" page-name)
- (replace-multi page-template
- (list "$$TITLE$$" page-title)
- (list "$$CONTENT$$" page-html)
- (list "$$LINKS$$" links))))
- (loop for post-name in posts-names
- for post-html in posts-html
- for post-title in posts-titles
- with links = (join-links links-for-posts)
- do (str:to-file
- (str:concat "./out/posts/" post-name)
- (replace-multi post-template
- (list "$$TITLE$$" post-title)
- (list "$$CONTENT$$" post-html)
- (list "$$LINKS$$" links))))
- (loop for post-title in posts-titles
- for post-html in posts-html
- for post-summary = (get-summary post-html)
- for post-name in posts-names
- for post-link = (make-link
- (str:concat "./posts/" post-name)
- "Read more")
- do
- (setf index-posts
- (str:concat index-posts
- (replace-multi post-summary-template
- (list "$$POST-TITLE$$"
- post-title)
- (list "$$POST-SUMMARY$$"
- post-summary)
- (list "$$POST-LINK$$"
- post-link)))))
- (str:to-file #P"./out/index.html"
- (replace-multi index-template
- (list (find-summary-template index-template)
- index-posts)
- (list "$$LINKS$$" (join-links
- links-for-index))))))
-
|