Refactor JSON and XML and close streams

forecast.lisp

@@ -6,16 +6,10 @@
 (defun forecast (lat lon &key time (currently t) minutely hourly daily alerts)
   (handler-case
       (bordeaux-threads:with-timeout (5)
-        (yason:parse
-         (flexi-streams:make-flexi-stream
-          (drakma:http-request
-           (format nil
-                   "~A/~A/~A,~A~@[,~A~]?units=si&exclude=~:[currently,~;~]~:[minutely,~;~]~:[hourly,~;~]~:[daily,~;~]~:[alerts,~;~]flags&lang=ru"
-                   +forecast-api-url+ *forecast-api-key* lat lon time
-                   currently minutely hourly daily alerts)
-           :force-binary t :want-stream t :decode-content t)
-          :external-format :utf8)
-         :object-as :alist))
+        (json-request (format nil
+                              "~A/~A/~A,~A~@[,~A~]?units=si&exclude=~:[currently,~;~]~:[minutely,~;~]~:[hourly,~;~]~:[daily,~;~]~:[alerts,~;~]flags&lang=ru"
+                              +forecast-api-url+ *forecast-api-key* lat lon time
+                              currently minutely hourly daily alerts)))
     (bordeaux-threads:timeout () (error "Timeout"))))
 
 (defvar *forecast-point-formats*

foursquare.lisp

@@ -10,24 +10,14 @@
 
 (defun %fsq-api-call (method &optional params)
   (let* ((resp
-          (yason:parse
-           (flex:make-flexi-stream
-            (handler-case
-                (bordeaux-threads:with-timeout (5)
-                  (drakma:http-request
-                   (format nil *fsq-api-url* method)
-                   :parameters (list*
-                                (cons "oauth_token" *fsq-access-token*)
-                                (cons "v" "20150811")
-                                params)
-                   :force-binary t
-                   :want-stream t
-                   :decode-content t))
-              (bordeaux-threads:timeout (e)
-                (declare (ignore e))
-                (error "Timeout")))
-            :external-format :utf-8)
-           :object-as :alist))
+          (handler-case
+              (bordeaux-threads:with-timeout (5)
+                (json-request (format nil *fsq-api-url* method)
+                              :parameters (list*
+                                           (cons "oauth_token" *fsq-access-token*)
+                                           (cons "v" "20150811")
+                                           params)))
+            (bordeaux-threads:timeout () (error "Timeout"))))
          (meta (aget "meta" resp)))
     (when (not (= 200 (aget "code" meta)))
       (error (format nil "Foursquare API error, code ~A, errorType '~A', errorDetail '~A'"

rss.lisp

@@ -7,31 +7,9 @@
 (defparameter *rss-max-period* 1800 "Max rss refresh period in seconds")
 (defparameter *rss-change-rate* 0.1 "Refresh period adjustment rata")
 
-(defun http-default (url)
-  (let ((uri (puri:uri url)))
-    (puri:render-uri
-     (if (null (puri:uri-scheme uri))
-         (puri:uri (format nil "http://~A" url))
-         uri)
-     nil)))
-
-(defun get-by-tag (node tag)
-  (nreverse (plump::get-elements-by-tag-name node tag)))
-
-(defun url-parse (url)
-  (multiple-value-bind (body-stream status headers uri stream)
-      (drakma:http-request (http-default url)
-                           :force-binary t
-                           :want-stream t
-                           :decode-content t)
-    (declare (ignore status headers stream))
-    (values
-     (plump:parse (flex:make-flexi-stream body-stream :external-format :utf-8))
-     uri)))
-
 (defun find-rss-links (url)
   (handler-case
-      (multiple-value-bind (root uri) (url-parse url)
+      (multiple-value-bind (root uri) (xml-request url)
         (loop for link in (get-by-tag root "link")
            when (string= "application/rss+xml" (plump:attribute link "type"))
            collect (list (plump:attribute link "title")
@@ -42,7 +20,7 @@
     (error (e) (log:error e))))
 
 (defun build-feed (url)
-  (let ((root (url-parse url)))
+  (let ((root (xml-request url)))
     (alexandria:when-let (rss (car (get-by-tag root "rss")))
       (make-feed :url url :title (child-text rss "title")))))
 
@@ -98,7 +76,7 @@
 
 (defun parse-rss (url)
   (let ((plump:*tag-dispatchers* plump:*xml-tags*))
-    (loop for item in (get-by-tag (url-parse url) "item")
+    (loop for item in (get-by-tag (xml-request url) "item")
        collect (make-feed-item :guid (child-text item "guid")
                                :link (child-text item "link")
                                :title (clean-text (child-text item "title"))

telegram.lisp

@@ -11,19 +11,14 @@
                                                         (princ-to-string v)))))
          (timeout (+ 5 (or (cdr (assoc :timeout args))
                            *telegram-timeout*)))
-         (response (yason:parse
-                    (flexi-streams:make-flexi-stream
-                     (handler-case
-                         (bordeaux-threads:with-timeout (timeout)
-                           (drakma:http-request (format nil +telegram-api-format+
-                                                        *telegram-token* method)
-                                                :method :post
-                                                :parameters params
-                                                :external-format-out :utf8
-                                                :want-stream t :force-binary t :decode-content t))
-                       (bordeaux-threads:timeout () (error "Timeout")))
-                     :external-format :utf8)
-                    :object-as :alist)))
+         (response
+          (handler-case
+              (bordeaux-threads:with-timeout (timeout)
+                (json-request (format nil +telegram-api-format+
+                                      *telegram-token* method)
+                              :method :post
+                              :parameters params))
+            (bordeaux-threads:timeout () (error "Timeout")))))
     (unless (aget "ok" response)
       (error (aget "description" response)))
     (aget "result" response)))

utils.lisp

@@ -54,6 +54,8 @@ is replaced with replacement."
   "Append together elements (or lists) in the list."
   (mappend #'(lambda (x) (if (listp x) (flatten x) (list x))) the-list))
 
+
+;; Circular lists
 (defun make-circular (items)
   "Make items list circular"
   (setf (cdr (last items)) items))
@@ -81,6 +83,43 @@ is replaced with replacement."
        (nreverse (push (car cur) result)))
     (push (car cur) result)))
 
+(defun http-default (url)
+  (let ((uri (puri:uri url)))
+    (puri:render-uri
+     (if (null (puri:uri-scheme uri))
+         (puri:uri (format nil "http://~A" url))
+         uri)
+     nil)))
+
+;; XML processing
+(defun xml-request (url)
+  (multiple-value-bind (http-stream status headers uri stream)
+      (drakma:http-request (http-default url)
+                           :force-binary t
+                           :want-stream t
+                           :decode-content t)
+    (declare (ignore status headers stream))
+    (unwind-protect
+         (progn
+           (setf (flex:flexi-stream-external-format http-stream) :utf-8)
+           (values (plump:parse http-stream) uri))
+      (ignore-errors (close http-stream)))))
+
+(defun get-by-tag (node tag)
+  (nreverse (plump::get-elements-by-tag-name node tag)))
+
+;; JSON processing
+(defun json-request (url &key (method :get) parameters (object-as :alist))
+  (multiple-value-bind (http-stream status headers uri stream)
+      (drakma:http-request (http-default url) :method method :parameters parameters
+                             :external-format-out :utf-8
+                             :force-binary t :want-stream t :decode-content t)
+    (declare (ignore status headers stream))
+    (unwind-protect
+         (progn
+           (setf (flex:flexi-stream-external-format http-stream) :utf-8)
+           (values (yason:parse http-stream :object-as object-as) uri))
+      (ignore-errors (close http-stream)))))
 
 ;; Fix bug in local-time (following symlinks in /usr/share/zoneinfo/
 ;; leads to bad cutoff)

vk.lisp

@@ -10,17 +10,9 @@
                           collect (cons
                                    (princ-to-string k)
                                    (princ-to-string v))))
-               (response (yason:parse
-                          (flex:make-flexi-stream
-                           (drakma:http-request (format nil +vk-api-url+ method)
-                                                :method :post
-                                                :parameters params
-                                                :external-format-out :utf-8
-                                                :force-binary t
-                                                :want-stream t
-                                                :decode-content t)
-                           :external-format :utf-8)
-                          :object-as :alist)))
+               (response (json-request (format nil +vk-api-url+ method)
+                                       :method :post
+                                       :parameters params)))
           (when (aget "error" response)
             (error (aget "error_msg" (aget "error" response))))
           (aget "response" response)))