diff options
Diffstat (limited to 'lib/GTFS.hs')
| -rw-r--r-- | lib/GTFS.hs | 31 |
1 files changed, 17 insertions, 14 deletions
diff --git a/lib/GTFS.hs b/lib/GTFS.hs index bd29b6d..68d92dc 100644 --- a/lib/GTFS.hs +++ b/lib/GTFS.hs @@ -189,7 +189,7 @@ instance FromJSON CalendarDate where instance ToJSON CalendarDate where toJSON = genericToJSON (aesonOptions "caldate") -data Trip (deep :: Depth) = Trip +data Trip (deep :: Depth) (shape :: Depth)= Trip { tripRoute :: Text , tripTripID :: TripID , tripHeadsign :: Maybe Text @@ -199,18 +199,21 @@ data Trip (deep :: Depth) = Trip , tripServiceId :: Text -- , tripWheelchairAccessible :: Bool -- , tripBikesAllowed :: Bool - , tripShape :: Switch deep Shape Text + , tripShape :: Switch shape Shape Text , tripStops :: Optional deep (Vector (Stop deep)) } deriving Generic -deriving instance Show (Trip Shallow) -deriving instance Show (Trip Deep) -instance (FromJSON (Switch d Shape Text), FromJSON (Optional d (Vector (Stop d)))) => FromJSON (Trip d) where +deriving instance Show (Trip Shallow Shallow) +deriving instance Show (Trip Deep Deep) +deriving instance Show (Trip Deep Shallow) +instance (FromJSON (Switch d Shape Text), FromJSON (Optional d (Vector (Stop d))), FromJSON (Switch s Shape Text)) => FromJSON (Trip d s) where parseJSON = genericParseJSON (aesonOptions "trip") -instance (ToJSON (Switch d Shape Text), ToJSON (Optional d (Vector (Stop d)))) => ToJSON (Trip d) where +instance (ToJSON (Switch d Shape Text), ToJSON (Optional d (Vector (Stop d))), ToJSON (Switch s Shape Text)) => ToJSON (Trip d s) where toJSON = genericToJSON (aesonOptions "trip") -instance ToSchema (Trip Deep) where +instance ToSchema (Trip Deep Deep) where + declareNamedSchema = genericDeclareNamedSchema (swaggerOptions "trip") +instance ToSchema (Trip Deep Shallow) where declareNamedSchema = genericDeclareNamedSchema (swaggerOptions "trip") -- | helper function to find things in Vectors of things @@ -297,7 +300,7 @@ instance CSV.FromNamedRecord CalendarDate where _ -> fail $ "unexpected value in exception_type: "+|int|+"." -instance CSV.FromNamedRecord (Trip Shallow) where +instance CSV.FromNamedRecord (Trip Shallow Shallow) where parseNamedRecord r = Trip <$> r .: "route_id" <*> r .: "trip_id" @@ -314,7 +317,7 @@ instance CSV.FromNamedRecord (Trip Shallow) where data RawGTFS = RawGTFS { rawStations :: Vector Station , rawStops :: Vector (Stop Shallow) - , rawTrips :: Vector (Trip Shallow) + , rawTrips :: Vector (Trip Shallow Shallow) , rawCalendar :: Maybe (Vector Calendar) , rawCalendarDates :: Maybe (Vector CalendarDate) , rawShapePoints :: Maybe (Vector ShapePoint) @@ -323,12 +326,12 @@ data RawGTFS = RawGTFS data GTFS = GTFS { stations :: Map StationID Station - , trips :: Map TripID (Trip Deep) + , trips :: Map TripID (Trip Deep Deep) , calendar :: Map DayOfWeek (Vector Calendar) , calendarDates :: Map Day (Vector CalendarDate) , shapes :: Map Text Shape - , fancyCalendar :: Day -> (Vector ServiceID, Vector (Trip Deep)) + , fancyCalendar :: Day -> (Vector ServiceID, Vector (Trip Deep Deep)) -- ^ a more "fancy" encoding of the calendar? } -- deriving Show @@ -400,7 +403,7 @@ loadGtfs path = do Just a -> pure a Nothing -> fail $ "station with id "+|stopStation stop|+"is mentioned but not defined." pure $ stop { stopStation = station } - pushTrip :: Vector (Stop Deep) -> Map Text Shape -> Trip Shallow -> IO (Trip Deep) + pushTrip :: Vector (Stop Deep) -> Map Text Shape -> Trip Shallow Shallow -> IO (Trip Deep Deep) pushTrip stops shapes trip = if V.length alongRoute < 2 then fail $ "trip with id "+|tripTripID trip|+" has no stops" else do @@ -430,7 +433,7 @@ servicesOnDay GTFS{..} day = notCancelled serviceID = null (tableLookup caldateServiceId serviceID removed) -tripsOfService :: GTFS -> ServiceID -> Map TripID (Trip Deep) +tripsOfService :: GTFS -> ServiceID -> Map TripID (Trip Deep Deep) tripsOfService GTFS{..} serviceId = M.filter (\trip -> tripServiceId trip == serviceId ) trips @@ -440,5 +443,5 @@ 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) +tripsOnDay :: GTFS -> Day -> Map TripID (Trip Deep Deep) tripsOnDay gtfs today = foldMap (tripsOfService gtfs) (servicesOnDay gtfs today) |