47 lines
1.3 KiB
Haskell
47 lines
1.3 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module System.Clock.Instances
|
|
(
|
|
) where
|
|
|
|
import ClassyPrelude
|
|
import System.Clock
|
|
import Data.Ratio ((%))
|
|
|
|
import Data.Fixed
|
|
|
|
import Control.Lens
|
|
|
|
|
|
instance Real TimeSpec where
|
|
toRational TimeSpec{..} = fromIntegral sec + fromIntegral nsec % 1e9
|
|
|
|
instance Fractional TimeSpec where
|
|
a / b = fromRational $ toRational a / toRational b
|
|
fromRational n = fromNanoSecs n'
|
|
where MkFixed n' = fromRational n :: Nano
|
|
|
|
instance RealFrac TimeSpec where
|
|
properFraction = over _2 fromRational . properFraction . toRational
|
|
|
|
round x = let (n,r) = properFraction x
|
|
m = bool (n + 1) (n -1) $ r < fromRational 0
|
|
s = signum (abs r - fromRational 0.5)
|
|
in if | s == fromRational (-1) -> n
|
|
| s == fromRational 0 -> bool m n $ even n
|
|
| s == fromRational 1 -> m
|
|
| otherwise -> error "round @TimeSpec: Bad value"
|
|
|
|
ceiling x = bool n (n + 1) $ r > 0
|
|
where (n,r) = properFraction x
|
|
|
|
floor x = bool n (n - 1) $ r > 0
|
|
where (n,r) = properFraction x
|
|
|
|
instance NFData TimeSpec
|
|
instance Hashable TimeSpec
|