fobil.lisp 4.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141
  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-ppcre)
  7. (setf 3bmd:*smart-quotes* t)
  8. (setf 3bmd-code-blocks:*code-blocks* t)
  9. (defun convert-to-html (md)
  10. (with-output-to-string (stream)
  11. (3bmd:parse-string-and-print-to-stream md stream)))
  12. (defun get-title (html)
  13. (let ((start (search "<h3>" html))
  14. (end (search "</h3>" html)))
  15. (subseq html (+ start 4) end)))
  16. (defun get-summary (html)
  17. (let ((start (search "<p>" html))
  18. (end (search "</p>" html)))
  19. (subseq html (+ start 3) end)))
  20. (defun markdown? (path)
  21. (equalp "md" (pathname-type path)))
  22. (defun make-link (path name)
  23. (str:concat "<a href='" path "'>" name "</a>"))
  24. (defun join-links (links)
  25. (str:join "&nbsp;|&nbsp;" links))
  26. (defun replace-multi (s &rest olds-news)
  27. (loop for old-new in olds-news
  28. do (setf s (str:replace-all (first old-new) (second old-new) s)))
  29. s)
  30. (defun find-summary-template (html)
  31. (first
  32. (cl-ppcre:all-matches-as-strings
  33. "(\\$\\$FOREACH\\$\\$(\\n(\\s*((?!\\$\\$END\\$\\$).)*\\n?)*)\\$\\$END\\\$\\$)"
  34. html)))
  35. (defun extract-index-post-template (html)
  36. (replace-multi (find-summary-template html)
  37. (list "$$FOREACH$$" "")
  38. (list "$$END$$" "")))
  39. (defun fobil ()
  40. (let* ((posts (uiop:directory-files #P"./posts/"))
  41. (pages (uiop:directory-files #P"./pages/"))
  42. (post-template (uiop:read-file-string #P"./templates/post.html"))
  43. (page-template (uiop:read-file-string #P"./templates/page.html"))
  44. (index-template (uiop:read-file-string #P"./templates/index.html"))
  45. (post-summary-template (extract-index-post-template
  46. index-template))
  47. (pages-html (loop for page in pages
  48. when (markdown? page)
  49. collect (convert-to-html
  50. (uiop:read-file-string page))))
  51. (posts-html (loop for post in posts
  52. when (markdown? post)
  53. collect (convert-to-html
  54. (uiop:read-file-string post))))
  55. (pages-names (loop for page in pages
  56. collect (str:concat
  57. (pathname-name page)
  58. ".html")))
  59. (pages-titles (loop for page-html in pages-html
  60. collect (get-title page-html)))
  61. (posts-titles (loop for post-html in posts-html
  62. collect (get-title post-html)))
  63. (index-posts "")
  64. (links-for-index '())
  65. (links-for-posts '())
  66. (links-for-pages '())
  67. (posts-names (loop for post in posts
  68. collect (str:concat
  69. (pathname-name post)
  70. ".html"))))
  71. (ensure-directories-exist "./out/")
  72. (ensure-directories-exist "./out/pages/")
  73. (ensure-directories-exist "./out/posts/")
  74. (loop for page-name in pages-names
  75. for page-title in pages-titles
  76. do
  77. (push
  78. (make-link (str:concat "./" page-name) page-title)
  79. links-for-pages)
  80. (push
  81. (make-link (str:concat "../pages/" page-name) page-title)
  82. links-for-posts)
  83. (push
  84. (make-link (str:concat "./pages/" page-name) page-title)
  85. links-for-index))
  86. (loop for page-name in pages-names
  87. for page-html in pages-html
  88. for page-title in pages-titles
  89. with links = (join-links links-for-pages)
  90. do (str:to-file
  91. (str:concat "./out/pages/" page-name)
  92. (replace-multi page-template
  93. (list "$$TITLE$$" page-title)
  94. (list "$$CONTENT$$" page-html)
  95. (list "$$LINKS$$" links))))
  96. (loop for post-name in posts-names
  97. for post-html in posts-html
  98. for post-title in posts-titles
  99. with links = (join-links links-for-posts)
  100. do (str:to-file
  101. (str:concat "./out/posts/" post-name)
  102. (replace-multi post-template
  103. (list "$$TITLE$$" post-title)
  104. (list "$$CONTENT$$" post-html)
  105. (list "$$LINKS$$" links))))
  106. (loop for post-title in posts-titles
  107. for post-html in posts-html
  108. for post-summary = (get-summary post-html)
  109. for post-name in posts-names
  110. for post-link = (make-link
  111. (str:concat "./posts/" post-name)
  112. "Read more")
  113. do
  114. (setf index-posts
  115. (str:concat index-posts
  116. (replace-multi post-summary-template
  117. (list "$$POST-TITLE$$"
  118. post-title)
  119. (list "$$POST-SUMMARY$$"
  120. post-summary)
  121. (list "$$POST-LINK$$"
  122. post-link)))))
  123. (str:to-file #P"./out/index.html"
  124. (replace-multi index-template
  125. (list (find-summary-template index-template)
  126. index-posts)
  127. (list "$$LINKS$$" (join-links
  128. links-for-index))))))