forecast.lsp

#!/usr/bin/env sbcl --script
;;; load quicklisp
(load "~/.quicklisp/setup.lisp")
;;; load package and redirect the loading msg to /dev/null
(with-open-file (*standard-output* "/dev/null" :direction 
  			 :output :if-exists :supersede) 
				(ql:quickload '("drakma" "com.informatimago.common-lisp.html-parser")))

;;; get html tag name
(defun html-tag (xml) 
	(first xml))
;;; get list of attribute
(defun html-attributes (xml) 
	(second xml))
;;; get html content in between
(defun html-content (xml)
	(cddr xml))
;;; get value of a specified attribute
(defun html-attribute (xml key)
	(cadr (member key (second xml))))

;;; result formatting
(defun print-forecast (forecasts) 
	(format t "~:{~&~A  ~7@A  ~4@A  ~A~}~%" forecasts))

;;; remove trail "List" string
(defun remove-trail (str)
	(setf str (reverse str))
	(setf str (subseq str 4))
	(reverse str))

;;; convert html code to symbol of %
(defun convert-percentage (str) 
	(setf str (reverse str))
	(setf str (subseq str 5))
	(setf str (reverse str))
	(concatenate 'string str "%"))

;;; add unit of temperature
(defun add-C (str)
	(concatenate 'string str "C"))

;;; find all td block
(defun filter-out-td (xml)
	(let ((ret nil))
		(dolist (elem xml)
			(if (listp elem) 
				(setf ret (cons elem ret))))
		(reverse ret)))

(defun get-nth-column (xml n)
	(car (html-content (car (html-content (nth n xml))))))

;;; get weather description
(defun get-desc (xml)
	(html-attribute (car (html-content xml)) :TITLE))

(defun get-data (xml data)
	(cond
		;;; get city name
		((equal data "city") (get-nth-column xml 0))
		;;; get temperature
		((equal data "temp") (add-C (get-nth-column xml 1)))
		;;; get probability of precipitation
		((equal data "rain") (convert-percentage (get-nth-column xml 2)))
		;;; get weather description
		((equal data "desc") (get-desc (get-nth-column xml 3)))))

(defun city-forecast (xml) 
	(let ((ret nil)
		  (content (filter-out-td (html-content xml))))
		(setf ret (cons (remove-trail (html-attribute xml :ID)) ret ))
		(setf ret (cons (get-data content "city") ret))
		(setf ret (cons (get-data content "temp") ret))
		(setf ret (cons (get-data content "rain") ret))
		(setf ret (cons (get-data content "desc") ret))
		(reverse ret)))

;;; search tr tag recursivily
(defun get-forecast (xml) 
	(let ((ret nil))
		(when (listp xml)
			(let ((tag (html-tag xml))
				  (content (html-content xml)))
				;;; forecast data stored in tr tag with id attribute
				(if (and (equal tag :TR) (html-attribute xml :ID))
					(setf ret (cons (city-forecast xml) ret))
					;;; if not tr tag, search its children
					(dolist (elem content)
						(let ((city-datas))
							(setf city-datas (get-forecast elem))
							(when (listp city-datas)
								(setf ret (append ret city-datas))))))))
		ret))

;;; set website url
(defvar website "http://www.cwb.gov.tw/V7/forecast/f_index.htm")
;;; start to fetch data
(let ((html (drakma:http-request website :external-format-in :utf-8))
	  (xml)
	  (ret nil))
		(setf xml (com.informatimago.common-lisp.html-parser.parse-html:parse-html-string html))
		(dolist (xmlblock xml)
			(let ((forecast (get-forecast xmlblock)))
				(if forecast
					(setf ret (append forecast ret)))))
		(setf ret (sort ret #'string-lessp :key #'car))
		(setf ret (mapcar #'cdr ret))
		(print-forecast ret))