(in-package :cl-user)

(use-package :lisp-unit)



;; Lisp is a great language for creating domain-specific languages
;; using text strings seems to be a hack around not having good
;; enough support for DSL programming.  So let's do it in Lisp itself.



;; our unit tests
;; the unit tests from the quiz seem to be in the wrong order
;; simplest unit tests first!

(define-test test-window-nil
  (let ((w (make-time-window)))
    (assert-true 
     (includesp w (make-time 2007 9 25 1 2 3)))))

;; test single day

(define-test test-window-single-day
  (let ((w (make-time-window Fri)))
    ;; Thursday
    (assert-false
     (includesp w (make-time 2007 9 27)))
    (assert-true
     (includesp w (make-time 2007 9 28)))))

(define-test test-window-day-range
  (let ((w (make-time-window (range Fri Mon))))
    (assert-false
     (includesp w (make-time 2007 9 27)))
    (assert-true
     (includesp w (make-time 2007 9 28)))
    (assert-true
     (includesp w (make-time 2007 9 29)))
    (assert-true
     (includesp w (make-time 2007 9 30)))
    ;; Monday
    (assert-true
     (includesp w (make-time 2007 10 1)))
    ;; Tuesday
    (assert-false
     (includesp w (make-time 2007 10 2)))))

(define-test test-window-day-union
  (let ((w (make-time-window (or fri mon))))
    ;; Thursday
    (assert-false 
     (includesp w (make-time 2007 9 27)))
    ;; Friday
    (assert-true
     (includesp w (make-time 2007 9 28)))
    ;; Monday
    (assert-true
     (includesp w (make-time 2007 9 24)))
    ;; Saturday
    (assert-false
     (includesp w (make-time 2007 9 29)))
    ;; Tuesday
    (assert-false
     (includesp w (make-time 2007 9 25)))))

(define-test test-window-time-range 
  (let ((w (make-time-window (range "0700" "0800"))))
    (assert-false
     (includesp w (make-time 2007 10 10 8 10)))
    (assert-true
     (includesp w (make-time 2008 10 10 7 10)))))

(define-test test-window-time-intersect
  (let ((w (make-time-window (and Mon (range "0700" "0800")))))
    (assert-false
     (includesp w (make-time 2007 9 24 8 10)))
    (assert-true
     (includesp w (make-time 2007 9 24 7 10)))
    (assert-false
     (includesp w (make-time 2007 9 26 7 10)))))

(define-test test-window-complicated 
  (let ((w (make-time-window (or (range Sat Sun)
				 (and (or Mon Wed)
				      (range "0700" "0900"))
				 (and Thu
				      (or (range "0700" "0900")
					  (range "1000" "1200")))))))
    (assert-false
     (includesp w (make-time 2007 9 25 8)))
    (assert-true
     (includesp w (make-time 2007 9 26 8)))
    (assert-false
     (includesp w (make-time 2007 9 26 11)))
    (assert-false
     (includesp w (make-time 2007 9 27 6 59 59)))
    (assert-true
     (includesp w (make-time 2007 9 27 7)))
    (assert-true
     (includesp w (make-time 2007 9 27 8 59 59)))
    (assert-false
     (includesp w (make-time 2007 9 27 9 0 0)))
    (assert-true
     (includesp w (make-time 2007 9 27 11)))
    (assert-true
     (includesp w (make-time 2007 9 29 11)))
    (assert-true
     (includesp w (make-time 2007 9 29)))
    (assert-true
     (includesp w (make-time 2007 9 29 23 59 59)))))


