diff options
| author | stuebinm | 2024-05-01 03:07:06 +0200 |
|---|---|---|
| committer | stuebinm | 2024-05-02 00:18:16 +0200 |
| commit | 80984549172d7de83564757de80996487ca2fb15 (patch) | |
| tree | 1e4bfe43fa9fc96fa5642fe34f502005775f257f /lib/Extrapolation.hs | |
| parent | b26a3d617e90c9693a4ee8b7cc8bbba506cd4746 (diff) | |
restructure: get the tracker to work again
This should hopefully be the final (major) part of the restructuring: a
tracker no longer has to know which trip it is on (and indeed it has no
idea for now), instead the server keeps state about which trips are
currently running and will insert incoming pings in a hopefully
reasonable manner, based on their geoposition & time.
There's lots of associated TODO items here (especially there should be
manual overrides for all this logic in the web ui), but that's work for
a future me.
(incidentally, this also adds support for sending all log messages out
via ntfy-sh)
Diffstat (limited to 'lib/Extrapolation.hs')
| -rw-r--r-- | lib/Extrapolation.hs | 9 |
1 files changed, 5 insertions, 4 deletions
diff --git a/lib/Extrapolation.hs b/lib/Extrapolation.hs index 01e5f6f..389d047 100644 --- a/lib/Extrapolation.hs +++ b/lib/Extrapolation.hs @@ -27,8 +27,8 @@ import GTFS (Seconds (..), import Persist (Geopos (..), ShapePoint (shapePointGeopos), Station (..), Stop (..), - Ticket (..), Token (..), - Tracker (..), + Ticket (..), TicketId, + Token (..), Tracker (..), TrainAnchor (..), TrainPing (..)) import Server.Util (utcToSeconds) @@ -40,6 +40,7 @@ class Extrapolator strategy where -- | here's a position ping, guess things from that! extrapolateAnchorFromPing :: strategy + -> TicketId -> Ticket -> V.Vector (Stop, Station, TimeZoneSeries) -> V.Vector ShapePoint @@ -68,9 +69,9 @@ instance Extrapolator LinearExtrapolator where $ NE.filter (\a -> trainAnchorSequence a < positionNow) history where difference status = positionNow - trainAnchorSequence status - extrapolateAnchorFromPing _ Ticket{..} stops shape ping@TrainPing{..} = TrainAnchor + extrapolateAnchorFromPing _ ticketId Ticket{..} stops shape ping@TrainPing{..} = TrainAnchor { trainAnchorCreated = trainPingTimestamp - , trainAnchorTicket = trainPingTicket + , trainAnchorTicket = ticketId , trainAnchorWhen = utcToSeconds trainPingTimestamp ticketDay , trainAnchorSequence , trainAnchorDelay |