fey.naomi/bus.fey.ink
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: initial departure search support

Browse Source
This commit is contained in:
Fey Naomi Schrewe 2026-01-13 17:35:33 +01:00
parent 4097972f84
commit c52ddc2e09
9 changed files with 278 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
deps.fnl
View File

@ -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"]

6
sql/create-tables.sql
View File

@ -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);

8
sql/find-stops.sql
View File

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

42
sql/get-departures.sql Normal file
View File

@ -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;

39
src/departures.fnl Normal file
View File

@ -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)})))

20
src/html.fnl
View File

@ -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}

148
src/import.fnl Normal file
View File

@ -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}

130
src/main.fnl
View File

@ -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))

40
src/sqlite.fnl
View File

@ -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}