{-# LANGUAGE FlexibleContexts #-} -- | mostly the monad the service runs in module Server.Util (Service, ServiceM, runService, sendErrorMsg, secondsNow, utcToSeconds) where 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 runService :: ServiceM a -> Handler a 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)