(in-package #:chains)

(defclass text ()
  ((content :reader content
            :initarg :content
            :type string
            :documentation "")))

(defun textp (object)
  (typep object 'text))

(defun make-text (content)
  (make-instance 'text :content content))

(defun concat-text (&rest text)
  (let ((strings (mapcar #'content text)))
    (make-text (apply #'concatenate 'string strings))))

(defmethod content ((object (eql 'empty-line)))
  (list (make-text "")))

(defclass closure ()
  ((function :reader closure-function
             :initarg :function
             :type function
             :documentation "")
   (arg-list :reader closure-arg-list
             :initarg :arg-list
             :type list
             :documentation "")
   (environment :reader closure-environment
                :initarg :environment
                :type list
                :documentation "")
   (specialp :reader closure-special-p
             :initarg :specialp
             :type boolean
             :documentation "")
   (groupp :reader closure-group-p
           :initarg :groupp
           :type function
           :documentation "")))

(defun make-closure (function arg-list specialp groupp &optional environment)
  (make-instance 'closure :function function :arg-list arg-list
                          :specialp specialp :groupp groupp
                          :environment environment))

(defun closurep (object)
  (typep object 'closure))

(defun group (item sequence &key (test #'eql))
  (group-if #'(lambda (x) (funcall test item x)) sequence))

(defun group-if (predicate sequence)
  (loop :for (head . tail) :on sequence
        :while (funcall predicate head)
        :collect head :into group
        :finally
           (return (values group (if (not (funcall predicate head))
                                     (cons head tail)
                                     tail)))))

(defun group-if-not (predicate sequence)
  (group-if (complement predicate) sequence))

(defun whitespacep (char-or-string)
  (if (stringp char-or-string)
      (every #'whitespacep char-or-string)
      (member char-or-string +whitespace+)))

(defun whitespace-text-p (object)
  (and (textp object) (whitespacep (content object))))

(defun special-char-p (x)
  (member x +special-characters+))

(defun empty-line-p (x)
  (or (emptyp x) (every #'whitespacep x)))

(defun newlinep (x)
  (eql x #\Newline))

(defun concat (&rest strings)
  (apply #'concatenate 'string strings))