nanotime 0.1.0 → 0.2.0

raw patch · 3 files changed

+170/−61 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• nanotime.cabal +1/−1
• src/Nanotime.hs +142/−54
• test/Main.hs +27/−6

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           nanotime-version:        0.1.0+version:        0.2.0 synopsis:       a tiny time library description:    Please see the README on GitHub at <https://github.com/ejconlon/nanotime#readme> homepage:       https://github.com/ejconlon/nanotime#readme

@@ -1,10 +1,10 @@ module Nanotime-  ( TimeDelta (..)+  ( Sign (..)+  , TimeDelta (..)   , timeDeltaFromFracSecs   , timeDeltaFromNanos   , timeDeltaToFracSecs   , timeDeltaToNanos-  , diffTimeDelta   , threadDelayDelta   , TimeLike (..)   , awaitDelta@@ -17,100 +17,175 @@   , NtpTime (..)   , posixToNtp   , ntpToPosix-  , assertingNonNegative   ) where  import Control.Concurrent (threadDelay) import Data.Bits (Bits (..)) import Data.Fixed (Fixed (..), Pico)-import Data.Semigroup (Sum (..)) import Data.Time.Clock (nominalDiffTimeToSeconds) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word (Word32, Word64) import GHC.Clock (getMonotonicTimeNSec)-import GHC.Generics (Generic) import GHC.Stack (HasCallStack) -assertingNonNegative :: (HasCallStack, Ord a, Num a, Show a) => a -> a-assertingNonNegative a =-  if a < 0-    then error ("Required non-negative value but got " ++ show a)-    else a+-- | Sign (negative or positive) of a magnitude of time difference+data Sign = SignNeg | SignPos+  deriving stock (Eq, Ord, Show, Enum, Bounded) --- | Non-negative time difference in nanoseconds since last event--- Like a 'Nano' (`Fixed E9`) but a machine word.-newtype TimeDelta = TimeDelta {unTimeDelta :: Word64}-  deriving stock (Eq, Show, Ord, Generic, Bounded)-  deriving newtype (Num)-  deriving (Semigroup, Monoid) via (Sum Word64)+-- | Signed time difference in nanoseconds since last event+-- Like a 'Nano' (`Fixed E9`) but using a machine word with explicit sign.+data TimeDelta = TimeDelta+  { tdSign :: !Sign+  , tdMag :: !Word64+  }+  deriving stock (Show) +instance Eq TimeDelta where+  TimeDelta s1 m1 == TimeDelta s2 m2 =+    (m1 == 0 && m2 == 0) || (s1 == s2 && m1 == m2)++instance Ord TimeDelta where+  compare (TimeDelta s1 m1) (TimeDelta s2 m2) =+    if m1 == 0 && m2 == 0+      then EQ+      else case s1 of+        SignPos ->+          case s2 of+            SignPos -> compare m1 m2+            SignNeg -> GT+        SignNeg ->+          case s2 of+            SignPos -> LT+            SignNeg -> compare m2 m1++instance Bounded TimeDelta where+  minBound = TimeDelta SignNeg maxBound+  maxBound = TimeDelta SignPos maxBound++instance Semigroup TimeDelta where+  td1@(TimeDelta s1 m1) <> td2@(TimeDelta s2 m2) =+    if+      | m1 == 0 -> td2+      | m2 == 0 -> td1+      | s1 == s2 -> mkTimeDelta s1 (m1 + m2)+      | otherwise ->+          if m1 >= m2+            then mkTimeDelta s1 (m1 - m2)+            else mkTimeDelta s2 (m2 - m1)++instance Monoid TimeDelta where+  mempty = TimeDelta SignPos 0++instance Num TimeDelta where+  (+) = (<>)+  (*) = error "TimeDelta multiplication has no meaning"+  abs (TimeDelta _ m) = TimeDelta SignPos m+  signum (TimeDelta s m) =+    if m == 0+      then 0+      else case s of+        SignPos -> 1+        SignNeg -> -1+  fromInteger i =+    if i >= 0+      then TimeDelta SignPos (fromInteger i)+      else TimeDelta SignNeg (fromInteger (negate i))+  negate td@(TimeDelta s m) =+    if m == 0 && s == SignPos+      then td+      else case s of+        SignPos -> TimeDelta SignNeg m+        SignNeg -> TimeDelta SignPos m++-- private+mkTimeDelta :: Sign -> Word64 -> TimeDelta+mkTimeDelta s m =+  if m == 0+    then TimeDelta SignPos m+    else TimeDelta s m+ -- | Return a 'TimeDelta' corresponding the the given number of fractional seconds. -- (For example, 1.5 represents one and a half seconds.)-timeDeltaFromFracSecs :: (Real a, Show a) => a -> TimeDelta-timeDeltaFromFracSecs d = TimeDelta (round (1000000000 * toRational (assertingNonNegative d)))+timeDeltaFromFracSecs :: (Real a) => a -> TimeDelta+timeDeltaFromFracSecs d =+  if d >= 0+    then TimeDelta SignPos (round (1000000000 * toRational d))+    else TimeDelta SignNeg (round (1000000000 * toRational (negate d)))  -- | Return a 'TimeDelta' corresponding the the given number of nanoseconds. -- (For example, 1000000000 represends one second.)-timeDeltaFromNanos :: (Integral a, Show a) => a -> TimeDelta-timeDeltaFromNanos = TimeDelta . fromIntegral . assertingNonNegative+timeDeltaFromNanos :: (Integral a) => a -> TimeDelta+timeDeltaFromNanos = fromIntegral -timeDeltaToFracSecs :: (Fractional a) => TimeDelta -> a-timeDeltaToFracSecs (TimeDelta n) = fromIntegral n / 1000000000+-- private+timeDeltaFromDiff :: Word64 -> Word64 -> TimeDelta+timeDeltaFromDiff end start =+  if end >= start+    then TimeDelta SignPos (end - start)+    else TimeDelta SignNeg (start - end) -timeDeltaToNanos :: TimeDelta -> Word64-timeDeltaToNanos = unTimeDelta+-- private+timeDeltaAdd :: Word64 -> TimeDelta -> Word64+timeDeltaAdd t (TimeDelta s m) =+  case s of+    SignPos -> t + m+    SignNeg -> t - m --- | Return the difference of two time deltas-diffTimeDelta-  :: TimeDelta-  -- ^ the "larger" delta-  -> TimeDelta-  -- ^ the "smaller" delta-  -> Maybe TimeDelta-  -- ^ difference between the two (Nothing if negative)-diffTimeDelta (TimeDelta big) (TimeDelta small) =-  if big <= small-    then Nothing-    else Just (TimeDelta (big - small))+timeDeltaToFracSecs :: (Fractional a) => TimeDelta -> a+timeDeltaToFracSecs (TimeDelta s m) =+  let a = fromIntegral m / 1000000000+  in  case s of+        SignPos -> a+        SignNeg -> negate a +timeDeltaToNanos :: TimeDelta -> Maybe Word64+timeDeltaToNanos (TimeDelta s m) =+  case s of+    SignNeg -> Nothing+    SignPos -> Just m+ threadDelayDelta :: TimeDelta -> IO ()-threadDelayDelta (TimeDelta td) = threadDelay (fromIntegral (div td 1000))+threadDelayDelta (TimeDelta s m) =+  case s of+    SignNeg -> pure ()+    SignPos -> threadDelay (fromIntegral (div m 1000))  class (Ord t) => TimeLike t where-  diffTime :: t -> t -> Maybe TimeDelta+  -- | `diffTime end start` computes `end - start`+  diffTime :: t -> t -> TimeDelta++  -- | `addTime start (diffTime end start) == end`   addTime :: t -> TimeDelta -> t+   currentTime :: IO t  awaitDelta :: (TimeLike t) => t -> TimeDelta -> IO t awaitDelta m t = do   let target = addTime m t   cur <- currentTime-  case diffTime target cur of-    Nothing -> pure cur-    Just td -> target <$ threadDelayDelta td+  let td = diffTime target cur+  target <$ threadDelayDelta td  newtype PosixTime = PosixTime {unPosixTime :: Word64}-  deriving stock (Eq, Show, Ord, Generic, Bounded)+  deriving stock (Eq, Show, Ord, Bounded) +-- private e9W :: Word64 e9W = 1000000000 +-- private picoToNanoWord :: Pico -> Word64 picoToNanoWord (MkFixed i) = fromInteger (div i 1000) -picoFromNanoWord :: Word64 -> Pico-picoFromNanoWord j = MkFixed (1000 * toInteger j)- instance TimeLike PosixTime where-  diffTime (PosixTime t2) (PosixTime t1) =-    if t2 <= t1 then Nothing else Just (TimeDelta (t2 - t1))-  addTime (PosixTime t) (TimeDelta d) = PosixTime (t + d)+  diffTime (PosixTime t2) (PosixTime t1) = timeDeltaFromDiff t2 t1+  addTime (PosixTime t) td = PosixTime (timeDeltaAdd t td)   currentTime = fmap (PosixTime . picoToNanoWord . nominalDiffTimeToSeconds) getPOSIXTime  -- | Monotonic time in nanoseconds since some unspecified epoch (see 'getMonotonicTimeNs') newtype MonoTime = MonoTime {unMonoTime :: Word64}-  deriving stock (Eq, Show, Ord, Generic, Bounded)+  deriving stock (Eq, Show, Ord, Bounded)  monoTimeFromFracSecs :: (Real a, Show a) => a -> MonoTime monoTimeFromFracSecs d = MonoTime (round (1000000000 * toRational (assertingNonNegative d)))@@ -125,48 +200,61 @@ monoTimeToNanos = unMonoTime  instance TimeLike MonoTime where-  diffTime (MonoTime t2) (MonoTime t1) =-    if t2 <= t1 then Nothing else Just (TimeDelta (t2 - t1))-  addTime (MonoTime t) (TimeDelta d) = MonoTime (t + d)+  diffTime (MonoTime t2) (MonoTime t1) = timeDeltaFromDiff t2 t1+  addTime (MonoTime t) td = MonoTime (timeDeltaAdd t td)   currentTime = fmap MonoTime getMonotonicTimeNSec  newtype NtpTime = NtpTime {unNtpTime :: Word64}-  deriving stock (Eq, Show, Ord, Generic, Bounded)+  deriving stock (Eq, Show, Ord, Bounded) +-- private nanoWordToSplit :: Word64 -> (Word32, Word32) nanoWordToSplit j =   let whole = div j e9W       part = j - e9W * whole   in  (fromIntegral whole, fromIntegral part) +-- private nanoWordFromSplit :: Word32 -> Word32 -> Word64 nanoWordFromSplit whole part = e9W * fromIntegral whole + fromIntegral part +-- private ntpFromSplit :: Word32 -> Word32 -> NtpTime ntpFromSplit whole part = NtpTime (shiftL (fromIntegral whole) 32 .|. fromIntegral part) +-- private ntpToSplit :: NtpTime -> (Word32, Word32) ntpToSplit (NtpTime k) = (fromIntegral (shiftR k 32), fromIntegral k) +-- private -- Difference in nano seconds between 1/1/1900 and 1/1/1970 -- 1900 is the NTP epoch, 1970 is the unix epoch ntpEpochDiffSeconds :: Word32 ntpEpochDiffSeconds = 2208988800 +-- | Convert 'NtpTime' to 'PosixTime' posixToNtp :: PosixTime -> NtpTime posixToNtp (PosixTime j) =   let (whole, part) = nanoWordToSplit j       whole' = whole + ntpEpochDiffSeconds   in  ntpFromSplit whole' part +-- | Convert 'NtpTime' to 'PosixTime' ntpToPosix :: NtpTime -> PosixTime ntpToPosix k =   let (whole, part) = ntpToSplit k       whole' = whole - ntpEpochDiffSeconds   in  PosixTime (nanoWordFromSplit whole' part) --- Probably best to do time arithmetic directly on PosixTime+-- (Probably best to do time arithmetic directly on PosixTime) instance TimeLike NtpTime where   diffTime n2 n1 = diffTime (ntpToPosix n2) (ntpToPosix n1)   addTime n d = posixToNtp (addTime (ntpToPosix n) d)   currentTime = fmap posixToNtp currentTime++-- private+assertingNonNegative :: (HasCallStack, Ord a, Num a, Show a) => a -> a+assertingNonNegative a =+  if a < 0+    then error ("Required non-negative value but got " ++ show a)+    else a

