(require 'org-element)
(require 'string-inflection)

(setq *test-tags* (json-read-file "TAGS2"))
(setq *keys* (delete-dups (mapcar (lambda (x) (mapcar (lambda (y) (car y)) x)) *test-tags*)))

(defun classes-with-members (tags-data)
  (delete nil (delete-dups
	       (mapcar
		(lambda (x)
		  (if (string-equal (alist-get 'scopeKind x) "class")
		      (alist-get 'scope x)))
		tags-data))))

(defun find-class (cls tags)
  (delete
   nil (mapcar (lambda (x) (let ((val (alist-get 'name x)))
			     (if (string-equal val cls) x)))
	       tags)))

(defun find-class-members (cls tags)
  ;;; These are only like "m_*" members, not like member 
  ;;; functions or getters or anything like that.
  (delete 
   nil (mapcar (lambda (x)
		 (if
		     (and (string-equal (alist-get 'scopeKind x) "class")
			  (string-equal (alist-get 'kind x) "member")
			  (string-equal (alist-get 'scope x) cls))
		     x))
	       tags)))


(defun tag-apply-predicates (tag-record conditions)
    (mapcar
     (lambda (condition)
       (pcase-let ((`(,func ,p ,q) condition))
	 (let ((x (apply func (list (alist-get p tag-record) q))))
	   (if (equal nil x) nil
	     tag-record))))
     conditions))

(defun find-tags (tags-data conditions)
  ;;; `conditions` is a list with a comparison function,
  ;;;  an alist key, and a value for comparison.
  (delete
   nil
   (mapcan (lambda (tag-record)
	     (let ((candidate (tag-apply-predicates tag-record conditions)))
	       (if (member nil candidate) nil
		 candidate)))
	   tags-data)))

(defun select-from-tags (tags-data keys &rest conditions)
  ;;; This one is fit for public consumption.
  (delete-dups
   (mapcar
    (lambda (x) (mapcar (lambda (k) (alist-get k x)) keys))
    (find-tags tags-data conditions))))


(defun tag-namespaced-name (tag)
  (let ((has-namespacep (alist-get 'scopeKind tag)))
    (if (string-equal has-namespacep "namespace")
	(string-join (list (alist-get 'scope tag) "::" (alist-get 'name tag)))
      (alist-get 'name tag))))


(setq *prototypes* (select-from-tags
		    *test-tags*
		    '(name access scope signature)
		    '(string-equal kind "prototype")))

(setq *render-window*
      '("sf::RenderWindow::RenderWindow" "public" "sf::RenderWindow"
	"(WindowHandle handle,const ContextSettings & settings=ContextSettings ())"))

(defun tag-wildcard (x y) t)
(setq *tag-wildcard* '(tag-wildcard i j))

(defun get-header-type-signature-info (tags-data header-path)
  (let* ((prototype-keys '(path name access typeref scope scopeKind signature))
	 (parameter-keys '(name typeref))
	 (prototypes
	  (mapcar (lambda (x) (seq-mapn 'cons prototype-keys x))
		  (select-from-tags
		   tags-data
		   prototype-keys
		   '(string-equal kind "prototype")
		   `(string-equal path ,header-path)))))
    (mapcar (lambda (x)
	      (let* ((parameter-info-list (select-from-tags
					   tags-data parameter-keys
					   `(string-equal scope ,(alist-get 'name x))
					   `(string-equal kind "parameter")))
		     (parameter-info-alist (mapcar
					    (lambda (p) (seq-mapn 'cons parameter-keys p))
					    parameter-info-list)))
		(cons `(parameters . ,parameter-info-alist) x)))
	    prototypes)))

(defun get-all-header-type-signature-info (tags-data)
  (mapcar (lambda (h) (get-header-type-signature-info tags-data h))
	  (mapcar
	   'car
	   (select-from-tags tags-data '(path) *tag-wildcard*))))

(defun get-signatures (tags) (delete nil (get-all-header-type-signature-info tags)))
(defun get-qualified-signatures (tags)
  (let ((qualified (mapcar (lambda (s)
			    (seq-filter
			     (lambda (x) (and
					  (string-match-p "sf::.+" (alist-get 'name x))
					  (string-equal "public" (alist-get 'access x))))
			     s))
			   (get-signatures tags))))
    (seq-filter (lambda (x) (not (equal x nil))) qualified)))
(defun get-paths (tags)
  (seq-sort
   'string-collate-lessp
   (mapcar (lambda (x) (alist-get 'path (car x)))
	   (get-qualified-signatures tags))))
  

(setq *signatures* (get-signatures *test-tags*))
      ;;(delete nil (get-all-header-type-signature-info *test-tags*)))
(setq *qualified-signatures* (get-qualified-signatures *test-tags*))
;; (let ((qualified (mapcar (lambda (s)
;;			    (seq-filter
;;			     (lambda (x) (and
;;					  (string-match-p "sf::.+" (alist-get 'name x))
;;					  (string-equal "public" (alist-get 'access x))))
;;			     s))
;;			  *signatures*)))
;;   (seq-filter (lambda (x) (not (equal x nil))) qualified)))
(setq *paths* (get-paths *test-tags*))
      ;(seq-sort
;	       'string-collate-lessp
;	       (mapcar (lambda (x) (alist-get 'path (car x))) *qualified-signatures*)))

(defun constructor-p (prototype)
  (let ((scope (split-string (alist-get 'scope prototype) "::"))
	(name (split-string (alist-get 'name prototype) "::")))
    (equal (last scope) (last name))))

(defun destructor-p (prototype)
  (let ((name (split-string (alist-get 'name prototype) "::")))
    (if (string-match-p "^~.+" (car (last name))) t nil)))

(defun constructor-type (prototype)
  (if (or (destructor-p prototype) (constructor-p prototype)) (alist-get 'scope prototype) nil))

(defun find-param-symbol (param) (car (last (split-string param " "))))

(defun find-param-type (param)
  (let* ((param-tokens (split-string param " "))
	 (token-count (length param-tokens)))
    (string-join (seq-take param-tokens (- token-count 1)) " ")))

(defun prepare-signature (sig)
  (let* ((sig-list (split-string (string-trim sig "(" ")") ","))
	 (type-symbol-pairs (mapcar
			     (lambda (x) `(,(find-param-type x) ,(find-param-symbol x)))
			     sig-list))
	 
	 ;; In most cases, the first parameter should be the object. Then, the predicate
	 ;; can be called like `render_window_draw(RenderWindow, Drawable, RenderStates).`

	 ;; Other clause orders could be like `render_window_some_static_method(X,Y,Z).`
	 ;; for static methods; and `render_window_create(RenderWindow, H, W, Etc).`
	 ;; The order matters for currying and sequential application and stuff -- probly
	 ;; need to adhere to some standard conventions to keep from getting confused.
	 
	 (param-enum (number-sequence 1 (length type-symbol-pairs))))
    (seq-mapn (lambda (i j) (cons (number-to-string i) j)) param-enum type-symbol-pairs)))

(defun format-parameter-rows (sig)
  (let ((row-data (mapcar (lambda (x) (string-join x " | ")) (prepare-signature sig))))
    (string-join (mapcar (lambda (x) (format "| %s | | |" x)) row-data) "\n")))

(defun parameter-table-columns ()
  (let ((columns '("Argv Idx"    "C++ type"    "C++ symbol"
		   "Prolog term" "Prolog mode" "Prolog type")))
    (format "| %s |" (string-join columns " | "))))

(defun make-parameter-table (sig)
  (format "%s\n|-\n%s"
	  (parameter-table-columns) (format-parameter-rows sig)))

(defun insert-parameter-table (sig)
  (insert (make-parameter-table sig))
  (org-table-align))

(defun upcase-p (c)
  (let ((s (char-to-string c)))
    (and (string-match "[A-Z]" s)
	 (string-equal s (upcase s)))))

(defun look-ahead (char-list i) (nth (+ i 1) char-list))

(defun camel-to-snake (s) (string-inflection-underscore-function s))
(defun camel-to-pascal (s) (string-inflection-pascal-case-function s))
     

;%(defun camel-to-snake (s)
;%  (string-match-

(defun get-module-name (prototype)
  (let* ((path (alist-get 'path prototype))
	 (module-name (last (split-string path "/"))))
    (camel-to-snake (car (split-string (car module-name) ".hpp")))))

(setq *sprite* (car (seq-filter
		     (lambda (x) (string-equal (alist-get 'path (car x))
					       "include/SFML/Graphics/Sprite.hpp"))
		     *qualified-signatures*)))


;; Argv Idx, SFML type, C++ Parameter, Prolog term, Prolog type, Prolog mode

'(:namespace :module :fn-name :return-type :caller-type :argv-idx :parameter-type)

(defun get-return-type (prototype)
  (cond ((constructor-p prototype) (alist-get 'scope prototype))
	((destructor-p prototype) "void")
	(t (string-remove-prefix "typename:" (alist-get 'typeref prototype)))))


(defvar *constructor* "constructor")
(defvar *destructor* "destructor")
(defvar *member-function* "member-function")
(defvar *member-data* "member-data")

(defun get-prototype-role (prototype)
  (cond ((constructor-p prototype) *constructor*)
	((destructor-p prototype) *destructor*)
	(t *member-function*)))


(defun prototype-information (namespace prototype)
  `((:namespace . ,namespace)
    (:module . ,(get-module-name prototype))
    (:fn-name . ,(alist-get 'name prototype))
    (:return-type . ,(get-return-type prototype))
    (:caller-type . ,(alist-get 'scope prototype))
    (:role . ,(get-prototype-role prototype))))

(defun parameter-information (argv-idx parameter)
  `((:argv-idx   . ,argv-idx)
    (:param-type . ,(string-remove-prefix "typename:" (alist-get 'typeref parameter)))
    (:param-sym  . ,(alist-get 'name parameter))))

(defun parameter-list-information (prototype-information parameter-list)
  (let ((caller-info `((:argv-idx . 1)
		       (:param-type . ,(alist-get :caller-type prototype-information))
		       (:param-sym . "<-this"))))
    (cond ((not parameter-list) (list caller-info))
	  ((= 1 (length parameter-list)) (append caller-info
					       `(,(parameter-information 2 (car parameter-list)))))
	  (t (let ((argv-index (number-sequence 0 (- (length parameter-list) 1))))
	       (append
		`(,caller-info)
		(mapcar
		 (lambda (idx) (let ((param (nth idx parameter-list)))
				 (parameter-information (+ 2 idx) param)))
		 argv-index)))))))

(defun get-tabular-prototype-signature (namespace prototype)
  (let ((prototype-info (prototype-information namespace prototype)))
    (mapcar
     (lambda (x) (append prototype-info x))
     (parameter-list-information prototype-info (alist-get 'parameters prototype)))))


(setq *sprite-info* (prototype-information "graphics" (car *sprite*)))
(setq *sprite-params* (parameter-list-information *sprite-info* (alist-get 'parameters (car *sprite*))))


(defun prototype-signature-row-infer-prolog-functor (tabular-signature-row)
  (let* ((qualified-name (split-string (alist-get :fn-name tabular-signature-row) "::"))
	 (name-parts-count (length qualified-name))
	 (name-parts (seq-take (reverse qualified-name) (- name-parts-count 1)))
	 (role (alist-get :role tabular-signature-row)))
    (camel-to-snake
     (cond ((string-equal role *constructor*)
	    (concat (string-join (delete-dups name-parts) "_") "_create"))
	   ((string-equal role *destructor*) (concat (string-join (delete-dups name-parts) "_") "_delete"))
	   ((string-equal role *member-function*) (string-join name-parts "_"))))))

(defun prototype-signature-infer-prolog-functor (tabular-signature)
  (prototype-signature-row-infer-prolog-functor (car tabular-signature)))

(defvar *<-this* "<-this")

(defun infer-prolog-term (tabular-signature-row)
  (let ((cpp-sym (alist-get :param-sym tabular-signature-row)))
    (cond ((string-equal cpp-sym *<-this*) (camel-to-pascal
					    (alist-get :module tabular-signature-row)))
	  (t (camel-to-pascal cpp-sym)))))
  
(defun prototype-signature-row-infer-prolog-information (tabular-signature-row)
  `((:prolog-functor . ,(prototype-signature-row-infer-prolog-functor tabular-signature-row))
    (:prolog-term . ,(infer-prolog-term tabular-signature-row))))  ;;;,(camel-to-pascal (alist-get :param-sym tabular-signature-row)))))
  
(defun prototype-signature-infer-prolog-information (tabular-signature)
  (mapcar 'prototype-signature-row-infer-prolog-information tabular-signature))