(defpackage :webutils.tables (:use :cl :webutils.forms :webutils.misc :araneida :webutils.xml-mixed-mode)
            (:export :define-table-generator :define-extended-table-generator :table-generator-form))
(in-package :webutils.tables)
(webutils::export-all :webutils.tables)

(defun sort-fn (thing)
  (ecase thing
    (:descending #'string>)
    (:ascending #'string<)))

(defun extract-sort-by (request column-triads)
  (declare (ignore request))
  (flet ((getp (string)
           (if (boundp 'webutils.forms::*form-param-access-function*)
               (funcall webutils.forms::*form-param-access-function* string)
               nil)))
    (let ((webutils-table-sort-by (getp "WEBUTILS-TABLE-SORT-BY"))
          (webutils-table-sort-then-by (getp "WEBUTILS-TABLE-SORT-THEN-BY"))
          (webutils-table-sort-direction (getp "WEBUTILS-TABLE-SORT-DIRECTION")))
     (if (not (zerop (length webutils-table-sort-by)))
         (list (pretty-string->keyword webutils-table-sort-by)
               (pretty-string->keyword webutils-table-sort-then-by)
               (pretty-string->keyword webutils-table-sort-direction))
         (list (car (first column-triads)) (car (if (cdr column-triads)
                                                    (second column-triads)
                                                    (first column-triads))) :ascending)))))

(defun generate-table (request list column-triads)
  (destructuring-bind (sort-by sort-then-by sort-direction)
      (extract-sort-by request column-triads)
    (let* ((sort-elt 0)
           (sort-then-elt 0)
           (presort-data (loop for elt in list
                            collect (loop for thing in column-triads
                                       for x from 0
                                       if (eq (first thing) sort-by)
                                       do (setf sort-elt x)
                                       if (eq (first thing) sort-then-by)
                                       do (setf sort-then-elt x)
                                       collect  (list (funcall (second thing) elt)
                                                      (princ-to-string (funcall (third thing) elt))))))
           (sorted (stable-sort presort-data
                                #'(lambda (a b)
                                    (let ((sort-1 (second (elt a sort-elt)))
                                          (sort-2 (second (elt b sort-elt))))
                                      (if (string= sort-1 sort-2)
                                          (let ((sort-1 (second (elt a sort-then-elt)))
                                                (sort-2 (second (elt b sort-then-elt))))
                                            (funcall (sort-fn sort-direction) sort-1 sort-2))
                                          (funcall (sort-fn sort-direction) sort-1 sort-2))))))
           (sorted (mapcar #'(lambda (e)
                               (mapcar #'first e)) sorted)))
      (<table class="webutils-table">
              (<tr>
               (loop for thing in column-triads
                  collect (<th> (keyword->pretty-string (first thing)))))
              (loop for elt in sorted
                 for alternate = t then (not alternate)
                 for alternate-class = (if alternate (list "class" "alternate"))
                 collect
                 (<tr $alternate-class>
                      (loop for thing in elt
                         collect (<td> thing))))))))

(defmacro define-table-generator (function-name &body column-triads)
  `(progn
     (define-form ,function-name () ((webutils-table-sort-by t) (webutils-table-sort-then-by t) (webutils-table-sort-direction t)))
     (define-form-field (,function-name webutils-table-sort-by) selector-form-field
       :pretty-name "Sort By"
       :allowed-values-generator (lambda ()
                                   ',(mapcar #'car column-triads))
       :string-to-value-translator #'pretty-string->keyword
       :value-to-string-translator #'keyword->pretty-string
       :default-value ',(car (first column-triads)))
     (define-form-field (,function-name webutils-table-sort-by :hidden-resort) hidden-form-field
       :string-to-value-translator #'pretty-string->keyword
       :value-to-string-translator #'keyword->pretty-string
       :default-value ',(car (first column-triads)))
     (define-form-field (,function-name webutils-table-sort-then-by) selector-form-field
       :pretty-name "Then Sort By"
       :allowed-values-generator (lambda ()
                                   ',(mapcar #'car column-triads))
       :string-to-value-translator #'pretty-string->keyword
       :value-to-string-translator #'keyword->pretty-string
       :default-value ',(car (if (cdr column-triads)
                                 (second column-triads)
                                 (first column-triads))))
     (define-form-field (,function-name webutils-table-sort-then-by :hidden-resort) hidden-form-field
       :string-to-value-translator #'pretty-string->keyword
       :value-to-string-translator #'keyword->pretty-string
       :default-value ',(car (if (cdr column-triads)
                                 (second column-triads)
                                 (first column-triads))))
     (define-form-field (,function-name webutils-table-sort-direction) selector-form-field
       :pretty-name "Sort Direction"
       :allowed-values-generator (lambda ()
                                   (list :ascending :descending))
       :string-to-value-translator #'pretty-string->keyword
       :value-to-string-translator #'keyword->pretty-string
       :default-value :ascending)
     (define-form-field (,function-name webutils-table-sort-direction :hidden-resort) hidden-form-field
       :string-to-value-translator #'pretty-string->keyword
       :value-to-string-translator #'keyword->pretty-string
       :default-value :ascending)
     (defun ,function-name (list request)
       (let ((fields (list ,@(mapcar #'(lambda (e)
                                         (list 'list `',(first e) (second e)
                                               (if (eql (length e) 3)
                                                   (third e)
                                                   (second e)))) column-triads))))
         (generate-table request list fields)))))

(defun generate-extended-table (object groups)
  (let* ((maxspan
          (loop for group in groups
             maximizing (* 2 (length (cdr group)))))
         (maxspan-attribute
          (princ-to-string (max 1 maxspan))))
    (<table class= "webutils-extended-table">
            (loop for group in groups
               for group-name = (first group)
               collect
               (<tr class= "group-header" > (<th colspan=?maxspan-attribute class= "group-header">
                                                 (keyword->pretty-string (first group))))
               collect
               (<tr class=?group-name>
                    (loop for (thing not-last-p) on (cdr group)
                       for count = 1 then (+ count 2)
                       for colspan-attribute = (princ-to-string
                                                (if not-last-p 1
                                                    (max 1 (- maxspan count))))
                       collect
                       (<th> (keyword->pretty-string (first thing)))
                       collect
                       (<td colspan=?colspan-attribute>
                            (funcall (second thing) object))))))))

(defmacro define-extended-table-generator (function-name &body groups)
  `(defun ,function-name (object)
     (generate-extended-table object
                              (list ,@(loop for group in groups
                                           collect
                                           (list* 'list `',(first group)
                                                  (loop for thing in (cdr group)
                                                       collect (list 'list `',(first thing)
                                                                     (second thing)))))))))