mirror of
https://github.com/composewell/streamly.git
synced 2024-10-27 12:12:05 +03:00
Move time formatting routines in the Time module
This commit is contained in:
parent
06a827f826
commit
34edd618b0
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user