#lang racket

(require data/queue
         racket/contract
         "loghash.rkt"
         )

(provide make-sl-store
         sl-store-grep-message
         sl-store-grep-topic
         sl-store-grep-level
         sl-store-grep
         sl-store-tail
         sl-store-enqueue!
         sl-store->list
         sl-store->display
         sl-store-length
         sl-store-max-length
         )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data structures
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-struct sl-store
  (max-length [length #:mutable] queue)
  )

(define-struct sl-store-item
  (topic level date-time message))

(define make-sl-store* make-sl-store)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(set! make-sl-store (λ ([max-length 1000])
                      (make-sl-store* max-length 0 (make-queue))))

(define levels '(debug info warning warn err error dbg fatal))

(define (level? l)
  (memq l levels))

(define (copy-queue q pred)
  (let ((nq (make-queue)))
    (sequence-for-each
     (λ (item)
       (when (pred item)
         (enqueue! nq item)))
     (in-queue q))
    nq))

(define (level-regexp->level l-re [raise-error #t])
  (let ((str-levels (map symbol->string levels)))
    (letrec ((f (λ (l)
                  (if (null? l)
                      (if raise-error
                          (error (format "Regular expression '~a' does not match a level"))
                          'debug)
                      (if (regexp-match? l-re (car l))
                          (string->symbol (car l))
                          (f (cdr l)))
                      )
                  )
                ))
      (f str-levels))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define/contract (sl-store-enqueue! store topic level date-time msg)
  (-> sl-store? symbol? level? string? string? void?)
  (void
   (let ((queue (sl-store-queue store))
         (ml    (sl-store-max-length store)))
     (enqueue! queue (make-sl-store-item topic level date-time msg))
     (set-sl-store-length! store (+ (sl-store-length store) 1))
     (let loop ()
       (if (> (queue-length queue) ml)
           (begin
             (dequeue! queue)
             (set-sl-store-length! store (- sl-store-length store 1))
             (loop))
           #t))
     )
   )
  )

(define/contract (sl-store->list store)
  (-> sl-store? list?)
  (map (λ (item)
         (list (sl-store-item-topic item)
               (sl-store-item-level item)
               (sl-store-item-date-time item)
               (sl-store-item-message item)))
       (queue->list (sl-store-queue store))))

(define/contract (sl-store->display store)
  (-> sl-store? void?)
  (void
   (for-each (λ (e)
               (displayln
                (format "~a:~a:~a:~a" (car e) (cadr e) (caddr e) (cadddr e))))
             (sl-store->list store))))

(define/contract (sl-store-grep-level store level)
  (-> sl-store? (or/c regexp? level?) sl-store?)
  (let* ((lvl (if (level? level) level (level-regexp->level level)))
         (num-level (hash-ref log-hash lvl 0)))
    (let ((nq (copy-queue (sl-store-queue store)
                          (λ (item)
                            (let ((num-level-item (hash-ref log-hash
                                                            (sl-store-item-level item)
                                                            0)))
                              (>= num-level-item num-level))))))
      (make-sl-store* (sl-store-max-length store)
                      (queue-length nq)
                      nq))))


(define/contract (sl-store-grep-topic store regexp)
  (-> sl-store? (or/c symbol? regexp?) sl-store?)
  (let ((nq (copy-queue (sl-store-queue store)
                        (λ (item)
                          (let ((topic (sl-store-item-topic item)))
                            (if (symbol? regexp)
                                (eq? regexp topic)
                                (regexp-match? regexp (symbol->string topic))))))))
    (make-sl-store* (sl-store-max-length store)
                    (queue-length nq)
                    nq)))
                                

(define/contract (sl-store-grep-message store regexp)
  (-> sl-store? regexp? sl-store?)
  (let ((nq (copy-queue (sl-store-queue store)
                        (λ (item)
                          (let ((msg (sl-store-item-message item)))
                            (regexp-match? regexp msg))))))
    (make-sl-store* (sl-store-max-length store)
                    (queue-length nq)
                    nq)))
  
(define/contract (sl-store-grep store regexp)
  (-> sl-store? (or/c symbol? regexp?) sl-store?)
  (let ((lvl (hash-ref log-hash
                       (if (regexp? regexp)
                           (level-regexp->level regexp #f)
                           (level-regexp->level (pregexp (symbol->string regexp)) #f))
                       0)))
    (let ((nq (copy-queue (sl-store-queue store)
                          (λ (item)
                          (let ((topic (sl-store-item-topic item))
                                (level (hash-ref log-hash (sl-store-item-level item) 0))
                                (msg (sl-store-item-message item)))
                            (and (>= level lvl)
                                 (or (if (symbol? regexp)
                                         (if (level? regexp)
                                             (or (>= level lvl) (eq? regexp topic))
                                             (eq? regexp topic))
                                         (regexp-match? regexp (symbol->string topic)))
                                     (if (symbol? regexp)
                                         #f
                                         (regexp-match? regexp msg)))))))))
      (make-sl-store* (sl-store-max-length store)
                      (queue-length nq)
                      nq))))

(define/contract (sl-store-tail store n)
  (-> sl-store? number? sl-store?)
  (let* ((q (sl-store-queue store))
         (from (if (>= n (queue-length q))
                   0
                   (- (queue-length q) n)))
         (i 0))
    (let ((nq (copy-queue q
                          (λ (item)
                            (if (>= i from)
                                #t
                                (begin
                                  (set! i (+ i 1))
                                  #f))))))
      (make-sl-store* (sl-store-max-length store) (queue-length nq) nq))))