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
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