module Data.RTCM3.SBP.Time
( gpsLeapMillis
, minuteMillis
, hourMillis
, dayMillis
, weekMillis
, toWn
, toStartDate
, toTow
, currentGpsTime
, rolloverTowGpsTime
, rolloverEpochGpsTime
) where
import BasicPrelude
import Control.Lens
import Data.Time
import Data.Time.Calendar.WeekDate
import Data.Word
import SwiftNav.SBP
gpsEpoch :: Day
gpsEpoch = fromGregorian 1980 1 6
gpsLeapSeconds :: Integer
gpsLeapSeconds = 18
gpsLeapMillis :: Integer
gpsLeapMillis = 1000 * gpsLeapSeconds
minuteSeconds :: Integer
minuteSeconds = 60
minuteMillis :: Integer
minuteMillis = 1000 * minuteSeconds
hourSeconds :: Integer
hourSeconds = 60 * 60
hourMillis :: Integer
hourMillis = 1000 * hourSeconds
daySeconds :: Integer
daySeconds = 24 * hourSeconds
dayMillis :: Integer
dayMillis = 1000 * daySeconds
weekSeconds :: Integer
weekSeconds = 7 * daySeconds
weekMillis :: Integer
weekMillis = 1000 * weekSeconds
toWn :: UTCTime -> Word16
toWn t = fromIntegral weeks
where
days = diffDays (utctDay t) gpsEpoch
weeks = days `div` 7
toStartDate :: (Integer, Int, Int) -> (Integer, Int, Int)
toStartDate (year, week, day)
| day == 7 = (year, week, 7)
| week == 1 = (year1, 52, 7)
| otherwise = (year, week1, 7)
fromStartDate :: UTCTime -> UTCTime
fromStartDate t = UTCTime (fromWeekDate year week day) 0
where
(year, week, day) = toStartDate $ toWeekDate $ utctDay t
toTow :: UTCTime -> Word32
toTow t = floor $ 1000 * diffUTCTime t (fromStartDate t)
currentGpsTime :: MonadIO m => m GpsTime
currentGpsTime = do
t <- liftIO $ addUTCTime (fromIntegral gpsLeapSeconds) <$> getCurrentTime
pure $ GpsTime (toTow t) 0 (toWn t)
rolloverTowGpsTime :: Word32 -> GpsTime -> GpsTime
rolloverTowGpsTime tow t = t & gpsTime_tow .~ tow & rollover
where
rollover
| increment = gpsTime_wn +~ 1
| decrement = gpsTime_wn +~ 1
| otherwise = gpsTime_wn +~ 0
new = fromIntegral tow
old = fromIntegral (t ^. gpsTime_tow)
increment = old > new && old new > weekMillis `div` 2
decrement = new > old && new old > weekMillis `div` 2
rolloverEpochGpsTime :: Word32 -> GpsTime -> GpsTime
rolloverEpochGpsTime epoch t = rolloverTowGpsTime tow t
where
epoch' = fromIntegral epoch 3 * hourMillis + gpsLeapMillis
epoch''
| epoch' < 0 = epoch' + dayMillis
| otherwise = epoch'
dow = fromIntegral (t ^. gpsTime_tow) `div` dayMillis
tod = fromIntegral (t ^. gpsTime_tow) dow * dayMillis
dow'
| increment = dow + 1 `mod` 7
| decrement = dow 1 `mod` 7
| otherwise = dow
increment = epoch'' > tod && epoch'' tod > dayMillis `div` 2
decrement = tod > epoch'' && tod epoch'' > dayMillis `div` 2
tow = fromIntegral $ dow' * dayMillis + epoch''