aboutsummaryrefslogtreecommitdiff
path: root/lib/GTFS.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/GTFS.hs')
-rw-r--r--lib/GTFS.hs32
1 files changed, 16 insertions, 16 deletions
diff --git a/lib/GTFS.hs b/lib/GTFS.hs
index 6d8bcc5..c4652e8 100644
--- a/lib/GTFS.hs
+++ b/lib/GTFS.hs
@@ -193,7 +193,7 @@ type family Optional c a where
Optional Shallow _ = ()
type StationID = Text
-type TripID = Text
+type TripId = Text
type ServiceID = Text
@@ -218,7 +218,7 @@ stationGeopos Station{..} = (stationLat, stationLon)
-- | This is what's called a stop time in GTFS
data Stop (deep :: Depth) = Stop
- { stopTrip :: TripID
+ { stopTrip :: TripId
, stopArrival :: Switch deep Time RawTime
, stopDeparture :: Switch deep Time RawTime
, stopStation :: Switch deep Station StationID
@@ -274,7 +274,7 @@ instance FromForm CalendarDate
data Trip (deep :: Depth) (shape :: Depth)= Trip
{ tripRoute :: Switch deep (Route Deep) Text
- , tripTripID :: TripID
+ , tripTripId :: TripId
, tripHeadsign :: Maybe Text
, tripShortName :: Maybe Text
, tripDirection :: Maybe Bool
@@ -487,7 +487,7 @@ data RawGTFS = RawGTFS
data GTFS = GTFS
{ stations :: Map StationID Station
- , trips :: Map TripID (Trip Deep Deep)
+ , trips :: Map TripId (Trip Deep Deep)
, calendar :: Map DayOfWeek (Vector Calendar)
, calendarDates :: Map Day (Vector CalendarDate)
, shapes :: Map Text Shape
@@ -549,7 +549,7 @@ loadGtfs path zoneinforoot = do
trips' <- V.mapM (pushTrip routes' stops' shapes) rawTrips
pure $ GTFS
{ stations = mapFromVector stationId rawStations
- , trips = mapFromVector tripTripID trips'
+ , trips = mapFromVector tripTripId trips'
, calendar =
fmap V.fromList
$ M.fromListWith (<>)
@@ -591,18 +591,18 @@ loadGtfs path zoneinforoot = do
, stopArrival = unRawTime (stopArrival stop) tzseries tzname }
pushTrip :: Map Text (Route Deep) -> Vector (Stop Deep) -> Map Text Shape -> Trip Shallow Shallow -> IO (Trip Deep Deep)
pushTrip routes stops shapes trip = if V.length alongRoute < 2
- then fail $ "trip with id "+|tripTripID trip|+" has no stops"
+ then fail $ "trip with id "+|tripTripId trip|+" has no stops"
else do
shape <- case M.lookup (tripShape trip) shapes of
- Nothing -> fail $ "trip with id "+|tripTripID trip|+" mentions a shape that does not exist."
+ Nothing -> fail $ "trip with id "+|tripTripId trip|+" mentions a shape that does not exist."
Just shape -> pure shape
route <- case M.lookup (tripRoute trip) routes of
- Nothing -> fail $ "trip with id "+|tripTripID trip|+" specifies a route_id which does not exist."
+ Nothing -> fail $ "trip with id "+|tripTripId trip|+" specifies a route_id which does not exist."
Just route -> pure route
pure $ trip { tripStops = alongRoute, tripShape = shape, tripRoute = route}
where alongRoute =
V.modify (V.sortBy (compare `on` stopSequence))
- $ V.filter (\s -> stopTrip s == tripTripID trip) stops
+ $ V.filter (\s -> stopTrip s == tripTripId trip) stops
pushRoute :: Vector (Agency Deep) -> Route Shallow -> IO (Route Deep)
pushRoute agencies route = case routeAgency route of
Nothing -> do
@@ -636,27 +636,27 @@ servicesOnDay GTFS{..} day =
notCancelled serviceID =
null (tableLookup caldateServiceId serviceID removed)
-tripsOfService :: GTFS -> ServiceID -> Map TripID (Trip Deep Deep)
+tripsOfService :: GTFS -> ServiceID -> Map TripId (Trip Deep Deep)
tripsOfService GTFS{..} serviceId =
M.filter (\trip -> tripServiceId trip == serviceId ) trips
-- TODO: this should filter out trips ending there
-tripsAtStation :: GTFS -> StationID -> Vector TripID
+tripsAtStation :: GTFS -> StationID -> Vector TripId
tripsAtStation GTFS{..} at = fmap stopTrip stops
where
stops = V.filter (\(stop :: Stop Deep) -> stationId (stopStation stop) == at) stops
-tripsOnDay :: GTFS -> Day -> Map TripID (Trip Deep Deep)
+tripsOnDay :: GTFS -> Day -> Map TripId (Trip Deep Deep)
tripsOnDay gtfs today = foldMap (tripsOfService gtfs) (servicesOnDay gtfs today)
-runsOnDay :: GTFS -> TripID -> Day -> Bool
+runsOnDay :: GTFS -> TripId -> Day -> Bool
runsOnDay gtfs trip day = not . null . M.filter same $ tripsOnDay gtfs day
- where same Trip{..} = tripTripID == trip
+ where same Trip{..} = tripTripId == trip
-runsToday :: MonadIO m => GTFS -> TripID -> m Bool
+runsToday :: MonadIO m => GTFS -> TripId -> m Bool
runsToday gtfs trip = do
today <- liftIO getCurrentTime <&> utctDay
pure (runsOnDay gtfs trip today)
tripName :: Trip a b -> Text
-tripName Trip{..} = fromMaybe tripTripID tripShortName
+tripName Trip{..} = fromMaybe tripTripId tripShortName