diff options
author | stuebinm | 2022-08-28 21:33:33 +0200 |
---|---|---|
committer | stuebinm | 2022-08-28 21:34:54 +0200 |
commit | f7066888652ed3326017adf2eb6786a21043ebf5 (patch) | |
tree | 82b14b74bd352b553eb4036f48b15d3a2c4cae37 /lib/GTFS.hs | |
parent | 1b2e30c134c996e82c282b21099f21501dd966ac (diff) |
some config thingyesod
works kinda well, but doesn't complain about unknown config values in
json, which is kinda hmpf tbh
Diffstat (limited to '')
-rw-r--r-- | lib/GTFS.hs | 48 |
1 files changed, 26 insertions, 22 deletions
diff --git a/lib/GTFS.hs b/lib/GTFS.hs index 2047d56..9eed8b5 100644 --- a/lib/GTFS.hs +++ b/lib/GTFS.hs @@ -1,19 +1,18 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -- | All kinds of stuff that has to deal with GTFS directly -- (i.e. parsing, querying, Aeson instances, etc.) @@ -467,7 +466,7 @@ data GTFS = GTFS loadRawGtfs :: FilePath -> IO RawGTFS loadRawGtfs path = do - zip <- Zip.toArchive <$> LB.readFile "./gtfs.zip" + zip <- Zip.toArchive <$> LB.readFile path RawGTFS <$> decodeTable' "stops.txt" zip <*> decodeTable' "stop_times.txt" zip @@ -490,8 +489,13 @@ loadRawGtfs path = do Nothing -> fail $ "required file "+|path|+" not found in gtfs.zip" Just a -> pure a -loadGtfs :: FilePath -> IO GTFS -loadGtfs path = do +-- | load a gtfs file "the complicated way", creating data structures much nicer +-- to work with than the raw representation of GTFS. +-- +-- Note that this additionally needs a path to the machine's timezone info +-- (usually /etc/zoneinfo or /usr/shared/zoneinfo) +loadGtfs :: FilePath -> FilePath -> IO GTFS +loadGtfs path zoneinforoot = do shallow@RawGTFS{..} <- loadRawGtfs path -- TODO: sort these according to sequence numbers let shapes = @@ -500,9 +504,9 @@ loadGtfs path = do (fromMaybe mempty rawShapePoints) -- all agencies must have the same timezone, so just take the first's let tzname = agencyTimezone $ V.head rawAgencies - tzseries <- getTimeZoneSeriesFromOlsonFile (T.unpack $ "/etc/zoneinfo/"<>tzname) + tzseries <- getTimeZoneSeriesFromOlsonFile (zoneinforoot<>T.unpack tzname) let agencies' = fmap (\a -> a { agencyTimezone = tzseries }) rawAgencies - routes' <- V.mapM (\raw -> pushRoute agencies' raw) rawRoutes + routes' <- V.mapM (pushRoute agencies') rawRoutes <&> mapFromVector routeId stops' <- V.mapM (pushStop tzseries tzname rawStations) rawStops trips' <- V.mapM (pushTrip routes' stops' shapes) rawTrips @@ -573,7 +577,7 @@ loadGtfs path = do sortShapePoint :: ShapePoint -> Map Text Shape -> Map Text Shape - sortShapePoint ShapePoint{..} shapes = M.alter appendPoint shapePtId shapes + sortShapePoint ShapePoint{..} = M.alter appendPoint shapePtId where point = (shapePtLat, shapePtLong) appendPoint = \case |