1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
-- | 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 Prometheus (MonadMonitor (doIO))
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
instance MonadMonitor ServiceM where
doIO = liftIO
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)
|
