Skip to content

Instantly share code, notes, and snippets.

@Lovesan
Created January 25, 2024 21:04
Show Gist options
  • Save Lovesan/3d3e37e9088952346e67c712f4a68de1 to your computer and use it in GitHub Desktop.
Save Lovesan/3d3e37e9088952346e67c712f4a68de1 to your computer and use it in GitHub Desktop.
Exchange rates & converter using russian central bank API
;;;; -*- 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment