|
|
@@ -0,0 +1,75 @@ |
|
|
|
(import medea) |
|
|
|
(import http-client) |
|
|
|
(import srfi-1) |
|
|
|
(import (chicken io)) |
|
|
|
(import (chicken sort)) |
|
|
|
|
|
|
|
(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")))) |
|
|
|
(vector->list (value 'ParkingAreaNewList result)))) |
|
|
|
|
|
|
|
(define (computerized? lot) |
|
|
|
(has-key? 'ParkingSpacesAvailable lot)) |
|
|
|
|
|
|
|
(define (only-has-handicap-spots? lot) |
|
|
|
(equal? '(4) (vector->list (value 'ParkingTypes lot)))) |
|
|
|
|
|
|
|
(define (electric-car-lot? lot) |
|
|
|
(member? 3 (value 'ParkingTypes lot))) |
|
|
|
|
|
|
|
(define (main) |
|
|
|
(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) |