-- Copyright 2016 Ertugrul Söylemez -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License. -- You may obtain a copy of the License at -- -- http://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -- See the License for the specific language governing permissions and -- limitations under the License. {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} -- | -- Module: Data.Time.Class.Clock -- Copyright: Copyright 2016 Ertugrul Söylemez -- License: Apache License 2.0 -- Maintainer: Ertugrul Söylemez <esz@posteo.de> -- -- This module exports the 'ClockTime' type, which is related to (but -- not a wrapper for) the 'TimeSpec' type provided by the -- <http://hackage.haskell.org/package/clock clock library>. It aims to -- implement a complete timelike interface to the clock library, so when -- using this module, you should not need to import "System.Clock". -- -- A value of type @'ClockTime' clock@ denotes a certain point in time -- as measured by the clock reflected by the @clock@ argument. For -- example @ClockTime Realtime@ is a point in time as measured by the -- real-time clock. See the documentation of 'Clock' for a list of -- available clocks. The type argument is currently only relevant when -- querying the clock using 'getTime', and unless the clock type can be -- inferred from context, you will need to write a suitable type -- signature. Example: -- -- > t <- getTime :: IO (ClockTime Realtime) -- -- The following example measures the duration of the action -- @someOperation@: -- -- > do t1 <- getTime :: IO (ClockTime Monotonic) -- > someOperation -- > t2 <- getTime -- > let elapsed = diffTime t2 t1 -- -- The following example delays the current thread until the start of -- the next second of real time: -- -- > do -- Prints the start time and then delays: -- > t' <- getTime :: IO (ClockTime Realtime) -- > print t' -- > delayUntil 1 (begin Second t') -- > -- > -- Should print roughly t' rounded up to the next second: -- > t <- getTime -- > print t -- > -- > -- Prints the amount of time passed: -- > print (diffTime t t') -- -- As noted above 'ClockTime' is not a wrapper for 'TimeSpec', but -- rather wraps 'Nano'. Arithmetic may be slightly slower, because -- 'Integer' division is needed, but on 64-bit platforms the difference -- should be negligible, because the size of a 64-bit word is seldomly -- exceeded. module Data.Time.Class.Clock ( -- * Time ClockTime(..), Clock(..), fromTimeSpec, toTimeSpec ) where import Control.Monad.IO.Class import Data.Fixed import Data.Time.Class import GHC.Generics import System.Clock (Clock(..), TimeSpec(..)) import qualified System.Clock as Clock -- | A value of type @ClockTime clock@ is a point in time as measured by -- the clock represented by @clock :: Clock@. See the documentation of -- 'Clock' for the meanings of the individual clocks. -- -- The 'timeOrigin' of all clocks is zero, which has different meanings -- depending on the chosen clock. For example the origin of the -- 'Realtime' clock is the epoch. newtype ClockTime (clock :: Clock) = ClockTime { fromClockTime :: Nano } deriving (Eq, Generic, Ord, Read, Show) instance (MonadIO m) => GetTime m (ClockTime Monotonic) where getTime = fromTimeSpec <$> liftIO (Clock.getTime Monotonic) instance (MonadIO m) => GetTime m (ClockTime Realtime) where getTime = fromTimeSpec <$> liftIO (Clock.getTime Realtime) instance (MonadIO m) => GetTime m (ClockTime ProcessCPUTime) where getTime = fromTimeSpec <$> liftIO (Clock.getTime ProcessCPUTime) instance (MonadIO m) => GetTime m (ClockTime ThreadCPUTime) where getTime = fromTimeSpec <$> liftIO (Clock.getTime ThreadCPUTime) #ifdef linux_HOST_OS -- | Linux only, since Linux 2.6.28. instance (MonadIO m) => GetTime m (ClockTime MonotonicRaw) where getTime = fromTimeSpec <$> liftIO (Clock.getTime MonotonicRaw) -- | Linux only, since Linux 2.6.39. instance (MonadIO m) => GetTime m (ClockTime Boottime) where getTime = fromTimeSpec <$> liftIO (Clock.getTime Boottime) -- | Linux only, since Linux 2.6.32. instance (MonadIO m) => GetTime m (ClockTime MonotonicCoarse) where getTime = fromTimeSpec <$> liftIO (Clock.getTime MonotonicCoarse) -- | Linux only, since Linux 2.6.32. instance (MonadIO m) => GetTime m (ClockTime RealtimeCoarse) where getTime = fromTimeSpec <$> liftIO (Clock.getTime RealtimeCoarse) #endif instance SkipUnit (ClockTime clock) where begin unit (ClockTime t) | r == 0 = ClockTime t | otherwise = ClockTime (d * fromInteger (u + 1)) where (u, r) = divMod' t d d = unitSecs unit next unit (ClockTime t) = let d = unitSecs unit in ClockTime (d * fromInteger (div' t d + 1)) skip n unit (ClockTime t) = ClockTime (t + fromInteger n * unitSecs unit) skipOne unit (ClockTime t) = ClockTime (t + unitSecs unit) instance Time (ClockTime clock) where type Delta (ClockTime clock) = Nano addTime dt (ClockTime t) = ClockTime (t + dt) diffTime (ClockTime t1) (ClockTime t2) = t1 - t2 instance TimeOrigin (ClockTime clock) where timeOrigin = ClockTime 0 instance TimeSeconds (ClockTime clock) where deltaSecs _ = realToFrac oneSecond _ = 1 -- | Convert the given 'TimeSpec' to a 'ClockTime' value. -- -- Note that the two types are not isomorphic. While 'TimeSpec' is -- limited to roughly 94 bits, 'ClockTime' does not have such a limit. -- This function is injective, and the following equation holds: -- -- > toTimeSpec . fromTimeSpec = id fromTimeSpec :: TimeSpec -> ClockTime clock fromTimeSpec = ClockTime . MkFixed . Clock.timeSpecAsNanoSecs -- | Convert the given 'ClockTime' value to a 'TimeSpec'. -- -- Note that the two types are not isomorphic. While 'TimeSpec' is -- limited to roughly 94 bits, 'ClockTime' does not have such a limit. -- This function is surjective, and the following equation holds: -- -- > toTimeSpec . fromTimeSpec = id toTimeSpec :: ClockTime clock -> TimeSpec toTimeSpec (ClockTime (MkFixed ns')) = let (s, ns) = divMod ns' 1000000000 in TimeSpec (fromInteger s) (fromInteger ns) -- | The given unit in seconds. unitSecs :: (Num a) => TimeUnit -> a unitSecs Second = 1 unitSecs Minute = 60 unitSecs Hour = 3600 unitSecs Day = 86400