(defmacro make-time-window (&optional (cs 'all-times))
  `(make-time-window-helper ',cs))

(defun make-time-window-helper (cs)
  (cond 
    ((null cs) nil)
    ((is-all-times-p cs) 'all-times)
    ((is-day-p cs) cs)
    ((is-time-string-p cs) cs)
    ((or (is-range-p cs) (is-union-p cs) (is-intersect-p cs))
     `(,(first cs) ,@(mapcar #'make-time-window-helper (rest cs))))
    (t (error "bad format"))))

(defun includesp (tw time)
  (cond
    ((null tw) nil)
    ((is-all-times-p tw) t)
    ((is-day-p tw) 
     (eq tw (day-symbol-of time)))
    ((is-union-p tw)
     (some #'identity (mapcar (lambda (tw)
				(includesp tw time))
			      (rest tw))))
    ((is-day-range-p tw)
     (find (day-symbol-of time)
	   (days-in-range (second tw) (third tw))))
    ((is-time-range-p tw)
     (scan-and-bind ((hour1 minute1) "(\\d\\d)(\\d\\d)" (second tw))
       (scan-and-bind ((hour2 minute2) "(\\d\\d)(\\d\\d)" (third tw))
	 (setf hour1 (s-utils:parse-integer-safely hour1))
	 (setf hour2 (s-utils:parse-integer-safely hour2))
	 (setf minute1 (s-utils:parse-integer-safely minute1))
	 (setf minute2 (s-utils:parse-integer-safely minute2))
	 (let ((hour (hour-of time))
	       (minute (minute-of time)))
	   (and
	    (<= (+ (hour-to-minute hour1)
		   minute1)
		(+ (hour-to-minute hour)
		   minute))
	    (< (+ (hour-to-minute hour)
		  minute)
	       (+ (hour-to-minute hour2)
		  minute)))))))
    ((is-intersect-p tw)
     (every #'identity (mapcar (lambda (tw)
				 (includesp tw time))
			       (rest tw))))))

;; util functions

(defun day-symbol-of (time)
  (multiple-value-bind
	(second minute hour date month year day)
      (decode-universal-time time)
    (nth day +day-symbols+)))