@@ -3,19 +3,40 @@   ) where +import Data.Word (Word64)+import Nanotime import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) -testDummy :: TestTree-testDummy = testCase "dummy" $ do-  let actual = (1 + 1) :: Int-      expected = 2 :: Int-  actual @?= expected+nsPerSec :: Word64+nsPerSec = 1000000000 +testDelta :: TestTree+testDelta = testCase "delta" $ do+  TimeDelta SignPos 0 == TimeDelta SignNeg 0 @?= True+  TimeDelta SignPos 1 == TimeDelta SignPos 1 @?= True+  TimeDelta SignPos 1 == TimeDelta SignNeg 1 @?= False+  TimeDelta SignPos 1 == TimeDelta SignPos 2 @?= False+  compare (TimeDelta SignPos 0) (TimeDelta SignNeg 0) @?= EQ+  compare (TimeDelta SignPos 1) (TimeDelta SignPos 1) @?= EQ+  compare (TimeDelta SignPos 1) (TimeDelta SignNeg 1) @?= GT+  compare (TimeDelta SignPos 1) (TimeDelta SignPos 2) @?= LT+  0 @?= TimeDelta SignPos 0+  mempty @TimeDelta @?= 0+  timeDeltaFromFracSecs @Rational 0 @?= 0+  timeDeltaFromFracSecs @Rational 1 @?= TimeDelta SignPos nsPerSec+  timeDeltaFromFracSecs @Rational (-1) @?= TimeDelta SignNeg nsPerSec+  negate @TimeDelta 0 @?= 0+  negate (TimeDelta SignPos 1) @?= TimeDelta SignNeg 1+  negate (TimeDelta SignNeg 1) @?= TimeDelta SignPos 1+  TimeDelta SignPos 1 + TimeDelta SignPos 2 @?= TimeDelta SignPos 3+  TimeDelta SignPos 1 - TimeDelta SignPos 2 @?= TimeDelta SignNeg 1+  TimeDelta SignPos 2 - TimeDelta SignPos 1 @?= TimeDelta SignPos 1+ main :: IO () main =   defaultMain $     testGroup       "Nanotime"-      [ testDummy+      [ testDelta       ]