From a4045a5b0a898042cd78eba9b22550c965a1bbd9 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 27 Aug 2022 01:45:12 +0200
Subject: controlroom: lots of pretty little knobs

(also some database schema changes, for good measure)
---
 lib/Persist.hs | 48 ++++++++++++++++++++++++++++++------------------
 1 file changed, 30 insertions(+), 18 deletions(-)

(limited to 'lib/Persist.hs')

diff --git a/lib/Persist.hs b/lib/Persist.hs
index 611da9e..39cdca1 100644
--- a/lib/Persist.hs
+++ b/lib/Persist.hs
@@ -58,32 +58,51 @@ instance ToSchema Token where
 instance ToParamSchema Token where
   toParamSchema _ = toParamSchema (Proxy @String)
 
-data AmendmentStatus = Cancelled | Added
+data AmendmentStatus = Cancelled | Added | PartiallyCancelled Int Int
   deriving (ToJSON, FromJSON, Generic, Show, Read, Eq)
 derivePersistField "AmendmentStatus"
-instance FromHttpApiData AmendmentStatus where
-  parseUrlPiece "Cancelled" = Right Cancelled
-  parseUrlPiece "Added"     = Right Added
-  parseUrlPiece other       = Left ("unknown AmendmentStatus: "<>other)
+-- instance FromHttpApiData AmendmentStatus where
+--   parseUrlPiece "Cancelled" = Right Cancelled
+--   parseUrlPiece "Added"     = Right Added
+--   parseUrlPiece other       = Left ("unknown AmendmentStatus: "<>other)
 
 share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
 -- | tokens which have been issued
-RunningTrip sql=tt_tracker_token
+Running sql=tt_tracker_token
   Id Token default=uuid_generate_v4()
   expires UTCTime
   blocked Bool
-  tripNumber Text
+  trip Text
+  day Day
   vehicle Text Maybe
+  agent Text
   deriving Eq Show Generic
 
-TripPing json sql=tt_trip_ping
-  token RunningTripId
+-- raw frames as received from OBUs
+TrainPing json sql=tt_trip_ping
+  token RunningId
   lat Double
   long Double
-  delay Double
   timestamp UTCTime
   deriving Show Generic Eq ToSchema
 
+-- status of a train somewhen in time (may be in the future),
+-- inferred from trainpings / entered via controlRoom
+TrainStatus sql=tt_train_status
+  timestamp UTCTime
+  trip TripID
+  day Day
+  when UTCTime
+  deriving Show Generic Eq ToSchema
+
+TripAnchor json sql=tt_trip_anchor
+  trip TripID
+  day Day
+  timestamp UTCTime
+  delay Int Maybe
+  msg Text Maybe
+  deriving Show Generic Eq ToSchema
+
 -- TODO: multi-language support?
 Announcement json sql=tt_announcements
   Id UUID default=uuid_generate_v4()
@@ -102,16 +121,9 @@ ScheduleAmendment json sql=tt_schedule_amendement
   status AmendmentStatus
   -- only one special rule per TripID and Day (else incoherent)
   TripAndDay trip day
-
--- TODO: possible to have regular trips moved in time without changing TripID?
-ExtraordinaryTrip sql=tt_extra_trip
-  trip TripID
-  day Text
-  stops (Vector Text)
-  stopTimes (Vector TimeOfDay)
 |]
 
-instance ToSchema RunningTripId where
+instance ToSchema RunningId where
   declareNamedSchema _ = declareNamedSchema (Proxy @UUID)
 
 runSql :: MonadIO m => Pool SqlBackend -> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) a -> m a
-- 
cgit v1.2.3