(defvar +day-symbols+ '(Mon Tue Wed Thu Fri Sat Sun))

(defun make-time (year &optional (month 1) (date 1) (hour 0) (minute 0) (second 0) (timezone nil))
  (encode-universal-time second minute hour date month year timezone))

(defun is-day-p (ob)
  (find ob +day-symbols+))

(defun is-all-times-p (ob)
  (eq 'all-times ob))

(defun is-time-string-p (ob)
  (and (stringp ob)
       (cl-ppcre:scan "^\\s*\\d\\d\\d\\d\\s*$" ob)))

(defun is-range-p (ob)
  (and (listp ob)
       (eq 'range (first ob))
       (= 3 (length ob))))

(defun is-union-p (ob)
  (and (listp ob)
       (eq 'or (first ob))))

(defun is-intersect-p (ob)
  (and (listp ob)
       (eq 'and (first ob))))

(defun is-day-range-p (ob)
  (and (is-range-p ob)
       (is-day-p (second ob))
       (is-day-p (third ob))))

(defun days-in-range (start end)
  (let ((sindex (position start +day-symbols+))
	(eindex (position end +day-symbols+)))
    (if (<= sindex eindex)
	(subseq +day-symbols+
		sindex
		(1+ eindex))
        (set-difference +day-symbols+ 
			(subseq +day-symbols+
				(1+ eindex)
				sindex)))))

(defun is-time-range-p (ob)
  (and (is-range-p ob)
       (is-time-string-p (second ob))
       (is-time-string-p (third ob))))

(defmacro scan-and-bind ((bindings regex string) &body body)
  (cl-utilities:with-unique-names (match values)
    `(multiple-value-bind (,match ,values) 
      (cl-ppcre:scan-to-strings ,regex ,string)
      (destructuring-bind ,bindings (map 'list #'identity ,values)
	,@body))))

(defun hour-to-minute (hour)
  (* 60 hour))

(defun hour-of (time)
  (multiple-value-bind (second minute hour) (decode-universal-time time)
    hour))

(defun minute-of (time)
  (multiple-value-bind (second minute) (decode-universal-time time)
    minute))


;; but since you insist, I'll make it do it with strings

(defun make-time-window-from-string (str)
  (cond
    ((equal "" str) (make-time-window-helper 'all-times))
    ((is-day-string-p str) (make-time-window-helper (read-from-string str)))
    ((is-day-range-string-p str)
     (scan-and-bind ((start end) "(\\w{3})\\s*-\\s*(\\w{3})" str)
       (make-time-window-helper (list 'range (make-time-window-from-string start) (make-time-window-from-string end)))))
    ((is-time-range-string-p str)
     (scan-and-bind ((start end) "(\\d{4})\\s*-\\s*(\\d{4})" str)
       (make-time-window-helper (list 'range start end))))
    ((has-semicolon-p str)
     (make-time-window-helper (cons 'or (mapcar #'make-time-window-from-string (get-semicolon-parts str)))))
    (t
     (let ((days (get-all-days str))
	   (day-ranges (get-all-day-ranges str))
	   (time-ranges (get-all-time-ranges str)))
       (let ((day-struct 
	      (append
	       (mapcar #'make-time-window-from-string days) 
	       (mapcar #'make-time-window-from-string day-ranges)))
	     (time-struct
	      (mapcar #'make-time-window-from-string time-ranges)))
	 (make-time-window-helper
	  (cond
	    ((and day-struct time-struct)
	     (make-time-window-helper (list 'and (cons 'or day-struct) (cons 'or time-struct))))
	    ((not (or day-struct time-struct))
	     (make-time-window-helper nil))
	    ((null day-struct)
	     (cons 'or time-struct))
	    ((null time-struct)
	     (cons 'or day-struct)))))))))

(defun is-time-range-string-p (str)
  (values (cl-ppcre:scan "^\\s*(\\d{4})\\s*-\\s*(\\d{4})\\s*$" str)))

(defun is-day-range-string-p (str)
  (values (cl-ppcre:scan "^\\s*(\\w{3})\\s*-\\s*(\\w{3})\\s*$" str)))

(defun has-semicolon-p (str)
  (find #\; str))

(defun get-semicolon-parts (str)
  (cl-utilities:split-sequence #\; str :remove-empty-subseqs t))

(defun is-day-string-p (str)
  (let ((day-strings '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")))
    (find str day-strings :test #'equal)))

(defun get-all-days (str)
  (cl-ppcre:all-matches-as-strings "[a-zA-Z]{3}" str))

(defun get-all-day-ranges (str)
  (cl-ppcre:all-matches-as-strings "[a-zA-Z]{3}\\s*-\\s*[a-zA-Z]{3}" str))

(defun get-all-time-ranges (str)
  (cl-ppcre:all-matches-as-strings "\\d{4}\\s*-\\s*\\d{4}" str))

(define-test test-window-complicated-string
  (let ((w (make-time-window-from-string "Sat-Sun; Mon Wed 0700-0900; Thu 0700-0900 1000-1200")))
    (assert-false
     (includesp w (make-time 2007 9 25 8)))
    (assert-true
     (includesp w (make-time 2007 9 26 8)))
    (assert-false
     (includesp w (make-time 2007 9 26 11)))
    (assert-false
     (includesp w (make-time 2007 9 27 6 59 59)))
    (assert-true
     (includesp w (make-time 2007 9 27 7)))
    (assert-true
     (includesp w (make-time 2007 9 27 8 59 59)))
    (assert-false
     (includesp w (make-time 2007 9 27 9 0 0)))
    (assert-true
     (includesp w (make-time 2007 9 27 11)))
    (assert-true
     (includesp w (make-time 2007 9 29 11)))
    (assert-true
     (includesp w (make-time 2007 9 29)))
    (assert-true
     (includesp w (make-time 2007 9 29 23 59 59)))))

(define-test test-window-union-of-day-ranges
  (let ((w (make-time-window-from-string "Sun Sat Mon-Wed")))
    (assert-true
     (includesp w (make-time 2007 10 24)))))

(define-test test-window-day-range-strings
  (let ((w (make-time-window-from-string "Fri-Mon")))
    (assert-false
     (includesp w (make-time 2007 9 27)))
    (assert-true
     (includesp w (make-time 2007 9 28)))
    (assert-true
     (includesp w (make-time 2007 9 29)))
    (assert-true
     (includesp w (make-time 2007 9 30)))
    ;; Monday
    (assert-true
     (includesp w (make-time 2007 10 1)))
    ;; Tuesday
    (assert-false
     (includesp w (make-time 2007 10 2)))))


(define-test test-window-nil
  (let ((w (make-time-window-from-string "" )))
    (assert-true 
     (includesp w (make-time 2007 9 25 1 2 3)))))