Set Bing's `Photo of the Day` as current wallpaper.

bing.rkt

#lang racket/base

;; bing.rkt
;;
;; Download Bing's Photo of the Day and set it as current
;; wallpaper. Uses hsetroot on Linux.

(require net/url
         racket/file
         racket/format
         racket/list
         racket/port
         racket/string
         racket/system
         json)

(define *bing-photo-of-the-day-url*
  (string->url
   "http://www.bing.com/HPImageArchive.aspx?format=js&idx=0&n=1&mkt=en-US"))

(define download-directory
  (make-parameter
   (build-path (find-system-path 'home-dir) "bing-wallpapers")))

(define (get-current-info)
  (read-json
   (get-pure-port *bing-photo-of-the-day-url*)))

(define (extract-bing-image-info info)
  (let ([url (string->url (~a "http://www.bing.com/" (hash-ref (car (hash-ref info 'images)) 'url)))]
        [name (last (string-split (hash-ref (car (hash-ref info 'images)) 'url) "/"))])
    (list name url)))

(define (download-wallpaper info)
  (let* ([name (first info)]
         [url (second info)]
         [download-path (build-path (download-directory) name)])
    (call-with-output-file download-path
      #:exists 'replace
      (λ (img-out)
        (copy-port (get-pure-port url) img-out)))
    (build-path download-path)))

(define (update-wallpaper path)
  (system* "/usr/bin/hsetroot" "-fill" path))

(module+ main
  (unless (directory-exists? (download-directory))
    (make-directory* (download-directory)))

  (let* ([bing-info (extract-bing-image-info (get-current-info))]
         [download-path (download-wallpaper bing-info)])
    (update-wallpaper download-path)))