{-# LANGUAGE DeriveDataTypeable #-}-- | Extra functions for working with times. Unlike the other modules in this package, there is no-- corresponding @System.Time@ module. This module enhances the functionality-- from "Data.Time.Clock", but in quite different ways.---- Throughout, time is measured in 'Seconds', which is a type alias for 'Double'.moduleSystem.Time.Extra(Seconds ,sleep ,timeout ,showDuration ,offsetTime ,offsetTimeIncrease ,duration )whereimportControl.ConcurrentimportSystem.ClockimportNumeric.Extra importControl.Monad.Extra importControl.Exception.Extra importData.TypeableimportData.Unique-- | A type alias for seconds, which are stored as 'Double'.typeSeconds =Double-- | Sleep for a number of seconds.---- > fmap (round . fst) (duration $ sleep 1) == return 1sleep::Seconds ->IO()sleep =loopM $\s ->-- important to handle both overflow and underflow vs Intifs <0thenreturn$Right()elseifs >2000thendothreadDelay2000000000-- 2000 * 1e6return$Left$s -2000elsedothreadDelay$ceiling$s *1000000return$Right()-- An internal type that is thrown as a dynamic exception to-- interrupt the running IO computation when the timeout has-- expired.newtypeTimeout =Timeout Uniquederiving(Eq,Typeable)instanceShowTimeout whereshow _="<<timeout>>"instanceExceptionTimeout -- | A version of 'System.Timeout.timeout' that takes 'Seconds' and never-- overflows the bounds of an 'Int'. In addition, the bug that negative-- timeouts run for ever has been fixed.---- > timeout (-3) (print 1) == return Nothing-- > timeout 0.1 (print 1) == fmap Just (print 1)-- > do (t, _) <- duration $ timeout 0.1 $ sleep 1000; print t; return $ t < 1-- > timeout 0.1 (sleep 2 >> print 1) == return Nothingtimeout::Seconds ->IOa ->IO(Maybea )-- Copied from GHC with a few tweaks.timeout n f |n <=0=returnNothing|otherwise=dopid <-myThreadIdex <-fmapTimeout newUniquehandleBool (==ex )(const$returnNothing)(bracket(forkIOWithUnmask$\unmask ->unmask $sleep n >>throwTopid ex )killThread(\_->fmapJustf ))-- | Show a number of seconds, typically a duration, in a suitable manner with-- reasonable precision for a human.---- > showDuration 3.435 == "3.44s"-- > showDuration 623.8 == "10m24s"-- > showDuration 62003.8 == "17h13m"-- > showDuration 1e8 == "27777h47m"showDuration::Seconds ->StringshowDuration x |x >=3600=f (x /60)"h""m"|x >=60=f x "m""s"|otherwise=showDP 2x ++"s"wheref x m s =showms ++m ++['0'|ss <10]++showss ++s where(ms ,ss )=roundx `divMod`60-- | Call once to start, then call repeatedly to get the elapsed time since the first call.-- The time is guaranteed to be monotonic. This function is robust to system time changes.---- > do f <- offsetTime; xs <- replicateM 10 f; return $ xs == sort xsoffsetTime::IO(IOSeconds )offsetTime =dostart <-time return$doend <-time return$1e-9*fromIntegral(toNanoSecs$end -start )wheretime =getTimeMonotonic{-# DEPRECATEDoffsetTimeIncrease"Use 'offsetTime' instead, which is guaranteed to always increase."#-}-- | A synonym for 'offsetTime'.offsetTimeIncrease::IO(IOSeconds )offsetTimeIncrease =offsetTime -- | Record how long a computation takes in 'Seconds'.---- > do (a,_) <- duration $ sleep 1; return $ a >= 1 && a <= 1.5duration::IOa ->IO(Seconds ,a )duration act =dotime <-offsetTime res <-act time <-time return(time ,res )