|
- ;;;; 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 medea)
- (import http-client)
- (import srfi-1)
- (import (chicken io))
- (import srfi-13)
- (import srfi-14)
-
- (define (curry fn a)
- (lambda (b)
- (fn a b)))
-
- (define (curry2 fn a b)
- (lambda (c)
- (fn a b c)))
-
- (define (perhaps fn a)
- (if a (fn a) a))
-
- (define (upon pred? fn a)
- (if (pred? a)
- (fn a)
- a))
-
- (define (member? a ln)
- (if (member a ln) #t #f))
-
- (define (default b a)
- (if a a b))
-
- ;;; Return the value for a given key in an association list, or #f if it doesn't exist.
- (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.
- (define (value-with-default k v ln)
- (default v (value k ln)))
-
- (define (has-key? k ln)
- (member? k (map car ln)))
-
- (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.
- (define (sort-via less-than? fn ln)
- (sort (lambda (a b)
- (less-than? (fn a) (fn b))) ln))
-
- (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))))
-
- ;;; 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.
- (define (format-assoc statement ln)
- (apply string-append
- (map (curry2 upon symbol? (compose ->string (curry (flip value) ln))) statement)))
-
- ;;; Get data from a uri and parse it as json.
- (define (simple-json-request uri)
- (with-input-from-request uri #f read-json))
-
- ;;; 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
- (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.
- (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.
- (define (computerized? lot)
- (has-key? 'parkingspacesavailable lot))
-
- ;;; The handicap lots are tracked as separate lots with duplicate names in the data set.
- (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.
- (define (electric-car-lot? lot)
- (member? 3 (value 'parkingtypes lot)))
-
- (define (main)
- ;; 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)) (json-parsers)))
- (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)
|