(use-modules (alterator gettext)
             (alterator http template)
             (alterator http html)

             (alterator configd woo)
             (alterator configd form)
             (alterator configd html)
             (alterator configd constraints)
             (alterator configd frontend))

;;possible modes: new,delete,edit,view
;;object variable defines object name
(define (get-command url url-args)
  (cond
   ((assoc "card-index-view" url-args) 'view)
   ((assoc "card-index-new" url-args) 'new)
   ((assoc "card-index-delete" url-args) 'delete)
   ((assoc "card-index-apply" url-args) 'apply)
   ((assoc "card-index-apply-main" url-args) 'apply-main)
   ((assoc "card-index-cancel" url-args) 'cancel)
   (else 'view)))

(define (woo-read-first/protected url . args)
  (woo-catch
     (thunk (apply woo-read-first url args))
     (lambda reason (list url))))

(define (get-current url . args)
  (woo-get-option (apply woo-read-first/protected url args)
                  'name
                  #f))

(define (make-constraints action args)
  (or (cond-plistq 'async (cdr args))
      (apply fill-constraints action args)))

(define (card-index-js)
  (tag: "head"
	(@ 'template-operation 'append-content)
        (html: "script" (@ 'src "/design/scripts/card-index.js"))))

(define (first-object objects)
  (let ((item (cond-car objects)))
    (and item (html:select-option-value item))))

(define (card-index url url-args template-args)
  (let* ((template-url (or (cond-assq 'scm template-args)
			   (design-path (cond-assq 'url template-args "form-unknown.html"))))
	 (language (cond-assoc "language" url-args '("en_US")))
	 (command (get-command url url-args))
	 (async (cond-assoc "async" url-args))
	 (args (car (woo-args url url-args)))
	 (current (or (cond-assoc "name" url-args) (apply get-current args)))
         (_ (make-translator "alterator-fbi" language)))

    (case command
      ((view cancel)
       (let* ((objects (if async '() (apply woo-list args)))
	      (current (or (and (eq? command 'view ) current) (first-object objects)))
	      (sub-url (and current (string-append url "/" current)))
	      (setup-constraints (make-constraints "write" args)))
	 (template template-url
		   (card-index-js)
		   ;;selector tuning
		   (tag: "form"
			 (@ 'class "selector-chooser")
			 (lambda (options content)
			   (if async
			     ""
			     (template
			       content
			       setup-constraints ;;for LABEL's
			       (if current
				 (list
				   (replace-tag: "select"
						 (@ 'name "name")
						 (lambda(options content)
						   `(select ,@options
							    ,(html:select-options current objects))))
				   (apply fill-form args))
				 (list
				   (replace-tag: "select"
						 (@ 'name "name") "")
				   (replace-tag: "input"
						 (@ 'name "card-index-delete") "")))))))

                   ;;object tuning
		   (tag: "form"
			 (@ 'class "selector-data")
			 (lambda (options content)
			   (if current
			     (template
			       content
			       setup-constraints ;;for LABEL's
			       (tag: "div"
				     (@ 'class "selector-name")
				     (html:hidden 'name current)
				     (html:hidden 'card-index-mode "write"))
			       (apply fill-form sub-url (cdr args)))
			     (_ "No objects found...")))) )))
      ((new)
       (let ((setup-constraints (make-constraints "new" args)))
	 (template template-url
		   (card-index-js)
                   ;;selector tuning
                   (tag: "form"
                         (@ 'class "selector-chooser")
                         (html:submit 'card-index-cancel
                                      (_ "Return to view")))
                   ;;object tuning
                   (tag: "form"
			 (@ 'class "selector-data")
			 (lambda (options content)
			   (template
			     content
			     setup-constraints ;;for LABEL's
			     (tag: "div"
				   (@ 'class "selector-name")
				   (@ 'template-operation 'append-content)
				   (html:hidden 'card-index-mode "new"))
			     (apply new-form args)))))))

      ((apply apply-main)
       (let* ((mode (cond-assoc "card-index-mode" url-args "write"))
              (delete-mode (string=? mode "delete"))
              (new-mode (string=? mode "new"))
              (object-name (or (and (eq? command 'apply) current) ""))
              (redirect (cond-assq 'redirect template-args #f))
              (new-url-args (acons "language" language '())))
         (for-each
          (lambda(cmd)
            (apply (if delete-mode woo-try woo-try/constraints)
                   mode
                   (if (and new-mode (string=? (car cmd) ""))
                       url
                       (string-append url "/" object-name))
                   (cdr cmd))
            )
          (woo-args "" url-args))
         (if (string? redirect)
             (html:redirect redirect)
             (card-index url
                         (if (not delete-mode)
                             (acons "name" current new-url-args)
                             new-url-args)
                         template-args))))
      ((delete) (template template-url
			  (card-index-js)
			  (tag: "form"
				(@ 'class "selector-data")
				(html:hidden 'name current)
				(html:hidden 'card-index-mode "delete")
				(html: "p" (_ "Do you really want to delete ") current "?")
				(html:submit 'card-index-cancel (_ "No"))
				(html: "&" "nbsp")
				(html:submit 'card-index-apply (_ "Yes")))

			  (replace-tag: "form"
					"")))
      (else
	(template template-url
		  (tag: "body"
			(_ "Unsupported mode") (->string command)))))))

(lambda (self objects options)
  (let ((url (string-append "/" (string-join objects "/")))
        (url-args (cond-plistq 'url-args options))
        (template-args (cond-plistq 'template-args options)))
    (list
     'scm
     (woo-catch
      (thunk (card-index url url-args template-args))
      (lambda(reason)
        (html:error (card-index url
                                (acons "card-index-view" #f url-args)
                                template-args)
                    reason))))))
