Lunar Homepage in Wisp

The SCSS functions have been adapted from those featured in Hugo's guile-lib.


Copyright (c) 2016 Hugo Hornquist
Copyright (c) 2023 antlers <antlers@illucid.net>

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

use-modules : haunt page
              haunt site
              haunt html
              srfi srfi-1

define : as-string string-like
  cond
       : string? string-like
         . string-like
       : number? string-like
         number->string string-like
       : symbol? string-like
         symbol->string string-like
       else
         throw 'bad-type
               . "expected number, string, or symbol: %s"
               . string-like

define : declaration->string decl
  string-concatenate
    ` , : as-string (car decl)
      . ": "
      , string-join : map as-string : cdr decl
                    . " "
      . ";"

define : sruleset->string ruleset
  string-concatenate
    if : not : list? : cadr ruleset
       map declaration->string : list ruleset
       append : list : as-string : car ruleset
                list "{"
                map declaration->string : cdr ruleset
                list "}"

define : scss->css struct
  string-join : map sruleset->string struct

define-syntax style
  syntax-rules :
    : _ structs ...
      ' style scss->css ' : structs ...

define css
  '
    a.button
      background bisque
      padding 0.5rem 1rem
      color black
      border-radius 0.5rem
    body
      display flex
      flex-direction column
      align-items center
      justify-content center
      text-align center

define index
  ` : doctype "html"
    html
      head
        title "Lunar - The defacto app for controlling monitor brightness"
        meta
          @ : itemprop "description"
              content "..."
        style , : scss->css css
      body
        @
          , style : background "#2e2431"
                    min-height 90vh
        h1
          @
            , style : color white
                      font bold 3rem monospace
          . Lunar
        img
          @ : src "https://files.lunar.fyi/display-page.png"
            , style : width 80%
        a
          @ : class button
              href "https://files.lunar.fyi/releases/Lunar.dmg"
          . Download

define : index-builder site posts
  make-page "index.html" index sxml->html

site #:title "Lunar - The defacto app for controlling monitor brightness"
     . #:domain "https://lunar.fyi/"
     . #:builders : list index-builder

(use-modules (haunt page)
             (haunt site)
             (haunt html)
             (srfi srfi-1))

(define (as-string string-like)
  (cond
    ((string? string-like)
     string-like)
    ((number? string-like)
     (number->string string-like))
    ((symbol? string-like)
     (symbol->string string-like))
    (else
     (throw 'bad-type
            "expected number, string, or symbol: %s"
            string-like))))

(define (declaration->string decl)
  (string-concatenate
    `(,(as-string (car decl))
      ": "
      ,(string-join (map as-string (cdr decl))
                    " ")
      ";")))

(define (sruleset->string ruleset)
  (string-concatenate
    (if (not (list? (cadr ruleset)))
        (map declaration->string (list ruleset))
        (append (list (as-string (car ruleset)))
                (list "{")
                (map declaration->string (cdr ruleset))
                (list "}")))))

(define (scss->css struct)
  (string-join (map sruleset->string struct)))

(define-syntax style
  (syntax-rules ()
    ((_ structs ...)
     '(style scss->css '(structs ...)))))

(define css
  '(
    (a.button
      (background bisque)
      (padding 0.5rem 1rem)
      (color black)
      (border-radius 0.5rem))
    (body
      (display flex)
      (flex-direction column)
      (align-items center)
      (justify-content center)
      (text-align center))))

(define index
  `((doctype "html")
    (html
      (head
        (title "Lunar - The defacto app for controlling monitor brightness")
        (meta
          (@ (itemprop "description")
             (content "...")))
        (style ,(scss->css css)))
      (body
        (@
          ,(style (background "#2e2431")
                  (min-height 90vh)))
        (h1
          (@
            ,(style (color white)
                    (font bold 3rem monospace)))
          Lunar)
        (img
          (@ (src "https://files.lunar.fyi/display-page.png")
             ,(style (width 80%))))
        (a
          (@ (class button)
             (href "https://files.lunar.fyi/releases/Lunar.dmg"))
          Download)))))

(define (index-builder site posts)
  (make-page "index.html" index sxml->html))

(site #:title "Lunar - The defacto app for controlling monitor brightness"
      #:domain "https://lunar.fyi/"
      #:builders (list index-builder))