diff options
Diffstat (limited to 'lib/Persist.hs')
-rw-r--r-- | lib/Persist.hs | 48 |
1 files changed, 30 insertions, 18 deletions
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 |