module Data.Duration
(
Duration
, flicksPerMillisecond
, flicksPerSecond
, flicksPerMinute
, flickRatio
, durationToRationalFlicks
, durationToRationalSeconds
, durationAsHours
, durationAsNanoseconds
, durationAsMicroseconds
, durationAsMilliseconds
, durationAsMinutes
, durationAsSeconds
, durationAsHms
, durationFromFlicks
, durationFromHours
, durationFromNanoseconds
, durationFromMicroseconds
, durationFromMilliseconds
, durationFromMinutes
, durationFromSeconds
, durationOfOneBeatAtBPM
, durationOfOneCycleAtHz
, frequencyInHzForWavePeriod
, durationOfRepeatedDuration
, durationFromDividingDuration
, durationIntoDuration
, negateDuration
, compareDurationsWithEpsilon
, delayThreadByDuration
, StartOfDuration
, startMeasuring
, durationSince
, measurementEpsilon
)
where
import Prelude
import Data.Ratio
import Data.Semigroup
import Data.Maybe
import System.Clock
import Control.Concurrent(threadDelay)
import Control.Monad ((>>), when)
flicksPerMillisecond :: Num a => a
flicksPerMillisecond = 705600
flicksPerSecond :: Num a => a
flicksPerSecond = 705600000
flicksPerMinute :: Num a => a
flicksPerMinute = 60 * 705600000
flickRatio :: Fractional a => a
flickRatio = recip flicksPerSecond
newtype Duration = Duration { fromDuration :: Integer }
deriving (Eq, Ord, Show)
instance Semigroup Duration where
a <> b = Duration $ fromDuration a + fromDuration b
instance Monoid Duration where
mempty = Duration 0
mappend = (<>)
durationToRationalFlicks :: Duration -> Rational
durationToRationalFlicks d = toRational (fromDuration d)
durationToRationalSeconds :: Duration -> Rational
durationToRationalSeconds d = flickRatio * durationToRationalFlicks d
durationIntoDuration :: Duration -> Duration -> Maybe Rational
durationIntoDuration _ d2 | fromDuration d2 == 0 = Nothing
durationIntoDuration d1 d2 = Just $ fromDuration d1 % fromDuration d2
durationOfRepeatedDuration :: Duration -> Rational -> Duration
durationOfRepeatedDuration d r = Duration $ truncate (durationToRationalFlicks d * r)
durationFromDividingDuration :: Duration -> Rational -> Maybe Duration
durationFromDividingDuration d r = if r == 0 then Nothing else Just $ durationOfRepeatedDuration d (recip r)
durationFromFlicks :: Integral a => a -> Duration
durationFromFlicks i = Duration (fromIntegral i)
durationFromNanoseconds :: Rational -> Duration
durationFromNanoseconds i = durationFromMicroseconds (i / 1000)
durationFromMicroseconds :: Rational -> Duration
durationFromMicroseconds i = durationFromMilliseconds (i / 1000)
durationFromMilliseconds :: Rational -> Duration
durationFromMilliseconds i = Duration (truncate (i * flicksPerMillisecond))
durationFromSeconds :: Rational -> Duration
durationFromSeconds i = Duration (truncate (i * flicksPerSecond))
durationFromMinutes :: Rational -> Duration
durationFromMinutes i = Duration (truncate (i * flicksPerMinute))
durationFromHours :: Rational -> Duration
durationFromHours i = durationFromMinutes (i * 60)
compareDurationsWithEpsilon :: Duration -> Duration -> Duration -> Ordering
compareDurationsWithEpsilon e a b =
let diff = (fromDuration a) - (fromDuration b)
in if abs diff <= fromDuration e
then EQ
else if diff < 0
then LT
else GT
durationOfOneCycleAtHz :: Rational -> Maybe Duration
durationOfOneCycleAtHz hz =
if hz <= 0
then Nothing
else durationFromDividingDuration (durationFromSeconds 1) hz
durationOfOneBeatAtBPM :: Rational -> Maybe Duration
durationOfOneBeatAtBPM bpm =
if bpm <= 0
then Nothing
else durationFromDividingDuration (durationFromMinutes 1) bpm
frequencyInHzForWavePeriod :: Duration -> Maybe Rational
frequencyInHzForWavePeriod = durationIntoDuration (durationFromSeconds 1)
durationAsSeconds :: Duration -> Rational
durationAsSeconds d = durationAsMilliseconds d / 1000
durationAsMinutes :: Duration -> Rational
durationAsMinutes d = durationAsSeconds d / 60
durationAsHours :: Duration -> Rational
durationAsHours d = durationAsMinutes d / 60
durationAsMilliseconds :: Duration -> Rational
durationAsMilliseconds d = fromDuration d % flicksPerMillisecond
durationAsMicroseconds :: Duration -> Rational
durationAsMicroseconds d = fromRational 1000 * durationAsMilliseconds d
durationAsNanoseconds :: Duration -> Rational
durationAsNanoseconds d = fromRational 1000 * durationAsMicroseconds d
negateDuration :: Duration -> Duration
negateDuration d = Duration (negate (fromDuration d))
maximumOfDurations :: Duration -> Duration -> Duration
maximumOfDurations d1 d2 =
if d1 > d2 then d1 else d2
minimumOfDurations :: Duration -> Duration -> Duration
minimumOfDurations d1 d2 =
if d1 < d2 then d1 else d2
durationAsHms :: Duration -> (Integer, Integer, Integer, Integer, Integer)
durationAsHms d =
let (h,hr) = fromDuration d `divMod` fromDuration (durationFromHours 1)
(m,mr) = hr `divMod` fromDuration (durationFromMinutes 1)
(s,sr) = mr `divMod` fromDuration (durationFromSeconds 1)
(ms,msr) = sr `divMod` fromDuration (durationFromMilliseconds 1)
(us,usr) = msr `divMod` fromDuration (durationFromMicroseconds 1)
in (h,m,s,ms,us)
delayThreadByDuration :: Duration -> IO ()
delayThreadByDuration d = do
let maxMicroseconds = durationFromMicroseconds (fromIntegral (maxBound :: Int))
let w = min d maxMicroseconds
threadDelay (truncate (durationAsMicroseconds (min d maxMicroseconds)))
when (w /= d) (delayThreadByDuration (d <> negateDuration w))
newtype StartOfDuration = StartOfDuration { toDurationFromOrigin :: Duration }
timespecToDuration :: TimeSpec -> Duration
timespecToDuration ts = durationFromSeconds (fromIntegral (sec ts)) <> durationFromNanoseconds (fromIntegral (nsec ts))
startMeasuring :: IO StartOfDuration
startMeasuring = do
now <- getTime Monotonic
let d1 = timespecToDuration now
return (StartOfDuration d1)
durationSince :: StartOfDuration -> IO Duration
durationSince s = do
now <- getTime Monotonic
let d1 = toDurationFromOrigin s
let d2 = timespecToDuration now
return (Duration ((fromDuration d2) - (fromDuration d1)))
measurementEpsilon :: IO Duration
measurementEpsilon = return (durationFromMilliseconds 100)