Exchange rates & converter using russian central bank API

cbrf.lisp

;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-

;;; Copyright (C) 2024, Dmitry Ignatiev <lovesan.ru at gmail.com>

;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:

;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.

;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.

(in-package #:cl-user)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (unless (find-package '#:alexandria)
    (ql:quickload '#:alexandria))
  (unless (find-package '#:dexador)
    (ql:quickload '#:dexador))
  (unless (find-package '#:cxml)
    (ql:quickload '#:cxml))
  (unless (find-package '#:cxml-dom)
    (ql:quickload '#:cxml/dom))
  (unless (find-package '#:xpath)
    (ql:quickload '#:xpath))
  (unless (find-package '#:parse-float)
    (ql:quickload '#:parse-float)))

(uiop:define-package #:cbrf
  (:use #:cl #:parse-float)
  (:import-from #:alexandria
                #:switch
                #:string-designator
                #:define-constant
                #:simple-parse-error)
  (:export
   #:rate
   #:ratep
   #:rate-name
   #:rate-code
   #:rate-value
   
   #:get-rates
   #:convert

   #:invalid-rate-designator
   #:invalid-rate-designator-value))

(in-package #:cbrf)

(define-constant +url+ "https://www.cbr-xml-daily.ru/daily_eng_utf8.xml"
  :test #'equal)

(define-constant +url-ru+ "https://www.cbr-xml-daily.ru/daily_utf8.xml"
  :test #'equal)

(eval-when (:compile-toplevel :load-toplevel :execute)
  
  (defstruct (rate (:constructor %rate (code short-name name value))
                   (:copier nil)
                   (:predicate %ratep))
    (code "" :type string)
    (short-name "" :type string)
    (name "" :type string)
    (value 0 :type rational))
  
  (defmethod make-load-form ((object rate) &optional env)
    (make-load-form-saving-slots object :environment env)))

(declaim (inline ratep))
(defun ratep (object)
  "Returns T on case of an OBJECT being a RATE."
  (%ratep object))

(defmethod print-object ((object rate) stream)
  (print-unreadable-object (object stream :type t)
    (format stream "~f ~a(~a)"
            (rate-value object)
            (rate-name object)
            (rate-short-name object)))
  object)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (define-constant +rub+ (%rate "643" "RUB" "Russian Ruble" 1)
    :test #'equalp)

  (define-constant +rub-ru+ (%rate "643" "RUB" "Российский Рубль" 1)
    :test #'equalp))

(define-condition invalid-rate-designator (error)
  ((value :initarg :value
          :reader invalid-rate-designator-value))
  (:report (lambda (c s)
             (format s "Invalid rate designator: ~s"
                     (invalid-rate-designator-value c))))
  (:documentation "Designates a condition of invalid rate designator."))

(defun invalid-rate-designator (designator)
  (error 'invalid-rate-designator :value designator))

(defun node->rate (node)
  (let (code short-name name value)
    (flet ((node->text (node)
             (dom:node-value (dom:first-child node))))
      (dom:do-node-list (elt (dom:child-nodes node))
        (switch ((dom:node-name elt) :test #'equal)
          ("NumCode" (setf code (node->text elt)))
          ("CharCode" (setf short-name (node->text elt)))
          ("Name" (setf name (node->text elt)))
          ("VunitRate" (setf value (node->text elt)))))
      (%rate code
             short-name
             name
             (parse-float value :type 'rational
                                :decimal-character #\,)))))

(defun get-rates (&key russian)
  "Returns a list of CBRF exchange rates.
:RUSSIAN - Unless NIL, return russian-localized names."
  (let* ((data (dexador:get (if russian +url-ru+ +url+)
                            :force-binary t))
         (dom (cxml:parse-octets data (cxml-dom:make-dom-builder)))
         (result '()))
    (xpath:do-node-set (node (xpath:evaluate "//Valute" dom)
                             (cons (if russian +rub-ru+ +rub+)
                                   (nreverse result)))
      (push (node->rate node) result))))

(defun convert (amount from to &key rates)
  (declare (type real amount)
           (type string-designator from to)
           (type list rates))
  "Converts an AMOUNT of money from FROM currency into TO currency using CBRF rates.
:RATES may be a list of pre-cached rates(as returned by GET-RATES).
       In case of it being null, rates are fetched by means of GET-RATES function."
  (flet ((rate-name-eq (name rate)
           (declare (type string name)
                    (type rate rate))
           (with-accessors ((full-name rate-name)
                            (short-name rate-short-name)
                            (code rate-code))
               rate
             (or (string-equal name short-name)
                 (string-equal name code)
                 (string-equal name full-name)))))
    (let* ((rates (or rates (get-rates)))
           (from-rate (or (find (string from) rates :test #'rate-name-eq)
                          (invalid-rate-designator from)))
           (to-rate (or (find (string to) rates :test #'rate-name-eq)
                        (invalid-rate-designator to))))
      (* amount (/ (rate-value from-rate)
                   (rate-value to-rate))))))

;;; vim: ft=lisp et