estafeta.lisp

;;; APIfy Estafeta's price check

(ql:quickload :drakma)
(ql:quickload :closure-html)
(ql:quickload :cl-json)
(ql:quickload :hunchentoot)

(defvar *server* nil)

(defun string-clean (str)
  "Remove every blank from the string."
  (string-trim '(#\Space #\Newline #\Backspace #\Tab #\Linefeed #\Page #\Return) str))

(defun node? (obj)
  (consp obj))

(defun node-type (node)
  (first node))

(defun node-attributes (node)
  (second node))

(defun node-text (node)
  (let ((item (car (last node))))
    (unless (node? item) item)))

(defun node-subnodes (node)
  (rest (rest node)))

(defun node-attribute (attribute node)
  (assoc attribute (node-attributes node)))

(defun node-attribute-value (attribute node)
  (second (node-attribute attribute node)))

(defun node-of-type? (type node)
  (eq (node-type node) type))

(defun node-find-recursively (predicate nodes)
  (when (node? nodes)
    (apply #'append
           (when (funcall predicate nodes) (list nodes))
           (remove-if #'null (mapcar (lambda (node) (node-find-recursively predicate node))
                                     (node-subnodes nodes))))))

(defun node-find-by-type (type nodes)
  (node-find-recursively
   (lambda (node) (node-of-type? type node)) nodes))

(defun node-find-by-attribute (attribute value nodes)
  (node-find-recursively
   (lambda (node)
     (string= (second (node-attribute attribute node)) value))
   nodes))

(defun estafeta-build-params (origen destino peso alto largo ancho)
  (list (cons "CPOrigen" (format nil "~5,'0D" origen))
        (cons "CPDestino" (format nil "~5,'0D" destino))
        (cons "Tipo" "paquete")
        (cons "cTipoEnvio" "paquete")
        (cons "Peso" (write-to-string peso))
        (cons "Alto" (write-to-string alto))
        (cons "Largo" (write-to-string largo))
        (cons "Ancho" (write-to-string ancho))))

(defun estafeta-make-request (origen destino peso alto largo ancho)
  (chtml:parse  (drakma:http-request
                 "http://herramientascs.estafeta.com/Cotizador/Cotizar"
                 :method :post
                 :parameters (estafeta-build-params origen destino peso alto largo ancho))
                (chtml:make-lhtml-builder)))

(defun td->service-name (td)
  (string-clean (node-text (first (node-find-by-type :strong td)))))

(defun td->number (td)
  (read-from-string (remove "," (string-clean (node-text td)) :test #'string=)))

(defun tr->service (tr)
  (let ((tds (node-find-by-type :td tr)))
    (cons (td->service-name (first tds))
          (list (cons :peso (td->number (second tds)))
                (cons :guia (td->number (third tds)))
                (cons :cc (td->number (fourth tds)))
                (cons :cargos-extra (td->number (fifth tds)))
                (cons :sobrepeso-costo (td->number (sixth tds)))
                (cons :sobrepeso-cc (td->number (seventh tds)))
                (cons :total (td->number (eighth tds)))))))

(defun response->source (response)
  (string-clean
   (node-attribute-value :value
                         (first (node-find-by-attribute
                                 :name "tarificador.codPosOri.desMuniEstado"
                                 response)))))

(defun response->destination (response)
  (string-clean
   (node-attribute-value :value
                         (first (node-find-by-attribute
                                 :name "tarificador.codPosDest.desMuniEstado"
                                 response)))))

(defun response->services (response)
  (mapcar #'tr->service
          (cddr (node-find-by-type
                 :tr (sixth (node-find-by-type :table response))))))

(defun estafeta->cotizar (origen destino peso alto largo ancho)
  (let ((response (estafeta-make-request origen destino peso alto largo ancho)))
    (unless (plusp (length (node-find-by-type :form response)))
      (list (cons :origen (response->source response))
            (cons :destino (response->destination response))
            (cons :servicios (response->services response))))))

(defun api ()
  (defparameter *server* (make-instance 'hunchentoot:easy-acceptor :port 4242
                                        :document-root #p"~/api/root/"))
  (hunchentoot:define-easy-handler (estafeta-cotizador
                                    :uri "/estafeta/cotizar"
                                    :default-request-type :POST) (origen destino peso alto largo ancho)
    (setf (hunchentoot:content-type*) "application/json")
    (json:encode-json-to-string (estafeta->cotizar (read-from-string (string-clean origen))
                                                   (read-from-string (string-clean destino))
                                                   (read-from-string (string-clean peso))
                                                   (read-from-string (string-clean alto))
                                                   (read-from-string (string-clean largo))
                                                   (read-from-string (string-clean ancho)))))
  (hunchentoot:start *server*))