(defpackage :fwoar.lisp-sandbox.eclector-test
  (:use :cl )
  (:export ))
(in-package :fwoar.lisp-sandbox.eclector-test)

(defvar *verbose* nil)

(defclass my-reader ()
  ())
(defvar *eclector-client*
  (make-instance 'my-reader))

(fw.lu:defclass+ fw-package ()
  ((%name :initarg :name :reader fw-name)
   (%symbols :reader fw-symbols :initform (make-hash-table :test 'equal))))


(defvar *fw-packages*
  (alexandria:alist-hash-table (list (cons "KEYWORD" (fw-package "KEYWORD")))
                               :test 'equal))

(defmethod print-object ((o fw-package) s)
  (print-unreadable-object (o s :type t :identity t)
    (format s "~s with ~d symbols"
            (fw-name o)
            (hash-table-count (fw-symbols o)))))

(defgeneric my-intern (symbol package)
  (:method ((symbol string) (package package))
    (intern symbol package))
  (:method ((symbol string) (package fw-package))
    (when *verbose*
      (:printv symbol package))
    (if (eql package (ensure-package "KEYWORD"))
        (intern symbol (find-package "KEYWORD"))
        (fw.lu:if-let* ((s-p (find-package (fw-name package)))
                        (s-s (and s-p (find-symbol symbol s-p)))
                        (_ (not (eql s-p (symbol-package s-s)))))
          (my-intern symbol
                     (ensure-package
                      (package-name
                       (symbol-package s-s))))
          (alexandria:ensure-gethash symbol
                                     (fw-symbols package)
                                     (make-symbol symbol))))))

(defgeneric my-find-symbol (symbol package)
  (:method ((symbol string) (package package))
    (find-symbol symbol package))
  (:method ((symbol string) (package fw-package))
    (gethash symbol (fw-symbols package))))

(defun my-find-package (package)
  (gethash package *fw-packages*))

(defun ensure-package (package)
  (etypecase package
    (fw-package package)
    (package (ensure-package (package-name package)))
    (symbol (ensure-package (symbol-name package)))
    (string (alexandria:ensure-gethash package *fw-packages*
                                       (fw-package package)))))

(defmethod eclector.reader:interpret-symbol
    ((client my-reader) input-stream package-indicator symbol-name internp)
  (let ((package (case package-indicator
                   (:current (ensure-package *package*))
                   (:keyword (ensure-package "KEYWORD"))
                   (t        (or (ensure-package package-indicator))))))
    (if *verbose*
        (:printv package-indicator package symbol-name (my-intern symbol-name package))
        (my-intern symbol-name package))))

(defparameter *my-readtable*
  (let ((readtable (eclector.readtable:copy-readtable eclector.reader:*readtable*)))
    (eclector.readtable:set-dispatch-macro-character
     readtable #\# #\+
     (lambda (stream char parameter)
       parameter
       char
       (:printv
        eclector.reader:*client*
        (let ((*verbose* t))
          (cons 'when-feature
                (eclector.reader:read stream t
                                      nil t))))))
    (eclector.readtable:set-dispatch-macro-character
     readtable #\# #\-
     (lambda (stream char parameter)
       parameter
       char
       (:printv
        eclector.reader:*client*
        (let ((*verbose* t))
          (cons 'unless-feature
                (eclector.reader:read stream t
                                      nil t))))))
    readtable))

(defun my-read-from-string (string)
  (let ((eclector.reader:*client* *eclector-client*)
        (eclector.reader:*readtable* *my-readtable*))
    (eclector.reader:read-from-string string)))