-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathgeonames.lisp
195 lines (172 loc) · 11 KB
/
geonames.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
(in-package #:geonames)
(defparameter *base-url* "http://api.geonames.org/")
(defparameter *username* nil)
;; (defvar *error-codes*
;; '((10 . "Authorization Exception")
;; (11 . "record does not exist")
;; (12 . "other error")
;; (13 . "database timeout")
;; (14 . "invalid parameter")
;; (15 . "no result found")
;; (16 . "duplicate exception")
;; (17 . "postal code not found")
;; (18 . "daily limit of credits exceeded")
;; (19 . "hourly limit of credits exceeded")
;; (20 . "weekly limit of credits exceeded")
;; (21 . "invalid input")
;; (22 . "server overloaded exception")
;; (23 . "service not implemented")
;; (24 . "radius too large")
;; (27 . "maxRows too large")))
(define-condition geonames-error (simple-error)
((code :reader code
:initarg :code
:documentation "The error code.")
(message :reader message
:initarg :message
:documentation "Explanation message.")
(parent-condition :reader parent-condition
:initarg :parent-condition
:initform nil))
(:report (lambda (condition stream)
(format stream "Geonames error ~A: ~A."
(code condition) (message condition)))))
(declaim (inline key-normalize))
(defun key-normalize (key)
(string-upcase (kebab:to-lisp-case key)))
(defun handle-status-response (data &optional parent-condition)
(let ((status (getf data :status)))
(error (make-condition 'geonames-error
:code (getf status :value)
:message (getf status :message)
:parent-condition parent-condition))))
(defun api-call (uri params)
(handler-case (multiple-value-bind (body status headers)
(dex:get (strcat *base-url* uri "?"
(quri:url-encode-params (append params
(list (cons "username" *username*)))))
:keep-alive nil)
(declare (ignore status))
(let ((data (jojo:parse body :keyword-normalizer #'key-normalize
:normalize-all t)))
(cond ((not (string-prefix-p "application/json"
(gethash "content-type" headers "")))
(error "response must be JSON"))
((eq (car data) :status)
(handle-status-response data))
(t
data))))
(dex:http-request-failed (e)
(if (string-prefix-p "application/json"
(gethash "content-type" (dex:response-headers e) ""))
(let* ((data (jojo:parse (dex:response-body e)
:keyword-normalizer #'key-normalize
:normalize-all t)))
(handle-status-response data e))
(error e)))))
;; ========== PUBLIC
(defun postal-code-search (&key postal-code place-name postal-code-starts-with place-name-starts-with
country country-bias is-reduced east west north south
(operator :and) (max-rows 10) (style :medium))
(let ((data (api-call "postalCodeSearchJSON" (append `(("isReduced" . ,is-reduced)
("maxRows" . ,max-rows)
("style" . ,(string style))
("operator" . ,(string operator)))
(when postal-code `(("postalcode" . ,postal-code)))
(when place-name `(("placename" . ,place-name)))
(when postal-code-starts-with `(("postalcode_startsWith" . ,postal-code-starts-with)))
(when place-name-starts-with `(("placename_startsWith" . ,place-name-starts-with)))
(when country (mapcar (lambda (c) (cons "country" c))
(uiop:ensure-list country)))
(when country-bias `(("countryBias" . ,country-bias)))
(when east `(("east" . ,east)
("west" . ,west)
("north" . ,north)
("south" . ,south)))))))
(getf data :postal-codes)))
(defun postal-code-lookup (postal-code &key country callback (max-rows 20))
(let ((data (api-call "postalCodeLookupJSON" (append `(("postalcode" . ,postal-code)
("maxRows" . ,max-rows))
(when country (mapcar (lambda (c) (cons "country" c))
(uiop:ensure-list country)))
(when callback `(("callback" . ,callback)))))))
(getf data :postalcodes)))
(defun find-nearby-postal-codes (&key postal-code latitude longitude radius country local-country is-reduced
(max-rows 5) (style :medium))
(assert (or postal-code (and latitude longitude)))
(let ((data (api-call "findNearbyPostalCodesJSON" (append `(("isReduced" . ,is-reduced)
("maxRows" . ,max-rows)
("style" . ,(string style)))
(when postal-code `(("postalcode" . ,postal-code)))
(when latitude `(("lat" . ,latitude)))
(when longitude `(("lng" . ,longitude)))
(when radius `(("radius" . ,radius)))
(when local-country `(("localCountry" . ,local-country)))
(when country (mapcar (lambda (c) (cons "country" c))
(uiop:ensure-list country)))))))
(getf data :postal-codes)))
(defun postal-code-country-info ()
(getf (api-call "postalCodeCountryInfoJSON" nil)
:geonames))
(defun find-nearby-place-name (latitude longitude &key radius local-country cities language
(max-rows 10) (style :medium))
(let ((data (api-call "findNearbyPlaceNameJSON" (append `(("maxRows" . ,max-rows)
("style" . ,(string style)))
(when latitude `(("lat" . ,latitude)))
(when longitude `(("lng" . ,longitude)))
(when radius `(("radius" . ,radius)))
(when local-country `(("localCountry" . ,local-country)))
(when cities `(("cities" . ,cities)))
(when language `(("lang" . ,language)))))))
(getf data :geonames)))
(defun find-nearby (latitude longitude &key radius local-country feature-class feature-code
(max-rows 10) (style :medium))
(let ((data (api-call "findNearbyJSON" (append `(("lat" . ,latitude)
("lng" . ,longitude)
("maxRows" . ,max-rows)
("style" . ,(string style)))
(when radius `(("radius" . ,radius)))
(when local-country `(("localCountry" . ,local-country)))
(when feature-code (mapcar (lambda (c) (cons "featureCode" c))
(uiop:ensure-list feature-code)))
(when feature-class `(("featureClass" . ,feature-class)))))))
(getf data :geonames)))
(defun extended-find-nearby (latitude longitude)
(getf (api-call "extendedFindNearbyJSON" `(("lat" . ,latitude)
("lng" . ,longitude)))
:geonames))
(defun country-info (&key country language)
(let ((data (api-call "countryInfoJSON" (append
(when language `(("lang" . ,language)))
(when country (mapcar (lambda (c) (cons "country" c))
(uiop:ensure-list country)))))))
(getf data :geonames)))
(defun country-code (latitude longitude &key radius type language)
(api-call "countryCodeJSON" (append `(("lat" . ,latitude)
("lng" . ,longitude))
(when radius `(("radius" . ,radius)))
(when type `(("type" . ,type)))
(when language `(("lang" . ,language))))))
(defun country-subdivision (latitude longitude &key radius level language)
(api-call "countrySubdivisionJSON" (append `(("lat" . ,latitude)
("lng" . ,longitude))
(when radius `(("radius" . ,radius)))
(when level `(("level" . ,level)))
(when language `(("lang" . ,language))))))
(defun srtm1 (latitude longitude)
(api-call "srtm1JSON" `(("lat" . ,latitude)
("lng" . ,longitude))))
(defun srtm3 (latitude longitude)
(api-call "srtm3JSON" `(("lat" . ,latitude)
("lng" . ,longitude))))
(defun astergdem (latitude longitude)
(api-call "astergdemJSON" `(("lat" . ,latitude)
("lng" . ,longitude))))
(defun gtopo30 (latitude longitude)
(api-call "gtopo30JSON" `(("lat" . ,latitude)
("lng" . ,longitude))))
(defun timezone (latitude longitude &key radius date)
(api-call "timezoneJSON" (append `(("lat" . ,latitude)
("lng" . ,longitude))
(when radius `(("radius" . ,radius)))
(when date `(("date" . ,date))))))