fobil.lisp 5.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171
  1. ;;;; Copyright (c) 2020 Farooq Karimi Zadeh <fkz@riseup.net>
  2. ;;;; It's under ISC license.
  3. (ql:quickload :str)
  4. (ql:quickload :3bmd)
  5. (ql:quickload :3bmd-ext-code-blocks)
  6. (ql:quickload :cl-mustache)
  7. (ql:quickload :osicat)
  8. (ql:quickload :jonathan)
  9. (setf 3bmd:*smart-quotes* t)
  10. (setf 3bmd-code-blocks:*code-blocks* t)
  11. (defun random-color ()
  12. ;; A list of W3.css colors... change this if you
  13. ;; use some other CSS framework...
  14. (nth (random 28)
  15. '("red" "purple" "indigo" "light-blue" "aqua"
  16. "green" "lime" "khaki" "amber" "deep-orange"
  17. "brown" "gray" "pale-red" "pale-green"
  18. "pink" "deep-purple" "blue" "cyan" "teal"
  19. "light-green" "sand" "yellow" "orange"
  20. "blue-gray" "light-gray" "dark-gray"
  21. "pale-yellow" "pale-blue")))
  22. (defun convert-to-html (md)
  23. (with-output-to-string (stream)
  24. (3bmd:parse-string-and-print-to-stream md stream)))
  25. (defun get-title (html)
  26. (let ((start (search "<h3>" html))
  27. (end (search "</h3>" html)))
  28. (subseq html (+ start 4) end)))
  29. (defun get-summary (html)
  30. (let ((start (search "<p>" html))
  31. (end (search "</p>" html)))
  32. (subseq html (+ start 3) end)))
  33. (defun markdown? (path)
  34. (equalp "md" (pathname-type path)))
  35. (defun make-link (path name)
  36. (str:concat "<a href='" path "'>" name "</a>"))
  37. (defun join-links (links)
  38. (str:join "&nbsp;|&nbsp;" links))
  39. (defun get-file-size (path)
  40. (let ((stat (osicat-posix:stat path)))
  41. (osicat-posix:stat-size stat)))
  42. (defun get-human-readable-size (size)
  43. (let ((units '("B" "KB" "MB" "GB" "TB"))
  44. (unit 0))
  45. (loop when (< size 1024)
  46. return (str:concat
  47. (with-output-to-string (out) (format out "~a" (round size)))
  48. (nth unit units))
  49. do (setf size (/ size 1024))
  50. (incf unit))))
  51. (defun fobil (&optional filesp)
  52. (let* ((posts (uiop:directory-files #P"./posts/"))
  53. (pages (uiop:directory-files #P"./pages/"))
  54. (post-template (mustache:compile-template #P"./templates/post.html"))
  55. (page-template (mustache:compile-template #P"./templates/page.html"))
  56. (index-template (mustache:compile-template #P"./templates/index.html"))
  57. (pages-html (loop for page in pages
  58. when (markdown? page)
  59. collect (convert-to-html
  60. (uiop:read-file-string page))))
  61. (posts-html (loop for post in posts
  62. when (markdown? post)
  63. collect (convert-to-html
  64. (uiop:read-file-string post))))
  65. (pages-names (loop for page in pages
  66. when (markdown? page)
  67. collect (str:concat
  68. (pathname-name page) ".html")))
  69. (pages-titles (loop for page-html in pages-html
  70. collect (get-title page-html)))
  71. (posts-titles (loop for post-html in posts-html
  72. collect (get-title post-html)))
  73. (links-for-index '())
  74. (links-for-posts '())
  75. (links-for-pages '())
  76. (posts-names (loop for post in posts
  77. when (markdown? post)
  78. collect (str:concat
  79. (pathname-name post) ".html"))))
  80. (ensure-directories-exist "./out/")
  81. (ensure-directories-exist "./out/pages/")
  82. (ensure-directories-exist "./out/posts/")
  83. (loop for page-name in pages-names
  84. for page-title in pages-titles
  85. do
  86. (push
  87. (make-link (str:concat "./" page-name) page-title)
  88. links-for-pages)
  89. (push
  90. (make-link (str:concat "../pages/" page-name) page-title)
  91. links-for-posts)
  92. (push
  93. (make-link (str:concat "./pages/" page-name) page-title)
  94. links-for-index))
  95. (loop for page-name in pages-names
  96. for page-html in pages-html
  97. for page-title in pages-titles
  98. with links = (join-links links-for-pages)
  99. do (str:to-file
  100. (str:concat "./out/pages/" page-name)
  101. (with-output-to-string (out)
  102. (funcall page-template (list
  103. (cons "title" page-title)
  104. (cons "content" page-html)
  105. (cons "links" links))
  106. out))))
  107. (loop for post-name in posts-names
  108. for post-html in posts-html
  109. for post-title in posts-titles
  110. with links = (join-links links-for-posts)
  111. do (str:to-file
  112. (str:concat "./out/posts/" post-name)
  113. (with-output-to-string (out)
  114. (funcall post-template (list
  115. (cons "title" post-title)
  116. (cons "content" post-html)
  117. (cons "links" links))
  118. out))))
  119. (let* ((posts-data (loop for post-title in posts-titles
  120. for post-html in posts-html
  121. for post-summary = (get-summary post-html)
  122. for post-name in posts-names
  123. for post-link = (make-link
  124. (str:concat "./posts/" post-name)
  125. "Read more")
  126. collect (list (cons "post-title" (get-title post-html))
  127. (cons "post-summary" post-summary)
  128. (cons "post-link" post-link)))))
  129. (str:to-file #P"./out/index.html"
  130. (with-output-to-string (out)
  131. (funcall index-template
  132. (list (cons "links" (join-links links-for-index))
  133. (cons "foreach" posts-data))
  134. out))))
  135. (when (and (probe-file #P"./files") filesp)
  136. (let* ((files-template (mustache:compile-template #P"./templates/files.html"))
  137. (files-list (jonathan:parse
  138. (uiop:read-file-string #P"./files/list.json")))
  139. (files-list- (loop for file in files-list
  140. for addr = (getf file :|addr|)
  141. collect (list (cons "color"
  142. (random-color))
  143. (cons "addr"
  144. (file-namestring addr))
  145. (cons "title"
  146. (file-namestring addr))
  147. (cons "description"
  148. (getf file :|description|))
  149. (cons "size"
  150. (get-human-readable-size
  151. (get-file-size addr)))))))
  152. (ensure-directories-exist #P"./out/files/")
  153. (str:to-file #P"./out/files/index.html"
  154. (with-output-to-string (out)
  155. (funcall files-template
  156. (list (cons "links" (join-links links-for-posts))
  157. (cons "foreach" files-list-))
  158. out)))))))