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/Persist.hs | 55 ++++++++++++++++++++++++++++++-------------------------
 1 file changed, 30 insertions(+), 25 deletions(-)

(limited to 'lib/Persist.hs')

diff --git a/lib/Persist.hs b/lib/Persist.hs
index cd77b7a..b52d7c6 100644
--- a/lib/Persist.hs
+++ b/lib/Persist.hs
@@ -29,6 +29,7 @@ import           Control.Monad.IO.Class      (MonadIO (liftIO))
 import           Control.Monad.Logger        (NoLoggingT)
 import           Control.Monad.Reader        (ReaderT)
 import           Data.Data                   (Proxy (..))
+import           Data.Map                    (Map)
 import           Data.Pool                   (Pool)
 import           Data.Time                   (NominalDiffTime, TimeOfDay,
                                               UTCTime (utctDay), addUTCTime,
@@ -39,7 +40,9 @@ import           Data.Vector                 (Vector)
 import           Database.Persist.Postgresql (SqlBackend)
 import           Fmt
 import           GHC.Generics                (Generic)
+import           MultiLangText               (MultiLangText)
 import           Web.PathPieces              (PathPiece)
+import           Yesod                       (Lang)
 
 
 newtype Token = Token UUID
@@ -54,28 +57,38 @@ instance ToParamSchema Token where
 
 deriving newtype instance PersistField Seconds
 deriving newtype instance PersistFieldSql Seconds
--- deriving newtype instance PathPiece Seconds
--- deriving newtype instance ToParamSchema Seconds
-
-data AmendmentStatus = Cancelled | Added | PartiallyCancelled Int Int
-  deriving (ToJSON, FromJSON, Generic, Show, Read, Eq)
-derivePersistField "AmendmentStatus"
 
 share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
+Ticket sql=tt_ticket
+  Id UUID default=uuid_generate_v4()
+  trip TripId
+  day Day
+  imported UTCTime
+  schedule_version ImportId Maybe
+  vehicle Text Maybe
+
+Import sql=tt_imports
+  url Text
+  date UTCTime
+
 -- | tokens which have been issued
-Running sql=tt_tracker_token
+Tracker sql=tt_tracker_token
   Id Token default=uuid_generate_v4()
   expires UTCTime
   blocked Bool
-  trip Text
-  day Day
-  vehicle Text Maybe
   agent Text
   deriving Eq Show Generic
 
+TrackerTicket
+  ticket TicketId
+  tracker TrackerId
+  UniqueTrackerTicket ticket tracker
+
+
 -- raw frames as received from OBUs
 TrainPing json sql=tt_trip_ping
-  token RunningId
+  ticket TicketId
+  token TrackerId
   lat Double
   long Double
   timestamp UTCTime
@@ -84,36 +97,28 @@ TrainPing json sql=tt_trip_ping
 -- status of a train somewhen in time (may be in the future),
 -- inferred from trainpings / entered via controlRoom
 TrainAnchor json sql=tt_trip_anchor
-  trip TripID
-  day Day
+  ticket TicketId
   created UTCTime
   when Seconds
   sequence Double
   delay Seconds
-  msg Text Maybe
+  msg MultiLangText Maybe
   deriving Show Generic Eq
 
 -- TODO: multi-language support?
 Announcement json sql=tt_announcements
   Id UUID default=uuid_generate_v4()
-  trip TripID
+  ticket TicketId
   header Text
   message Text
-  day Day
   url Text Maybe
   announcedAt UTCTime Maybe
   deriving Generic Show
-
--- | this table works as calendar_dates.txt in GTFS
-ScheduleAmendment json sql=tt_schedule_amendement
-  trip TripID
-  day Day
-  status AmendmentStatus
-  -- only one special rule per TripID and Day (else incoherent)
-  TripAndDay trip day
 |]
 
-instance ToSchema RunningId where
+instance ToSchema TicketId where
+  declareNamedSchema _ = declareNamedSchema (Proxy @UUID)
+instance ToSchema TrackerId where
   declareNamedSchema _ = declareNamedSchema (Proxy @UUID)
 instance ToSchema TrainPing where
   declareNamedSchema = genericDeclareNamedSchema (swaggerOptions "trainPing")
-- 
cgit v1.2.3