scheme version of parking

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