diff --git a/Makefile.in b/Makefile.in index 4b85543..5cc1501 100644 --- a/Makefile.in +++ b/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: diff --git a/backend/Makefile.in b/backend/Makefile.in index 737707d..9b306fe 100644 --- a/backend/Makefile.in +++ b/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 - @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 a couple minutes as data is fetched and initialized." +.backend.lock: yacswa/yacswa.scm + @${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 diff --git a/backend/main.scm b/backend/main.scm deleted file mode 100644 index 5a6124a..0000000 --- a/backend/main.scm +++ /dev/null @@ -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") diff --git a/backend/src/associations.scm b/backend/src/associations.scm deleted file mode 100644 index 0906b82..0000000 --- a/backend/src/associations.scm +++ /dev/null @@ -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)))) diff --git a/backend/src/scheduler.scm b/backend/yacswa/data.scm similarity index 58% rename from backend/src/scheduler.scm rename to backend/yacswa/data.scm index 350b218..62b5002 100644 --- a/backend/src/scheduler.scm +++ b/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"))) @@ -139,7 +226,21 @@ ;; (sleep 1)) -; Functional parts of the asynchronous code above -(git:fetch) +;; 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))) + diff --git a/backend/src/debugging.scm b/backend/yacswa/debugging.scm similarity index 64% rename from backend/src/debugging.scm rename to backend/yacswa/debugging.scm index b6afe34..e8972bb 100644 --- a/backend/src/debugging.scm +++ b/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) diff --git a/backend/src/repo.scm b/backend/yacswa/git.scm similarity index 53% rename from backend/src/repo.scm rename to backend/yacswa/git.scm index f0a6569..a35bccc 100644 --- a/backend/src/repo.scm +++ b/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-info "./repo/other/hr_map.csv") +(define path-hr-cases (string-append %repo-dir "/timeseries_hr/cases_timeseries_hr.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)) diff --git a/backend/src/spawn_interaction.scm b/backend/yacswa/routes.scm similarity index 88% rename from backend/src/spawn_interaction.scm rename to backend/yacswa/routes.scm index 442c0a8..be53f90 100644 --- a/backend/src/spawn_interaction.scm +++ b/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 - -;;(define repl-sock (make-unix-domain-server-socket #:path "./bc")) -;;(spawn-server repl-sock) - -;; endpoint helpers +;; 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) - (let ((hr-sym (ssa> "HR" code))) - (symbol-property hr-sym 'json-string))) +;; Init +(display "Spawning repl on port 1337...") +(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. -(run #:port 1665) +(display "done.\n") diff --git a/backend/yacswa/yacswa.scm b/backend/yacswa/yacswa.scm new file mode 100644 index 0000000..f3e1abe --- /dev/null +++ b/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)