diff options
| author | stuebinm | 2022-06-27 22:30:33 +0200 |
|---|---|---|
| committer | stuebinm | 2022-06-27 22:32:03 +0200 |
| commit | add2aecf6ce4e219f3e4e2b6b731e84e64da51a9 (patch) | |
| tree | e7df89cf4e9e13300210e21955c30db082ab91a0 /lib/Server.hs | |
| parent | 85ced3b1fad9f57a3882178fad380bf87f399e0e (diff) | |
optional date parameter for the timetable endpoint
(mostly to make debugging easier, but also more generially useful i guess)
Diffstat (limited to 'lib/Server.hs')
| -rw-r--r-- | lib/Server.hs | 12 |
1 files changed, 8 insertions, 4 deletions
diff --git a/lib/Server.hs b/lib/Server.hs index 91f1f36..2375d2b 100644 --- a/lib/Server.hs +++ b/lib/Server.hs @@ -12,7 +12,7 @@ module Server (application) where import Conduit (MonadTrans (lift), ResourceT) import Control.Concurrent.STM import Control.Monad (when) -import Control.Monad.Extra (whenM) +import Control.Monad.Extra (whenM, maybeM) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Logger.CallStack (NoLoggingT) import Control.Monad.Reader (forM) @@ -38,6 +38,7 @@ import Data.UUID (UUID) import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID import Data.Vector (Vector) +import qualified Data.Vector as V import Database.Persist import Database.Persist.Postgresql import GHC.Generics (Generic) @@ -76,10 +77,13 @@ server :: GTFS -> Pool SqlBackend -> Server CompleteAPI server gtfs@GTFS{..} dbpool = handleDebugAPI :<|> handleStations :<|> handleTimetable :<|> handleTrip :<|> handleRegister :<|> handleTripPing :<|> handleDebugState where handleStations = pure stations - handleTimetable station = do + handleTimetable station maybeDay = do -- TODO: resolve "overlay" trips (perhaps just additional CalendarDates?) - today <- liftIO getCurrentTime <&> utctDay - pure $ tripsOnDay gtfs today + day <- liftIO $ maybeM (getCurrentTime <&> utctDay) pure (pure maybeDay) + pure + -- don't send stations ending at this station + . M.filter ((==) station . stationId . stopStation . V.last . tripStops) + $ tripsOnDay gtfs day handleTrip trip = case M.lookup trip trips of Just res -> pure res Nothing -> throwError err404 |