Move time formatting routines in the Time module

This commit is contained in:
Harendra Kumar 2019-01-12 02:15:28 +05:30
parent 06a827f826
commit 34edd618b0
2 changed files with 72 additions and 36 deletions

View File

@ -134,9 +134,8 @@ import GHC.IO (IO(..))
import Streamly.Time.Clock (Clock(..), getTime) import Streamly.Time.Clock (Clock(..), getTime)
import Streamly.Time.Units import Streamly.Time.Units
(AbsTime, NanoSecond64(..), MicroSecond64(..), diffAbsTime64, (AbsTime, NanoSecond64(..), MicroSecond64(..), diffAbsTime64,
fromRelTime64, toRelTime64) fromRelTime64, toRelTime64, showNanoSecond64, showRelTime64)
import System.IO (hPutStrLn, stderr) import System.IO (hPutStrLn, stderr)
import Text.Printf (printf)
import qualified Data.Heap as H import qualified Data.Heap as H
import qualified Data.Set as S import qualified Data.Set as S
@ -643,31 +642,6 @@ collectLatency sv yinfo drain = do
-- Dumping the SVar for debug/diag -- Dumping the SVar for debug/diag
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- | Convert a number of seconds to a string. The string will consist
-- of four decimal places, followed by a short description of the time
-- units.
secs :: Double -> String
secs k
| k < 0 = '-' : secs (-k)
| k >= 1 = k `with` "s"
| k >= 1e-3 = (k*1e3) `with` "ms"
#ifdef mingw32_HOST_OS
| k >= 1e-6 = (k*1e6) `with` "us"
#else
| k >= 1e-6 = (k*1e6) `with` "μs"
#endif
| k >= 1e-9 = (k*1e9) `with` "ns"
| k >= 1e-12 = (k*1e12) `with` "ps"
| k >= 1e-15 = (k*1e15) `with` "fs"
| k >= 1e-18 = (k*1e18) `with` "as"
| otherwise = printf "%g s" k
where with (t :: Double) (u :: String)
| t >= 1e9 = printf "%.4g %s" t u
| t >= 1e3 = printf "%.0f %s" t u
| t >= 1e2 = printf "%.1f %s" t u
| t >= 1e1 = printf "%.2f %s" t u
| otherwise = printf "%.3f %s" t u
dumpSVarStats :: SVar t m a -> SVarStats -> SVarStyle -> IO String dumpSVarStats :: SVar t m a -> SVarStats -> SVarStyle -> IO String
dumpSVarStats sv ss style = do dumpSVarStats sv ss style = do
case yieldRateInfo sv of case yieldRateInfo sv of
@ -709,21 +683,17 @@ dumpSVarStats sv ss style = do
then "\nheap max size = " <> show maxHp then "\nheap max size = " <> show maxHp
else "") else "")
<> (if minLat > 0 <> (if minLat > 0
then "\nmin worker latency = " then "\nmin worker latency = " <> showNanoSecond64 minLat
<> secs (fromIntegral minLat * 1e-9)
else "") else "")
<> (if maxLat > 0 <> (if maxLat > 0
then "\nmax worker latency = " then "\nmax worker latency = " <> showNanoSecond64 maxLat
<> secs (fromIntegral maxLat * 1e-9)
else "") else "")
<> (if avgCnt > 0 <> (if avgCnt > 0
then let lat = avgTime `div` fromIntegral avgCnt then let lat = avgTime `div` fromIntegral avgCnt
in "\navg worker latency = " in "\navg worker latency = " <> showNanoSecond64 lat
<> secs (fromIntegral lat * 1e-9)
else "") else "")
<> (if svarLat > 0 <> (if svarLat > 0
then "\nSVar latency = " then "\nSVar latency = " <> showRelTime64 svarLat
<> secs (fromIntegral svarLat * 1e-9)
else "") else "")
<> (if svarCnt > 0 <> (if svarCnt > 0
then "\nSVar yield count = " <> show svarCnt then "\nSVar yield count = " <> show svarCnt

View File

@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
#include "inline.hs" #include "inline.hs"
@ -24,6 +25,7 @@ module Streamly.Time.Units
, NanoSecond64(..) , NanoSecond64(..)
, MicroSecond64(..) , MicroSecond64(..)
, MilliSecond64(..) , MilliSecond64(..)
, showNanoSecond64
-- * Absolute times (using TimeSpec) -- * Absolute times (using TimeSpec)
, AbsTime(..) , AbsTime(..)
@ -43,10 +45,12 @@ module Streamly.Time.Units
, fromRelTime64 , fromRelTime64
, diffAbsTime64 , diffAbsTime64
, addToAbsTime64 , addToAbsTime64
, showRelTime64
) )
where where
import Data.Int import Data.Int
import Text.Printf (printf)
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- Some constants -- Some constants
@ -68,11 +72,25 @@ tenPower9 = 1000000000
-- Time Unit Representations -- Time Unit Representations
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- XXX We should be able to use type families to use different represenations
-- for a unit.
--
-- Second Rational
-- Second Double
-- Second Int64
-- Second Integer
-- NanoSecond Int64
-- ...
-- Double or Fixed would be a much better representation so that we do not lose -- Double or Fixed would be a much better representation so that we do not lose
-- information between conversions. However, for faster arithmetic operations -- information between conversions. However, for faster arithmetic operations
-- we use an 'Int64' here. When we need convservation of values we can use a -- we use an 'Int64' here. When we need convservation of values we can use a
-- different system of units with a Fixed precision. -- different system of units with a Fixed precision.
--
-------------------------------------------------------------------------------
-- Integral Units
-------------------------------------------------------------------------------
-- | An 'Int64' time representation with a nanosecond resolution. It can -- | An 'Int64' time representation with a nanosecond resolution. It can
-- represent time up to ~292 years. -- represent time up to ~292 years.
newtype NanoSecond64 = NanoSecond64 Int64 newtype NanoSecond64 = NanoSecond64 Int64
@ -115,6 +133,10 @@ newtype MilliSecond64 = MilliSecond64 Int64
, Ord , Ord
) )
-------------------------------------------------------------------------------
-- Fractional Units
-------------------------------------------------------------------------------
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- TimeSpec representation -- TimeSpec representation
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
@ -403,3 +425,47 @@ diffAbsTime (AbsTime t1) (AbsTime t2) = RelTime (t1 - t2)
{-# INLINE addToAbsTime #-} {-# INLINE addToAbsTime #-}
addToAbsTime :: AbsTime -> RelTime -> AbsTime addToAbsTime :: AbsTime -> RelTime -> AbsTime
addToAbsTime (AbsTime t1) (RelTime t2) = AbsTime $ t1 + t2 addToAbsTime (AbsTime t1) (RelTime t2) = AbsTime $ t1 + t2
-------------------------------------------------------------------------------
-- Formatting and printing
-------------------------------------------------------------------------------
-- | Convert nanoseconds to a string showing time in an appropriate unit.
showNanoSecond64 :: NanoSecond64 -> String
showNanoSecond64 time@(NanoSecond64 ns)
| time < 0 = '-' : showNanoSecond64 (-time)
| ns < 1000 = fromIntegral ns `with` "ns"
#ifdef mingw32_HOST_OS
| ns < 1000000 = (fromIntegral ns / 1000) `with` "us"
#else
| ns < 1000000 = (fromIntegral ns / 1000) `with` "μs"
#endif
| ns < 1000000000 = (fromIntegral ns / 1000000) `with` "ms"
| ns < (60 * 1000000000) = (fromIntegral ns / 1000000000) `with` "s"
| ns < (60 * 60 * 1000000000) =
(fromIntegral ns / (60 * 1000000000)) `with` "min"
| ns < (24 * 60 * 60 * 1000000000) =
(fromIntegral ns / (60 * 60 * 1000000000)) `with` "hr"
| ns < (365 * 24 * 60 * 60 * 1000000000) =
(fromIntegral ns / (24 * 60 * 60 * 1000000000)) `with` "days"
| otherwise =
(fromIntegral ns / (365 * 24 * 60 * 60 * 1000000000)) `with` "years"
where with (t :: Double) (u :: String)
| t >= 1e9 = printf "%.4g %s" t u
| t >= 1e3 = printf "%.0f %s" t u
| t >= 1e2 = printf "%.1f %s" t u
| t >= 1e1 = printf "%.2f %s" t u
| otherwise = printf "%.3f %s" t u
-- In general we should be able to show the time in a specified unit, if we
-- omit the unit we can show it in an automatically chosen one.
{-
data UnitName =
Nano
| Micro
| Milli
| Sec
-}
showRelTime64 :: RelTime64 -> String
showRelTime64 = showNanoSecond64 . fromRelTime64