;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
;;; $Header: src/components.lisp $

;;; Copyright (c) 2008, Andrea Chiumenti.  All rights reserved.

;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:

;;;   * Redistributions of source code must retain the above copyright
;;;     notice, this list of conditions and the following disclaimer.

;;;   * Redistributions in binary form must reproduce the above
;;;     copyright notice, this list of conditions and the following
;;;     disclaimer in the documentation and/or other materials
;;;     provided with the distribution.

;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(in-package :claw-html)

(defclass claw-html-builder (chtml::lhtml-builder)
  ()) 

(defun make-claw-html-builder ()
  (make-instance 'claw-html-builder))

(defmethod hax:start-element ((handler claw-html-builder) name attrs)
  (let* ((parent (car (chtml::stack handler)))
	 (this (list (find-symbol (format nil "~a>" (string-upcase name)) :claw-html)
                     (flatten (chtml::pt-attributes-to-lhtml attrs)))))
    (push this (chtml::stack handler))
    (if parent
	(push this (cddr parent))
	(setf (chtml::root handler) this))))

(defmethod hax:end-element ((handler claw-html-builder) name)
  (let ((current (pop (chtml::stack handler))))
    (setf (cdr current) 
          (append (cadr current) (reverse (cddr current))))))

;; component parser

(defvar *component-content-template* nil)

(defclass claw-html-component-builder (claw-html-builder)
  ((component-content-template :initform nil
                               :accessor component-content-template-p)
   (component-content-ignore :initform nil
                               :accessor component-content-ignore-p)
   (parsed-content :initform nil
                   :accessor parsed-content))) 

(defun make-claw-html-component-builder ()
  (make-instance 'claw-html-component-builder))

(defmethod hax:start-element :before ((handler claw-html-builder) name attrs)
  (dolist (attr attrs)
    (cond 
      ((and (string-equal (hax:attribute-name attr) "CLAWTYPE")
            (string-equal (hax:attribute-value attr) "$ignore$"))
       (setf (component-content-ignore-p handler) t))
      ((and (string-equal (hax:attribute-name attr) "CLAWTYPE")
            (string-equal (hax:attribute-value attr) "$content$")
            (null (component-content-ignore-p handler)))
       (if (component-content-template-p handler)
         (error "$content$ found multiple times in template")
         (setf (component-content-template-p handler) t))))))

(defun parse-attributes (attrs)
  (loop for (key value) on attrs by #'cddr
     collect key 
     when value collect (parse-attribute-value value)))

(defun parse-attribute-value (value)
  (multiple-value-bind (result matchesp)
      (cl-ppcre:regex-replace "(?i)(^\\$lisp>)+([.])*" value "\\2")
    (if matchesp
        (read-from-string result)
        result)))


(defmethod hax:end-element ((handler claw-html-component-builder) name) 
  (let ((current (pop (chtml::stack handler))))
    (let ((attrs (parse-attributes (cadr current))))
      (cond 
        ((string-equal (getf attrs :clawtype) "$ignore$")
         (setf (cdr current) nil
               attrs nil
               (component-content-ignore-p handler) nil
               (car current) (find-symbol "IGNORE>" "CLAW-HTML")))
        ((string-equal (getf attrs :clawtype) "$body$")
         (setf (cdr current) nil
               attrs (list (find-symbol "*CLAW-THIS-COMPONENT*" "CLAW-HTML"))
               (car current) (find-symbol "HTCOMPONENT-BODY" "CLAW-HTML")))
        ((and (component-content-template-p handler)
              (string-equal (getf attrs :clawtype) "$content$")
              (null (parsed-content handler)))
         (remf attrs :clawtype)
         (setf (parsed-content handler) (append (list (first current)) 
                                                attrs
                                                (reverse (cddr current))))))
      (unless (component-content-ignore-p handler)
        (setf (cdr current) 
              (append attrs (reverse (cddr current))))))))


(defun parse-claw-template (input)
  "Parses the input and returns a claw form template (i.e. a CLAW-HTML:TAG instance) and returns a lambda function with no parameters.
The inpus may be a string a file or a stream.
"
  (eval `(lambda () ,(let ((handler (make-claw-html-component-builder)))
                          (chtml:parse input handler)
                          (let ((result (parsed-content handler)))
                            (or (parsed-content handler) result))))))