diff --git a/parking.scm b/parking.scm new file mode 100644 index 0000000..b3fcdf1 --- /dev/null +++ b/parking.scm @@ -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