commit
f7181f68d9
@ -0,0 +1,7 @@
|
||||
# emacs buffers and backup files
|
||||
**/*~
|
||||
**/*#
|
||||
|
||||
# elm buildfiles
|
||||
frontend/elm-stuff/
|
||||
frontend/www/elm.js
|
||||
@ -0,0 +1,24 @@
|
||||
|
||||
(use-modules (artanis artanis)
|
||||
(csv csv)
|
||||
(ice-9 popen)
|
||||
(ice-9 regex)
|
||||
(ice-9 string-fun)
|
||||
(ice-9 textual-ports)
|
||||
(ice-9 threads)
|
||||
(mcron base)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-11)
|
||||
(srfi srfi-19)
|
||||
(sxml simple)
|
||||
(sxml transform)
|
||||
(tk listlogic)
|
||||
(tk mcron)
|
||||
(tk short))
|
||||
|
||||
|
||||
(begin (primitive-load "./src/debugging.scm")
|
||||
(primitive-load "./src/repo.scm")
|
||||
(primitive-load "./src/associations.scm")
|
||||
(primitive-load "./src/scheduler.scm")
|
||||
(primitive-load "./src/spawn_interaction.scm"))
|
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,62 @@
|
||||
;; 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))))
|
||||
@ -0,0 +1,38 @@
|
||||
|
||||
(define test-hr (make-hook 1))
|
||||
(define test-pc (make-hook 1))
|
||||
(define test-data (make-hook 1))
|
||||
|
||||
;; hrinfo
|
||||
(add-hook! test-hr
|
||||
(lambda (sym)
|
||||
(begin (display-if-not (symbol-property sym 'province)
|
||||
"province key missing: " ,(ss< sym))
|
||||
(display-if-not (symbol-property sym 'terse)
|
||||
"terse key missing: " ,(ss< sym))
|
||||
(display-if-not (symbol-property sym 'hr_full)
|
||||
"hr_full key missing: " ,(ss< sym))
|
||||
(display-if-not (symbol-property sym 'population)
|
||||
"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)
|
||||
"(" (number->string (length report-ls)) ")"))))
|
||||
|
||||
;; pcinfo
|
||||
(add-hook! test-pc
|
||||
(lambda (sym)
|
||||
(begin (display-if-not (symbol-fref sym)
|
||||
"association missing: " ,(ss< sym)))))
|
||||
|
||||
(define test-mode? #f)
|
||||
|
||||
(define (test-on)
|
||||
(set! test-mode? #t))
|
||||
|
||||
(define (test-off)
|
||||
(set! test-mode? #f))
|
||||
@ -0,0 +1,29 @@
|
||||
(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-pc-map "./res/FSA_HR2018.csv")
|
||||
(define path-update-time "./repo/update_time.txt")
|
||||
|
||||
(define (repo-exists?)
|
||||
(access? %repo-dir (logior W_OK R_OK)))
|
||||
|
||||
(define (init-repo)
|
||||
(let ((git (open-pipe* OPEN_READ "git" "clone" %repo-url %repo-dir)))
|
||||
(close-pipe git)))
|
||||
|
||||
(define (update-repo)
|
||||
(begin (chdir (string-append (getcwd) "/repo"))
|
||||
(let ((git (open-pipe* OPEN_READ "git" "pull" "--rebase" %repo-url)))
|
||||
(close-pipe git))
|
||||
(chdir "..")))
|
||||
|
||||
(define (git:fetch)
|
||||
(if (repo-exists?)
|
||||
(update-repo)
|
||||
(init-repo)))
|
||||
|
||||
(define (git:init)
|
||||
(if (not (repo-exists?))
|
||||
(init-repo)))
|
||||
@ -0,0 +1,134 @@
|
||||
|
||||
(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)))))))
|
||||
(set-symbol-property! hr-sym 'json-string json-esc)))
|
||||
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)))
|
||||
|
||||
(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))
|
||||
@ -0,0 +1,113 @@
|
||||
(use-modules (system repl server))
|
||||
|
||||
;;TODO: Better verify functions
|
||||
;; : figure out the #:mtime directive for (response-emit)
|
||||
;; : Change the API around to separate expiry tagging
|
||||
;; : Provide API for populating a dropdown selection for regions
|
||||
;; :
|
||||
;; :
|
||||
|
||||
;; Backchannel
|
||||
(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"))
|
||||
(define err:invalid (err: "invalid-code"))
|
||||
(define err:maintenance (err: "admin-maintenance"))
|
||||
(define err:scheduled (err: "scheduled-maintenance"))
|
||||
|
||||
(define postal-first-digits "[ABCEGHJKLMNPRSTVXY]")
|
||||
(define postal-final-digits "[ABCEGHJKLMNPRSVWXYTZ]")
|
||||
|
||||
(define (verify-postal code)
|
||||
(regexp-match? (string-match (string-append "^" postal-first-digits
|
||||
"[0-9]"
|
||||
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)))
|
||||
|
||||
;; endpoints
|
||||
(init-server #:statics '(png jpg jpeg ico html js css)
|
||||
#:cache-statics? #t #:exclude '())
|
||||
|
||||
(get "/json/pc/:pc"
|
||||
(lambda (rc)
|
||||
(response-emit
|
||||
(case (who-locked?)
|
||||
((admin) err:maintenance)
|
||||
((mcron) err:scheduled)
|
||||
(else (let ((pc (string-upcase! (params rc "pc"))))
|
||||
(if (verify-postal pc)
|
||||
(if-some-else (get-by-postal pc)
|
||||
err:notfound)
|
||||
err:invalid))))
|
||||
#:status 200 #:headers '((content-type . (application/json))))))
|
||||
|
||||
(get "/json/hr/:hr"
|
||||
(lambda (rc)
|
||||
(response-emit
|
||||
(case (who-locked?)
|
||||
((admin) err:maintenance)
|
||||
((mcron) err:scheduled)
|
||||
(else (let ((hr (params rc "hr")))
|
||||
(if (verify-hr hr)
|
||||
(if-some-else (get-by-hr hr)
|
||||
err:notfound)
|
||||
err:invalid))))
|
||||
#:status 200 #:headers '((content-type . (application/json))))))
|
||||
|
||||
(post "/json/batch" #:from-post 'json
|
||||
(lambda (rc)
|
||||
(response-emit
|
||||
(case (who-locked?)
|
||||
((admin) err:maintenance)
|
||||
((mcron) err:scheduled)
|
||||
(else (let-values (((pc-list hr-list)
|
||||
(:from-post rc 'get-vals "pc-list" "hr-list")))
|
||||
(let* ((hrs (string-join
|
||||
(map (lambda (hr) (if-some-else (get-by-hr hr)
|
||||
err:notfound))
|
||||
hr-list)
|
||||
","))
|
||||
(pcs (string-join
|
||||
(map (lambda (pc) (if-some-else (get-by-pc pc)
|
||||
err:notfound))
|
||||
pc-list)
|
||||
",")))
|
||||
(string-append "[" (string-join (list hrs pcs) ",") "]")))))
|
||||
#:status 200 #:headers '((content-type . (application/json))))))
|
||||
|
||||
(get "/update/last"
|
||||
(lambda (rc)
|
||||
(number->string $base-time)))
|
||||
|
||||
(get "/update/next"
|
||||
(lambda (rc)
|
||||
(number->string $expiry-timestamp)))
|
||||
|
||||
(get "/update/delta"
|
||||
(lambda (rc)
|
||||
(number->string (next-timestamp))))
|
||||
|
||||
(get "/update/status"
|
||||
(lambda (rc)
|
||||
(case (updated?)
|
||||
((#t) "Updated")
|
||||
((#f) "Expecting"))))
|
||||
|
||||
;; No SSL. Sad.
|
||||
(run #:port 1665)
|
||||
@ -0,0 +1,33 @@
|
||||
{
|
||||
"type": "application",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"elm-version": "0.19.1",
|
||||
"dependencies": {
|
||||
"direct": {
|
||||
"NoRedInk/elm-json-decode-pipeline": "1.0.1",
|
||||
"elm/browser": "1.0.2",
|
||||
"elm/core": "1.0.5",
|
||||
"elm/html": "1.0.0",
|
||||
"elm/http": "2.0.0",
|
||||
"elm/json": "1.1.3",
|
||||
"elm/random": "1.0.0",
|
||||
"elm/regex": "1.0.0",
|
||||
"elm/time": "1.0.0",
|
||||
"elm-community/list-extra": "8.7.0",
|
||||
"elm-community/maybe-extra": "5.3.0",
|
||||
"the-sett/elm-localstorage": "3.0.0"
|
||||
},
|
||||
"indirect": {
|
||||
"elm/bytes": "1.0.8",
|
||||
"elm/file": "1.0.5",
|
||||
"elm/url": "1.0.0",
|
||||
"elm/virtual-dom": "1.0.3"
|
||||
}
|
||||
},
|
||||
"test-dependencies": {
|
||||
"direct": {},
|
||||
"indirect": {}
|
||||
}
|
||||
}
|
||||
@ -0,0 +1,47 @@
|
||||
module EventOverrides exposing (onSubmit_, onTerminalBlur)
|
||||
|
||||
import Html.Events exposing ( on, onSubmit, preventDefaultOn )
|
||||
import Html exposing (Attribute)
|
||||
import Json.Decode as Json
|
||||
import Maybe.Extra exposing (join)
|
||||
|
||||
alwaysPreventDefault : msg -> ( msg, Bool )
|
||||
alwaysPreventDefault msg =
|
||||
( msg, True )
|
||||
|
||||
elID : Json.Decoder String
|
||||
elID =
|
||||
Json.field "id" Json.string
|
||||
|
||||
elParentEl : Json.Decoder a -> Json.Decoder (Maybe a)
|
||||
elParentEl decoder =
|
||||
Json.field "parentElement" (Json.nullable decoder)
|
||||
|
||||
target : Json.Decoder a -> Json.Decoder a
|
||||
target decoder =
|
||||
Json.field "target" decoder
|
||||
|
||||
relatedTarget : Json.Decoder a -> Json.Decoder (Maybe a)
|
||||
relatedTarget decoder =
|
||||
Json.field "relatedTarget" (Json.nullable decoder)
|
||||
|
||||
eventTargetSameParent : Json.Decoder Bool
|
||||
eventTargetSameParent =
|
||||
Json.map2
|
||||
(\a_ b_ ->
|
||||
let
|
||||
a = Maybe.withDefault "a" (join a_)
|
||||
b = Maybe.withDefault "b" b_
|
||||
in
|
||||
a == b
|
||||
)
|
||||
(relatedTarget (elParentEl elID))
|
||||
(target (elParentEl elID))
|
||||
|
||||
onTerminalBlur : (Bool -> msg) -> Attribute msg
|
||||
onTerminalBlur message =
|
||||
on "focusout" (Json.map message eventTargetSameParent)
|
||||
|
||||
onSubmit_ : msg -> Attribute msg
|
||||
onSubmit_ msg =
|
||||
preventDefaultOn "submit" (Json.map alwaysPreventDefault (Json.succeed msg))
|
||||
@ -0,0 +1,74 @@
|
||||
module Figures exposing ( bigNumString
|
||||
, perNStringWidth
|
||||
, perNString
|
||||
, percentString
|
||||
)
|
||||
|
||||
import Array exposing (Array)
|
||||
|
||||
--- NOTE: These interfaces output only the number
|
||||
--- They don't intelligently round
|
||||
--- TODO: Intelligent width decisions
|
||||
--- Currently the flat 3 value is based on assumptions about percentages
|
||||
--- Counting digits of the base can be used to calculate appropriate
|
||||
--- assumptions
|
||||
perNStringWidth : Int -> Int -> Float -> String
|
||||
perNStringWidth base digits prop =
|
||||
let
|
||||
disp = prop * (toFloat base)
|
||||
whole = toFloat (truncate disp)
|
||||
--This tells us how many digits are before the decimal
|
||||
log = 1 + truncate (logBase 10 whole)
|
||||
|
||||
remDigits = digits - log
|
||||
frac = (toFloat (10 ^ remDigits)) * (disp - whole)
|
||||
|
||||
(prefix, fixedVal, width) =
|
||||
if frac < 1 then
|
||||
if whole < 1 then
|
||||
("<", Just ( "."
|
||||
++ String.repeat (digits - 2) "0"
|
||||
++ "1" )
|
||||
, 0)
|
||||
else
|
||||
("~", Nothing, log)
|
||||
else
|
||||
("", Nothing, (digits + 1))
|
||||
in
|
||||
prefix ++
|
||||
Maybe.withDefault (String.slice 0 width
|
||||
(String.fromFloat disp))
|
||||
fixedVal
|
||||
|
||||
perNString : Int -> Float -> String
|
||||
perNString base prop =
|
||||
let digits = (truncate (logBase 10 (toFloat base))) + 1 in
|
||||
perNStringWidth base digits prop
|
||||
|
||||
percentString : Float -> String
|
||||
percentString prop =
|
||||
perNStringWidth 100 3 prop
|
||||
|
||||
abbr : Array String
|
||||
abbr = Array.fromList [ ""
|
||||
, " thousand"
|
||||
, " million"
|
||||
, " billion"
|
||||
, " trillion"
|
||||
, " quadrillion"
|
||||
]
|
||||
|
||||
bigNumString : Int -> String
|
||||
bigNumString value =
|
||||
let
|
||||
fltVal = toFloat value
|
||||
log = truncate (logBase 10 fltVal)
|
||||
abbrIdx = log // 3
|
||||
digits = (modBy 3 log) + 1
|
||||
disp = fltVal * toFloat (10 ^ (-3 * abbrIdx))
|
||||
in
|
||||
String.slice 0 (digits + 2)
|
||||
(String.fromFloat disp)
|
||||
++
|
||||
(Array.get abbrIdx abbr
|
||||
|> Maybe.withDefault "")
|
||||
@ -0,0 +1,128 @@
|
||||
module HRInfo exposing ( HRAPI
|
||||
, HRInfo
|
||||
, HRError
|
||||
, decoder
|
||||
, encoder
|
||||
, statsDecoder
|
||||
, strError
|
||||
, strExpiry
|
||||
)
|
||||
|
||||
import Json.Decode as D
|
||||
import Json.Encode as E
|
||||
import Json.Decode.Pipeline exposing (required)
|
||||
import Time exposing (Posix, Weekday, Zone)
|
||||
|
||||
type alias HRAPI = Result HRError (Posix, HRInfo)
|
||||
|
||||
type HRError
|
||||
= NotFound
|
||||
| InvalidCode
|
||||
| AdminMaintenance
|
||||
| ScheduledMaintenance
|
||||
| Unknown String
|
||||
|
||||
type alias HRInfo =
|
||||
{ hr : String
|
||||
, population : Int
|
||||
, engName : String
|
||||
, terseName : String
|
||||
, province : String
|
||||
, terseProv : String
|
||||
, last7 : Int
|
||||
, last14 : Int
|
||||
}
|
||||
|
||||
translateError : String -> HRError
|
||||
translateError errString =
|
||||
case errString of
|
||||
"not-found" -> NotFound
|
||||
"invalid-code" -> InvalidCode
|
||||
"admin-maintenance" -> AdminMaintenance
|
||||
"scheduled-maintenance" -> ScheduledMaintenance
|
||||
any -> Unknown any
|
||||
|
||||
errorDecoder : D.Decoder HRError
|
||||
errorDecoder =
|
||||
D.map translateError (D.field "error" D.string)
|
||||
|
||||
timeDecoder : D.Decoder Posix
|
||||
timeDecoder =
|
||||
D.map (\ts -> Time.millisToPosix (ts * 1000)) D.int
|
||||
|
||||
statsDecoder : D.Decoder HRInfo
|
||||
statsDecoder =
|
||||
D.succeed HRInfo
|
||||
|> required "hr" D.string
|
||||
|> required "population" D.int
|
||||
|> required "hr-full" D.string
|
||||
|> required "hr-terse" D.string
|
||||
|> required "province" D.string
|
||||
|> required "prov-terse" D.string
|
||||
|> required "last-7" D.int
|
||||
|> required "last-14" D.int
|
||||
|
||||
apiDecoder : D.Decoder (Posix, HRInfo)
|
||||
apiDecoder =
|
||||
D.map2 Tuple.pair
|
||||
( D.succeed identity
|
||||
|> required "expires" timeDecoder
|
||||
)
|
||||
statsDecoder
|
||||
|
||||
timeEncoder : Posix -> E.Value
|
||||
timeEncoder time =
|
||||
Time.toMillis Time.utc time
|
||||
|> E.int
|
||||
|
||||
encoder : HRInfo -> E.Value
|
||||
encoder hrInfo =
|
||||
E.object
|
||||
[ ("hr", E.string hrInfo.hr)
|
||||
, ("population", E.int hrInfo.population)
|
||||
, ("hr-full", E.string hrInfo.engName)
|
||||
, ("hr-terse", E.string hrInfo.terseName)
|
||||
, ("province", E.string hrInfo.province)
|
||||
, ("prov-terse", E.string hrInfo.terseProv)
|
||||
, ("last-7", E.int hrInfo.last7)
|
||||
, ("last-14", E.int hrInfo.last14)
|
||||
]
|
||||
|
||||
decoder : D.Decoder HRAPI
|
||||
decoder =
|
||||
D.oneOf [ D.map Err errorDecoder
|
||||
, D.map Ok apiDecoder
|
||||
]
|
||||
|
||||
strError : HRError -> String
|
||||
strError err =
|
||||
case err of
|
||||
NotFound -> "Couldn't find that postal code in my data, try another nearby."
|
||||
InvalidCode -> "That doesn't look like valid fnord input, are you messing with validation?"
|
||||
AdminMaintenance -> "The database is being worked on, check back later."
|
||||
ScheduledMaintenance -> "The database is updating, check back in a few minutes."
|
||||
Unknown _ -> "An unknown error occurred."
|
||||
|
||||
weekdayString : Time.Weekday -> String
|
||||
weekdayString wd =
|
||||
case wd of
|
||||
Time.Mon -> "Mon"
|
||||
Time.Tue -> "Tue"
|
||||
Time.Wed -> "Wed"
|
||||
Time.Thu -> "Thu"
|
||||
Time.Fri -> "Fri"
|
||||
Time.Sat -> "Sat"
|
||||
Time.Sun -> "Sun"
|
||||
|
||||
|
||||
strExpiry : Posix -> Zone -> String
|
||||
strExpiry info tz =
|
||||
List.foldr (++) ""
|
||||
[ String.fromInt (Time.toDay tz info)
|
||||
, ","
|
||||
, weekdayString (Time.toWeekday tz info)
|
||||
, " "
|
||||
, String.fromInt (Time.toHour tz info)
|
||||
, ":"
|
||||
, String.fromInt (Time.toMinute tz info)
|
||||
]
|
||||
@ -0,0 +1,25 @@
|
||||
port module LocalStoragePorts exposing ( clear
|
||||
, getItem
|
||||
, listKeys
|
||||
, make
|
||||
, response
|
||||
, setItem
|
||||
)
|
||||
|
||||
import LocalStorage exposing ( ClearPort
|
||||
, GetItemPort
|
||||
, ListKeysPort
|
||||
, LocalStorage
|
||||
, ResponsePort
|
||||
, SetItemPort
|
||||
)
|
||||
|
||||
port getItem : GetItemPort msg
|
||||
port setItem : SetItemPort msg
|
||||
port clear : ClearPort msg
|
||||
port listKeys : ListKeysPort msg
|
||||
port response : ResponsePort msg
|
||||
|
||||
make : String -> LocalStorage msg
|
||||
make =
|
||||
LocalStorage.make getItem setItem clear listKeys
|
||||
@ -0,0 +1,733 @@
|
||||
module Main exposing (main)
|
||||
|
||||
import Array exposing (Array)
|
||||
import Browser
|
||||
import Browser.Dom exposing (Viewport, getViewport)
|
||||
import Browser.Events
|
||||
import EventOverrides exposing (onSubmit_, onTerminalBlur)
|
||||
import Figures exposing (bigNumString, perNStringWidth)
|
||||
import HRInfo exposing (HRAPI, HRError, HRInfo)
|
||||
import Html exposing (..)
|
||||
import Html.Attributes as A
|
||||
import Html.Events exposing (onBlur, onClick, onInput)
|
||||
import Http
|
||||
import Json.Decode as JD
|
||||
import Json.Encode as JE
|
||||
import List.Extra exposing (getAt, removeAt, setAt)
|
||||
import Postal exposing (checkPostal, genPostal, postalRegexString)
|
||||
import Random
|
||||
import StorageWrapper as LS
|
||||
import Task
|
||||
import Time exposing (Zone)
|
||||
|
||||
|
||||
|
||||
-- Entrypoint
|
||||
|
||||
|
||||
main =
|
||||
Browser.element
|
||||
{ init = init
|
||||
, update = update
|
||||
, subscriptions = subscriptions
|
||||
, view = view
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- Model
|
||||
|
||||
|
||||
type PostalStatus
|
||||
= Incomplete String
|
||||
| Valid String
|
||||
| Invalid String
|
||||
|
||||
|
||||
type alias InfoForm =
|
||||
List Int
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ -- Globalish
|
||||
error : Maybe String
|
||||
, tz : Zone
|
||||
|
||||
-- Postal Codes
|
||||
, postalForm : PostalStatus
|
||||
, postalPlaceholder : String
|
||||
|
||||
-- Stats
|
||||
, infoCards : List ( HRInfo, InfoForm )
|
||||
|
||||
-- LocalStorage
|
||||
, lsHandler : LS.Handler StorageEndpoint
|
||||
, opt : Bool
|
||||
|
||||
-- Scheduler
|
||||
-- TODO
|
||||
}
|
||||
|
||||
|
||||
encodeInfoCards : List ( HRInfo, InfoForm ) -> JE.Value
|
||||
encodeInfoCards cards =
|
||||
JE.list
|
||||
(\( card, form ) ->
|
||||
JE.object
|
||||
[ ( "card", HRInfo.encoder card )
|
||||
, ( "form", JE.list JE.int <| form )
|
||||
]
|
||||
)
|
||||
cards
|
||||
|
||||
|
||||
decodeInfoCards : JD.Decoder (List ( HRInfo, InfoForm ))
|
||||
decodeInfoCards =
|
||||
JD.list
|
||||
(JD.map2 Tuple.pair
|
||||
(JD.field "card" HRInfo.statsDecoder)
|
||||
(JD.field "form" (JD.list JD.int))
|
||||
)
|
||||
|
||||
|
||||
eqCard : HRInfo -> (HRInfo -> Bool)
|
||||
eqCard card =
|
||||
\other -> card.hr == other.hr
|
||||
|
||||
|
||||
hasCards : Model -> Bool
|
||||
hasCards model =
|
||||
List.length model.infoCards > 0
|
||||
|
||||
|
||||
hasError : Model -> Bool
|
||||
hasError model =
|
||||
case model.error of
|
||||
Just _ ->
|
||||
True
|
||||
|
||||
Nothing ->
|
||||
False
|
||||
|
||||
|
||||
|
||||
-- Init
|
||||
|
||||
|
||||
infoFormDefault : InfoForm
|
||||
infoFormDefault =
|
||||
[ 12, 25, 50 ]
|
||||
|
||||
|
||||
lsHandlerInit : LS.Handler StorageEndpoint
|
||||
lsHandlerInit =
|
||||
LS.init "data"
|
||||
|> LS.handleItem "opt" JD.bool Opt
|
||||
|> LS.handleItemWithDefault "infoCards" decodeInfoCards [] InfoCards
|
||||
|> LS.handleItemNotFound "opt" OptNotFound
|
||||
|> LS.handleItemNotFound "infoCards" InfoCardsNotFound
|
||||
|> LS.handleError LSError
|
||||
|
||||
|
||||
init : () -> ( Model, Cmd Msg )
|
||||
init _ =
|
||||
let
|
||||
handler =
|
||||
lsHandlerInit
|
||||
in
|
||||
( Model Nothing Time.utc (Incomplete "") "" [] handler True
|
||||
, Cmd.batch
|
||||
[ Random.generate (\p -> Init (PlaceholderPostal p)) genPostal
|
||||
, Task.perform (\tz -> Init (TimezoneInfo tz)) Time.here
|
||||
, LS.getItem handler "opt" Storage
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- Messaging
|
||||
|
||||
|
||||
type InitMsg
|
||||
= PlaceholderPostal String
|
||||
| TimezoneInfo Zone
|
||||
|
||||
|
||||
updateInit : InitMsg -> Model -> Model
|
||||
updateInit msg model =
|
||||
case msg of
|
||||
PlaceholderPostal str ->
|
||||
{ model | postalPlaceholder = str }
|
||||
|
||||
TimezoneInfo tz ->
|
||||
{ model | tz = tz }
|
||||
|
||||
|
||||
type PassiveMsg
|
||||
= EnterPostal String
|
||||
| EnterNPeople ( Int, Int, String )
|
||||
| SortCardNPeople Int Bool
|
||||
|
||||
|
||||
postalValidate : String -> PostalStatus
|
||||
postalValidate postal =
|
||||
if String.length postal == 3 then
|
||||
if checkPostal postal then
|
||||
Valid postal
|
||||
|
||||
else
|
||||
Invalid postal
|
||||
|
||||
else
|
||||
Incomplete postal
|
||||
|
||||
|
||||
updatePassive : PassiveMsg -> Model -> ( Model, Cmd Msg )
|
||||
updatePassive msg model =
|
||||
case msg of
|
||||
EnterPostal postal ->
|
||||
( { model | postalForm = postalValidate (String.toUpper postal) }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
EnterNPeople ( idx, jdx, str ) ->
|
||||
let
|
||||
el =
|
||||
getAt idx model.infoCards
|
||||
in
|
||||
( case el of
|
||||
Nothing ->
|
||||
{ model
|
||||
| error =
|
||||
Just
|
||||
("EnterNPeople["
|
||||
++ String.fromInt idx
|
||||
++ "]: Index out of bounds"
|
||||
)
|
||||
}
|
||||
|
||||
-- A case could be made to have a inputStringAsNumber
|
||||
Just ( stats, form ) ->
|
||||
let
|
||||
n =
|
||||
case String.toInt str of
|
||||
Nothing ->
|
||||
-- Empty Strings are 0'd
|
||||
if str == "" then
|
||||
0
|
||||
-- Invalid Strings are ignored
|
||||
|
||||
else
|
||||
case getAt jdx form of
|
||||
Just n_ ->
|
||||
n_
|
||||
|
||||
Nothing ->
|
||||
0
|
||||
|
||||
Just n_ ->
|
||||
if n_ > 9999 then
|
||||
9999
|
||||
|
||||
else if n_ < 1 then
|
||||
0
|
||||
|
||||
else
|
||||
n_
|
||||
|
||||
updatedForm =
|
||||
setAt jdx n form
|
||||
in
|
||||
{ model
|
||||
| infoCards =
|
||||
setAt idx ( stats, updatedForm ) model.infoCards
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
SortCardNPeople idx p ->
|
||||
let
|
||||
el =
|
||||
getAt idx model.infoCards
|
||||
in
|
||||
if not p then
|
||||
case el of
|
||||
Nothing ->
|
||||
( { model
|
||||
| error =
|
||||
Just
|
||||
("SortCardNPeople["
|
||||
++ String.fromInt idx
|
||||
++ "]: Index out of bounds"
|
||||
)
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
Just ( stats, form ) ->
|
||||
let
|
||||
sortedForm =
|
||||
List.sort form
|
||||
|
||||
newModel =
|
||||
{ model
|
||||
| infoCards =
|
||||
setAt idx ( stats, sortedForm ) model.infoCards
|
||||
}
|
||||
in
|
||||
( newModel
|
||||
, persistCards newModel
|
||||
)
|
||||
|
||||
else
|
||||
( model, Cmd.none )
|
||||
|
||||
|
||||
type ActiveMsg
|
||||
= GetPostal String
|
||||
| GotHRResponse (Result Http.Error HRAPI)
|
||||
| DismissInfocard Int
|
||||
| StorageOpt Bool
|
||||
|
||||
|
||||
getPostal : String -> Cmd Msg
|
||||
getPostal postal =
|
||||
Http.get
|
||||
{ url = "/json/pc/" ++ postal
|
||||
, expect = Http.expectJson (\r -> Active (GotHRResponse r)) HRInfo.decoder
|
||||
}
|
||||
|
||||
|
||||
modelHRResponse : Model -> HRAPI -> ( Model, Cmd Msg )
|
||||
modelHRResponse model hrapi =
|
||||
case hrapi of
|
||||
Ok ( expiry, info ) ->
|
||||
if List.any (eqCard info) (List.map Tuple.first model.infoCards) then
|
||||
( model, Cmd.none )
|
||||
|
||||
else
|
||||
let
|
||||
newModel =
|
||||
{ model
|
||||
| infoCards =
|
||||
List.append
|
||||
model.infoCards
|
||||
[ ( info, infoFormDefault ) ]
|
||||
}
|
||||
in
|
||||
( newModel
|
||||
, persistCards newModel
|
||||
)
|
||||
|
||||
Err err ->
|
||||
( { model | error = Just (HRInfo.strError err) }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
|
||||
updateActive : ActiveMsg -> Model -> ( Model, Cmd Msg )
|
||||
updateActive msg modl =
|
||||
let
|
||||
model =
|
||||
{ modl | error = Nothing }
|
||||
in
|
||||
case msg of
|
||||
GetPostal postal ->
|
||||
( { model | postalForm = Incomplete "" }, getPostal postal )
|
||||
|
||||
GotHRResponse res ->
|
||||
case res of
|
||||
Ok hrapi ->
|
||||
modelHRResponse model hrapi
|
||||
|
||||
Err (Http.BadBody err) ->
|
||||
( { model | error = Just err }, Cmd.none )
|
||||
|
||||
Err _ ->
|
||||
( { model | error = Just "HTTP error while fetching stats" }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
DismissInfocard idx ->
|
||||
let
|
||||
newModel =
|
||||
{ model | infoCards = removeAt idx model.infoCards }
|
||||
in
|
||||
( newModel
|
||||
, persistCards newModel
|
||||
)
|
||||
|
||||
StorageOpt b ->
|
||||
let
|
||||
newModel =
|
||||
{ model | opt = b }
|
||||
in
|
||||
( newModel
|
||||
, Cmd.batch
|
||||
[ if b then
|
||||
persistCards newModel
|
||||
|
||||
else
|
||||
LS.clear newModel.lsHandler Storage
|
||||
, LS.setItem newModel.lsHandler "opt" (JE.bool b) Storage
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
type alias StorageMsg =
|
||||
LS.LSOps
|
||||
|
||||
|
||||
type StorageEndpoint
|
||||
= Opt Bool
|
||||
| OptNotFound
|
||||
| InfoCards (List ( HRInfo, InfoForm ))
|
||||
| InfoCardsNotFound
|
||||
| LSError String
|
||||
|
||||
|
||||
persistCards : Model -> Cmd Msg
|
||||
persistCards model =
|
||||
if model.opt then
|
||||
LS.setItem model.lsHandler
|
||||
"infoCards"
|
||||
(encodeInfoCards model.infoCards)
|
||||
Storage
|
||||
|
||||
else
|
||||
Cmd.none
|
||||
|
||||
|
||||
updateStorage : StorageMsg -> Model -> ( Model, Cmd Msg )
|
||||
updateStorage msg modl =
|
||||
case LS.update modl.lsHandler msg of
|
||||
Ok m ->
|
||||
case m of
|
||||
Opt o ->
|
||||
( { modl | opt = o }
|
||||
, if o then
|
||||
LS.getItem modl.lsHandler "infoCards" Storage
|
||||
|
||||
else
|
||||
Cmd.none
|
||||
)
|
||||
|
||||
OptNotFound ->
|
||||
( { modl | opt = True }
|
||||
-- First visit, probably
|
||||
, LS.setItem modl.lsHandler
|
||||
"opt"
|
||||
(JE.bool True)
|
||||
Storage
|
||||
)
|
||||
|
||||
InfoCards list ->
|
||||
( { modl | infoCards = list }, Cmd.none )
|
||||
|
||||
InfoCardsNotFound ->
|
||||
( modl, Cmd.none )
|
||||
|
||||
LSError e ->
|
||||
( { modl | error = Just (Debug.log "LSError" e) }, Cmd.none )
|
||||
|
||||
Err e ->
|
||||
( { modl | error = Just <| Debug.toString e }, Cmd.none )
|
||||
|
||||
|
||||
type Msg
|
||||
= Init InitMsg
|
||||
| Passive PassiveMsg
|
||||
| Active ActiveMsg
|
||||
| Storage StorageMsg
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update m model =
|
||||
case m of
|
||||
Init msg ->
|
||||
( updateInit msg model, Cmd.none )
|
||||
|
||||
Passive msg ->
|
||||
updatePassive msg model
|
||||
|
||||
Active msg ->
|
||||
updateActive msg model
|
||||
|
||||
Storage msg ->
|
||||
updateStorage msg model
|
||||
|
||||
|
||||
|
||||
-- Subs
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Sub.batch
|
||||
[ LS.subscribe model.lsHandler Storage
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- View
|
||||
|
||||
|
||||
viewPostalForm : Model -> Html Msg
|
||||
viewPostalForm model =
|
||||
let
|
||||
( postal, postalValid, postalInvalid ) =
|
||||
case model.postalForm of
|
||||
Valid str ->
|
||||
( str, True, False )
|
||||
|
||||
Invalid str ->
|
||||
( str, False, True )
|
||||
|
||||
Incomplete str ->
|
||||
( str, False, False )
|
||||
|
||||
cardsDisplayed : Bool
|
||||
cardsDisplayed =
|
||||
hasCards model
|
||||
|
||||
promptText : String
|
||||
promptText =
|
||||
case cardsDisplayed of
|
||||
True ->
|
||||
"Check another area"
|
||||
|
||||
False ->
|
||||
"Enter the first 3 digits of your postal code"
|
||||
in
|
||||
form
|
||||
[ A.id "postal-prompt"
|
||||
, onSubmit_ (Active (GetPostal postal))
|
||||
, A.classList [ ( "cards-displayed", cardsDisplayed ) ]
|
||||
]
|
||||
[ label [ A.for "postal-prompt" ]
|
||||
[ text promptText ]
|
||||
, div []
|
||||
[ input
|
||||
[ A.type_ "text"
|
||||
, A.id "postal-text"
|
||||
, A.maxlength 3
|
||||
, A.size 7
|
||||
, A.placeholder model.postalPlaceholder
|
||||
, A.pattern postalRegexString
|
||||
, A.value postal
|
||||
, A.autofocus True
|
||||
, onInput (\s -> Passive (EnterPostal s))
|
||||
, A.classList
|
||||
[ ( "left-input", True )
|
||||
, ( "postal-valid", postalValid )
|
||||
, ( "postal-invalid", postalInvalid )
|
||||
]
|
||||
]
|
||||
[]
|
||||
, button
|
||||
[ A.disabled (not postalValid)
|
||||
, A.id "get-postal"
|
||||
, A.class "right-input"
|
||||
, onClick (Active (GetPostal postal))
|
||||
]
|
||||
[ text "Enter" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewCardTitle : HRInfo -> Int -> Html Msg
|
||||
viewCardTitle info idx =
|
||||
div [ A.class "card-title" ]
|
||||
[ div [ A.class "title-text" ]
|
||||
[ h2 [ A.class "full" ] [ text info.province ]
|
||||
, h3 [ A.class "full allow-shrink" ] [ text (", " ++ info.engName) ]
|
||||
, h2 [ A.class "terse" ] [ text info.terseProv ]
|
||||
, h3 [ A.class "terse allow-shrink" ] [ text (", " ++ info.terseName) ]
|
||||
]
|
||||
, span [ A.class "title-spacer" ] []
|
||||
, button
|
||||
[ A.class "dismiss-button"
|
||||
, onClick (Active (DismissInfocard idx))
|
||||
]
|
||||
[]
|
||||
]
|
||||
|
||||
|
||||
viewCardForm : Float -> Int -> Int -> Int -> ( Html Msg, Html Msg )
|
||||
viewCardForm prop cIdx fIdx n =
|
||||
let
|
||||
calc =
|
||||
\x -> 1.0 - ((1.0 - prop) ^ x)
|
||||
in
|
||||
( input
|
||||
[ A.class "interactiveHint figures"
|
||||
, A.type_ "number"
|
||||
, A.min "0"
|
||||
, A.value (String.fromInt n)
|
||||
, onInput (\i -> Passive (EnterNPeople ( cIdx, fIdx, i )))
|
||||
]
|
||||
[]
|
||||
, div [ A.class "figures" ]
|
||||
[ text (perNStringWidth 100 3 (calc (toFloat n))) ]
|
||||
)
|
||||
|
||||
|
||||
viewCardForms : Float -> Int -> InfoForm -> Html Msg
|
||||
viewCardForms prop cIdx frm =
|
||||
let
|
||||
( inputs, results ) =
|
||||
List.unzip
|
||||
(List.foldr (::)
|
||||
[]
|
||||
(List.indexedMap (viewCardForm prop cIdx) frm)
|
||||
)
|
||||
in
|
||||
div []
|
||||
[ div [ A.class "card-content" ]
|
||||
[ span [ A.class "left" ]
|
||||
[ text "After seeing" ]
|
||||
, form
|
||||
[ onTerminalBlur (\b -> Passive (SortCardNPeople cIdx b))
|
||||
, A.class "center"
|
||||
, A.id ("frmCard" ++ String.fromInt cIdx)
|
||||
]
|
||||
inputs
|
||||
, span [ A.class "right" ]
|
||||
[ text "people" ]
|
||||
]
|
||||
, div [ A.class "card-content" ]
|
||||
[ span [ A.class "left" ]
|
||||
[ text "there is a" ]
|
||||
, span [ A.class "center" ]
|
||||
results
|
||||
, span [ A.class "right" ]
|
||||
[ text "% chance" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewCardInfo : Int -> HRInfo -> InfoForm -> Html Msg
|
||||
viewCardInfo idx info form =
|
||||
let
|
||||
-- As Float
|
||||
popFlt =
|
||||
toFloat info.population
|
||||
|
||||
last7Flt =
|
||||
toFloat info.last7
|
||||
|
||||
last14Flt =
|
||||
toFloat info.last14
|
||||
|
||||
activeFlt =
|
||||
last7Flt + (2 * (last14Flt - last7Flt) / 7)
|
||||
|
||||
proportion =
|
||||
activeFlt / popFlt
|
||||
|
||||
-- As String
|
||||
popStr =
|
||||
bigNumString info.population
|
||||
|
||||
activeStr =
|
||||
bigNumString (round activeFlt)
|
||||
|
||||
percentStr =
|
||||
"(" ++ perNStringWidth 100 3 proportion ++ "%)"
|
||||
in
|
||||
div [ A.class "card-body" ]
|
||||
[ div [ A.class "card-header" ]
|
||||
[ span []
|
||||
[ text <| "With approximately " ++ activeStr ++ " " ]
|
||||
, span [ A.class "figures" ]
|
||||
[ text percentStr ]
|
||||
, span []
|
||||
[ text " active cases in a population of "
|
||||
, text popStr
|
||||
]
|
||||
, br [] []
|
||||
, text "All else being equal"
|
||||
]
|
||||
, viewCardForms proportion idx form
|
||||
, div [ A.class "card-footer" ]
|
||||
[ text """that you have seen at least one person currently
|
||||
infectious with Covid-19"""
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewCardFineprint : Int -> Html Msg
|
||||
viewCardFineprint idx =
|
||||
div [ A.class "card-fineprint" ]
|
||||
[ a
|
||||
[ A.class "fineprint"
|
||||
, A.href "#"
|
||||
]
|
||||
[ text "Show your work" ]
|
||||
, pre [ A.class "fineprint" ] [ text " | " ]
|
||||
, a
|
||||
[ A.class "fineprint"
|
||||
, A.href "#"
|
||||
]
|
||||
[ text "How to read these stats" ]
|
||||
, span [ A.class "title-spacer" ] []
|
||||
]
|
||||
|
||||
|
||||
viewCard : Int -> ( HRInfo, InfoForm ) -> Html Msg
|
||||
viewCard idx ( info, form ) =
|
||||
node "info-card"
|
||||
[]
|
||||
[ viewCardTitle info idx
|
||||
, viewCardInfo idx info form
|
||||
, viewCardFineprint idx
|
||||
]
|
||||
|
||||
|
||||
viewCards : Bool -> List ( HRInfo, InfoForm ) -> Html Msg
|
||||
viewCards displayed cards =
|
||||
div
|
||||
[ A.id "info-cards"
|
||||
, A.hidden (not displayed)
|
||||
]
|
||||
(List.indexedMap viewCard cards)
|
||||
|
||||
|
||||
viewPostalAndStats : Model -> Html Msg
|
||||
viewPostalAndStats model =
|
||||
let
|
||||
cardsDisplayed : Bool
|
||||
cardsDisplayed =
|
||||
hasCards model
|
||||
in
|
||||
div [ A.id "spotlight-segment" ]
|
||||
[ viewCards cardsDisplayed model.infoCards
|
||||
, viewPostalForm model
|
||||
]
|
||||
|
||||
|
||||
view : Model -> Html Msg
|
||||
view model =
|
||||
let
|
||||
error : Bool
|
||||
error =
|
||||
hasError model
|
||||
|
||||
strError : String
|
||||
strError =
|
||||
case model.error of
|
||||
Just str ->
|
||||
str
|
||||
|
||||
Nothing ->
|
||||
""
|
||||
in
|
||||
div []
|
||||
[ div
|
||||
[ A.id "error"
|
||||
, A.hidden (not error)
|
||||
]
|
||||
[ text strError ]
|
||||
, div [ A.id "main" ]
|
||||
[ viewPostalAndStats model ]
|
||||
]
|
||||
@ -0,0 +1,51 @@
|
||||
module Postal exposing (genPostal, checkPostal, postalRegexString)
|
||||
|
||||
import Random
|
||||
import Regex
|
||||
|
||||
postalAllowedFirst = [ 'B', 'C', 'E', 'G', 'H', 'J', 'K', 'L'
|
||||
, 'M', 'N', 'P', 'R', 'S', 'T', 'V', 'X'
|
||||
, 'Y'
|
||||
]
|
||||
postalAllowedFinal = [ 'B', 'C', 'E', 'G', 'H', 'J', 'K', 'L'
|
||||
, 'M', 'N', 'P', 'R', 'S', 'T', 'V', 'W'
|
||||
, 'X', 'Y', 'Z'
|
||||
]
|
||||
postalFirstRandom : Random.Generator String
|
||||
postalFirstRandom =
|
||||
Random.map (\c -> String.fromChar c) (Random.uniform 'A' postalAllowedFirst)
|
||||
|
||||
postalDigitRandom : Random.Generator String
|
||||
postalDigitRandom =
|
||||
Random.map (\n -> String.fromInt n) (Random.int 1 9)
|
||||
|
||||
postalFinalRandom : Random.Generator String
|
||||
postalFinalRandom =
|
||||
Random.map (\c -> String.fromChar c) (Random.uniform 'A' postalAllowedFinal)
|
||||
|
||||
genPostal : Random.Generator String
|
||||
genPostal =
|
||||
Random.map3 (\a b c -> "Eg: " ++ a ++ b ++ c)
|
||||
postalFirstRandom
|
||||
postalDigitRandom
|
||||
postalFinalRandom
|
||||
|
||||
postalRegexString : String
|
||||
postalRegexString =
|
||||
let
|
||||
firstDigit =
|
||||
"[" ++ "A" ++ String.fromList postalAllowedFirst ++ "]"
|
||||
finalDigit =
|
||||
"[" ++ "A" ++ String.fromList postalAllowedFinal ++ "]"
|
||||
in
|
||||
"^" ++ firstDigit ++ "[0-9]" ++ finalDigit ++ "$"
|
||||
|
||||
postalRegex : Regex.Regex
|
||||
postalRegex =
|
||||
Maybe.withDefault Regex.never <|
|
||||
Regex.fromString ( postalRegexString )
|
||||
|
||||
-- postal is user input data, clean it up a bit first
|
||||
checkPostal : String -> Bool
|
||||
checkPostal postal =
|
||||
Regex.contains postalRegex postal
|
||||
@ -0,0 +1,2 @@
|
||||
module Scheduler exposing (..)
|
||||
|
||||
@ -0,0 +1,51 @@
|
||||
module Session exposing ( Session
|
||||
)
|
||||
|
||||
import StorageWrapper as LS
|
||||
import HRInfo exposing ( HRInfo
|
||||
, HRApi
|
||||
)
|
||||
import Time
|
||||
import Time.Extras exposing (Decoder as )
|
||||
|
||||
type alias Session =
|
||||
{ storageCntrl : StorageCntrl
|
||||
}
|
||||
|
||||
type alias StorageCntrl =
|
||||
{ stats : List HRInfo
|
||||
, lsHandle : LS.Handler
|
||||
}
|
||||
|
||||
type Msg
|
||||
= Storage
|
||||
| Schedule
|
||||
|
||||
type StorageResponse
|
||||
= Opt Bool
|
||||
| Expiry Time.Posix
|
||||
| Stats (List HRInfo)
|
||||
| OptNotFound
|
||||
| ExpiryNotFound
|
||||
| StatsNotFound
|
||||
| LSError String
|
||||
|
||||
begin : (Session, Cmd Msg)
|
||||
begin =
|
||||
let lsHandler = lsHandlerInit in
|
||||
( Session (StorageCntrl [] lsHandler)
|
||||
, LS.getItem lsHandler "opt" Storage
|
||||
)
|
||||
|
||||
lsHandlerInit : LS.Handler StorageResponse
|
||||
lsHandlerInit =
|
||||
LS.init "bewilde.red/data"
|
||||
|> LS.handleItem "opt" JD.bool Opt
|
||||
|> LS.handleItem "expiry"
|
||||
|> LS.handleItemWithDefault "stats" (decodeStats) [] Stats
|
||||
|> LS.handleItemNotFound "opt" OptNotFound
|
||||
|> LS.handleItemNotFound "expiry" ExpiryNotFound
|
||||
|> LS.handleItemNotFound "stats" StatsNotFound
|
||||
|> LS.handleError LSError
|
||||
|
||||
requestStatsPC : StorageCntrl -> String ->
|
||||
@ -0,0 +1,43 @@
|
||||
module Site exposing (main)
|
||||
|
||||
import Browser
|
||||
import Browser.Navigation as Nav
|
||||
|
||||
type SiteMsg
|
||||
= Persistence Persistence.Cmd
|
||||
| Scheduler Scheduler.Cmd
|
||||
|
||||
type Msg
|
||||
= UrlChanged Url
|
||||
| ClickedLink Browser.UrlRequest
|
||||
| GotMainMsg MainApp.Msg
|
||||
| GotSiteMsg SiteMsg
|
||||
|
||||
main =
|
||||
Browser.application
|
||||
{ init = init
|
||||
, onUrlChange = UrlChanged
|
||||
, onUrlRequest = ClickedLink
|
||||
, subscriptions = subscriptions
|
||||
, update = update
|
||||
, view = view
|
||||
}
|
||||
|
||||
type PageModel
|
||||
= MainApp
|
||||
| About
|
||||
| Contact
|
||||
|
||||
type alias GlobalModel =
|
||||
{
|
||||
,
|
||||
}
|
||||
|
||||
type alias Model =
|
||||
{ page : PageModel
|
||||
, sitewide : GlobalModel
|
||||
}
|
||||
|
||||
init : () -> Url -> Nav.Key -> (Model, Cmd Msg)
|
||||
init flags url navKey =
|
||||
|
||||
@ -0,0 +1,149 @@
|
||||
module StorageWrapper exposing ( init
|
||||
, addHandler
|
||||
, handleItem
|
||||
, handleItemWithDefault
|
||||
, handleKeyList
|
||||
, handleItemNotFound
|
||||
, handleError
|
||||
, update
|
||||
, subscribe
|
||||
, getItem
|
||||
, setItem
|
||||
, clear
|
||||
, listKeys
|
||||
, Error
|
||||
, Handler
|
||||
, LSOps
|
||||
)
|
||||
|
||||
import LocalStoragePorts as Ports
|
||||
import LocalStorage exposing (LocalStorage, Response)
|
||||
|
||||
import Json.Decode as D
|
||||
import Json.Encode as E
|
||||
|
||||
type alias LSOps = Response
|
||||
|
||||
type Sled msg
|
||||
= Done msg
|
||||
| DecodeError D.Error
|
||||
| Pass
|
||||
|
||||
type alias Handler msg =
|
||||
{ portHandle : LocalStorage LSOps
|
||||
, responseHandlers : List (LSOps -> Sled msg)
|
||||
}
|
||||
|
||||
type Error
|
||||
= JsonDecode D.Error
|
||||
| UnhandledResponse Response
|
||||
|
||||
init : String -> Handler msg
|
||||
init pfx =
|
||||
Handler (Ports.make pfx) []
|
||||
|
||||
addHandler : Handler msg -> (LSOps -> Sled msg) -> Handler msg
|
||||
addHandler handler proc =
|
||||
let hlers = handler.responseHandlers in
|
||||
{ handler | responseHandlers = proc :: hlers}
|
||||
|
||||
handleItem : String -> D.Decoder a -> (a -> msg) -> Handler msg -> Handler msg
|
||||
handleItem key decoder wrapper handler=
|
||||
addHandler handler
|
||||
(\r ->
|
||||
case r of
|
||||
LocalStorage.Item k v ->
|
||||
if k == key then
|
||||
case D.decodeValue decoder v of
|
||||
Ok val -> Done (wrapper val)
|
||||
Err e -> DecodeError e
|
||||
else
|
||||
Pass
|
||||
_ -> Pass
|
||||
)
|
||||
|
||||
handleItemWithDefault : String -> D.Decoder a -> a -> (a -> msg) -> Handler msg
|
||||
-> Handler msg
|
||||
handleItemWithDefault key decoder default wrapper handler =
|
||||
addHandler handler
|
||||
(\r ->
|
||||
case r of
|
||||
LocalStorage.Item k v ->
|
||||
if k == key then
|
||||
let val = D.decodeValue decoder v in
|
||||
Done (wrapper
|
||||
<| Result.withDefault default val)
|
||||
else
|
||||
Pass
|
||||
_ -> Pass
|
||||
)
|
||||
|
||||
handleKeyList : (List String -> msg) -> Handler msg -> Handler msg
|
||||
handleKeyList wrapper handler =
|
||||
addHandler handler
|
||||
(\r ->
|
||||
case r of
|
||||
LocalStorage.KeyList list ->
|
||||
Done (wrapper list)
|
||||
_ -> Pass
|
||||
)
|
||||
|
||||
handleItemNotFound : String -> msg -> Handler msg -> Handler msg
|
||||
handleItemNotFound key wrapper handler =
|
||||
addHandler handler
|
||||
(\r ->
|
||||
case r of
|
||||
LocalStorage.ItemNotFound k ->
|
||||
if k == key then Done wrapper
|
||||
else Pass
|
||||
_ -> Pass
|
||||
)
|
||||
|
||||
handleError : (String -> msg) -> Handler msg -> Handler msg
|
||||
handleError wrapper handler =
|
||||
addHandler handler
|
||||
(\r ->
|
||||
case r of
|
||||
LocalStorage.Error err ->
|
||||
Done (wrapper err)
|
||||
_ -> Pass
|
||||
)
|
||||
|
||||
update : Handler msg -> LSOps -> Result Error msg
|
||||
update handler response =
|
||||
let runner = (\h sl -> case sl of
|
||||
Pass -> h response
|
||||
DecodeError _ -> sl
|
||||
Done _ -> sl ) in
|
||||
case List.foldl runner Pass handler.responseHandlers of
|
||||
Pass -> Err <| UnhandledResponse response
|
||||
DecodeError err -> Err <| JsonDecode err
|
||||
Done v -> Ok v
|
||||
|
||||
subscribe : Handler msg -> (LSOps -> resp) -> Sub resp
|
||||
subscribe handler respWrapper =
|
||||
Sub.map respWrapper
|
||||
( handler.portHandle
|
||||
|> LocalStorage.responseHandler identity
|
||||
|> Ports.response
|
||||
)
|
||||
|
||||
getItem : Handler msg -> String -> (LSOps -> resp) -> Cmd resp
|
||||
getItem handler key wrapper =
|
||||
LocalStorage.getItem handler.portHandle key
|
||||
|> Cmd.map wrapper
|
||||
|
||||
clear : Handler msg -> (LSOps -> resp) -> Cmd resp
|
||||
clear handler wrapper =
|
||||
LocalStorage.clear handler.portHandle
|
||||
|> Cmd.map wrapper
|
||||
|
||||
setItem : Handler msg -> String -> E.Value -> (LSOps -> resp) -> Cmd resp
|
||||
setItem handler key value wrapper =
|
||||
LocalStorage.setItem handler.portHandle key value
|
||||
|> Cmd.map wrapper
|
||||
|
||||
listKeys : Handler msg -> String -> (LSOps -> resp) -> Cmd resp
|
||||
listKeys handler pfx wrapper =
|
||||
LocalStorage.listKeys handler.portHandle pfx
|
||||
|> Cmd.map wrapper
|
||||
@ -0,0 +1,40 @@
|
||||
module Time.Extras exposing ( decodeSec
|
||||
, encodeSec
|
||||
, toString
|
||||
)
|
||||
|
||||
import Json.Decode as JD
|
||||
import Json.Encode as JE
|
||||
|
||||
import Time exposing (Posix)
|
||||
|
||||
decodeSec : JD.Decoder Posix
|
||||
decodeSec =
|
||||
JD.map (\ts -> Time.millisToPosix (ts * 1000)) JD.int
|
||||
|
||||
encodeSec : Posix -> E.Value
|
||||
encodeSec time =
|
||||
/ (Time.posixToMillis time) 1000
|
||||
|> JE.int
|
||||
|
||||
weekdayString : Time.Weekday -> String
|
||||
weekdayString wd
|
||||
case wd of
|
||||
Time.Mon -> "Mon"
|
||||
Time.Tue -> "Tue"
|
||||
Time.Wed -> "Wed"
|
||||
Time.Thu -> "Thu"
|
||||
Time.Fri -> "Fri"
|
||||
Time.Sat -> "Sat"
|
||||
Time.Sun -> "Sun"
|
||||
|
||||
toString : Posix -> Zone -> String
|
||||
toString info tz =
|
||||
String.append [ String.fromInt (Time.toDay tz info)
|
||||
, ","
|
||||
, weekdayString (Time.toWeekday tz info)
|
||||
, " "
|
||||
, String.fromInt (Time.toHour tz info)
|
||||
, ":"
|
||||
, String.fromInt (Time.toMinute tz info)
|
||||
]
|
||||
@ -0,0 +1,377 @@
|
||||
|
||||
/* Extra small */
|
||||
@media screen and (max-width:480px) {
|
||||
:root {
|
||||
--global-font-size:15px;
|
||||
--global-line-height:1.2em;
|
||||
--global-space:8px;
|
||||
--global-pad:0px;
|
||||
--min-width:35ch;
|
||||
--max-width:100%;
|
||||
--head-size-base:100%;
|
||||
--head-size-step:0%;
|
||||
|
||||
/*Content*/
|
||||
--dismiss-content:"✘";
|
||||
--enter-content:"";
|
||||
}
|
||||
.full {
|
||||
display:none;
|
||||
}
|
||||
}
|
||||
|
||||
/* Small */
|
||||
@media screen and (min-width:481px) {
|
||||
:root {
|
||||
--global-font-size:18px;
|
||||
--global-line-height:1.2em;
|
||||
--global-space:8px;
|
||||
--global-pad:4px;
|
||||
--min-width:35ch;
|
||||
--head-size-base:112%;
|
||||
--head-size-step:6.25%;
|
||||
|
||||
/*Content*/
|
||||
--dismiss-content:"✘";
|
||||
--enter-content:" ⮨";
|
||||
}
|
||||
.terse {
|
||||
display:none;
|
||||
}
|
||||
}
|
||||
|
||||
/* Medium */
|
||||
@media screen and (min-width:768px) {
|
||||
:root {
|
||||
--global-font-size:0.156in;
|
||||
--global-line-height:1.2em;
|
||||
--global-space:8px;
|
||||
--global-pad:4px;
|
||||
--min-width:48ch;
|
||||
--head-size-base:125%;
|
||||
--head-size-step:12.5%;
|
||||
|
||||
/*Content*/
|
||||
--dismiss-content:"Close ✘";
|
||||
--enter-content:" ⮨";
|
||||
}
|
||||
.terse {
|
||||
display:none;
|
||||
}
|
||||
}
|
||||
|
||||
:root {
|
||||
--font-stack:Roboto, Helvetica, Arial, sans;
|
||||
--header-stack:Noto Serif, serif;
|
||||
--figures-font-stack:Inconsolata, Liberation Mono, Courier New, monospace;
|
||||
|
||||
--page-width:85ch;
|
||||
|
||||
--warning-font-color:firebrick;
|
||||
|
||||
--warning-background-color:khaki;
|
||||
--error-background-color:thistle;
|
||||
--valid-font-color:darkgreen;
|
||||
--valid-background-color:palegreen;
|
||||
|
||||
/*Rethink these colors*/
|
||||
--content-font-color:black;
|
||||
--content-background-color:#FEFEFF;
|
||||
--text-hl-color:#E0E0FC;
|
||||
--text-ll-color:#251125;
|
||||
--text-interactive-color:indigo;
|
||||
|
||||
--background-texture:url('data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAFAAAABQCAYAAACOEfKtAAAKYElEQVR4nO3c74dVXRjG8fX//wdJkiRJkiQZGSNJkoyMJEnGGBkZSZLkel48Puc4F/NqnZdrvdn22Xuvtc6+v+u67/Vrj6dPnyZJ3rx5kyS5fft2kuTOnTtJknv37iVJfv/+nST59OlTkuTk5CRJ8vz58537v337liS5f/9+kuTjx49JksPDwyTJu3fvkiTn5+c7+f3582envF+/fiVJ1O/WrVtJkpcvX+7kI/8bN27s1PPHjx9Jkrt37+489/Xr1yTJ9evXd8r7/PnzTn0+fPiQJDk7O0uSnJ6e7jzv95GVptJAkjfMcoh48uRJkuTi4iJJ8vfv3yTJ27dvkyRfvnxJkrx48SLJlgTP9f3Hx8dJtpa8du1aki3RSNESvn//nmRLmnLk/+/fvyTJw4cPk2xJ0iLev3+fJLl582aS5PXr10m2BD179izJtuWoLwIfPHiwU3/Xf/78+f8LzEpTaSCAhRGFOJrAQk0oi9A0lnEfLXTO8o60jsbRNhanUZ5/9OhRki3Bykc24tS3Nfbx48c79yEYachFrPp7H+rl/y4CJ9NgwfamfndkOZpEs9qruU5TaRWSEERjlEubkCAf9yNTvsjVYmgfotTn1atXSbYEIhOB/pd8Dg4OkmyjBu9Dvs7970XgZBosw+s5F085ZzFE0U7a0BrF0rSNptAk+dESRCEQkQjxHFKci1/VS715c4QfHR0l2WqaaEH58lFvJCK/40bvZRE4mQbLSSzDKyOABVmWNl5eXibZWgjJNMM5jZKPeA6h8qEttM59vKyehR4KTRLPdY9Di0CsliAfieYpV1ypft2zct8icDINmsIyHb9p67wmzaNRNIaFked5FuS1O/5y3TmNoU28sXqpr5ZBo1pjEaK+WpbyEcZLI5oWaylamvq57vlF4GQavA7L0izEsJCeA8vQDKQ4p3UIpEVIcz+tQrj7e5RFfghCWseH8umejHojiPYhWjk01P3I1QK0NGRLi8DJNPqNsiCvx5IswYKusxwyexSEZrTGIra1sONN5SK0y9dyxI/IRpJ4jjZ2T0jc6H87uk+5ooyOThaBk2nTF/ZmHbV5mtgRPhJ4ox4/Qw6CRfos3OOQtJHWiQvl6/ce7XGf+smvexCIRRZt5wMc/T/vQUvokfrVE9lTGt40IpAjdZ/Qm2dJBCCIpWgj8mghjdPDQDBC3I8o5agXr6zeCEOoPjpN9rz8e8RaC1QurfR8x7tIld8icDIN3o/FESEO4s14O/f1rBqLIIJFeV8WRCKSkS8/ZLTGyl+99BwQr340l5b1iDhN1UKQ3eOW6uP/+59N/CJwMg09BfFYj8OxIO/G0khiQZpGU+TTcRwvKrGso3zdL16kxZ73OxIk3lU91QORCO+4Uz5aBvI8j0znWtgicDINlkYOYrxx11mk54Pdx4KeZ2la4ogQ99MU5NG4Hk1pL9rPIwkhnlf/Hgnnnf2vHo9s7yz1PPkicDINmsKitIZ36xFh3oxXpZ3yYWHempb26IrriO3RGl7yKuLbm/YItPvVU3xIO3t+1++tecrh9f1fJC4CJ9OgVd3nFZ8hEyFIoxm9uqstRmN4t+6xXDXqIx9EdQ9HPWkqL6sFIE89aZa4VJ+952bk27N2NFp+a23MntJgYRrA8ohAKA2hgchhSZZBSI9asKx8lUMbu8dBg7pP3fPB6tPjkvJ1v+Q+9e1RGCRe1fK0EMdF4GQaNIRmOO9xQZbgRcVfvZIVWT3/yrshEQESAnjtHr/zu/K75Yj7EO9cuTSdFsqH90aiFtWrsvwfWigtAifToAlI6XitR1l6jsM5smiFfFiSV0aI6zSxV6jy3sjutcs9cow4RCqPdvecCTK1ON4WkT1y7nfvy/9aBE6mzayc+AlpvbIAYSzgPhbtuQ0E9wg3gnoUBjlagvwdlcvrNtFaCrIk5KkPTaPt3eK0IP+nCafd3ssicDJtXqD4SaIBtIiFnCO2xxNZCFGuO/KmyKKlyEQSC/dqLuQoH5m99gX5vf+lR65dR6566OuqJ+J5a9HHInAybbwwb0OTWBBZCEQMQtzXK0xpTc+Otdfr0RaEOvZIsPJpUu8yoN2978NR/XptuPz1iGiheqqP96W8ReBkGj2jz0Is7c27j2V5PxbrnklrEMvRKIQin+bSShamSd3n1QIQ2CR5ruPC3kuHNL+rX6/2cvSc6GMROJkGyyGJlnnTNAwpjryU6wgWx/GKCGDpHk1BOnJpGM11n3qyPC2Vv3wR2esCtRDJ/3Ts1Ve9b8X76fWHi8DJNLR5FhVvIaLXQPd+Dd61+5rIkW/PiiGnZwORz+I9/tgtQX7uQwiClEPjel+JFtREt/dVT+V6bhE4mTZxoNS7MlmCpXt1E2+KvNY8GtORPSL1XHp/BvLFgVLvkUOGloMYSb17VZiEJOQ2obxx93jUYxE4mYY3yeLisJ7dklhIXMXi+prOexwNSeI3cZrryO49b440rWfRHHv1F7J67gNRWgIv3XGf691CtMi1MmFPabNTCTE94iye6v0ZvZcMIZ7v2TZeulfJ92hHRwWI7l2jPT/dX93wv3o1WHtnLQOx4rve5Sn/Hm1aBE6mQQN4GRqDvO6L9l643t/LG3sOCbSOhtIQmtJzGt0Xd79zpKun/NVHC/Bcf11E6h6TFuW89+QpZ2ngntLQA/CGaYz4qr+J0F+96JUAtJTXo20szXL6zMqnefqyCGxS9Uj6qxzdImgtr949oPbKvUZIPv5f73NZozF7SqP35TrnPXsuwTlikMlL+Z2W8Gqus3jHh62BvGdrGqIR4Ny6RuWop/xpZe+gQniPsvTXPZTfPZZF4GQaveqe5WiUN017WJxFaCXyWBzBLI9UpPT4I6/tes8/IwIhNK7JFA30zvTuwYjz5EMDPd9fbOoejPe0CJxMA1nadq8EpUl+Z9H+MhELIcF1lnXUt0WC5Lr69De2eh9Kf3emZ9FoG+/cq8V6JFr0oAWJd3s8tGcbF4GTaXjjtJCFev9vjwPqmfTaGmT1mmhk9ZxGj970HESvlaZ5tBIJzpXTGtb7n51racjSQtSj10XS4LVGek9p9L4HGtPjc62V7Y1oDeL6+3uI6r11znvuob9d2l/d6K+/9bcfRA/9fUMJYb3qq7+t0HM6/bW3ReBkGt2T8Ib1SY1/sUB/DUPcpK/rOov2HEuviqclNKj70OqBBOXSTC2j9zHLB7m9QkG5vXuTT+jvHSK1VygsAifT6P29LNIjxt5493X7mwLiq/bOSEaOcxoqP9rCuzrvlajIUD/k9Zro3rPXX2NDdM+HIxfJyuv4dRE4mUbPyDcBve+W12zLIKHna5HGsjQIiUjv/cKIc06DeqS6Na3HF3vUpb/V1X1g9e9VYL2+kEYuAifTZjSGd2mvxLLiwV4pytIsjLheV4fwXtGqZ9GrtXqHkPuc9zii+tFi/6tX2ipXy3G/FiEaoY29g76/BbEInExDfNcrQGlLfz3Dm2eJ/uZWf5GSxfvbCa7TMhamWfJRj/6yeo/79XijloOoXqXVKyoQ2+OSjv01ET5gETiZ/gOI7wLRCCrHBwAAAABJRU5ErkJggg==');
|
||||
}
|
||||
|
||||
/* Tags */
|
||||
html * {
|
||||
line-height:var(--global-line-height);
|
||||
font-family:var(--font-stack);
|
||||
font-size:var(--global-font-size);
|
||||
margin:0;
|
||||
padding:0;
|
||||
box-sizing:border-box;
|
||||
}
|
||||
|
||||
input::-webkit-outer-spin-button,
|
||||
input::-webkit-inner-spin-button {
|
||||
-webkit-appearance:none;
|
||||
margin: 0;
|
||||
}
|
||||
input[type=number] {
|
||||
-moz-appearance: textfield;
|
||||
border:none;
|
||||
box-sizing:content-box;
|
||||
background:transparent;
|
||||
color:var(--text-interactive-color);
|
||||
font-weight:bold;
|
||||
max-width:4.5ch;
|
||||
}
|
||||
|
||||
body {
|
||||
background-image:var(--background-texture);
|
||||
margin:var(--global-space);
|
||||
padding:var(--global-pad);
|
||||
min-width:var(--min-width);
|
||||
}
|
||||
|
||||
info-card {
|
||||
padding:1em;
|
||||
}
|
||||
|
||||
input,
|
||||
button,
|
||||
a {
|
||||
text-align:center;
|
||||
flex-shrink:0;
|
||||
height:var(--global-line-height);
|
||||
}
|
||||
|
||||
button {
|
||||
background-image:none;
|
||||
background-color:var(--content-background-color);
|
||||
border-color:var(--text-hl-color);
|
||||
}
|
||||
|
||||
h1,
|
||||
h2,
|
||||
h3,
|
||||
h4,
|
||||
h5 {
|
||||
padding-top:0.2em;
|
||||
padding-bottom:0.4em;
|
||||
font-weight:bold;
|
||||
font-family:var(--header-stack);
|
||||
}
|
||||
h1 {
|
||||
font-size:calc(var(--head-size-base) + calc(4 * var(--head-size-step)));
|
||||
}
|
||||
h2 {
|
||||
font-size:calc(var(--head-size-base) + calc(3 * var(--head-size-step)));
|
||||
}
|
||||
h3 {
|
||||
font-size:calc(var(--head-size-base) + calc(2 * var(--head-size-step)));
|
||||
}
|
||||
h4 {
|
||||
font-size:calc(var(--head-size-base) + calc(1 * var(--head-size-step)));
|
||||
}
|
||||
|
||||
/*Line by line highlight*/
|
||||
code,
|
||||
p,
|
||||
.card-body {
|
||||
background-image:linear-gradient(var(--text-hl-color) 50%, transparent 50%);
|
||||
background-size:var(--min-width) calc(2 * var(--global-line-height));
|
||||
}
|
||||
|
||||
ul>:nth-child(odd) {
|
||||
background-color:var(--text-hl-color);
|
||||
}
|
||||
|
||||
/*classes*/
|
||||
.postal-invalid {
|
||||
color:var(--warning-font-color);
|
||||
background-color:var(--warning-background-color);
|
||||
}
|
||||
.postal-valid {
|
||||
color:var(--valid-font-color);
|
||||
background-color:var(--valid-background-color);
|
||||
}
|
||||
|
||||
.left-input {
|
||||
background-image:
|
||||
linear-gradient(to right,
|
||||
var(--content-background-color),
|
||||
var(--text-hl-color));
|
||||
border-color:var(--text-hl-color);
|
||||
border-style:solid;
|
||||
border-width: 0px var(--global-pad) 0px 0px;
|
||||
}
|
||||
.right-input {
|
||||
display:inline-block;
|
||||
background-image:
|
||||
linear-gradient(to left,
|
||||
var(--content-background-color),
|
||||
var(--text-hl-color));
|
||||
border-style:hidden;
|
||||
padding-left:var(--global-pad);
|
||||
}
|
||||
|
||||
.dismiss-button {
|
||||
align-self:center;
|
||||
border-style:solid none;
|
||||
}
|
||||
.dismiss-button::after {
|
||||
content:var(--dismiss-content);
|
||||
}
|
||||
|
||||
.interactive-hint {
|
||||
background-color:var(--content-background-color);
|
||||
border:none;
|
||||
height:var(--global-line-height);
|
||||
}
|
||||
|
||||
.card-title {
|
||||
display:flex;
|
||||
flex-flow:row nowrap;
|
||||
align-items:baseline;
|
||||
justify-content:space-between;
|
||||
max-width:100%;
|
||||
margin-bottom:0.2em;
|
||||
}
|
||||
.card-title > * {
|
||||
box-sizing:content-box;
|
||||
}
|
||||
|
||||
.card-body {
|
||||
display:flex;
|
||||
flex-flow:column nowrap;
|
||||
align-items:center;
|
||||
text-align:center;
|
||||
}
|
||||
.card-content {
|
||||
position:relative;
|
||||
}
|
||||
.center {
|
||||
display:inline-flex;
|
||||
flex-flow:row nowrap;
|
||||
align-items:center;
|
||||
justify-content:space-around;
|
||||
width:100%;
|
||||
}
|
||||
.center > * {
|
||||
padding:0 0.5ch;
|
||||
}
|
||||
|
||||
.right {
|
||||
text-align:left;
|
||||
position:absolute;
|
||||
width:100%;
|
||||
top:0%;
|
||||
left:100%;
|
||||
}
|
||||
.left {
|
||||
text-align:right;
|
||||
position:absolute;
|
||||
right:100%;
|
||||
width:100%;
|
||||
}
|
||||
|
||||
.title-text {
|
||||
display:flex;
|
||||
flex-flow:row nowrap;
|
||||
align-items:center;
|
||||
max-width:87%;
|
||||
}
|
||||
.title-spacer {
|
||||
background-color:var(--text-hl-color);
|
||||
height:2px;
|
||||
align-self:center;
|
||||
margin:0 15px;
|
||||
width:90%;
|
||||
flex-shrink:100;
|
||||
}
|
||||
|
||||
.card-fineprint {
|
||||
display:flex;
|
||||
flex-flow:row nowrap;
|
||||
justify-content:space-between;
|
||||
width:100%;
|
||||
padding-top:0.4em;
|
||||
}
|
||||
.card-fineprint > .title-spacer {
|
||||
margin-right:0;
|
||||
}
|
||||
|
||||
.allow-shrink {
|
||||
overflow:hidden;
|
||||
text-overflow:ellipsis;
|
||||
white-space:nowrap;
|
||||
flex-shrink:50;
|
||||
}
|
||||
.fineprint {
|
||||
font-size:70%;
|
||||
color:var(--text-ll-color);
|
||||
}
|
||||
|
||||
.figures {
|
||||
font-family:var(--figures-font-stack);
|
||||
}
|
||||
|
||||
/*ids*/
|
||||
|
||||
#error {
|
||||
margin:var(--global-space) auto;
|
||||
background-color:var(--error-background-color);
|
||||
background-image:initial;
|
||||
border-radius:var(--global-space);
|
||||
max-width:calc(var(--page-width) + var(--global-space));
|
||||
padding:var(--global-pad);
|
||||
}
|
||||
|
||||
#warn {
|
||||
margin:var(--global-space) 0;
|
||||
background-color:var(--warning-background-color);
|
||||
background-image:initial;
|
||||
border-radius:var(--global-space);
|
||||
max-width:calc(var(--page-width) + var(--global-space));
|
||||
padding:var(--global-pad);
|
||||
}
|
||||
|
||||
#main {
|
||||
margin:auto;
|
||||
background-color:var(--content-background-color);
|
||||
background-image:initial;
|
||||
border-radius:var(--global-space);
|
||||
max-width:calc(var(--page-width));
|
||||
padding:var(--global-pad);
|
||||
}
|
||||
|
||||
#info-cards {
|
||||
display:flex;
|
||||
flex-flow:column;
|
||||
justify-content:flex-start;
|
||||
align-items:stretch;
|
||||
width:100%;
|
||||
}
|
||||
|
||||
#postal-prompt {
|
||||
display:flex;
|
||||
flex-flow:column;
|
||||
text-align:center;
|
||||
margin:auto;
|
||||
padding:0 1em;
|
||||
}
|
||||
#postal-prompt > label {
|
||||
font-size:calc(var(--head-size-base) + calc(4 * var(--head-size-step)));
|
||||
font-weight:bold;
|
||||
padding-top:0.2em;
|
||||
padding-bottom:0.4em;
|
||||
}
|
||||
#postal-prompt.cards-displayed > label {
|
||||
font-size:initial;
|
||||
font-weight:bold;
|
||||
}
|
||||
|
||||
#get-postal:after {
|
||||
content:var(--enter-content);
|
||||
}
|
||||
|
||||
#spotlight-segment {
|
||||
display:flex;
|
||||
justify-content:space-between;
|
||||
flex-flow:column wrap;
|
||||
min-height:96vh;
|
||||
width:100%;
|
||||
}
|
||||
|
||||
/*ids + class override*/
|
||||
#postal-prompt.cards-displayed {
|
||||
align-self: flex-end;
|
||||
align-items:baseline;
|
||||
justify-content:flex-end;
|
||||
flex-flow:row;
|
||||
margin:inherit;
|
||||
}
|
||||
|
||||
@ -0,0 +1,79 @@
|
||||
var ElmLocalStoragePorts = function() {};
|
||||
|
||||
ElmLocalStoragePorts.prototype.subscribe =
|
||||
function(app, getPortName, setPortName, clearPortName, responsePortName, listKeysPortName) {
|
||||
if (!getPortName) getPortName = "getItem";
|
||||
if (!setPortName) setPortName = "setItem";
|
||||
if (!clearPortName) clearPortName = "clear";
|
||||
if (!listKeysPortName) listKeysPortName = "listKeys";
|
||||
if (!responsePortName) responsePortName = "response";
|
||||
|
||||
if (app.ports[responsePortName]) {
|
||||
var responsePort = app.ports[responsePortName];
|
||||
|
||||
if (app.ports[getPortName]) {
|
||||
app.ports[getPortName].subscribe(function(key) {
|
||||
var val = null;
|
||||
try {
|
||||
val = JSON.parse(localStorage.getItem(key))
|
||||
} catch (e) {}
|
||||
responsePort.send({
|
||||
key:key,
|
||||
value:val
|
||||
})
|
||||
});
|
||||
} else {
|
||||
console.warn(getPortName + ": This port is not connected.");
|
||||
}
|
||||
|
||||
if (app.ports[setPortName]) {
|
||||
app.ports[setPortName].subscribe(function(kv) {
|
||||
var key = kv[0];
|
||||
var json = kv[1];
|
||||
if (json === null) {
|
||||
localStorage.removeItem(key);
|
||||
} else {
|
||||
localStorage.setItem(key, JSON.stringify(json));
|
||||
}
|
||||
});
|
||||
} else {
|
||||
console.warn(setPortName + ": This port is not connected.");
|
||||
}
|
||||
|
||||
if (app.ports[clearPortName]) {
|
||||
app.ports[clearPortName].subscribe(function(prefix) {
|
||||
if (prefix) {
|
||||
var cnt = localStorage.length;
|
||||
for (var i = cnt - 1; i >= 0; --i) {
|
||||
var key = localStorage.key(i);
|
||||
if (key && key.startsWith(prefix)) {
|
||||
localStorage.removeItem(key);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
localStorage.clear();
|
||||
}
|
||||
});
|
||||
} else {
|
||||
console.warn(clearPortName + ": This port is not connected.");
|
||||
}
|
||||
|
||||
if (app.ports[listKeysPortName]) {
|
||||
app.ports[listKeysPortName].subscribe(function(prefix) {
|
||||
var cnt = localStorage.length;
|
||||
var keys = [];
|
||||
for (var i = 0; i < cnt; i++) {
|
||||
var key = localStorage.key(i);
|
||||
if (key && key.startsWith(prefix)) {
|
||||
keys.push(key);
|
||||
}
|
||||
}
|
||||
responsePort.send(keys);
|
||||
});
|
||||
} else {
|
||||
console.warn(listKeysPortName + ": This port is not connected.");
|
||||
}
|
||||
} else {
|
||||
console.warn(responsePortName + ": This port is not connected.");
|
||||
}
|
||||
};
|
||||
@ -0,0 +1,78 @@
|
||||
|
||||
ElmLocalStoragePorts.prototype.subscribe =
|
||||
function(app, getPortName, setPortName, clearPortName, responsePortName, listKeysPortName) {
|
||||
if (!getPortName) getPortName = "getItem";
|
||||
if (!setPortName) setPortName = "setItem";
|
||||
if (!clearPortName) clearPortName = "clear";
|
||||
if (!listKeysPortName) listKeysPortName = "listKeys";
|
||||
if (!responsePortName) responsePortName = "response";
|
||||
|
||||
if (app.ports[responsePortName]) {
|
||||
var responsePort = app.ports[responsePortName];
|
||||
|
||||
if (app.ports[getPortName]) {
|
||||
app.ports[getPortName].subscribe(function(key) {
|
||||
var val = null;
|
||||
try {
|
||||
val = JSON.parse(localStorage.getItem(key))
|
||||
} catch (e) {}
|
||||
responsePort.send({
|
||||
key:key,
|
||||
value:val
|
||||
})
|
||||
});
|
||||
} else {
|
||||
console.warn(getPortName + ": This port is not connected.");
|
||||
}
|
||||
|
||||
if (app.ports[setPortName]) {
|
||||
app.ports[setPortName].subscribe(function(kv) {
|
||||
var key = kv[0];
|
||||
var json = kv[1];
|
||||
if (json === null) {
|
||||
localStorage.removeItem(key);
|
||||
} else {
|
||||
localStorage.setItem(key, JSON.stringify(json));
|
||||
}
|
||||
});
|
||||
} else {
|
||||
console.warn(setPortName + ": This port is not connected.");
|
||||
}
|
||||
|
||||
if (app.ports[clearPortName]) {
|
||||
app.ports[clearPortName].subscribe(function(prefix) {
|
||||
if (prefix) {
|
||||
var cnt = localStorage.length;
|
||||
for (var i = cnt - 1; i >= 0; --i) {
|
||||
var key = localStorage.key(i);
|
||||
if (key && key.startsWith(prefix)) {
|
||||
localStorage.removeItem(key);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
localStorage.clear();
|
||||
}
|
||||
});
|
||||
} else {
|
||||
console.warn(clearPortName + ": This port is not connected.");
|
||||
}
|
||||
|
||||
if (app.ports[listKeysPortName]) {
|
||||
app.ports[listKeysPortName].subscribe(function(prefix) {
|
||||
var cnt = localStorage.length;
|
||||
var keys = [];
|
||||
for (var i = 0; i < cnt; i++) {
|
||||
var key = localStorage.key(i);
|
||||
if (key && key.startsWith(prefix)) {
|
||||
keys.push(key);
|
||||
}
|
||||
}
|
||||
responsePort.send(keys);
|
||||
});
|
||||
} else {
|
||||
console.warn(listKeysPortName + ": This port is not connected.");
|
||||
}
|
||||
} else {
|
||||
console.warn(responsePortName + ": This port is not connected.");
|
||||
}
|
||||
};
|
||||
@ -0,0 +1,25 @@
|
||||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
<meta content="text/html; charset=utf-8" equiv="Content-Type" charset="utf-8">
|
||||
<meta content="width=device-width, initial-scale=0.86, minimum-scale=0.86 shrink-to-fit=no" name="viewport">
|
||||
<title>COVID-19 statistics for individuals</title>
|
||||
<link rel="preconnect" href="https://fonts.googleapis.com">
|
||||
<link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
|
||||
<link href="https://fonts.googleapis.com/css2?family=Inconsolata&family=Noto+Serif&family=Roboto&display=swap" rel="stylesheet">
|
||||
<link rel="stylesheet" href="assets/style.css">
|
||||
<script src="elm.js"></script>
|
||||
<script src="elm-local-storage-ports.js"></script>
|
||||
</head>
|
||||
<body>
|
||||
<div id="elm"></div>
|
||||
<script type="text/javascript">
|
||||
const localStoragePorts = new ElmLocalStoragePorts();
|
||||
var app = Elm.Main.init({
|
||||
node: document.getElementById("elm"),
|
||||
flags: []});
|
||||
localStoragePorts.subscribe(app);
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
||||
|
||||
Loading…
Reference in new issue