;;;; derrida.lisp

(in-package #:derrida)



(defmacro with-alist ((&optional (accessor 'cdr)) (&rest bindings) alist &body body)
  "Bind variables to accessors into ALISTS. ACCESSOR, which should be
  an accessor function, is called like (ACCESSOR (ASSOC ..)).

   Each member of BINDINGS is either a symbol VAR or a list that
   looks like (VAR KEY-TERM . KWARGS).

   KWARGS are passed as keyword argments to (ASSOC KEY-TERM ALIST ...).

EXAMPLE:

  (let ((al 
          (list (cons 'name \"colin\")
                (list :hobbies \"fiddling\" \"diddling\")
                (list \"job\" :executive \"crum bum\"))))
    (with-alist () 
        (name (hobbies :hobbies) (job \"job\" :test 'equalp)) 
        al 
      (setf job (format nil \"~{~a~^ ~}\" job))
      (format t \"---------------------------~%\")
      (format t \"name: ~a~%hobbies: ~{~a~^,~}~%job: ~a~%\" 
              name hobbies job) 
      (format t \"---------------------------~%\")
      al))
---------------------------
name: colin
hobbies: fiddling,diddling
job: EXECUTIVE crum bum
---------------------------

((NAME . \"colin\") (:HOBBIES \"fiddling\" \"diddling\")
 (\"job\" . \"EXECUTIVE crum bum\"))
"
  (let* ((alist-var
           (gensym))
         (macrolet-bindings
           (loop for term in bindings
                 when (symbolp term )
                   collect `(,term (,accessor (assoc ',term ,alist-var)))
                 when (consp term)
                   collect `(,(first term)
                             (,accessor (assoc ',(second term) ,alist-var ,@(nthcdr 2 term)))))))
    `(let ((,alist-var ,alist)) (symbol-macrolet ,macrolet-bindings ,@body))))

(defmacro with-plist (keys plist &body body)
  "KEYS is a list, each member of which is either a symbol or a pair of symbols.

If a member is just a symbol, say KEY, then it is treated as the name
of a symbol-macro (defined using symbol-macrolet) that expands to the
expression (getf PLIST KEY).  In this case, KEY is not allowed to be a
keyword symbol.

If a member is a pair of symbols, it is of the form (VAR KEY). Here,
key is a valid key into the PLIST and VAR is the name of the symbol
macrolet that will be bound to (getf PLIST KEY).

EXAMPLE:

(let ((pl 
        (list 'name \"colin\" :age 40 :|currentJob| :crumb-bum)))
  (hq:with-plist (name (age :age) (job :|currentJob|)) pl 
    (setf age (1+ age)) 
    (format t \"~a the ~a had a birthday, and is now ~a years old~%\" 
            name job age) 
    pl))

The above would print out:
colin the CRUMB-BUM had a birthday, and is now 41 years old

And would return 
(NAME \"colin\" :AGE 41 :|currentJob| :CRUMB-BUM)"  

  (let* ((plist-var
           (gensym))
         (macrolet-bindings
           (loop for term in keys
                 when (consp term )
                   collect (destructuring-bind (var key) term
                               `(,var (getf ,plist-var ',key)))
                 else
                   collect `(,term (getf ,plist-var ',term)))))
    `(let ((,plist-var ,plist)) (symbol-macrolet ,macrolet-bindings ,@body))))


(defun get-nested (plist-tree &rest indicators)
  "PLIST-TREE is plist some of whose values are also
   PLISTS. INDICATORS are keyes to the plists."
  (if (or (null plist-tree) (null indicators))
      plist-tree
      (apply #'get-nested (getf plist-tree (car indicators)) (cdr indicators))))

(defmacro pluck-nested (keypaths plist &body body)
  "Pluck nested binds variables to paths into a plist tree."
  (let ((tmp-plist (gensym "plist")))
    `(let ((,tmp-plist ,plist)) 
       (let ,(loop for (var . path) in keypaths
                    collect `(,var (get-nested ,tmp-plist ,@path)))
         ,@body))))