Rewrote backend to use Guile's module system rather than primitive loads

Makefile.in

@@ -26,15 +26,15 @@ uninstall:
 	sudo rm @nginx_dir@sites-available/@nginx_config@
 	sudo rm -rf @public_dir@
 
-up: install @nginx_dir@sites_enabled/@nginx_config@
+up: install @nginx_dir@sites-enabled/@nginx_config@
 	@cd backend && ${MAKE} up
 
-@nginx_dir@sites_enabled/@nginx_config@:
+@nginx_dir@sites-enabled/@nginx_config@:
 	@sudo mkdir -p @nginx_dir@sites-enabled
 	@sudo @LN_S@ @nginx_dir@sites-available/@nginx_config@ @nginx_dir@sites-enabled/
 
 down:
-	@sudo rm -f @nginx_dir@sites_enabled/@nginx_config@
+	@sudo rm -fv @nginx_dir@sites-enabled/@nginx_config@
 	@cd backend && ${MAKE} down
 
 clean:

backend/Makefile.in

@@ -1,4 +1,6 @@
 
+ENV=GUILE_AUTO_COMPILE=0 GUILE_LOAD_PATH=".:..."
+
 .PHONY: all deps tk csv up down
 
 all: deps
@@ -13,8 +15,8 @@ csv:
 
 up: .backend.lock
 
-.backend.lock: main.scm
+.backend.lock: yacswa/yacswa.scm
-	@GUILE_AUTO_COMPILE=0 @GUILE@ ./main.scm > yacswa-backend.log 2>&1 & PID=$$!; echo $${PID} > .backend.lock && echo "Server spawned with PID $${PID}" && echo "Allow for "
+	@${ENV} @GUILE@ yacswa/yacswa.scm 2>&1 > yacswa-backend.log & PID=$$!; echo $${PID} > .backend.lock && echo "Server spawned with PID $${PID}" && echo "Allow for a couple minutes as data is fetched and initialized."
 
 down:
 	@PID=`cat .backend.lock` && kill -15 $${PID} && rm .backend.lock && echo "Server on PID $${PID} down."; unset PID

backend/main.scm

@@ -1,28 +0,0 @@
-
-(use-modules (artanis artanis)
-	     (csv csv)
-             (git bindings)
-             (git clone)
-             (git repository)
-             (git remote)
-             (ice-9 popen)
-             (ice-9 regex)
-             (ice-9 string-fun)
-             (ice-9 textual-ports)
-             (ice-9 threads)
-             (srfi srfi-1)
-             (srfi srfi-11)
-             (srfi srfi-19)
-             (sxml simple)
-             (sxml transform)
-             (tk listlogic)
-             (tk mcron)
-             (tk short))
-
-
-(include "./src/debugging.scm")
-(include "./src/repo.scm")
-(git:init)
-(include "./src/associations.scm")
-(include "./src/scheduler.scm")
-(include "./src/spawn_interaction.scm")

backend/src/associations.scm

@@ -1,62 +0,0 @@
-;; Prevent the GC from collecting the associations
-(define hr-syms '())
-(define pc-syms '())
-(define text-syms '())
-
-(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))))

backend/yacswa/data.scm

@@ -1,4 +1,91 @@
 
+(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")))
@@ -107,8 +194,8 @@
           'admin)
       '()))
 
-(define mcron:user (getpw (if-some-else (getlogin)
+;;(define mcron:user (getpw (if-some-else (getlogin)
-                                        ("covInd"))))
+;;                                        "covInd")))
 
 (define (job-loop)
   (let loop ()
@@ -139,7 +226,21 @@
 ;;  (sleep 1))
 
 
-; Functional parts of the asynchronous code above
+;; Functional parts of the asynchronous code above
-(git:fetch)
+
+(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)))
+

backend/yacswa/debugging.scm

@@ -1,4 +1,13 @@
 
+(define-module (yacswa debugging)
+  #:use-module (tk short)
+  #:export (test-hr
+            test-pc
+            test-data
+            test-mode?
+            test-on
+            test-off))
+
 (define test-hr (make-hook 1))
 (define test-pc (make-hook 1))
 (define test-data (make-hook 1))
