haunt.scm 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405
  1. ;;; 8sync's website
  2. ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
  3. ;;;
  4. ;;; This program is free software: you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation, either version 3 of the License, or
  7. ;;; (at your option) any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; You should have received a copy of the GNU General Public License
  15. ;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  16. (use-modules (ice-9 match)
  17. (haunt asset)
  18. (haunt html)
  19. (haunt site)
  20. (haunt page)
  21. (haunt post)
  22. (haunt utils)
  23. (haunt builder blog)
  24. (haunt builder atom)
  25. (haunt builder assets)
  26. (haunt reader)
  27. (haunt reader skribe)
  28. (syntax-highlight)
  29. (syntax-highlight scheme))
  30. ;;; Utilities
  31. ;;; ---------
  32. (define %site-prefix (make-parameter ""))
  33. (define (prefix-url url)
  34. (string-append (%site-prefix) url))
  35. ;;; Latest release info
  36. ;;; -------------------
  37. (define latest-version "0.4.2")
  38. (define main-download-url "ftp://ftp.gnu.org/gnu/8sync/")
  39. (define latest-filename
  40. (string-append "8sync-"
  41. latest-version
  42. ".tar.gz"))
  43. (define latest-release-url
  44. (string-append main-download-url
  45. latest-filename))
  46. (define latest-release-sig-url
  47. (string-append latest-release-url
  48. ".sig"))
  49. ;;; Templates
  50. ;;; ---------
  51. (define (stylesheet name)
  52. `(link (@ (rel "stylesheet")
  53. (href ,(prefix-url (string-append "/css/" name ".css"))))))
  54. (define (base-image image alt)
  55. `(img (@ (src ,(prefix-url (string-append "/images/" image)))
  56. (alt ,alt))))
  57. (define (header-menu)
  58. `(("docs" "https://www.gnu.org/software/8sync/manual/")
  59. ("download" ,(prefix-url "/download/"))
  60. ("community" ,(prefix-url "/community/"))
  61. ("news" ,(prefix-url "/news/"))))
  62. (define* (base-layout site body
  63. #:key title big-logo)
  64. `((doctype "html")
  65. (head
  66. (meta (@ (charset "utf-8")))
  67. (title ,(if title
  68. (string-append title " -- 8sync")
  69. (site-title site)))
  70. ;; css
  71. (link (@ (rel "stylesheet")
  72. (href ,(prefix-url "/css/main.css"))))
  73. (link (@ (rel "stylesheet")
  74. (href ,(prefix-url "/css/code.css"))))
  75. ;; atom feed
  76. (link (@ (rel "alternate")
  77. (title "8sync news")
  78. (type "application/atom+xml")
  79. (href ,(prefix-url "/feed.xml")))))
  80. (body
  81. (div (@ (class "main-wrapper"))
  82. (header (@ (id "site-header"))
  83. ;; 8sync logo
  84. (div (@ (class "header-logo-wrapper"))
  85. (a (@ (href ,(prefix-url "/"))
  86. (class "8sync-header-logo"))
  87. ,(base-image ;; "8sync-logo-header.png"
  88. (if big-logo
  89. "8sync-logo-500px.png"
  90. "8sync-logo-300px.png")
  91. "8sync logo")))
  92. ;; Header menu
  93. (div (@ ,(if big-logo
  94. '(class "navbar-menu big-navbar")
  95. '(class "navbar-menu small-navbar")))
  96. ,@(map
  97. (lambda (item)
  98. (match item
  99. ((name url)
  100. `(div
  101. (a (@ (href ,url))
  102. ,name)))))
  103. (header-menu))))
  104. (div (@ (class "site-main-content"))
  105. ,body))
  106. ;; TODO: Link to source.
  107. (div (@ (class "footer"))
  108. (a (@ (href "https://notabug.org/cwebber/8sync-website"))
  109. "Site contents")
  110. " dual licensed under "
  111. (a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
  112. "Creative Commons 4.0 International")
  113. " and "
  114. (a (@ (href "http://www.gnu.org/licenses/gpl-3.0.en.html"))
  115. "the GNU GPL, version 3 or any later version")
  116. ". Powered by "
  117. (a (@ (href "http://haunt.dthompson.us/"))
  118. "Haunt")
  119. "."))))
  120. (define* (post-template post #:key post-link)
  121. `(div (@ (class "content-box blogpost"))
  122. (h1 (@ (class "title"))
  123. ,(if post-link
  124. `(a (@ (href ,post-link))
  125. ,(post-ref post 'title))
  126. (post-ref post 'title)))
  127. (div (@ (class "post-about"))
  128. (span (@ (class "by-line"))
  129. ,(post-ref post 'author))
  130. " -- " ,(date->string* (post-date post)))
  131. (div (@ (class "post-body"))
  132. ,(post-sxml post))))
  133. (define (post-uri site post)
  134. (prefix-url
  135. (string-append "/news/" (site-post-slug site post) ".html")))
  136. (define (collection-template site title posts prefix)
  137. ;; In our case, we ignore the prefix argument because
  138. ;; the filename generated and the pathname might not be the same.
  139. ;; So we use (prefix-url) instead.
  140. `((div (@ (class "news-header"))
  141. (h3 "recent news"))
  142. (div (@ (class "post-list"))
  143. ,@(map
  144. (lambda (post)
  145. (post-template post #:post-link (post-uri site post)))
  146. posts))))
  147. (define 8sync-haunt-theme
  148. (theme #:name "8sync"
  149. #:layout
  150. (lambda (site title body)
  151. (base-layout
  152. site body
  153. #:title title
  154. #:big-logo #f))
  155. #:post-template post-template
  156. #:collection-template collection-template))
  157. ;;; Plain content pages
  158. ;;; -------------------
  159. (define code-snippet
  160. (string-join
  161. '("(define-class <my-irc-bot> (<irc-bot>))"
  162. ""
  163. "(define-method (handle-line (irc-bot <my-irc-bot>) message"
  164. " speaker channel line emote?)"
  165. " (define my-name (irc-bot-username irc-bot))"
  166. " (define (looks-like-me? str)"
  167. " (or (equal? str my-name)"
  168. " (equal? str (string-concatenate (list my-name \":\")))))"
  169. " (match (string-split line #\\space)"
  170. " (((? looks-like-me? _) action action-args ...)"
  171. " (match action"
  172. " ;; The classic botsnack!"
  173. " (\"botsnack\""
  174. " (<- (actor-id irc-bot) 'send-line channel"
  175. " \"Yippie! *does a dance!*\"))"
  176. " ;; Return greeting"
  177. " ((or \"hello\" \"hello!\" \"hello.\" \"hi\" \"hi!\")"
  178. " (<- (actor-id irc-bot) 'send-line channel"
  179. " (format #f \"Oh hi ~a!\" speaker)))"
  180. " ;; Default"
  181. " (_"
  182. " (<- (actor-id irc-bot) 'send-line channel"
  183. " \"*stupid puppy look*\"))))))")
  184. "\n"))
  185. (define (index-content site posts)
  186. `(div
  187. ;; Main intro
  188. (div (@ (class "content-box bigger-text"))
  189. (h1 (@ (class "title"))
  190. "What's 8sync?")
  191. (p "8sync (pronounced \"eight-sync\") is an asynchronous "
  192. "programming library for "
  193. (a (@ (href "http://www.gnu.org/software/guile/"))
  194. "GNU Guile")
  195. ". Based on the "
  196. (a (@ (href "https://en.wikipedia.org/wiki/Actor_model"))
  197. "actor model")
  198. ", it makes use of "
  199. (a (@ (href "https://www.gnu.org/software/guile/manual/html_node/Prompts.html"))
  200. "delimited continuations")
  201. " to avoid a mess of callbacks "
  202. "resulting in clean, easy to read non-blocking code.")
  203. (p "8sync also aims to be batteries included. "
  204. "Ever wanted to make your own IRC bot? "
  205. "Here's a real example taken straight from "
  206. (a (@ (href "https://www.gnu.org/software/8sync/manual/html_node/Tutorial.html#Tutorial"))
  207. "the tutorial")
  208. ".")
  209. (div (@ (class "code"))
  210. ,(highlights->sxml
  211. (highlight lex-scheme code-snippet)))
  212. (p "8sync is alpha software, but with a promising future. "
  213. (a (@ (href "https://www.gnu.org/software/8sync/manual/html_node/Preface.html#Preface"))
  214. "Read more")
  215. " on 8sync's core ideas. "
  216. "Now's a great time to get involved in shaping the future of "
  217. "8sync. "
  218. (a (@ (href ,(prefix-url "/community/")))
  219. "Join us!")))
  220. ;; Video
  221. (div (@ (class "homepage-video-box"))
  222. (video (@ (controls "controls")
  223. (preload "metadata")
  224. (poster ,(prefix-url "/images/live_network_coding_8sync-video-preview.jpg")))
  225. (source (@ (src "https://archive.org/download/feb_2017-live_network_coding_8sync/live_network_coding_8sync.webm")
  226. (type "video/webm"))
  227. (@ (src "https://archive.org/download/feb_2017-live_network_coding_8sync/live_network_coding_8sync.mp4")
  228. (type "video/mp4")))))
  229. (p (@ (style "text-align: center; margin-top: 0px;"))
  230. (i "Watch 8sync in action through live hacking a multiplayer game! "
  231. "Or watch the "
  232. (a (@ (href "https://ftp.heanet.ie/mirrors/fosdem-video/2017/K.4.601/networkfreedom.vp8.webm"))
  233. "FOSDEM edition")
  234. " of this talk!"))
  235. ;; News updates and etc
  236. (div (@ (class "content-box homepage-news-box"))
  237. (h1 (@ (class "title"))
  238. "News!")
  239. (ul (@ (class "homepage-news-items"))
  240. ,@(map (lambda (post)
  241. `(li (a (@ (href ,(post-uri site post)))
  242. ,(post-ref post 'title))
  243. (div (@ (class "news-feed-item-date"))
  244. ,(date->string* (post-date post)))))
  245. (take-up-to 10 (posts/reverse-chronological posts)))))))
  246. (define (index-page site posts)
  247. (make-page
  248. "index.html"
  249. (base-layout site
  250. (index-content site posts)
  251. #:big-logo #t)
  252. sxml->html))
  253. ;; (define (docs-content posts)
  254. ;; `(div (@ (class "content-box"))
  255. ;; (h1 (@ (class "title"))
  256. ;; "Documentation")
  257. ;; (p
  258. ;; "We haven't done a formal export yet! :) "
  259. ;; "I suppose in the meanwhile we should add an appropriately oldschool "
  260. ;; (a (@ (href "http://www.textfiles.com/underconstruction/"))
  261. ;; "under construction gif")
  262. ;; " here...")
  263. ;; (p
  264. ;; "In the meanwhile, you can read a "
  265. ;; (a (@ (href "http://dustycloud.org/tmp/8sync-tutorial-part1.html"))
  266. ;; "work in progress tutorial")
  267. ;; ".")))
  268. ;; (define (docs-page site posts)
  269. ;; (make-page
  270. ;; "docs/index.html"
  271. ;; (base-layout site
  272. ;; (docs-content posts)
  273. ;; #:big-logo #f)
  274. ;; sxml->html))
  275. (define (download-content posts)
  276. `(div (@ (class "content-box"))
  277. (h1 (@ (class "title"))
  278. "Download")
  279. (ul
  280. (li "Download the latest 8sync release: "
  281. (a (@ (href ,latest-release-url))
  282. ,latest-filename)
  283. " (" (a (@ (href ,latest-release-sig-url))
  284. "signature") ")")
  285. (li "See "
  286. (a (@ (href ,main-download-url))
  287. "all 8sync releases")))
  288. (p "For the latest code, we are "
  289. (a (@ (href "https://savannah.gnu.org/projects/8sync"))
  290. "hosted on Savannah. ")
  291. "Pull down our git repo:")
  292. (div (@ (class "code"))
  293. "git clone git://git.savannah.gnu.org/8sync.git")))
  294. (define (download-page site posts)
  295. (make-page
  296. "download/index.html"
  297. (base-layout site
  298. (download-content posts)
  299. #:big-logo #f)
  300. sxml->html))
  301. (define (community-content posts)
  302. `(div (@ (class "content-box"))
  303. (h1 (@ (class "title"))
  304. "Community")
  305. (p "Want to get involved in 8sync development? "
  306. "(Contributions of all kind are welcome!) "
  307. "Or maybe you're just a user looking for some help? "
  308. "We'd love to hear from you!")
  309. (ul
  310. (li (b "IRC:")
  311. " Chat with us on " (b "irc.freenode.net") " in "
  312. (a (@ (href "http://webchat.freenode.net/?channels=guile"))
  313. "#guile")
  314. " and "
  315. (a (@ (href "http://webchat.freenode.net/?channels=8sync"))
  316. "#8sync")
  317. ".")
  318. (li (b "Email:")
  319. " For now we're using the "
  320. (a (@ (href "https://lists.gnu.org/mailman/listinfo/guile-user"))
  321. "guile-user mailing list")
  322. " for most communication. "
  323. "You can also send patches there. "
  324. "Maybe in the future we'll get our own mailing lists..."))))
  325. (define (community-page site posts)
  326. (make-page
  327. "community/index.html"
  328. (base-layout site
  329. (community-content posts)
  330. #:big-logo #f)
  331. sxml->html))
  332. ;;; Site constructor
  333. ;;; ----------------
  334. (define* (make-site #:key
  335. site-prefix
  336. (build-directory "site"))
  337. (if site-prefix
  338. (%site-prefix site-prefix))
  339. (site #:title "8sync: Asynchronous Programming Made Awesome"
  340. #:domain "8sync.org"
  341. #:default-metadata
  342. '((author . "Christopher Allan Webber")
  343. (email . "cwebber@dustycloud.org"))
  344. #:readers (list (make-skribe-reader
  345. #:modules '((haunt skribe utils)
  346. (skribe-utils))))
  347. #:build-directory build-directory
  348. #:builders (list (blog #:theme 8sync-haunt-theme
  349. #:prefix "/news")
  350. index-page
  351. ;; docs-page
  352. download-page
  353. community-page
  354. (atom-feed #:blog-prefix (prefix-url "/news"))
  355. (atom-feeds-by-tag #:blog-prefix (prefix-url "/news"))
  356. (static-directory "static/images" "images")
  357. (static-directory "static/css" "css")
  358. ;;; Not sure we'll ever need this
  359. ;; (static-directory "static/js" "js")
  360. (static-directory "static/fonts" "fonts"))))
  361. (make-site)