Scripts/parking.scm

;;;; A program to print out the current real-time status of the computer parking terminal equipped
;;;; parking garages in the city of Linköping using the municipal open data API.

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

;; We want members to be parsed as lowercase symbols, and arrays to be parsed as lists.
;; This is not a legal way to parse json, which requires case-sensitive members
;; but makes for neater scheme code.
(json-parsers (append `((member . ,(lambda (k v)
                                     (cons (string->symbol (string-downcase k)) v)))
                        (array . ,identity)
                        (null . ,(constantly '()))) (json-parsers)))

(: curry (procedure * --> procedure))
(define (curry fn a)
  (lambda (b)
    (fn a b)))

(: curry2 (procedure * * --> procedure))
(define (curry2 fn a b)
  (lambda (c)
    (fn a b c)))

(: perhaps (procedure * -> *))
(define (perhaps fn a)
  (if a (fn a) a))

(: upon (('a -> boolean) ('a -> 'b) 'a -> (or 'a 'b)))
(define (upon pred? fn a)
  (if (pred? a) (fn a) a))

(: member? (* list --> boolean))
(define (member? a ln)
  (if (member a ln) #t #f))

(: default ('a 'b --> (or 'a 'b)))
(define (default b a)
  (if a a b))

(define-type association-list (list-of pair))

;;; Return the value for a given key in an association list, or #f if it doesn't exist.
(: value (* association-list --> *))
(define value
  (compose (curry perhaps cdr) assoc))

;;; Return the value for a given key in an association list, or a default value if it doesn't exist.
(: value-with-default (* * association-list --> *))
(define (value-with-default k v ln)
  (default v (value k ln)))

(: has-key? (* association-list --> boolean))
(define (has-key? k ln)
  (member? k (map car ln)))

(: sort (('a 'a -> boolean) (list-of 'a) --> (list-of 'a)))
(define (sort less-than? ln)
  (if (<= (length ln) 1)
      ln
      (append (sort less-than? (filter (complement (curry less-than? (car ln))) (cdr ln)))
              (list (car ln))
              (sort less-than? (filter (curry less-than? (car ln)) (cdr ln))))))

;;; Sort using fn to extract a value for less-than? to compare for each element in ln.
(: sort-via (('a 'a -> boolean) ('b -> 'a) (list-of 'b) -> (list-of 'b)))
(define (sort-via less-than? fn ln)
  (sort (lambda (a b)
          (less-than? (fn a) (fn b))) ln))

(: display-newline (string -> undefined))
(define (display-newline str)
  (display str)
  (newline))

(: ->string ((or string symbol number char) -> string))
(define (->string a)
  (cond ((string? a) a)
        ((symbol? a) (symbol->string a))
        ((number? a) (number->string a))
        ((char? a) (string a))))

;;; Given a list of either symbols or strings and an association list:
;;; look up every symbol from left to right in the association list and replace it with the value found
;;; then concatenate the resulting list of strings.
;;; Inspired by Python 3's dictionary formatting string syntax.
(: format-assoc ((list-of (or symbol string)) association-list --> string))
(define (format-assoc statement ln)
  (apply string-append
         (map (curry2 upon symbol? (compose ->string (curry (flip value) ln))) statement)))

(define-type json *)
(define-type json
  (or string boolean number float null
      (list-of json)
      (list-of (pair symbol json))))

;;; Get data from a uri and parse it as json.
(: simple-json-request (string -> json))
(define (simple-json-request uri)
  (condition-case (with-input-from-request uri #f read-json)
    ((exn i/o net) (begin (display-newline "Connection failed.")
                          (exit 1)))))

;;; The API key is an alphanumeric string of length 32
;;; The Linköping municipal open data API key generator portal is located at http://opendata.linkoping.se
(: parking-key string)
(define parking-key
  (string-delete char-set:whitespace (with-input-from-file "key-parking" read-line)))

;;; Get a list of parking lots with various metadata from the municipal servers.
;;; It should be noted that this API is both glitchy and bugged. Two bugs have been noted:
;;; the timestamp parameter, which is supposed to give you a list of lots changed since a given UNIX timestamp
;;; instead results in giving you every lot up until a timestamp of under one hour into the future, after which
;;; it returns nothing. This bug may be platform related; as of this writing the server system providing the API
;;; runs on Windows Server 2016 via IIS 10.0.
;;; The second bug involves returning only partial data upon request - no pattern to this bug has been observed.
(: get-parking-lots (-> json))
(define (get-parking-lots)
  (value 'parkingareanewlist
         (simple-json-request (string-append "http://parkering.linkoping.se/Parkeringsdata/ParkeringsdataV1.svc/GetParkeringsYtaList/" parking-key "/0"))))

;;; Only lots tracked by parking lot computer terminals have the parkingspacesavailable key.
(: computerized (json --> boolean))
(define (computerized? lot)
  (has-key? 'parkingspacesavailable lot))

;;; The handicap lots are tracked as separate lots with duplicate names in the data set.
(: only-has-handicap-spots? (json --> boolean))
(define (only-has-handicap-spots? lot)
  (equal? '(4) (value 'parkingtypes lot)))

;;; Electric car lots have a separate lot type, and the downtown parking garages have spaces with charging stations
;;; but they are not implemented in the data set.
(: electric-car-lot? (json --> boolean))
(define (electric-car-lot? lot)
  (member? 3 (value 'parkingtypes lot)))

(: main (-> undefined))
(define (main)
  (display-newline "Parking spaces available:")
  (map (compose display-newline (curry format-assoc '(name ": " parkingspacesavailable "/" parkingspaces)))
       (sort-via string-ci<? (curry value 'name)
                 (filter (conjoin computerized? (complement only-has-handicap-spots?)) (get-parking-lots)))))

(main)