module Data.MediaBus.Clock ( IsClock(..) , timeSince , UtcClock(..) , useUtcClock , _utcClockTimeDiff , _utcClockTime , utcClockTimeDiff ) where import Conduit import Control.Lens import Data.Default import Data.Function ( on ) import Data.Kind import Data.MediaBus.Monotone import Data.Proxy import Data.Time.Calendar import Data.Time.Clock import Data.Word import Test.QuickCheck import GHC.Generics ( Generic ) import Control.DeepSeq -- | Clocks can generate reference times, and they can convert these to tickss. Tickss are mere integrals class (Default (ClockTimeDiff c), Ord (ClockTimeDiff c), Eq (ClockTimeDiff c), Num (ClockTimeDiff c), Show (ClockTime c), Eq (ClockTime c), Show (ClockTimeDiff c), LocalOrd (ClockTimeDiff c)) => IsClock c where data ClockTime c data ClockTimeDiff c type MonadClock c (m :: Type -> Type) :: Constraint now :: MonadClock c m => m (ClockTime c) timeAsTimeDiff :: ClockTime c -> ClockTimeDiff c diffTime :: ClockTime c -> ClockTime c -> ClockTimeDiff c timeAddTimeDiff :: ClockTime c -> ClockTimeDiff c -> ClockTime c timeSince :: (IsClock c, MonadClock c m, Monad m) => ClockTime c -> m (ClockTimeDiff c) timeSince t0 = do t1 <- now return (diffTime t1 t0) data UtcClock = MkUtcClock deriving Generic instance NFData UtcClock useUtcClock :: Proxy UtcClock useUtcClock = Proxy instance IsClock UtcClock where newtype ClockTime UtcClock = MkUtcClockTime{_utcClockTime :: UTCTime} deriving (Eq, Generic) newtype ClockTimeDiff UtcClock = MkUtcClockTimeDiff{_utcClockTimeDiff :: NominalDiffTime} deriving (Ord, Eq, Num, Generic) type MonadClock UtcClock m = MonadIO m now = MkUtcClockTime <$> liftIO getCurrentTime timeAsTimeDiff (MkUtcClockTime ref) = MkUtcClockTimeDiff $ diffUTCTime ref $ UTCTime (toEnum 0) 0 timeAddTimeDiff (MkUtcClockTime t) (MkUtcClockTimeDiff dt) = MkUtcClockTime (addUTCTime dt t) diffTime (MkUtcClockTime later) (MkUtcClockTime sooner) = MkUtcClockTimeDiff $ diffUTCTime later sooner instance NFData (ClockTime UtcClock) instance Show (ClockTime UtcClock) where show (MkUtcClockTime t) = show t instance Show (ClockTimeDiff UtcClock) where show (MkUtcClockTimeDiff t) = "dt:" ++ show t instance NFData (ClockTimeDiff UtcClock) instance Default (ClockTimeDiff UtcClock) where def = MkUtcClockTimeDiff $ fromInteger def instance Arbitrary (ClockTime UtcClock) where arbitrary = MkUtcClockTime <$> (UTCTime <$> (ModifiedJulianDay <$> arbitrary) <*> (fromInteger <$> arbitrary)) instance Arbitrary (ClockTimeDiff UtcClock) where arbitrary = MkUtcClockTimeDiff . fromInteger <$> arbitrary utcClockTimeDiff :: Lens' (ClockTimeDiff UtcClock) NominalDiffTime utcClockTimeDiff = lens _utcClockTimeDiff (const MkUtcClockTimeDiff) instance LocalOrd (ClockTimeDiff UtcClock) where succeeds = succeeds `on` roundToSeconds where roundToSeconds = round . (/ 1000000000000) . _utcClockTimeDiff roundToSeconds :: ClockTimeDiff UtcClock -> Word64