diff options
Diffstat (limited to 'lib/GTFS.hs')
-rw-r--r-- | lib/GTFS.hs | 20 |
1 files changed, 14 insertions, 6 deletions
diff --git a/lib/GTFS.hs b/lib/GTFS.hs index 2bcfdd5..a2718b1 100644 --- a/lib/GTFS.hs +++ b/lib/GTFS.hs @@ -35,6 +35,7 @@ import Data.Function (on) import Data.Functor ((<&>)) import Data.Kind (Type) import Data.Maybe (fromJust, fromMaybe) +import qualified Data.Swagger as Swagger import Data.Text (Text) import Data.Time (TimeZone (timeZoneMinutes), UTCTime (..), dayOfWeek, @@ -474,6 +475,10 @@ instance CSV.FromNamedRecord (Route Shallow) where <*> r .:? "network_id" +newtype GTFSFile = GTFSFile ByteString +instance ToSchema GTFSFile where + declareNamedSchema _ = pure $ Swagger.NamedSchema (Just "gtfs.zip") $ mempty + & Swagger.type_ ?~ Swagger.SwaggerArray data RawGTFS = RawGTFS { rawStations :: Vector Station @@ -484,6 +489,7 @@ data RawGTFS = RawGTFS , rawShapePoints :: Maybe (Vector ShapePoint) , rawAgencies :: Vector (Agency Shallow) , rawRoutes :: Vector (Route Shallow) + , rawGtfsFile :: GTFSFile } @@ -497,12 +503,14 @@ data GTFS = GTFS -- ^ not a Map AgencyID Agency since if there's only one agency, it may lack an ID , routes :: Map Text (Route Deep) , tzseries :: TimeZoneSeries + , gtfsFile :: GTFSFile } loadRawGtfs :: FilePath -> IO RawGTFS loadRawGtfs path = do - zip <- Zip.toArchive <$> LB.readFile path + bytes <- LB.readFile path + let zip = Zip.toArchive bytes RawGTFS <$> decodeTable' "stops.txt" zip <*> decodeTable' "stop_times.txt" zip @@ -512,6 +520,7 @@ loadRawGtfs path = do <*> decodeTable "shapes.txt" zip <*> decodeTable' "agency.txt" zip <*> decodeTable' "routes.txt" zip + <*> pure (GTFSFile $ LB.toStrict bytes) where decodeTable :: CSV.FromNamedRecord a => FilePath -> Zip.Archive -> IO (Maybe (Vector a)) decodeTable path zip = @@ -562,10 +571,11 @@ loadGtfs path zoneinforoot = do , agencies = agencies' , routes = routes' , tzseries + , gtfsFile = rawGtfsFile } where mapFromVector :: Ord k => (a -> k) -> Vector a -> Map k a - mapFromVector by v = M.fromList $ fmap (\a -> (by a,a)) $ V.toList v + mapFromVector by v = M.fromList $ (\a -> (by a,a)) <$> V.toList v weekdays Calendar{..} = [Monday | calMonday] <> [Tuesday | calTuesday] @@ -629,7 +639,7 @@ servicesOnDay GTFS{..} day = . fromMaybe mempty $ M.lookup day calendarDates regular = fmap calServiceId $ V.filter (\Calendar{..} -> day >= calStartDate && day <= calEndDate) - $ maybe mempty id + $ fromMaybe mempty $ M.lookup (dayOfWeek day) calendar notCancelled serviceID = null (tableLookup caldateServiceId serviceID removed) @@ -657,6 +667,4 @@ runsToday gtfs trip = do pure (runsOnDay gtfs trip today) tripName :: Trip a b -> Text -tripName Trip{..} = case tripShortName of - Just name -> name - Nothing -> tripTripID +tripName Trip{..} = fromMaybe tripTripID tripShortName |