86 lines
2.2 KiB
Scheme
86 lines
2.2 KiB
Scheme
(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 (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))
|
|
|
|
(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 (curry2 upon symbol? (compose ->string (curry (flip value) ln))) 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:")
|
|
(map (compose display-newline (curry format-assoc '(name ": " parkingspacesavailable "/" parkingspaces)))
|
|
(filter (conjoin computerized? (complement only-has-handicap-spots?))
|
|
(sort-via string-ci<? (curry value 'name) (get-parking-lots)))))
|
|
|
|
(main)
|