From 607b9486a81ed6cb65d30227aeecea3412bd1ccd Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 20 Apr 2024 03:18:46 +0200
Subject: restructure: have "tickets" independent of gtfs

this is mostly meant to guard against the gtfs changing under
tracktrain, and not yet complete (e.g. a ticket does not yet save its
expected stops, which it probably should).
---
 lib/Extrapolation.hs | 22 ++++++++++------------
 1 file changed, 10 insertions(+), 12 deletions(-)

(limited to 'lib/Extrapolation.hs')

diff --git a/lib/Extrapolation.hs b/lib/Extrapolation.hs
index 6a2d88a..8edcc25 100644
--- a/lib/Extrapolation.hs
+++ b/lib/Extrapolation.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE MultiWayIf          #-}
 {-# LANGUAGE RecordWildCards     #-}
 
@@ -24,8 +23,8 @@ import           GTFS               (Depth (Deep), GTFS (..), Seconds (..),
                                      Shape (..), Station (stationName),
                                      Stop (..), Time, Trip (..), seconds2Double,
                                      stationGeopos, toSeconds)
-import           Persist            (Running (..), TrainAnchor (..),
-                                     TrainPing (..))
+import           Persist            (Ticket (..), Token (..), Tracker (..),
+                                     TrainAnchor (..), TrainPing (..))
 import           Server.Util        (utcToSeconds)
 
 -- | Determines how to extrapolate delays (and potentially other things) from the real-time
@@ -33,7 +32,7 @@ import           Server.Util        (utcToSeconds)
 -- TODO: maybe split into two classes?
 class Extrapolator a where
   -- | here's a position ping, guess things from that!
-  extrapolateAnchorFromPing :: a -> GTFS -> Running -> TrainPing -> TrainAnchor
+  extrapolateAnchorFromPing :: a -> GTFS -> Ticket -> TrainPing -> TrainAnchor
 
   -- | extrapolate status at some time (i.e. "how much delay does the train have *now*?")
   extrapolateAtSeconds :: a -> NonEmpty TrainAnchor -> Seconds -> Maybe TrainAnchor
@@ -47,7 +46,7 @@ instance Extrapolator LinearExtrapolator where
   extrapolateAtSeconds _ history secondsNow =
     fmap (minimumBy (compare `on` difference))
     $ NE.nonEmpty $ NE.filter (\a -> trainAnchorWhen a < secondsNow) history
-    where difference status = secondsNow - (trainAnchorWhen status)
+    where difference status = secondsNow - trainAnchorWhen status
 
   -- note that this sorts (descending) for time first as a tie-breaker
   -- (in case the train just stands still for a while, take the most recent update)
@@ -55,19 +54,18 @@ instance Extrapolator LinearExtrapolator where
     fmap (minimumBy (compare `on` difference))
     $ NE.nonEmpty $ sortOn (Down . trainAnchorWhen)
     $ NE.filter (\a -> trainAnchorSequence a < positionNow) history
-    where difference status = positionNow - (trainAnchorSequence status)
+    where difference status = positionNow - trainAnchorSequence status
 
-  extrapolateAnchorFromPing _ gtfs@GTFS{..} Running{..} ping@TrainPing{..} = TrainAnchor
+  extrapolateAnchorFromPing _ gtfs@GTFS{..} Ticket{..} ping@TrainPing{..} = TrainAnchor
     { trainAnchorCreated = trainPingTimestamp
-    , trainAnchorTrip = runningTrip
-    , trainAnchorDay = runningDay
-    , trainAnchorWhen = utcToSeconds trainPingTimestamp runningDay
+    , trainAnchorTicket = trainPingTicket
+    , trainAnchorWhen = utcToSeconds trainPingTimestamp ticketDay
     , trainAnchorSequence
     , trainAnchorDelay
     , trainAnchorMsg = Nothing
     }
-    where Just trip = M.lookup runningTrip trips
-          (trainAnchorDelay, trainAnchorSequence) = linearDelay gtfs trip ping runningDay
+    where Just trip = M.lookup ticketTrip trips
+          (trainAnchorDelay, trainAnchorSequence) = linearDelay gtfs trip ping ticketDay
 
 linearDelay :: GTFS -> Trip Deep Deep -> TrainPing -> Day -> (Seconds, Double)
 linearDelay GTFS{..} trip@Trip{..} TrainPing{..} runningDay = (observedDelay, observedSequence)
-- 
cgit v1.2.3