aboutsummaryrefslogtreecommitdiff
path: root/lib/Persist.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Persist.hs')
-rw-r--r--lib/Persist.hs48
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