From c52ddc2e09c9f380c70695df3979d43b458b2a9e Mon Sep 17 00:00:00 2001 From: Fey Naomi Schrewe Date: Tue, 13 Jan 2026 17:35:33 +0100 Subject: [PATCH] feat: initial departure search support --- deps.fnl | 6 +- sql/create-tables.sql | 6 ++ sql/find-stops.sql | 8 ++- sql/get-departures.sql | 42 ++++++++++++ src/departures.fnl | 39 +++++++++++ src/html.fnl | 20 ------ src/import.fnl | 148 +++++++++++++++++++++++++++++++++++++++++ src/main.fnl | 130 +----------------------------------- src/sqlite.fnl | 40 +++++++---- 9 files changed, 278 insertions(+), 161 deletions(-) create mode 100644 sql/get-departures.sql create mode 100644 src/departures.fnl delete mode 100644 src/html.fnl create mode 100644 src/import.fnl diff --git a/deps.fnl b/deps.fnl index f3eddec..06f1c51 100644 --- a/deps.fnl +++ b/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"] diff --git a/sql/create-tables.sql b/sql/create-tables.sql index 4565c94..14bd0ba 100644 --- a/sql/create-tables.sql +++ b/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); diff --git a/sql/find-stops.sql b/sql/find-stops.sql index 8666398..1801d47 100644 --- a/sql/find-stops.sql +++ b/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; diff --git a/sql/get-departures.sql b/sql/get-departures.sql new file mode 100644 index 0000000..d55120d --- /dev/null +++ b/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; diff --git a/src/departures.fnl b/src/departures.fnl new file mode 100644 index 0000000..bf991b8 --- /dev/null +++ b/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)}))) diff --git a/src/html.fnl b/src/html.fnl deleted file mode 100644 index dd4a820..0000000 --- a/src/html.fnl +++ /dev/null @@ -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} diff --git a/src/import.fnl b/src/import.fnl new file mode 100644 index 0000000..b6cc14c --- /dev/null +++ b/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} diff --git a/src/main.fnl b/src/main.fnl index ef8ff31..f984f3a 100644 --- a/src/main.fnl +++ b/src/main.fnl @@ -1,128 +1,4 @@ -(local {: view} (require :fennel)) -(local csv (require :ftcsv)) -(local sql (require :sqlite)) -(local {: OK} (require :lsqlite3)) -(local {: encode-wkb} (require :wkb)) +(local {: import} (require :import)) -(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 (= (. 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) +(case arg + [:import & rest] (import rest)) diff --git a/src/sqlite.fnl b/src/sqlite.fnl index b7c6b43..241c61a 100644 --- a/src/sqlite.fnl +++ b/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] - (statement:reset) - (each [i name (ipairs args)] - (statement:bind i (. params name))) - (statement:nrows)) +(fn query [{: statements} name params] + (let [{: statement : args} (. statements name)] + (statement:reset) + (each [i name (ipairs args)] + (let [name (string.sub name 2)] ; remove parameter prefix + (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} - {:__call call-statement - :close (fn [] (statement:finalize))}))))) + {: statement + :close (fn [] (statement:finalize)) + : args})))) + (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}