(defpackage #:rails-to-caveman.helpers
  (:use #:cl
	#:plump
	;; #:dexador
	#:clss
	#:status-code)
  (:shadowing-import-from #:dexador
			  #:get)
  (:export #:*doc*))
(in-package #:rails-to-caveman.helpers)

(defvar *doc* (plump:parse
	       (dexador:get "https://www.w3.org/protocols/rfc2616/rfc2616-sec10.html")))

(defun constant-forms()
  (mapcon (lambda(list)
	    (when (equal "h3" (plump:tag-name (car list)))
	      (let*((position (position "h3"
					(cdr list)
					:test #'equal
					:key #'plump:tag-name))
		    (ps (subseq (cdr list) 0 position))
		    (h3 (loop :for element
				:across (plump:children (car list))
			      :when (plump:text-node-p element)
				:collect (plump:text element)
				  :into result
			      :finally (return
					 (string-trim " "
						      (apply #'concatenate 'string result)))))
		    (code))
		(multiple-value-bind (match-p start)
		    (ppcre:scan "^[0-9][0-9][0-9]" h3)
		  (if (and match-p (not (eql 306
					     (setf code (parse-integer h3
								       :junk-allowed t)))))
		      `((defconstant ,(read-from-string (format nil "+~A+"
								(substitute #\- #\space(string-trim
											" "
											(ppcre::nsubseq h3 start)))))
			  ,code ,(string-trim '(#\newline #\space)
					      (remove #\return
						      (apply #'concatenate 'string
							     (mapcar #'plump:text ps)))))))))))
	  (let* ((vector (plump:child-elements (aref (clss:select "body" *doc*)0)))
		 (position (position "h3" vector :test #'equal
						 :key #'plump:tag-name)))
	    (coerce (subseq vector position)'list))))

(defun thunk() (let ((list (constant-forms)))
		 (format t "~&~(~S~)"
			 `(in-package :cl-user))
		 (format t "~&~(~S~)"
			 `(defpackage #:rfc2616-sec10 (:use :cl)
				      (:nicknames #:status-code)
				      (:export ,@(mapcar #'cadr list))))
		 (format t "~&~(~S~)"  `(in-package #:rfc2616-sec10))
		 (format t "~{~&~%~S~}" list)))

(defmacro with-authenticity-check ((&rest check*) &body body)
  (labels ((rec (list)
	     (if(endp list)
		`(progn ,@body)
		(body (caar list)
		      (cadar list)
		      (cdr list))))
	   (body (key value rest)
	     (ecase key (:token
			 `(if (not (string= ,value (token)))
			      (throw-code status-code:+forbidden+)
			      ,(rec rest)))
		    (:logged-in `(if (not(hermetic:logged-in-p))
				     (throw-code status-code:+unauthorized+)
				     ,(rec rest))))))
    (rec (mapcar #'alexandria:ensure-list check*))))

(defmacro ensure-let ((&rest bind*) &body body)
  (labels ((rec(binds)
	     (if (endp binds)
		 `(progn ,@body)
		 (body (car binds)(cdr binds))))
	   (body (bind rest)
	     `(let (,bind)
		(if (null ,(car bind))
		    (myway:next-route) ,(rec rest))))) (rec bind*)))

(defgeneric update-instance (object &rest args))

(defmethod update-instance ((object standard-object )&rest args)
  (loop :with initargs = (loop :for key :in args :by #'cddr :collect key)
	:for slot :in (c2mop:class-slots (class-of object))
	:for keys = (intersection (c2mop:slot-definition-initargs slot) initargs)
	:when (and keys (or (null (cdr keys)) (error "Dupcated initargs ~S"keys)))
	  :do (let ((value (getf args(car keys))))
		(unless (equal "" value)
		  (setf (slot-value object
				    (c2mop:slot-definition-name slot))
			value))))
  object)

(define-method-combination validate()
                           ((primary (validate) :required t))
  (labels((rec(methods)
            (if (endp (cdr methods))
              `(call-method ,(car methods) nil)
              `(multiple-value-bind(o e),(rec (cdr methods))
                 (values o (append e (nth-value 1 (call-method ,(car methods) nil))))))))
    (rec primary)))

(defgeneric validate(object &key target-slots test)
  (:method-combination validate))

(defmacro method-case (method &rest clauses)
  (let ((var (gensym"VAR")))
    `(let ((,var ,method))
       (cond ,@(mapcar (lambda(clause)
			 `((string= ,(car clause),var),@(cdr clause)))
		       clauses)
	     (t (throw-code status-code:+method-not-allowed+))))))