(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 (time 7 0) (time 8 0)))))
    (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 (time 7 0) (time 8 0))))))
    (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 (time 7 0) (time 9 0)))
				 (and Thu
				      (or (range (time 7 0) (time 9 0))
					  (range (time 10 0) (time 12 0))))))))
    (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)))))

(defun make-day-range-matcher (start end success failure)
  (let ((days-in-range (days-in-range start end)))
    (lambda (time)
      (if (find (day-symbol-of time)
		days-in-range)
	  (funcall success time)
	  (funcall failure time)))))

(defun make-day-matcher (day success failure)
  (lambda (time)
    (if (eq day (day-symbol-of time))
	(funcall success time)
	(funcall failure time))))

(defun make-time-range-matcher (start end success failure)
  (lambda (time)
    (let* ((hour (hour-of time))
	   (minute (minute-of time))
	   (hour-minute (+ (hour-to-minute hour)
			   minute)))
      (if (and
	   (<= start hour-minute)
	   (< hour-minute end))
	  (funcall success time)
	  (funcall failure time)))))

(defun make-and-matcher (forms success failure)
  (if (null forms)
      success
      (make-time-window-helper (first forms)
			       (make-and-matcher (rest forms)
						 success failure)
			       failure)))

(defun make-or-matcher (forms success failure)
  (if (null forms)
      failure
      (make-time-window-helper (first forms)
			       success
			       (make-or-matcher (rest forms)
						success failure))))

(defun make-not-matcher (form success failure)
  (make-time-window-helper form failure success))

(defmacro make-time-window (&optional (cs 'all-times))
  (make-time-window-helper cs (constantly t) (constantly nil)))

(defun make-time-window-helper (cs success failure)
  (pcond:pcond 
   ((null cs) failure)
   ((:pat all-times cs) success)
   ((is-day-p cs) (make-day-matcher cs success failure))
   ((and (:pat (range ?start ?end) cs)
	 (is-day-p ?start)
	 (is-day-p ?end)) 
    (make-day-range-matcher ?start ?end success failure))
   ((and (:pat (range (time ?hour1 ?minute1) (time ?hour2 ?minute2)) cs))
    (make-time-range-matcher 
     (+ (hour-to-minute ?hour1)
	?minute1)
     (+ (hour-to-minute ?hour2)
	?minute2)
     success failure))
   ((:pat (not ?form) cs)
    (make-not-matcher ?form success failure))
   ((:pat (or . ?rest) cs)
    (make-or-matcher ?rest success failure))
   ((:pat (and . ?rest) cs)
    (make-and-matcher ?rest success failure))
   (t (error "bad format"))))

(defun includesp (tw time)
  (funcall tw time))

;; util functions

(defun day-symbol-of (time)
  (nth (nth-value 6 (decode-universal-time time)) +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 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 hour-to-minute (hour)
  (* 60 hour))

(defun hour-of (time)
  (nth-value 2 (decode-universal-time time)))

(defun minute-of (time)
  (nth-value 1 (decode-universal-time time)))



;; but since you insist, I'll make it do it with strings
(defmacro make-time-window-from-string (str)
  (if (stringp str)
      (make-time-window-helper (make-time-window-from-string-helper str)
			       (constantly t)
			       (constantly nil))
      `(make-time-window-helper (make-time-window-from-string-helper ,str)
	(constantly t)
	(constantly nil))))

(defun make-time-window-from-string-helper (str)
  (pcond:pcond
    ((equal "" str) 'all-times)
    ((is-day-string-p str) (read-from-string str))
    ((:re "^(.+);(.+)" str (f s))
     `(or ,(make-time-window-from-string-helper f)
       ,(make-time-window-from-string-helper s)))
    ((:re "^([\\D -]+) (\\d.+)" str (days times))
     `(and ,(make-time-window-from-string-helper days)
       ,(make-time-window-from-string-helper times)))
    ((:re "^\\s*(\\D{3})( .+)?\\s*$" str (day rst))
     `(or
       ,(make-time-window-from-string-helper day)
       ,(when rst (make-time-window-from-string-helper rst))))
    ((:re "^\\s*(\\D{3})\\s*-\\s*(\\D{3})( .+)?\\s*$" str (start end rst))
     `(or
       (range 
	,(make-time-window-from-string-helper start) 
	,(make-time-window-from-string-helper end))
       ,(when rst (make-time-window-from-string-helper rst))))
    ((:re "^\\s*(\\d{2})(\\d{2})\\s*-\\s*(\\d{2})(\\d{2})( .+)?\\s*$" str 
	  ((#'parse-integer starthour startminute endhour endminute) rst))
     `(or
       (range (time ,starthour ,startminute)
	(time ,endhour ,endminute))
       ,(when rst (make-time-window-from-string-helper rst))))
    (t (error "I don't know what to do with this: ~A" str))))

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

(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)))))