Paste number 143311: guix package list web server

Paste number 143311: guix package list web server
Pasted by: davexunit
When:7 years, 3 months ago
Share:Tweet this! | http://paste.lisp.org/+32KV
Channel:None
Paste contents:
Raw Source | XML | Display As
#!/usr/bin/guile
-*- scheme-mode -*-
!#

(use-modules (ice-9 rdelim)
             (srfi srfi-1)
             (web request)
             (web server)
             (web uri)
             (guix packages)
             (guix licenses)
             (gnu packages)
             (sxml simple))

(define (license-link package)
  (let ((license (package-license package)))
    (if license
        (let ((license (if (list? license)
                           (first license)
                           license)))
          `(a (@ (href ,(license-uri license)))
              ,(license-name license)))
        "")))

(define (all-packages)
  `(html
    (head
     (title "GNU Guix")
     (link (@ (rel "stylesheet")
              (href "/css/bootstrap.css"))))
    (body
     (div (@ (class "container"))
      (h1 "GNU Guix")
      (h2 "Packages")
      (table (@ (class "table"))
             (tr (th "Name")
                 (th "Version")
                 (th "Synopsis")
                 (th "Home Page")
                 (th "License"))
             ,@(map (lambda (p)
                      `(tr (td ,(package-name p))
                           (td ,(package-version p))
                           (td ,(package-synopsis p))
                           (td (a (@ (href ,(package-home-page p)))
                                  ,(package-home-page p)))
                           (td ,(license-link p))))
                    (fold-packages cons '())))))))

(define (file-extension file-name)
  (last (string-split file-name #\.)))

(define (serve-file file-name)
  (let ((mime-types '(("css" . (text/css))
                      ("js" . (text/javascript)))))
    (values `((content-type . ,(assoc-ref mime-types
                                          (file-extension file-name))))
            (with-input-from-file (string-append "." file-name)
              read-string))))

(define (handler request body)
  (display request) (newline)
  (let ((uri (request-uri request)))
    (if (string=? (uri-path uri) "/")
        (values '((content-type . (text/html)))
                (string-append
                 "<!DOCTYPE html>\n"
                 (with-output-to-string
                   (lambda ()
                     (sxml->xml (all-packages))))))
        (serve-file (uri-path uri)))))

(run-server handler)

;;; Local Variables:
;;; compile-command: "./guix-web"
;;; End:

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.