|
- (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)
|