123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405 |
- ;;; 8sync's website
- ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
- ;;;
- ;;; This program is free software: you can redistribute it and/or modify
- ;;; it under the terms of the GNU General Public License as published by
- ;;; the Free Software Foundation, either version 3 of the License, or
- ;;; (at your option) any later version.
- ;;;
- ;;; This program is distributed in the hope that it will be useful,
- ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;;; GNU General Public License for more details.
- ;;;
- ;;; You should have received a copy of the GNU General Public License
- ;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
- (use-modules (ice-9 match)
- (haunt asset)
- (haunt html)
- (haunt site)
- (haunt page)
- (haunt post)
- (haunt utils)
- (haunt builder blog)
- (haunt builder atom)
- (haunt builder assets)
- (haunt reader)
- (haunt reader skribe)
- (syntax-highlight)
- (syntax-highlight scheme))
- ;;; Utilities
- ;;; ---------
- (define %site-prefix (make-parameter ""))
- (define (prefix-url url)
- (string-append (%site-prefix) url))
- ;;; Latest release info
- ;;; -------------------
- (define latest-version "0.4.2")
- (define main-download-url "ftp://ftp.gnu.org/gnu/8sync/")
- (define latest-filename
- (string-append "8sync-"
- latest-version
- ".tar.gz"))
- (define latest-release-url
- (string-append main-download-url
- latest-filename))
- (define latest-release-sig-url
- (string-append latest-release-url
- ".sig"))
- ;;; Templates
- ;;; ---------
- (define (stylesheet name)
- `(link (@ (rel "stylesheet")
- (href ,(prefix-url (string-append "/css/" name ".css"))))))
- (define (base-image image alt)
- `(img (@ (src ,(prefix-url (string-append "/images/" image)))
- (alt ,alt))))
- (define (header-menu)
- `(("docs" "https://www.gnu.org/software/8sync/manual/")
- ("download" ,(prefix-url "/download/"))
- ("community" ,(prefix-url "/community/"))
- ("news" ,(prefix-url "/news/"))))
- (define* (base-layout site body
- #:key title big-logo)
- `((doctype "html")
- (head
- (meta (@ (charset "utf-8")))
- (title ,(if title
- (string-append title " -- 8sync")
- (site-title site)))
- ;; css
- (link (@ (rel "stylesheet")
- (href ,(prefix-url "/css/main.css"))))
- (link (@ (rel "stylesheet")
- (href ,(prefix-url "/css/code.css"))))
- ;; atom feed
- (link (@ (rel "alternate")
- (title "8sync news")
- (type "application/atom+xml")
- (href ,(prefix-url "/feed.xml")))))
- (body
- (div (@ (class "main-wrapper"))
- (header (@ (id "site-header"))
- ;; 8sync logo
- (div (@ (class "header-logo-wrapper"))
- (a (@ (href ,(prefix-url "/"))
- (class "8sync-header-logo"))
- ,(base-image ;; "8sync-logo-header.png"
- (if big-logo
- "8sync-logo-500px.png"
- "8sync-logo-300px.png")
- "8sync logo")))
- ;; Header menu
- (div (@ ,(if big-logo
- '(class "navbar-menu big-navbar")
- '(class "navbar-menu small-navbar")))
- ,@(map
- (lambda (item)
- (match item
- ((name url)
- `(div
- (a (@ (href ,url))
- ,name)))))
- (header-menu))))
- (div (@ (class "site-main-content"))
- ,body))
- ;; TODO: Link to source.
- (div (@ (class "footer"))
- (a (@ (href "https://notabug.org/cwebber/8sync-website"))
- "Site contents")
- " dual licensed under "
- (a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
- "Creative Commons 4.0 International")
- " and "
- (a (@ (href "http://www.gnu.org/licenses/gpl-3.0.en.html"))
- "the GNU GPL, version 3 or any later version")
- ". Powered by "
- (a (@ (href "http://haunt.dthompson.us/"))
- "Haunt")
- "."))))
- (define* (post-template post #:key post-link)
- `(div (@ (class "content-box blogpost"))
- (h1 (@ (class "title"))
- ,(if post-link
- `(a (@ (href ,post-link))
- ,(post-ref post 'title))
- (post-ref post 'title)))
- (div (@ (class "post-about"))
- (span (@ (class "by-line"))
- ,(post-ref post 'author))
- " -- " ,(date->string* (post-date post)))
- (div (@ (class "post-body"))
- ,(post-sxml post))))
- (define (post-uri site post)
- (prefix-url
- (string-append "/news/" (site-post-slug site post) ".html")))
- (define (collection-template site title posts prefix)
- ;; In our case, we ignore the prefix argument because
- ;; the filename generated and the pathname might not be the same.
- ;; So we use (prefix-url) instead.
- `((div (@ (class "news-header"))
- (h3 "recent news"))
- (div (@ (class "post-list"))
- ,@(map
- (lambda (post)
- (post-template post #:post-link (post-uri site post)))
- posts))))
- (define 8sync-haunt-theme
- (theme #:name "8sync"
- #:layout
- (lambda (site title body)
- (base-layout
- site body
- #:title title
- #:big-logo #f))
- #:post-template post-template
- #:collection-template collection-template))
- ;;; Plain content pages
- ;;; -------------------
- (define code-snippet
- (string-join
- '("(define-class <my-irc-bot> (<irc-bot>))"
- ""
- "(define-method (handle-line (irc-bot <my-irc-bot>) message"
- " speaker channel line emote?)"
- " (define my-name (irc-bot-username irc-bot))"
- " (define (looks-like-me? str)"
- " (or (equal? str my-name)"
- " (equal? str (string-concatenate (list my-name \":\")))))"
- " (match (string-split line #\\space)"
- " (((? looks-like-me? _) action action-args ...)"
- " (match action"
- " ;; The classic botsnack!"
- " (\"botsnack\""
- " (<- (actor-id irc-bot) 'send-line channel"
- " \"Yippie! *does a dance!*\"))"
- " ;; Return greeting"
- " ((or \"hello\" \"hello!\" \"hello.\" \"hi\" \"hi!\")"
- " (<- (actor-id irc-bot) 'send-line channel"
- " (format #f \"Oh hi ~a!\" speaker)))"
- " ;; Default"
- " (_"
- " (<- (actor-id irc-bot) 'send-line channel"
- " \"*stupid puppy look*\"))))))")
- "\n"))
- (define (index-content site posts)
- `(div
- ;; Main intro
- (div (@ (class "content-box bigger-text"))
- (h1 (@ (class "title"))
- "What's 8sync?")
- (p "8sync (pronounced \"eight-sync\") is an asynchronous "
- "programming library for "
- (a (@ (href "http://www.gnu.org/software/guile/"))
- "GNU Guile")
- ". Based on the "
- (a (@ (href "https://en.wikipedia.org/wiki/Actor_model"))
- "actor model")
- ", it makes use of "
- (a (@ (href "https://www.gnu.org/software/guile/manual/html_node/Prompts.html"))
- "delimited continuations")
- " to avoid a mess of callbacks "
- "resulting in clean, easy to read non-blocking code.")
- (p "8sync also aims to be batteries included. "
- "Ever wanted to make your own IRC bot? "
- "Here's a real example taken straight from "
- (a (@ (href "https://www.gnu.org/software/8sync/manual/html_node/Tutorial.html#Tutorial"))
- "the tutorial")
- ".")
- (div (@ (class "code"))
- ,(highlights->sxml
- (highlight lex-scheme code-snippet)))
- (p "8sync is alpha software, but with a promising future. "
- (a (@ (href "https://www.gnu.org/software/8sync/manual/html_node/Preface.html#Preface"))
- "Read more")
- " on 8sync's core ideas. "
- "Now's a great time to get involved in shaping the future of "
- "8sync. "
- (a (@ (href ,(prefix-url "/community/")))
- "Join us!")))
- ;; Video
- (div (@ (class "homepage-video-box"))
- (video (@ (controls "controls")
- (preload "metadata")
- (poster ,(prefix-url "/images/live_network_coding_8sync-video-preview.jpg")))
- (source (@ (src "https://archive.org/download/feb_2017-live_network_coding_8sync/live_network_coding_8sync.webm")
- (type "video/webm"))
- (@ (src "https://archive.org/download/feb_2017-live_network_coding_8sync/live_network_coding_8sync.mp4")
- (type "video/mp4")))))
- (p (@ (style "text-align: center; margin-top: 0px;"))
- (i "Watch 8sync in action through live hacking a multiplayer game! "
- "Or watch the "
- (a (@ (href "https://ftp.heanet.ie/mirrors/fosdem-video/2017/K.4.601/networkfreedom.vp8.webm"))
- "FOSDEM edition")
- " of this talk!"))
- ;; News updates and etc
- (div (@ (class "content-box homepage-news-box"))
- (h1 (@ (class "title"))
- "News!")
- (ul (@ (class "homepage-news-items"))
- ,@(map (lambda (post)
- `(li (a (@ (href ,(post-uri site post)))
- ,(post-ref post 'title))
- (div (@ (class "news-feed-item-date"))
- ,(date->string* (post-date post)))))
- (take-up-to 10 (posts/reverse-chronological posts)))))))
- (define (index-page site posts)
- (make-page
- "index.html"
- (base-layout site
- (index-content site posts)
- #:big-logo #t)
- sxml->html))
- ;; (define (docs-content posts)
- ;; `(div (@ (class "content-box"))
- ;; (h1 (@ (class "title"))
- ;; "Documentation")
- ;; (p
- ;; "We haven't done a formal export yet! :) "
- ;; "I suppose in the meanwhile we should add an appropriately oldschool "
- ;; (a (@ (href "http://www.textfiles.com/underconstruction/"))
- ;; "under construction gif")
- ;; " here...")
- ;; (p
- ;; "In the meanwhile, you can read a "
- ;; (a (@ (href "http://dustycloud.org/tmp/8sync-tutorial-part1.html"))
- ;; "work in progress tutorial")
- ;; ".")))
- ;; (define (docs-page site posts)
- ;; (make-page
- ;; "docs/index.html"
- ;; (base-layout site
- ;; (docs-content posts)
- ;; #:big-logo #f)
- ;; sxml->html))
- (define (download-content posts)
- `(div (@ (class "content-box"))
- (h1 (@ (class "title"))
- "Download")
- (ul
- (li "Download the latest 8sync release: "
- (a (@ (href ,latest-release-url))
- ,latest-filename)
- " (" (a (@ (href ,latest-release-sig-url))
- "signature") ")")
- (li "See "
- (a (@ (href ,main-download-url))
- "all 8sync releases")))
- (p "For the latest code, we are "
- (a (@ (href "https://savannah.gnu.org/projects/8sync"))
- "hosted on Savannah. ")
- "Pull down our git repo:")
- (div (@ (class "code"))
- "git clone git://git.savannah.gnu.org/8sync.git")))
- (define (download-page site posts)
- (make-page
- "download/index.html"
- (base-layout site
- (download-content posts)
- #:big-logo #f)
- sxml->html))
- (define (community-content posts)
- `(div (@ (class "content-box"))
- (h1 (@ (class "title"))
- "Community")
- (p "Want to get involved in 8sync development? "
- "(Contributions of all kind are welcome!) "
- "Or maybe you're just a user looking for some help? "
- "We'd love to hear from you!")
- (ul
- (li (b "IRC:")
- " Chat with us on " (b "irc.freenode.net") " in "
- (a (@ (href "http://webchat.freenode.net/?channels=guile"))
- "#guile")
- " and "
- (a (@ (href "http://webchat.freenode.net/?channels=8sync"))
- "#8sync")
- ".")
- (li (b "Email:")
- " For now we're using the "
- (a (@ (href "https://lists.gnu.org/mailman/listinfo/guile-user"))
- "guile-user mailing list")
- " for most communication. "
- "You can also send patches there. "
- "Maybe in the future we'll get our own mailing lists..."))))
- (define (community-page site posts)
- (make-page
- "community/index.html"
- (base-layout site
- (community-content posts)
- #:big-logo #f)
- sxml->html))
- ;;; Site constructor
- ;;; ----------------
- (define* (make-site #:key
- site-prefix
- (build-directory "site"))
- (if site-prefix
- (%site-prefix site-prefix))
- (site #:title "8sync: Asynchronous Programming Made Awesome"
- #:domain "8sync.org"
- #:default-metadata
- '((author . "Christopher Allan Webber")
- (email . "cwebber@dustycloud.org"))
- #:readers (list (make-skribe-reader
- #:modules '((haunt skribe utils)
- (skribe-utils))))
- #:build-directory build-directory
- #:builders (list (blog #:theme 8sync-haunt-theme
- #:prefix "/news")
- index-page
- ;; docs-page
- download-page
- community-page
- (atom-feed #:blog-prefix (prefix-url "/news"))
- (atom-feeds-by-tag #:blog-prefix (prefix-url "/news"))
- (static-directory "static/images" "images")
- (static-directory "static/css" "css")
- ;;; Not sure we'll ever need this
- ;; (static-directory "static/js" "js")
- (static-directory "static/fonts" "fonts"))))
- (make-site)
|