module Data.RTCM3.Replay
( replayer
) where
import BasicPrelude
import Control.Concurrent hiding (yield)
import Control.Lens
import Data.Conduit
import Data.RTCM3
import Data.Time
import Data.Time.Calendar.WeekDate
toTow :: UTCTime -> Word32
toTow t = floor since
where
(y, w, _d) = toWeekDate (utctDay t)
begin = addDays (1) $ fromWeekDate y w 1
since = 1000 * diffUTCTime t (UTCTime begin 0)
currentTow :: MonadIO m => m Word32
currentTow =
liftIO $ toTow . addUTCTime (fromIntegral gpsLeapSeconds) <$> getCurrentTime
where
gpsLeapSeconds = 18 :: Int
delayTow :: MonadIO m => Word32 -> Word32 -> m ()
delayTow tow tow' =
when (tow' > tow) $ do
let diff = tow' tow
unless (diff > diffMilliseconds) $
liftIO $ threadDelay $ fromIntegral $ diff * 1000
where
diffMilliseconds = 15 * 1000
replay :: MonadIO m => Word32 -> RTCM3Msg -> ConduitM i RTCM3Msg m Word32
replay tow = \case
(RTCM3Msg1002 m _rtcm3) -> do
let tow' = m ^. msg1002_header ^. gpsObservationHeader_tow
delayTow tow tow'
tow'' <- currentTow
let n = set (msg1002_header . gpsObservationHeader_tow) tow'' m
yield (RTCM3Msg1002 n (toRTCM3 n))
pure tow'
(RTCM3Msg1004 m _rtcm3) -> do
let tow' = m ^. msg1004_header ^. gpsObservationHeader_tow
delayTow tow tow'
tow'' <- currentTow
let n = set (msg1004_header . gpsObservationHeader_tow) tow'' m
yield (RTCM3Msg1004 n (toRTCM3 n))
pure tow'
rtcm3Msg -> do
yield rtcm3Msg
pure tow
replayer :: MonadIO m => Conduit RTCM3Msg m RTCM3Msg
replayer = loop maxBound
where
loop tow =
await >>= maybe (pure ()) ((>>= loop) . replay tow)