(define-module (yacswa data)
  #:use-module (csv csv)
  #:use-module (ice-9 textual-ports)
  #:use-module (ice-9 threads)
  #:use-module (json)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-19)
  #:use-module (sxml simple)
  #:use-module (sxml transform)
  #:use-module (tk listlogic)
  #:use-module (tk mcron)
  #:use-module (tk short)
  #:use-module (yacswa debugging)
  #:use-module (yacswa git)

  #:export (get-by-postal
            get-by-hr))

;; Prevent the GC from collecting the associations
(define-once hr-syms '())
(define-once pc-syms '())
(define-once text-syms '())

(display "Updating stats repository...")
(git:init)
(display "Done.\n")

(define-once $hr-tree
  (csv->sxml (open-input-file path-hr-info)
             #:record-sym (lambda x "hr")))

(define-once $pc-tree
  (csv->sxml (open-input-file path-hr-pc-map)
             #:record-sym (lambda x "pc")))

(define-syntax hr
  (syntax-rules ()
    ((hr (($sym) (province $prov) (province_full $prov_text)
          (province_short $prov_abbr) (health_region $hr_terse)
          (health_region_esri $hr_full) $pop))
     (begin (set! hr-syms (cons '$sym hr-syms))
            (let (($text-sym (ssa> $prov "-" $hr_terse)))
              (begin (set! text-syms (cons $text-sym text-syms))
                     (symbol-fset! $text-sym '$sym)))
            (set-symbol-property! '$sym 'prov-code $prov_abbr)
            (set-symbol-property! '$sym 'province $prov)
            (set-symbol-property! '$sym 'terse $hr_terse)
            (set-symbol-property! '$sym 'hr-full $hr_full)
            (set-symbol-property! '$sym 'population $pop)))))

(define (hrinfo!)
  (for-each (lambda (x) (eval x (interaction-environment)))
            (pre-post-order
             (cdr $hr-tree)
             `((HR_UID . ,(lambda (l x) `(,(ssa> "HR" x))))
               (pop . ,(lambda (l x) (string->number x)))
               (*text* . ,(lambda (l x) x))
               (*default* . ,(lambda x x))))))

(define-syntax pc
  (syntax-rules ()
    ((pc (($pc) ($sym) (Prov $prov_num) (ENGNAME $eng_name)
          (FRENAME $fre_name) (EstimatedPop $pop)))
     (begin (set! pc-syms (cons '$pc pc-syms))
            (symbol-fset! '$pc (cons '$sym (if-some (symbol-fref '$pc))))))))

(define (pcinfo!)
  (for-each (lambda (x) (eval x (interaction-environment)))
            (pre-post-order
             (cdr $pc-tree)
             `((FSA . ,(lambda (l x) `(,(ssa> "PC" x))))
               (HR_UID . ,(lambda (l x) `(,(ssa> "HR" x))))
               (*text* . ,(lambda (l x) x))
               (*default* . ,(lambda x x))))))

(begin (hrinfo!)
       (set! hr-syms (delq! 'HR9999 hr-syms))
       (if test-mode?
           (begin (display "Testing hr symbols") (newline)
                  (for-each (lambda (s) (run-hook test-hr s)) hr-syms)))
       (pcinfo!)
       (if test-mode?
           (begin (display "Testing pc symbols") (newline)
                  (for-each (lambda (s) (run-hook test-pc s)) pc-syms))))

;; Data update logic

(define-once $stat-tree
  (csv->sxml (open-input-file path-hr-cases)
             #:record-sym (lambda x "rec")))
(define ($stat-tree-update)
  (set! $stat-tree
    (csv->sxml (open-input-file path-hr-cases)
               #:record-sym (lambda x "rec")))
  $stat-tree)

(define (log-stats-reset)
  (sxml->xml $stat-tree (open-output-file
                         (string-append (yesterday-date-string)
                                        "-stats.log")))
  (for-each (lambda (sym)
              (set-symbol-property! sym 'reports '()))
            hr-syms))

;; Time Management
(define-once $base-time
  (time-second
   (date->time-utc
    (string->date (get-string-all (open-input-file path-update-time))
                  "~Y~m~d~H~M"))))

(define ($base-time!)
  (let ((new-time (strf->secs (get-string-all (open-input-file path-update-time))
                              "~Y~m~d~H~M")))
    (begin (set! $base-time new-time)
           ($expiry-timestamp!)))
  $base-time)

(define (updated?)
  (let ((prev-base $base-time)
        (new-time ($base-time!)))
    (if (equal? prev-base new-time)
        #f
        #t)))

(define $expiry-timestamp
  (let ((ct (time-second (current-time))))
    (step-from $base-time sec/day ct)))
(define ($expiry-timestamp!)
  (let ((ct (time-second (current-time))))
    (set! $expiry-timestamp (step-from $base-time sec/day ct)))
  $expiry-timestamp)

(define (next-timestamp)
  (- ($expiry-timestamp!)
     (time-second (current-time))))

;; Data Wrangling
(define-syntax rec
  (syntax-rules ()
    ((rec ($prov $region $date $cases $c_cases))
     (let* (($sym (symbol-fref (ssa> $prov "-" $region)))
            ($report-stack (if-some (symbol-property $sym 'reports))))
       (unless (eq? $sym 'HR9999) ; special case, HR9999 has no meaningful data
         (set-symbol-property! $sym 'reports (merge! $report-stack
                                                     '(($date . $cases))
                                                     (lambda (a b)
                                                       (time<? (car a)
                                                               (car b))))))))))

(define (process-stats! $tree)
  (for-each
   (lambda (x)
     (eval x (interaction-environment)))
   (pre-post-order
    (cdr $tree)
    `((province . ,(lambda (l x) x))
      (health_region . ,(lambda (l x) x))
      (date_report . ,(lambda (l x) (date->time-utc (string->date x "~d~m~Y"))))
      (cases . ,(lambda (l x) (string->number x)))
      (cumulative_cases . ,(lambda (l x) (string->number x)))
      (*text* . ,(lambda (l x) x))
      (*default* . ,(lambda x x))))))

(define (calculate-strings!)
  (define (sum-first-n n $records)
    (fold + 0 (map cdr (list-tail $records (- (length $records) n)))))
  (for-each
   (lambda (hr-sym)
     (let* ((plist (symbol-pref hr-sym))
            (json (scm->json-string
                   `((hr . ,(substring (ss< hr-sym) 2))
                     (population . ,(assq-ref plist 'population))
                     (hr-full . ,(assq-ref plist 'hr-full))
                     (hr-terse . ,(assq-ref plist 'terse))
                     (province . ,(assq-ref plist 'province))
                     (prov-terse . ,(assq-ref plist 'prov-code))
                     (last-7 . ,(sum-first-n 7 (assq-ref plist 'reports)))
                     (last-14 . ,(sum-first-n 14 (assq-ref plist 'reports)))
                     (expires . ,$expiry-timestamp)))))
       (set-symbol-property! hr-sym 'json-string json)))
   hr-syms))

;;Update Thread
(define %json-lock (make-mutex))

(define mcron-locked '())

(define (who-locked?)
  (if (mutex-locked? %json-lock)
      (if (eqv? (mutex-owner %json-lock) mcron-locked)
          'mcron
          'admin)
      '()))

;;(define mcron:user (getpw (if-some-else (getlogin)
;;                                        "covInd")))

(define (job-loop)
  (let loop ()
    (git:fetch)
    (if (updated?)
        (begin (with-mutex %json-lock
                 (log-stats-reset)
                 (process-stats! ($stat-tree-update))
                 (calculate-strings!))
               (sleep (next-timestamp)))
        (begin (set! next-timestamp (+ next-timestamp (sec/mins 9)))
               (sleep (sec/mins 9))))
    (loop)))

;; As the git repository is no longer updated there is no need to
;;  establish a job loop or populate the statistics tables asynchronously

;;(begin-thread (with-mutex %json-lock
;;              (git:fetch)
;;              (set! mcron-locked (mutex-owner %json-lock))
;;              (process-stats! $stat-tree)
;;              (calculate-strings!))
;;            (sleep (next-timestamp))
;;            (job-loop))

;;(sleep 1)
;;(while (mutex-locked? %json-lock)
;;  (sleep 1))


;; Functional parts of the asynchronous code above

(display "Processing stats...")
(process-stats! $stat-tree)
(display "and calculating json strings...")
(calculate-strings!)
(display "Done.\n")

;; Public Interface
(define (get-by-postal code)
  (let* ((pc-sym (ssa> "PC" code))
         (hr-sym (car (if-some-else (symbol-fref pc-sym) '(ndef)))))
    (symbol-property hr-sym 'json-string)))

(define (get-by-hr code)
  (let ((hr-sym (ssa> "HR" code)))
    (symbol-property hr-sym 'json-string)))