content: {-# OPTIONS_GHC -fno-warn-type-defaults #-}
  module System.Clock.Seconds
    ( Clock(..)
    , Seconds(..)
    , getTime
    , getRes
    , fromNanoSecs
    , toNanoSecs
    , diffTimeSpec
    ) where
  
  import Data.Coerce
  import Data.Ratio
  import Data.Typeable (Typeable)
  import Foreign.Storable
  import GHC.Generics (Generic)
  
  import System.Clock(TimeSpec(..), Clock, s2ns, normalize)
  import qualified System.Clock as C
  
  newtype Seconds = Seconds { toTimeSpec :: TimeSpec }
   deriving (Generic, Read, Show, Typeable, Eq, Ord, Storable, Bounded)
  
  instance Num Seconds where
    fromInteger n = Seconds $ TimeSpec (fromInteger n) 0
    Seconds (TimeSpec xs xn) * Seconds (TimeSpec ys yn) =
      Seconds $ normalize $! TimeSpec (xs*ys) (xs*yn+xn*ys+((xn*yn) `div` s2ns))
    (+) = coerce ((+) :: TimeSpec -> TimeSpec -> TimeSpec)
    (-) = coerce ((-) :: TimeSpec -> TimeSpec -> TimeSpec)
    negate = coerce (negate :: TimeSpec -> TimeSpec)
    abs = coerce (abs :: TimeSpec -> TimeSpec)
    signum (Seconds a) = case signum a of
      1 -> 1
      (-1) -> (-1)
      _ -> 0
  
  instance Enum Seconds where
    succ x = x + 1
    pred x = x - 1
    toEnum x = Seconds $ 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 || ns == 0 = (fromIntegral s, Seconds $ TimeSpec 0 ns)
      | otherwise = (fromIntegral (s+1), Seconds $ TimeSpec (-1) ns)
  
  -- | The 'getTime' function shall return the current value for the
  --   specified clock.
  getTime :: Clock -> IO Seconds
  getTime = coerce C.getTime
  
  -- | The 'getRes' function shall return the resolution of any clock.
  --   Clock resolutions are implementation-defined and cannot be set
  --   by a process.
  getRes :: Clock -> IO Seconds
  getRes = coerce C.getRes
  
  -- | Seconds from nano seconds.
  fromNanoSecs :: Integer -> Seconds
  fromNanoSecs = coerce C.fromNanoSecs
  
  -- | Seconds to nano seconds.
  toNanoSecs :: Seconds -> Integer
  toNanoSecs = coerce C.toNanoSecs
  
  -- | Compute the absolute difference.
  diffTimeSpec :: Seconds -> Seconds -> Seconds
  diffTimeSpec = coerce C.diffTimeSpec
  