Scripts/parking.scm

(import medea)
(import http-client)
(import srfi-1)
(import (chicken io))
(import (chicken sort))
(import srfi-13)

(define (curry fn a)
  (lambda (b)
    (fn a b)))

(define (perhaps fn a)
  (if a (fn a) a))

(define (member? a ln)
  (if (member a ln) #t #f))

(define (default b a)
  (if a a b))

(define value
  (compose (curry perhaps cdr) assoc))

(define (value-with-default k v ln)
  (default v (value k ln)))

(define (has-key? k ln)
  (member? k (map car ln)))

(define (sort-via less-than? fn ln)
  (sort ln (lambda (a b)
             (less-than? (fn a) (fn b)))))

(define (display-newline str)
  (display str)
  (newline))

(define (->string a)
  (cond ((string? a) a)
        ((symbol? a) (symbol->string a))
        ((number? a) (number->string a))
        ((char? a) (string a))))
    
(define (format-assoc statement ln)
  (apply string-append
         (map (lambda (directive)
                (if (symbol? directive)
                    (->string (value directive ln))
                    directive)) statement)))

(define (simple-json-request uri)
  (with-input-from-request uri #f read-json))

(define parking-key
  (with-input-from-file "key-parking" read-line))

(define (get-parking-lots)
  (let ((result (simple-json-request (string-append "http://parkering.linkoping.se/Parkeringsdata/ParkeringsdataV1.svc/GetParkeringsYtaList/" parking-key "/0"))))
    (value 'parkingareanewlist result)))

(define (computerized? lot)
  (has-key? 'parkingspacesavailable lot))

(define (only-has-handicap-spots? lot)
  (equal? '(4) (value 'parkingtypes lot)))

(define (electric-car-lot? lot)
  (member? 3 (value 'parkingtypes lot)))

(define (main)
  (json-parsers (append `((member . ,(lambda (k v)
                                       (cons (string->symbol (string-downcase k)) v)))
                          (array . ,identity)) (json-parsers)))
  (display-newline "Parking spaces available:")
  (let ((lots (sort-via string-ci<? (curry value 'name) (get-parking-lots))))
    (map (compose display-newline (curry format-assoc '(name ": " parkingspacesavailable "/" parkingspaces)))
         (filter (conjoin computerized? (complement only-has-handicap-spots?)) lots))))

(main)