"Seconds" RealFrac instance

System/Clock.hsc

@@ -20,8 +20,10 @@ module System.Clock
   ) where
 
 import Control.Applicative ((<$>), (<*>))
+import Data.Coerce
 import Data.Int
 import Data.Word
+import Data.Ratio
 import Data.Typeable (Typeable)
 import Foreign.C
 import Foreign.Ptr
@@ -44,7 +46,7 @@ import GHC.Generics (Generic)
 
 -- | Clock types. A clock may be system-wide (that is, visible to all processes)
 --   or per-process (measuring time that is meaningful only within a process).
---   All implementations shall support 'Realtime'. 
+--   All implementations shall support 'Realtime'.
 data Clock
 
     -- | The identifier for the system-wide monotonic clock, which is defined as
@@ -227,21 +229,34 @@ normalize (TimeSpec xs xn) | xn < 0 || xn >= s2ns = TimeSpec (xs + q)  r
 instance Num TimeSpec where
   (TimeSpec xs xn) + (TimeSpec ys yn) = normalize $! TimeSpec (xs + ys) (xn + yn)
   (TimeSpec xs xn) - (TimeSpec ys yn) = normalize $! TimeSpec (xs - ys) (xn - yn)
-  (TimeSpec xs xn) * (TimeSpec ys yn) = normalize $! TimeSpec (xsi_ysi) (xni_yni)
-                                         where xsi_ysi = fromInteger $!  xsi*ysi 
-                                               xni_yni = fromInteger $! (xni*yni + (xni*ysi + xsi*yni) * s2ns) `div` s2ns
-                                               xsi     =   toInteger  xs
-                                               ysi     =   toInteger  ys
-                                               xni     =   toInteger  xn
-                                               yni     =   toInteger  yn
-
+  (toInteger-> t1) * (toInteger-> t2) = fromInteger $! t1 * t2
   negate (TimeSpec xs xn) = normalize $! TimeSpec (negate xs) (negate xn)
   abs    (normalize -> TimeSpec xs xn) | xs == 0   = normalize $! TimeSpec 0 xn
                                        | otherwise = normalize $! TimeSpec (abs xs) (signum xs * xn)
   signum (normalize -> TimeSpec xs xn) | xs == 0   = TimeSpec (signum xn) 0
                                        | otherwise = TimeSpec (signum xs) 0
   fromInteger x = TimeSpec (fromInteger q) (fromInteger r) where (q, r) = x `divMod` s2ns
 
+instance Enum TimeSpec where
+  succ x = x + 1
+  pred x = x - 1
+  toEnum x = normalize $ TimeSpec 0 (fromIntegral x)
+  fromEnum = fromEnum . toInteger
+
+instance Real TimeSpec where
+  toRational x = toInteger x % 1
+
+instance Integral TimeSpec where
+  toInteger = toNanoSecs
+  quot (toInteger-> t1) (toInteger-> t2) = fromInteger $! quot t1 t2
+  rem (toInteger-> t1) (toInteger-> t2) = fromInteger $! rem t1 t2
+  div (toInteger-> t1) (toInteger-> t2) = fromInteger $! div t1 t2
+  mod (toInteger-> t1) (toInteger-> t2) = fromInteger $! mod t1 t2
+  divMod (toInteger-> t1) (toInteger-> t2) =
+    let (q,r)=divMod t1 t2 in (fromInteger $! q, fromInteger $! r)
+  quotRem (toInteger-> t1) (toInteger-> t2) =
+    let (q,r)=quotRem t1 t2 in (fromInteger $! q, fromInteger $! r)
+
 instance Eq TimeSpec where
   (normalize -> TimeSpec xs xn) == (normalize -> TimeSpec ys yn) | True == es = xn == yn
                                                                  | otherwise  = es
@@ -269,3 +284,34 @@ diffTimeSpec ts1 ts2 = abs (ts1 - ts2)
 -- | TimeSpec as nano seconds.
 timeSpecAsNanoSecs :: TimeSpec -> Integer
 timeSpecAsNanoSecs   (TimeSpec s n) = toInteger s * s2ns + toInteger n
+
+newtype Seconds = Seconds TimeSpec
+ deriving (Generic, Read, Show, Typeable, Eq, Ord, Storable)
+
+instance Num Seconds where
+  fromInteger n = Seconds $ TimeSpec (fromInteger n) 0
+  Seconds a * Seconds b = Seconds $ a * b `div` s2ns
+  (+) = coerce ((+) :: TimeSpec -> TimeSpec -> TimeSpec)
+  (-) = coerce ((-) :: TimeSpec -> TimeSpec -> TimeSpec)
+  negate = coerce (negate :: TimeSpec -> TimeSpec)
+  abs = coerce (abs :: TimeSpec -> TimeSpec)
+  signum = coerce (signum :: TimeSpec -> TimeSpec)
+
+instance Enum Seconds where
+  succ x = x + 1
+  pred x = x - 1
+  toEnum x = Seconds . normalize $ TimeSpec (fromIntegral x) 0
+  fromEnum (Seconds (TimeSpec s _)) = fromEnum s
+
+instance Real Seconds where
+  toRational (Seconds x) = toInteger x % s2ns
+
+instance Fractional Seconds where
+  fromRational x = Seconds . fromInteger $ floor (x * s2ns)
+  Seconds a / Seconds b = Seconds $ a * s2ns `div` b
+  recip (Seconds a) = Seconds $ s2ns * s2ns `div` a
+
+instance RealFrac Seconds where
+  properFraction (Seconds (TimeSpec s ns))
+    | s >= 0 = (fromIntegral s, Seconds $ TimeSpec 0 ns)
+    | otherwise = (fromIntegral (s+1), Seconds $ TimeSpec (-1) ns)

clock.cabal

@@ -76,6 +76,7 @@ library
                          ForeignFunctionInterface
                          ScopedTypeVariables
                          ViewPatterns
+                         GeneralizedNewtypeDeriving
     if os(windows)
       c-sources:         cbits/hs_clock_win32.c
     include-dirs:        cbits