{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
module Bench.Consensus.ChainSyncClient.Driver (mainWith) where
import Control.Monad (when)
import qualified Data.Array.IO as UA
import Data.Int (Int64)
import Data.Time.Clock (diffTimeToPicoseconds)
import qualified Data.Time.Clock.System as SysTime
import qualified Data.Time.Clock.TAI as TAI
import Data.Word (Word32)
import System.Environment (getArgs)
import Text.Read (readMaybe)
newtype X = X Int64
{-# INLINE mainWith #-}
mainWith :: (Int64 -> IO ()) -> IO ()
mainWith :: (Int64 -> IO ()) -> IO ()
mainWith Int64 -> IO ()
fut = do
xx <- IO [String]
getArgs IO [String] -> ([String] -> IO (X, X)) -> IO (X, X)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[String
loStr, String
hiStr]
| Just Int64
lo <- String -> Maybe Int64
forall a. Read a => String -> Maybe a
readMaybe String
loStr
, Just Int64
hi <- String -> Maybe Int64
forall a. Read a => String -> Maybe a
readMaybe String
hiStr
-> (X, X) -> IO (X, X)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> X
X Int64
lo, Int64 -> X
X Int64
hi)
[String]
_ -> String -> IO (X, X)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Pass min and max index as arguments $1 and $2"
let zz@(!lo, !hi) = mkMeasurementIndexInterval xx
varStarts <- newTimeArray_ zz
varStops <- newTimeArray_ zz
let go !MeasurementIndex
z = do
TimeArray -> MeasurementIndex -> IO ()
recordTimeArray TimeArray
varStarts MeasurementIndex
z
let X Int64
i = (X, RepetitionIndex) -> X
forall a b. (a, b) -> a
fst ((X, RepetitionIndex) -> X) -> (X, RepetitionIndex) -> X
forall a b. (a -> b) -> a -> b
$ MeasurementIndex -> (X, RepetitionIndex)
coords MeasurementIndex
z in Int64 -> IO ()
fut Int64
i
TimeArray -> MeasurementIndex -> IO ()
recordTimeArray TimeArray
varStops MeasurementIndex
z
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MeasurementIndex
z MeasurementIndex -> MeasurementIndex -> Bool
forall a. Ord a => a -> a -> Bool
< MeasurementIndex
hi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MeasurementIndex -> IO ()
go (MeasurementIndex -> MeasurementIndex
incrMeasurementIndex MeasurementIndex
z)
go lo
render varStarts varStops zz
newtype RepetitionIndex = RepetitionIndex Int64
newtype MeasurementIndex = MeasurementIndex Int64
deriving (MeasurementIndex -> MeasurementIndex -> Bool
(MeasurementIndex -> MeasurementIndex -> Bool)
-> (MeasurementIndex -> MeasurementIndex -> Bool)
-> Eq MeasurementIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MeasurementIndex -> MeasurementIndex -> Bool
== :: MeasurementIndex -> MeasurementIndex -> Bool
$c/= :: MeasurementIndex -> MeasurementIndex -> Bool
/= :: MeasurementIndex -> MeasurementIndex -> Bool
Eq, Eq MeasurementIndex
Eq MeasurementIndex =>
(MeasurementIndex -> MeasurementIndex -> Ordering)
-> (MeasurementIndex -> MeasurementIndex -> Bool)
-> (MeasurementIndex -> MeasurementIndex -> Bool)
-> (MeasurementIndex -> MeasurementIndex -> Bool)
-> (MeasurementIndex -> MeasurementIndex -> Bool)
-> (MeasurementIndex -> MeasurementIndex -> MeasurementIndex)
-> (MeasurementIndex -> MeasurementIndex -> MeasurementIndex)
-> Ord MeasurementIndex
MeasurementIndex -> MeasurementIndex -> Bool
MeasurementIndex -> MeasurementIndex -> Ordering
MeasurementIndex -> MeasurementIndex -> MeasurementIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MeasurementIndex -> MeasurementIndex -> Ordering
compare :: MeasurementIndex -> MeasurementIndex -> Ordering
$c< :: MeasurementIndex -> MeasurementIndex -> Bool
< :: MeasurementIndex -> MeasurementIndex -> Bool
$c<= :: MeasurementIndex -> MeasurementIndex -> Bool
<= :: MeasurementIndex -> MeasurementIndex -> Bool
$c> :: MeasurementIndex -> MeasurementIndex -> Bool
> :: MeasurementIndex -> MeasurementIndex -> Bool
$c>= :: MeasurementIndex -> MeasurementIndex -> Bool
>= :: MeasurementIndex -> MeasurementIndex -> Bool
$cmax :: MeasurementIndex -> MeasurementIndex -> MeasurementIndex
max :: MeasurementIndex -> MeasurementIndex -> MeasurementIndex
$cmin :: MeasurementIndex -> MeasurementIndex -> MeasurementIndex
min :: MeasurementIndex -> MeasurementIndex -> MeasurementIndex
Ord, Ord MeasurementIndex
Ord MeasurementIndex =>
((MeasurementIndex, MeasurementIndex) -> [MeasurementIndex])
-> ((MeasurementIndex, MeasurementIndex)
-> MeasurementIndex -> Int)
-> ((MeasurementIndex, MeasurementIndex)
-> MeasurementIndex -> Int)
-> ((MeasurementIndex, MeasurementIndex)
-> MeasurementIndex -> Bool)
-> ((MeasurementIndex, MeasurementIndex) -> Int)
-> ((MeasurementIndex, MeasurementIndex) -> Int)
-> Ix MeasurementIndex
(MeasurementIndex, MeasurementIndex) -> Int
(MeasurementIndex, MeasurementIndex) -> [MeasurementIndex]
(MeasurementIndex, MeasurementIndex) -> MeasurementIndex -> Bool
(MeasurementIndex, MeasurementIndex) -> MeasurementIndex -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (MeasurementIndex, MeasurementIndex) -> [MeasurementIndex]
range :: (MeasurementIndex, MeasurementIndex) -> [MeasurementIndex]
$cindex :: (MeasurementIndex, MeasurementIndex) -> MeasurementIndex -> Int
index :: (MeasurementIndex, MeasurementIndex) -> MeasurementIndex -> Int
$cunsafeIndex :: (MeasurementIndex, MeasurementIndex) -> MeasurementIndex -> Int
unsafeIndex :: (MeasurementIndex, MeasurementIndex) -> MeasurementIndex -> Int
$cinRange :: (MeasurementIndex, MeasurementIndex) -> MeasurementIndex -> Bool
inRange :: (MeasurementIndex, MeasurementIndex) -> MeasurementIndex -> Bool
$crangeSize :: (MeasurementIndex, MeasurementIndex) -> Int
rangeSize :: (MeasurementIndex, MeasurementIndex) -> Int
$cunsafeRangeSize :: (MeasurementIndex, MeasurementIndex) -> Int
unsafeRangeSize :: (MeasurementIndex, MeasurementIndex) -> Int
UA.Ix)
samplesPerX :: Int64
samplesPerX :: Int64
samplesPerX = Int64
1000
mkMeasurementIndexInterval :: (X, X) -> (MeasurementIndex, MeasurementIndex)
mkMeasurementIndexInterval :: (X, X) -> (MeasurementIndex, MeasurementIndex)
mkMeasurementIndexInterval (X Int64
lo, X Int64
hi) =
( Int64 -> MeasurementIndex
MeasurementIndex (Int64 -> Int64
firstSample Int64
lo)
, Int64 -> MeasurementIndex
MeasurementIndex (Int64 -> Int64
firstSample (Int64
hi Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
)
where
firstSample :: Int64 -> Int64
firstSample Int64
x = Int64
samplesPerX Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
x
coords :: MeasurementIndex -> (X, RepetitionIndex)
coords :: MeasurementIndex -> (X, RepetitionIndex)
coords (MeasurementIndex Int64
z) =
(Int64 -> X
X Int64
q, Int64 -> RepetitionIndex
RepetitionIndex Int64
r)
where
(Int64
q, Int64
r) = Int64
z Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
samplesPerX
incrMeasurementIndex :: MeasurementIndex -> MeasurementIndex
incrMeasurementIndex :: MeasurementIndex -> MeasurementIndex
incrMeasurementIndex (MeasurementIndex Int64
z) = Int64 -> MeasurementIndex
MeasurementIndex (Int64 -> MeasurementIndex) -> Int64 -> MeasurementIndex
forall a b. (a -> b) -> a -> b
$ Int64
z Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1
render :: TimeArray -> TimeArray -> (MeasurementIndex, MeasurementIndex) -> IO ()
render :: TimeArray
-> TimeArray -> (MeasurementIndex, MeasurementIndex) -> IO ()
render TimeArray
varStarts TimeArray
varStops (MeasurementIndex, MeasurementIndex)
zz = do
String -> IO ()
putStrLn String
"# Uuid RelativeSample Index Nanoseconds"
(MeasurementIndex -> IO ()) -> [MeasurementIndex] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MeasurementIndex -> IO ()
each ((MeasurementIndex, MeasurementIndex) -> [MeasurementIndex]
forall a. Ix a => (a, a) -> [a]
UA.range (MeasurementIndex, MeasurementIndex)
zz)
where
each :: MeasurementIndex -> IO ()
each MeasurementIndex
z = do
let (X Int64
x, RepetitionIndex Int64
y) = MeasurementIndex -> (X, RepetitionIndex)
coords MeasurementIndex
z
start <- TimeArray -> MeasurementIndex -> IO SystemTime
readTimeArray TimeArray
varStarts MeasurementIndex
z
stop <- readTimeArray varStops z
let dur = SystemTime
stop SystemTime -> SystemTime -> Integer
`diffPico` SystemTime
start
putStrLn $ unwords [let MeasurementIndex i = z in show i, show y, show x, show dur]
data TimeArray = TimeArray !(UA.IOUArray MeasurementIndex Int64) !(UA.IOUArray MeasurementIndex Word32)
newTimeArray_ :: (MeasurementIndex, MeasurementIndex) -> IO TimeArray
newTimeArray_ :: (MeasurementIndex, MeasurementIndex) -> IO TimeArray
newTimeArray_ (MeasurementIndex, MeasurementIndex)
zz = do
seconds <- (MeasurementIndex, MeasurementIndex)
-> IO (IOUArray MeasurementIndex Int64)
forall i. Ix i => (i, i) -> IO (IOUArray i Int64)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
UA.newArray_ (MeasurementIndex, MeasurementIndex)
zz
nanos <- UA.newArray_ zz
pure $ TimeArray seconds nanos
{-# INLINE recordTimeArray #-}
recordTimeArray :: TimeArray -> MeasurementIndex -> IO ()
recordTimeArray :: TimeArray -> MeasurementIndex -> IO ()
recordTimeArray TimeArray
tarr = \MeasurementIndex
z -> do
tm <- IO SystemTime
SysTime.getSystemTime
let SysTime.MkSystemTime {
SysTime.systemSeconds = a
, SysTime.systemNanoseconds = b
} = tm
UA.writeArray seconds z a
UA.writeArray nanos z b
where
TimeArray IOUArray MeasurementIndex Int64
seconds IOUArray MeasurementIndex Word32
nanos = TimeArray
tarr
readTimeArray :: TimeArray -> MeasurementIndex -> IO SysTime.SystemTime
readTimeArray :: TimeArray -> MeasurementIndex -> IO SystemTime
readTimeArray TimeArray
tarr = \MeasurementIndex
z -> do
a <- IOUArray MeasurementIndex Int64 -> MeasurementIndex -> IO Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
UA.readArray IOUArray MeasurementIndex Int64
seconds MeasurementIndex
z
b <- UA.readArray nanos z
pure SysTime.MkSystemTime {
SysTime.systemSeconds = a
, SysTime.systemNanoseconds = b
}
where
TimeArray IOUArray MeasurementIndex Int64
seconds IOUArray MeasurementIndex Word32
nanos = TimeArray
tarr
diffPico :: SysTime.SystemTime -> SysTime.SystemTime -> Integer
diffPico :: SystemTime -> SystemTime -> Integer
diffPico SystemTime
stop SystemTime
start =
DiffTime -> Integer
diffTimeToPicoseconds (DiffTime -> Integer) -> DiffTime -> Integer
forall a b. (a -> b) -> a -> b
$ AbsoluteTime
stop' AbsoluteTime -> AbsoluteTime -> DiffTime
`TAI.diffAbsoluteTime` AbsoluteTime
start'
where
stop' :: AbsoluteTime
stop' = SystemTime -> AbsoluteTime
SysTime.systemToTAITime SystemTime
stop
start' :: AbsoluteTime
start' = SystemTime -> AbsoluteTime
SysTime.systemToTAITime SystemTime
start