(in-package #:fwoar.lisputils)
 

 ;; (pick '("a" "b" "c")
 ;;         { "a": { "b" : { "c" : 3 })
 ;; =>> 3 t 3 "c"

 ;; (pick '("a" "b" "c")
 ;;         { "a": { "b" : 3 } })
 ;; =>> nil nil 3 "b"
 
 ;; (pick '("a" "b" "c")
 ;;         { "a": 3 })
 ;; =>> nil nil 3 "a"
 
 ;; (pick '("a" "b" "c")
 ;;         {})
 ;; =>> nil nil {} nil
 
 
 (defun pick (keys h-t &optional default)
   "(PICK KEYS H-T) => (values result found last-value last-key)
    result if all keys found, otherwise (or default nil)
    last-value the value associated with last-key or H-T if no key matches
    last-key the last key to match, or nil
    found-p nil if all keys didn't match otherwise truthy"
   (let ((result default) (found nil) (last-value h-t) (last-key nil)
 	(matched-keys 0) (key-count 0))
     (dolist (key keys)
       (incf key-count)
       (if (hash-table-p last-value)
 	  (multiple-value-bind (next-value next-found) (gethash key last-value)
 	    (setf found next-found)
 	    (when next-found
 	      (incf matched-keys)
 	      (setf last-key key
 		    last-value next-value)))
 	  (setf found nil)))
     (when (= matched-keys key-count)
       (setf result last-value))
     (values result found last-value last-key)))
 
 (define-condition pick-error (error)
   ((%key :initarg :key :reader key)
    (%value :initarg :value :reader value :initform nil)))
 
 ;; Stolen from sbcl . . . 
 (defun read-evaluated-form (&optional (prompt-control nil promptp)
                             &rest prompt-args)
   (apply #'format *query-io*
          (if promptp prompt-control "~&Type a form to be evaluated: ")
          prompt-args)
   (finish-output *query-io*)
   (list (eval (read *query-io*))))
 
 (defun pick/r (keys h-t &optional default)
   "Pick keys from h-t until fully traversed or no longer found.
    provide a restart for filling missing values. Raises pick-error
    if it tries to traverse a non-existent key or a non-hash-table
    value"
 
   (flet ((ensure-hash-table (v)
 	   (unless (hash-table-p v)
 	     (error 'type-error :expected-type 'hash-table :datum v))))
     (let ((cur-ht h-t))
       (dolist (key (butlast keys) (gethash (car (last keys)) cur-ht default))
 	start
 	(restart-case
 	    (multiple-value-bind (value found) (gethash key cur-ht)
 	      (cond ((null found) (error 'pick-error :key key))
 		    ((hash-table-p value) (setf cur-ht value))
 		    (t (error 'pick-error :key key :value value))))
 	  (use-value (v)
 	    :interactive read-evaluated-form
 	    :report (lambda (stream) (format stream "Act as if the key was found"))
 	    (ensure-hash-table v)
 	    (setf cur-ht v))
 	  (store-value (v)
 	    :test (lambda (c) c (hash-table-p cur-ht))
 	    :interactive read-evaluated-form
 	    :report (lambda (stream) (format stream "Store a new value for ~S." key))
 	    (ensure-hash-table v)
 	    (setf (gethash key cur-ht) v)
 	    (go start)))))))