feat: initial departure search support

deps.fnl

@@ -4,7 +4,11 @@
  :deps {:ftcsv {:type :rock
                 :version :1.5.0}
         :lsqlite3 {:type :rock
-                   :version :0.9.6}}
+                   :version :0.9.6}
+        :io.github.luafun/luafun 
+        {:type :git
+         :sha "12837884993a3d25bda8aaf835bb9d79132fcbc6"
+         :paths {:lua [ "?.lua" ]}}}
 
  :paths {:fennel ["src/?.fnl"]
          :macro ["src/?.fnlm"]

sql/create-tables.sql

@@ -46,6 +46,8 @@ CREATE TABLE stop_times (
 	stop_id TEXT,
 	PRIMARY KEY(trip_id, sequence)
 );
+CREATE INDEX stop_times_idx
+ON stop_times (stop_id, arrival);
 
 CREATE TABLE calendar (
 	service TEXT PRIMARY KEY,
@@ -53,6 +55,8 @@ CREATE TABLE calendar (
 	start_date TEXT NOT NULL,
   end_date TEXT NOT NULL
 );
+CREATE INDEX calendar_idx
+ON calendar (service, start_date);
 
 CREATE TABLE calendar_dates (
 	service TEXT,
@@ -60,3 +64,5 @@ CREATE TABLE calendar_dates (
 	type INTEGER,
 	PRIMARY KEY(service, date)
 );
+CREATE INDEX calendar_date_idx
+ON calendar_dates (service, date);

sql/find-stops.sql

@@ -2,4 +2,10 @@
 SELECT *
 FROM stops
 WHERE
-id = :id
+	ST_Distance(
+		stops.location,
+		ST_Transform(
+			ST_GeomFromWkb(:searchgeom, 4326),
+			25832
+		)
+	) < 500;

sql/get-departures.sql

@@ -0,0 +1,42 @@
+WITH exceptions AS (
+	SELECT service, NOT (type - 1) as added
+	FROM calendar_dates
+	WHERE
+		calendar_dates.date = date(:time)
+)
+SELECT timediff(
+	stop_times.departure,
+	time(:time)
+) as wait,
+	routes.*,
+	trips.headsign,
+	trips.short_name as trip_name,
+	stop_times.arrival,
+	stop_times.departure
+FROM
+	stop_times
+JOIN trips
+ON stop_times.trip_id = trips.id
+JOIN routes
+ON trips.route_id = routes.id
+JOIN calendar
+ON calendar.service = trips.service_id
+LEFT JOIN exceptions
+ON exceptions.service = calendar.service
+WHERE
+	stop_times.stop_id = :stop
+AND
+	stop_times.departure > time(:time)
+AND (
+	1 << (strftime('%w', :time) - 1) & calendar.days <> 0
+AND
+	calendar.start_date < date(:time)
+AND
+	calendar.end_date > date(:time)
+AND
+	added IS NULL
+OR
+	added)
+ORDER BY
+	stop_times.departure
+LIMIT :limit;

src/departures.fnl

@@ -0,0 +1,39 @@
+(local {: client : query} (require :sqlite))
+(local {: encode-wkb} (require :wkb))
+(local {: dofile} (require :fennel))
+
+(local dev-config (dofile :config.fnl))
+
+(fn now []
+  (os.date :%Y-%m-%dT%T (os.time)))
+
+(local types {:0 :tram
+              :1 :metro
+              :2 :train
+              :3 :bus
+              :4 :boat
+              :5 :cable-tram
+              :6 :aerial-tram
+              :7 :funicular
+              :11 :trolleybus
+              :12 :monorail})
+
+(fn parse-departure [{: color :text_color text-color}]
+  (fn color->html [?color]
+    (and ?color (string.format :#%x color))))
+
+(with-open [client (client)]
+  (let [q (partial query client)]
+    (icollect 
+      [{:short_name name : id &as stop}
+       (q
+        :find-stops
+        {:searchgeom (encode-wkb dev-config.dev-location)})]
+      {: stop
+       :departures
+       (icollect [departure 
+                  (q :get-departures {:limit 5
+                                      :time
+                                      "2026-01-12T07:00:00"
+                                      :stop id})]
+                 departure)})))

src/html.fnl

@@ -1,20 +0,0 @@
-(local self-closing [:area
-                     :base
-                     :br
-                     :col
-                     :embed
-                     :hr
-                     :img
-                     :input
-                     :link
-                     :meta
-                     :param
-                     :source
-                     :track
-                     :wbr])
-
-(fn html [elements])
-
-(fn page [elements])
-
-{: html : page}

src/import.fnl

@@ -0,0 +1,148 @@
+(local {: view} (require :fennel))
+(local csv (require :ftcsv))
+(local sql (require :sqlite))
+(local {: OK} (require :lsqlite3))
+(local {: encode-wkb} (require :wkb))
+
+(fn execute-statement [db script-name]
+  (let [script (with-open
+                 [script 
+                  (io.open (.. "sql/" script-name ".sql"))]
+                 (script:read :*all))]
+    (if (not= OK (db:execute script))
+      (error (db:errmsg)))))
+
+(local day-index
+  (collect [i day (ipairs [:monday
+                           :tuesday
+                           :wednesday
+                           :thursday
+                           :friday
+                           :saturday
+                           :sunday])]
+           day (- i 1)))
+(fn days->bitmap [row]
+  (accumulate [mask 0
+               day shift (pairs day-index)]
+              (if (= (tonumber (. row day)) 1)
+                (bor mask (lshift 1 shift))
+                mask)))
+
+(fn normalize-time [value]
+  (let [(hour min sec) (string.match value "(%d+):(%d+):(%d+)")]
+    (string.format "'%02d:%02d:%02d'"
+                   (tonumber hour)
+                   (tonumber min)
+                   (tonumber sec))))
+
+(fn normalize-date [value]
+  (let [(hour min sec) (string.match value "(%d%d%d%d)(%d%d)(%d%d)")]
+    (string.format "'%04d-%02d-%02d'"
+                   (tonumber hour)
+                   (tonumber min)
+                   (tonumber sec))))
+
+(fn latlng->wkb [tbl row]
+  (let [name (string.sub tbl 1 (- (length tbl) 1))
+        lat (. row (.. name "_lat"))
+        long (. row (.. name "_lon"))
+        point [:point lat long]]
+    (if (and lat long) 
+      (let [wkb (encode-wkb point true)
+            bytes (table.pack (string.byte wkb 1 (length wkb)))
+            hex (table.concat (icollect [_ b (ipairs bytes)]
+                                        (string.format :%02x b)) "")]
+        (.. "ST_Transform(ST_GeomFromWkb(x'" hex "', 4326), 25832)")))))
+
+(fn create-insert-statement [tbl mapping row]
+  (when (. mapping :days)
+    (set row.days (days->bitmap row)))
+  (when (. mapping :location)
+    (set row.location (latlng->wkb tbl row)))
+  (let [keys (icollect [k (pairs row)] k)
+        color-key? (fn [key] (string.match key :color$))
+        date-key? (fn [key] (string.match key :date$))
+        time-key? (fn [key] (string.match key :time$))
+        val->str (fn [key value]
+                   (if 
+                     (= value "") :NULL
+                     (color-key? key) (tonumber value 16)
+                     (date-key? key) (normalize-date value)
+                     (time-key? key) (normalize-time value)
+                     (= key :location) value
+                     (.. "'" (string.gsub value "'" "''") "'")))]
+    (..
+      "INSERT INTO "
+      tbl
+      "("
+      (table.concat
+        (icollect [_ key (ipairs keys)]
+                  (. mapping key))
+        ",")
+      ") VALUES ("
+       (table.concat
+         (icollect [_ key (ipairs keys)]
+                   (if (. mapping key)
+                     (let [value (. row key)]
+                       (val->str key value))))
+         "," )
+       ")")))
+
+(fn insert-table [db tbl mapping]
+  (let [file-path (.. "gtfs-data/" tbl ".txt")]
+    (print "inserting into " tbl)
+    (each [_ line (csv.parseLine file-path {:headers true})]
+      (let [stmt (create-insert-statement
+                    tbl mapping line)]
+        (match (db:execute stmt)
+        OK nil
+        _ (do
+               (print stmt)
+               (error (.. "error inserting: " (db:errmsg)))))))))
+
+(local mappings 
+  {:stops {:stop_id :id
+          :stop_desc :description
+          :stop_name :name
+          :stop_code :code
+          :platform_code :platform
+          :parent_station :parent
+          :location :location}
+   :routes {:route_id :id
+            :route_short_name :short_name
+            :route_long_name :long_name
+            :route_desc :description
+            :route_type :type
+            :route_color :color
+            :route_text_color :text_color}
+   :trips {:trip_id :id
+           :route_id :route_id
+           :service_id :service_id
+           :trip_headsign :headsign
+           :trip_short_name :short_name}
+   :stop_times {:trip_id :trip_id
+                :stop_sequence :sequence
+                :stop_id :stop_id
+                :departure_time :departure
+                :arrival_time :arrival}
+   :calendar {:service_id :service
+              :start_date :start_date
+              :end_date :end_date
+              :days :days}
+   :calendar_dates {:service_id :service
+                    :date :date
+                    :exception_type :type}})
+
+(fn import [?directory]
+  "I don't do much, yet."
+  (with-open [db (sql.connection)]
+             (print "creating database structure")
+             (execute-statement db :create-tables)
+             (db:execute "BEGIN TRANSACTION")
+             (each [k v (pairs mappings)]
+               (insert-table db k v))
+             (db:execute "COMMIT")
+             (print "analysing database")
+             (db:execute "ANALYZE")))
+
+{: import}

src/main.fnl

@@ -1,128 +1,4 @@
-(local {: view} (require :fennel))
+(local {: import} (require :import))
-(local csv (require :ftcsv))
-(local sql (require :sqlite))
-(local {: OK} (require :lsqlite3))
-(local {: encode-wkb} (require :wkb))
 
-(fn execute-statement [db script-name]
+(case arg
-  (let [script (with-open
+  [:import & rest] (import rest))
-                 [script 
-                  (io.open (.. "sql/" script-name ".sql"))]
-                 (script:read :*all))]
-    (if (not= OK (db:execute script))
-      (error (db:errmsg)))))
-
-(local day-index
-  (collect [i day (ipairs [:monday
-                           :tuesday
-                           :wednesday
-                           :thursday
-                           :friday
-                           :saturday
-                           :sunday])]
-           day (- i 1)))
-(fn days->bitmap [row]
-  (accumulate [mask 0
-               day shift (pairs day-index)]
-              (if (= (. row day) :1)
-                (bor mask (lshift 1 shift))
-                mask)))
-
-(fn latlng->wkb [tbl row]
-  (let [name (string.sub tbl 1 (- (length tbl) 1))
-        lat (. row (.. name "_lat"))
-        long (. row (.. name "_lng"))
-        point [:point lat long]]
-    (if (and lat long) 
-      (let [wkb (encode-wkb point true)
-            bytes (table.pack (string.byte wkb 1 (length wkb)))
-            hex (table.concat (icollect [_ b (ipairs bytes)]
-                                        (string.format :%02x b)) "")]
-        (.. "ST_Transform(ST_GeomFromWkb(x'" hex "', 4326), 25832)")))))
-
-(fn create-insert-statement [tbl mapping row]
-  (when (. mapping :days)
-    (set row.days (days->bitmap row)))
-  (when (. mapping :location)
-    (set row.location (latlng->wkb tbl row)))
-  (let [keys (icollect [k (pairs row)] k)
-        color-key? (fn [key] (string.match key :color$))
-        val->str (fn [key value]
-                   (if 
-                     (= value "") :NULL
-                     (color-key? key) (tonumber value 16)
-                     (= key :location) value
-                     (.. "'" (string.gsub value "'" "''") "'")))]
-    (..
-      "INSERT INTO "
-      tbl
-      "("
-      (table.concat
-        (icollect [_ key (ipairs keys)]
-                  (. mapping key))
-        ",")
-      ") VALUES ("
-       (table.concat
-         (icollect [_ key (ipairs keys)]
-                   (if (. mapping key)
-                     (let [value (. row key)]
-                       (val->str key value))))
-         "," )
-       ")")))
-
-(fn insert-table [db tbl mapping]
-  (let [file-path (.. "gtfs-data/" tbl ".txt")]
-    (print "inserting into " tbl)
-    (each [_ line (csv.parseLine file-path {:headers true})]
-      (let [stmt (create-insert-statement
-                    tbl mapping line)]
-        (match (db:execute stmt)
-        OK nil
-        _ (do
-               (print stmt)
-               (error (.. "error inserting: " (db:errmsg)))))))))
-
-(local mappings 
-  {:stops {:stop_id :id
-          :stop_desc :description
-          :stop_name :name
-          :stop_code :code
-          :platform_code :platform
-          :parent_station :parent
-          :location :location}
-   :routes {:route_id :id
-            :route_short_name :short_name
-            :route_long_name :long_name
-            :route_desc :description
-            :route_type :type
-            :route_color :color
-            :route_text_color :text_color}
-   :trips {:trip_id :id
-           :route_id :route_id
-           :service_id :service_id
-           :headsign :headsign
-           :trip_short_name :short_name}
-   :stop_times {:trip_id :trip_id
-                :stop_sequence :sequence
-                :stop_id :stop_id
-                :departure_time :departure
-                :arrival_time :arrival}
-   :calendar {:service_id :service
-              :start_date :start_date
-              :end_date :end_date
-              :days :days}
-   :calendar_dates {:service_id :service
-                    :date :date
-                    :exception_type :type}})
-
-(fn main []
-  "I don't do much, yet."
-  (with-open [db (sql.connection)]
-             (execute-statement db :create-tables)
-             (db:execute "BEGIN TRANSACTION")
-             (each [k v (pairs mappings)]
-               (insert-table db k v))
-             (db:execute "COMMIT")
-             (db:execute "ANALYZE")))
-
-(main)

src/sqlite.fnl

@@ -1,12 +1,17 @@
 (local sqlite (require :lsqlite3))
+(local {: view} (require :fennel))
 
-(local sql-files [:find-stops])
+(local sql-files [:find-stops :get-departures])
 
-(fn call-statement [{: statement : args} params]
+(fn query [{: statements} name params]
+  (let [{: statement : args} (. statements name)]
     (statement:reset)
     (each [i name (ipairs args)]
-    (statement:bind i (. params name)))
+      (let [name (string.sub name 2)] ; remove parameter prefix
-  (statement:nrows))
+        (if (string.match name :geom$)
+          (statement:bind_blob i (. params name))
+          (statement:bind i (. params name)))))
+    (statement:nrows)))
 
 (fn prepare-sql [db file]
   (let [sql (with-open [f (io.open (.. "sql/" file ".sql"))]
@@ -23,13 +28,13 @@
       (let [args
             (fcollect [n 1 (statement:bind_parameter_count)]
                       (statement:bind_parameter_name n))]
-        (setmetatable 
         {: statement
-           : args}
+         :close (fn [] (statement:finalize))
-          {:__call call-statement
+         : args}))))
-           :close (fn [] (statement:finalize))})))))
+
 
 (fn connection []
+  "get a simple sqlite connection without prepared statements"
   (case (sqlite.open :gtfs.db)
     (nil ?code ?msg) (error 
                        (.. "Failed to open database: "
@@ -40,4 +45,15 @@
          (db:load_extension :mod_spatialite)
          db)))
 
-{: connection}
+(fn client []
+  (let [db (connection)
+        statements {}]
+    (collect [_ file (ipairs sql-files) &into statements]
+             file (prepare-sql db file))
+    {: statements
+     :close (fn []
+              (each [_ s (pairs statements)]
+                (s:close))
+              (db:close))}))
+
+{: connection : query : client}