@@ -7,27 +16,27 @@
 (add-hook! test-hr
            (lambda (sym)
              (begin (display-if-not (symbol-property sym 'province)
-                                    "province key missing: " ,(ss< sym))
+                                    "province key missing: " (ss< sym))
                     (display-if-not (symbol-property sym 'terse)
-                                    "terse key missing: " ,(ss< sym))
+                                    "terse key missing: " (ss< sym))
                     (display-if-not (symbol-property sym 'hr_full)
-                                    "hr_full key missing: " ,(ss< sym))
+                                    "hr_full key missing: " (ss< sym))
                     (display-if-not (symbol-property sym 'population)
-                                    "population data missing: " ,(ss< sym)))))
+                                    "population data missing: " (ss< sym)))))
 
 ;; process-stats
 (add-hook! test-data
            (lambda (sym)
              (let ((report-ls (if-some (symbol-property sym 'reports))))
                (display-if-not (<= 14 (length report-ls))
-                               "Not enough reports under " ,(ss< sym)
+                               "Not enough reports under " (ss< sym)
                                "(" (number->string (length report-ls)) ")"))))
 
 ;; pcinfo
 (add-hook! test-pc
            (lambda (sym)
              (begin (display-if-not (symbol-fref sym)
-                                    "association missing: " ,(ss< sym)))))
+                                    "association missing: " (ss< sym)))))
 
 (define test-mode? #f)
 

backend/yacswa/git.scm

@@ -1,12 +1,26 @@
 
+(define-module (yacswa git)
+  #:use-module (git bindings)
+  #:use-module (git clone)
+  #:use-module (git repository)
+  #:use-module (git remote)
+
+  #:export (path-hr-cases
+            path-hr-info
+            path-hr-pc-map
+            path-update-time
+            git:init
+            git:fetch)
+  )
+
 (define %new-repo-url "https://github.com/ccodwg/CovidTimelineCanada")
 (define %repo-url "https://github.com/ccodwg/Covid19Canada.git")
 (define %repo-dir "./repo")
 
-(define path-hr-cases "./repo/timeseries_hr/cases_timeseries_hr.csv")
+(define path-hr-cases (string-append %repo-dir "/timeseries_hr/cases_timeseries_hr.csv"))
-(define path-hr-info "./repo/other/hr_map.csv")
+(define path-hr-info  (string-append %repo-dir "/other/hr_map.csv"))
 (define path-hr-pc-map "./res/FSA_HR2018.csv")
-(define path-update-time "./repo/update_time.txt")
+(define path-update-time (string-append %repo-dir "/update_time.txt"))
 
 (define (repo-exists?)
   (openable-repository? %repo-dir))

backend/yacswa/routes.scm

@@ -1,3 +1,11 @@
+
+(define-module (yacswa routes)
+  #:use-module (artanis artanis)
+  #:use-module (artanis config)
+  #:use-module (ice-9 regex)
+  #:use-module (tk short)
+  #:use-module (yacswa data))
+
 (use-modules (system repl server))
 
 ;;TODO: Better verify functions
@@ -7,12 +15,7 @@
 ;;    : 
 ;;    : 
 
-;; Backchannel
+;; Helpers
-
-;;(define repl-sock (make-unix-domain-server-socket #:path "./bc"))
-;;(spawn-server repl-sock)
-
-;; endpoint helpers
 (define (err: text) (scm->json-string `((error . ,text))))
 
 (define err:notfound (err: "not-found"))
@@ -29,22 +32,22 @@
                                               postal-final-digits "$")
                                code)))
 
-(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 (verify-hr code)
   (regexp-match? (string-match "^[0-9][0-9][0-9][0-9]$" code)))
 
-(define (get-by-hr code)
+;; Init
-  (let ((hr-sym (ssa> "HR" code)))
+(display "Spawning repl on port 1337...")
-    (symbol-property hr-sym 'json-string)))
+(define repl-sock (make-tcp-server-socket #:port 1337))
+(display "done.\n")
+
 
-;; endpoints
+(display "Calling init-server...\n")
 (init-server #:statics '(png jpg jpeg ico html js css)
              #:cache-statics? #t #:exclude '())
+(display "Artanis initialized!\n")
+(display "Setting routes...")
 
+;; Routes
 (get "/json/pc/:pc"
      (lambda (rc)
        (response-emit
@@ -110,5 +113,4 @@
          ((#t) "Updated")
          ((#f) "Expecting"))))
 
-;; No SSL. Sad.
+(display "done.\n")
-(run #:port 1665)

backend/yacswa/yacswa.scm

@@ -0,0 +1,14 @@
+
+(define-module (yacswa yacswa)
+  #:use-module (artanis artanis)
+  #:use-module (system repl server)
+  #:use-module (yacswa data)
+  #:use-module (yacswa routes))
+
+
+;;(define repl-sock (make-unix-domain-server-socket #:path "./bc"))
+;;(spawn-server repl-sock)
+
+;; No SSL. Sad.
+(display "Bringing server up...\n")
+(run #:port 1665)