dotassoc.lsp

;;; dotassoc.lsp

;; 連想リストの Key-Value 参照をドット記法で

;;; Example:

;; (let ((student '((id 1332412)
;;                  (name ((first "Student")
;;                         (last  "Example"))))))
;;   (with-dotassoc
;;     (upper-case student.name.first)))
;;=> "STUDENT"

;; 読取り時に変換する (リーダマクロのようなもの)
;; (reader-event 'dotassoc-transform)

;; student.name.first
;;  ~> (lookup 'first (lookup 'name student))
;;  => "Student"

;; (setq json (json-parse (get-url "http://httpbin.org/get")))
;;
;; json.headers.User-Agent
;;=> "newLISP v10603"
;;
;; setf による代入も一応可能
;; (setf json.headers.Host "localhost")
;;=> "localhost"

;; Original (emacs-lisp):
;;   - https://gist.github.com/skeeto/7edbedfdec3444925451

;;; Code:

(define (dotassoc-transform-symbol symbol)
  (let ((names (parse (term symbol) ".")))
    (if (= 1 (length names))
        symbol
        (let (reduce (lambda (f seq)
                       (apply f seq 2)))
          (reduce (lambda (obj key)
                    (letex (~obj obj ~key key ~strkey (string key))
                      '(or (lookup '~key ~obj)
                           (lookup '~strkey ~obj))))
                  (map sym names))))))

(define (dotassoc-transform expr)
  ;;(println ";;=> " expr)
  (cond
   ((list? expr)   (map dotassoc-transform expr))
   ((symbol? expr) (dotassoc-transform-symbol expr))
   (true expr)))

;; @syntax (with-dotassoc BODY*)
(define-macro (with-dotassoc)
  (eval (cons 'begin (dotassoc-transform (args)))))

;;; eof