#| access to data in a mysql DB
 This relies on
  mysql command
  shell from which to run it
  clisp ext:run-shell-command
 sample usage:
  suppose you have access to a mysql database via the command
  mysql --password=pass --user=username dbname
  Suppose further that in that database there is a table named table1
  with columns (among others) x, y, z, where x is numeric and y and z
  are text.  And suppose that this table has indices on the x and y
  columns (which you want to use).
 The following gives you access to table1 via the ap5 relation T1
 
 (defrelation T1 :representation
  (mysql "table1" "mysql -N -B -e ~S --password=pass --user=username dbname"
	 ("x" "y" "z") (number string string) :indices (("x" "y"))))

 You can now test whether a tuple is in the relation
 (?? t1 3 "a" "b")
 or generate a list of tuples
 (listof t1)
 or a list of tuples where x is 15
 (listof (x y) s.t. (t1 15 x y))
 etc.
|#
;; various code below uses unexported functions
;; easier to just use ap5 pkg than to use ::'s
(in-package :ap5) 
(defun parse-mysql-select (stream coltypes)
  "parse output of command
 mysql -N -B -e 'SELECT...' ...
 fields are separated by tabs
 coltypes should be a list of types in mysql-parse-types"
  ;; we currently assume strings do not contain tabs
  (loop with line while (setf line (read-line stream nil nil)) collect
    (parse-mysql-select-line line coltypes)))

(defun parse-mysql-select-line (line types &aux *read-eval* pos tab)
  (setf tab -1)
  (loop for type in types
    do
    (setf pos (1+ tab) tab (position #\tab line :start pos))
    collect
    (ecase type
      (string (subseq line pos tab))
      (number (read-from-string line t nil :start pos :end tab)))))

;; types we accept for mysql relations
(defvar mysql-parse-types '(string number))
;; add dates/times?

(defun mysql (relname defrel-args sqlname command colnames coltypes
		      &key indices)
  ;; sqlname is the name of the relation in mysql
  ;; command is a string with a ~S in it for accessing the relation
  ;; the ~S is to be replaced with a SQL statement.
  ;; something like "mysql -N -B -e ~S --password=foo test"
  ;; colnames is a list of column names
  ;; coltypes is a corresponding list of types, limited to mysql-parse-types
  ;; indices is a list of lists of column names, indicating that we should
  ;;  build a generator in which those columns are the inputs
  ;;  
  ;; (any x s.t. (parameter-list rel x))) = (mysql <relname> <sqlname> ...)
  (let ((arity (length colnames)))
    (unless (= arity (length coltypes))
      (error "mysql needs the same number of column names and column types"))
    (loop for type in coltypes unless (member type mysql-parse-types) do
	(error "type ~a not in ~a" type mysql-parse-types))
    (append `(:representation individual
	      :nonatomic t
	      :arity ,arity
	      :types ,coltypes
	      :type-enforcements ,(loop for i below arity collect :none)
	      :tester mysql-tester
	      :generator (mysql-generators))
	    defrel-args)))

(defun mysql-tester
  (rel &rest ignore)
  (declare (ignore ignore))
  `(lambda (rel &rest tuple)
     (let ((params (any x s.t. (parameter-list rel x))) stream)
       (setf stream
	     (ext:run-shell-command
	      (format nil (third params)
		      (with-output-to-string
			(s)
			(format s "SELECT * FROM ~a where " (second params))
			(loop for col on (fourth params) as val in tuple do
			  (format s "~a=~s" (car col) val)
			  (when (cdr col) (format s " and ")))))
	      :output :stream))
       (unwind-protect
	   (not (not (read-line stream nil nil)))
	 (close stream)))))

(defun sql-gen (pat params)
  ;; pat is the subset of params supplied as inputs
  `(lambda (rel &rest args)
     (declare (ignore rel))
     (let ((state
	    (let (stream)
	      (setf stream
		    (ext:run-shell-command
		     (apply #'format
		      nil
		      ,(format nil (third params)
			       (format nil "SELECT ~a FROM ~a~a~a"
				       (with-output-to-string
					 (s)
					 (loop with done1 = nil
					   for col in (fourth params) unless
					   (member col pat :test 'string=) do
					   (format s (if done1 ",~a" "~a") col)
					   (setf done1 t)))
				       (second params)
				       (if pat " where " "")
				       (with-output-to-string
					 (s)
					 (loop with done1 = nil
					   for col in (fourth params)
					   when (member col pat :test 'string=)
					   do
					   (when done1 (format s " and "))
					   (setf done1 t)
					   (format s "~a=~~s" col)))))
		     args)
		     :output :stream))
	      (unwind-protect
		  (parse-mysql-select
		   stream
		   ',(loop for p in (fifth params) as a in (fourth params)
		       unless (member a pat :test 'string=) collect p))
		(close stream)))))
       #'(lambda (&rest ignore)
	   (declare (ignore ignore))
	   (if state
	       #+clisp;; clisp likes the original
	     (apply #'values nil (pop state))
	     #-clisp
	     ;; most others seem to like this much better
	     (values-list (cons nil (pop state)))
	     t)))))


#| effort per tuple generated, *** need to calibrate
 should be divided into overhead and incremental cost per tuple
|#
(defvar *mysql-effort-per-tuple* 300)

(defun mysql-generators ;; originally baserelgenerator
  (ignore vars rel &rest args)
  (declare (ignore ignore vars))
    ;; this test should never fail -- we believe it is TOTALLY unnecessary
    (unless (= (length args) (arity* rel))
	   (error "wrong arity ~s" (cons rel args)))
    ; new version: initialstate contains code which is applied to
    ; (rel &rest constant-args) [as before] but returns [rather than state]
    ; a closure which can be funcall'd to produce what pulsecode used to 
    ; return [except new state]
    (values-list
     ;; (cons ...)
     #+ignore 
     `((initialstate sql-total-gen);; originally baserelgen
       (template
	;;,(loop for arg in args collect 'output)
	,(make-list (length args) :initial-element 'output))
       (effort , (iftimes (relationsize args (cons rel args))
			  *mysql-effort-per-tuple*)))
     (loop with params = (any x s.t. (parameter-list rel x))
       for pat in (cons nil (cadr (member :indices params)))
       collect
       `((initialstate ,(sql-gen pat params))
	 (template
	  ,(loop for arg in (fourth params) collect
	     (if (member arg pat :test 'string=) 'input 'output)))
	 (effort , (iftimes (relationsize
			     (loop for a in args as arg in (fourth params)
			       unless (member arg pat :test 'string=)
			       collect a)
			     (cons rel args))
			    *mysql-effort-per-tuple*))))))