aboutsummaryrefslogtreecommitdiff
path: root/lib/Server
diff options
context:
space:
mode:
authorstuebinm2022-06-27 22:30:33 +0200
committerstuebinm2022-06-27 22:32:03 +0200
commitadd2aecf6ce4e219f3e4e2b6b731e84e64da51a9 (patch)
treee7df89cf4e9e13300210e21955c30db082ab91a0 /lib/Server
parent85ced3b1fad9f57a3882178fad380bf87f399e0e (diff)
optional date parameter for the timetable endpoint
(mostly to make debugging easier, but also more generially useful i guess)
Diffstat (limited to '')
-rw-r--r--lib/Server.hs12
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