diff options
Diffstat (limited to 'lib/Server/Util.hs')
| -rw-r--r-- | lib/Server/Util.hs | 30 |
1 files changed, 23 insertions, 7 deletions
diff --git a/lib/Server/Util.hs b/lib/Server/Util.hs index 5bfba52..4410711 100644 --- a/lib/Server/Util.hs +++ b/lib/Server/Util.hs @@ -1,14 +1,19 @@ {-# LANGUAGE FlexibleContexts #-} -- | mostly the monad the service runs in -module Server.Util (Service, ServiceM, runService, sendErrorMsg) where +module Server.Util (Service, ServiceM, runService, sendErrorMsg, secondsNow, utcToSeconds) where -import Control.Monad.Logger (LoggingT, runStderrLoggingT) -import qualified Data.Aeson as A -import Data.ByteString (ByteString) -import Data.Text (Text) -import Servant (Handler, ServerError, ServerT, err404, - errBody, errHeaders, throwError) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Logger (LoggingT, runStderrLoggingT) +import qualified Data.Aeson as A +import Data.ByteString (ByteString) +import Data.Text (Text) +import Data.Time (Day, UTCTime (..), diffUTCTime, + getCurrentTime, + nominalDiffTimeToSeconds) +import GTFS (Seconds (..)) +import Servant (Handler, ServerError, ServerT, err404, + errBody, errHeaders, throwError) type ServiceM = LoggingT Handler type Service api = ServerT api ServiceM @@ -19,3 +24,14 @@ runService = runStderrLoggingT sendErrorMsg :: Text -> ServiceM a sendErrorMsg msg = throwError err404 { errBody = A.encode $ A.object ["error" A..= (404 :: Int), "msg" A..= msg] } + +secondsNow :: MonadIO m => Day -> m Seconds +secondsNow runningDay = do + now <- liftIO getCurrentTime + pure $ utcToSeconds now runningDay + +-- | convert utc time to seconds on a day, with wrap-around +-- for trains that cross midnight. +utcToSeconds :: UTCTime -> Day -> Seconds +utcToSeconds time day = + Seconds $ round $ nominalDiffTimeToSeconds $ diffUTCTime time (UTCTime day 0) |