Generate.hs

module Test.MessagePack.Generate (generate) where

import           Control.Monad                    (when)
import qualified Data.ByteString.Lazy             as L
import           Data.Int                         (Int64)
import           Data.MessagePack.Arbitrary       ()
import           Data.MessagePack.Types           (Object (..))
import           Data.Time.Clock                  (diffUTCTime, getCurrentTime)
import           System.Environment               (getArgs)
import           System.IO                        (hPutStr, hPutStrLn, stderr)
import           Test.QuickCheck.Arbitrary        (arbitrary)
import qualified Test.QuickCheck.Gen              as Gen
import           Test.QuickCheck.Instances.Vector ()
import           Test.QuickCheck.Random           (mkQCGen)


seed :: Int
seed = 33


showBytes :: Int64 -> String
showBytes size
  | size > 10 * (1024 * 1024) = show (size `div` (1024 * 1024)) <> " MiB"
  | size > 10 * 1024 = show (size `div` 1024) <> " KiB"
  | otherwise = show size <> " B"


showSpeed :: Int64 -> Double -> String
showSpeed size time =
    show (fromIntegral size / (1024 * 1024) / time) <> " MiB/s"


generate :: (Object -> L.ByteString) -> IO ()
generate pack = do
    size:_ <- (++[30]) . map read <$> getArgs

    start <- getCurrentTime
    hPutStrLn stderr "Generating sample..."

    let sample@(ObjectArray array) = ObjectArray $ Gen.unGen (Gen.resize size arbitrary) (mkQCGen 0) seed
    when (sample == sample) $  -- force deep evaluation of the whole structure (kind of deepseq)
        hPutStr stderr $ "Generated msgpack array of length " <> show (length array)
    sampleTime <- getCurrentTime
    hPutStrLn stderr $ " in " <> show (diffUTCTime sampleTime start)

    let packed = pack sample
    hPutStr stderr $ "Message packed into " <> showBytes (L.length packed)
    packTime <- getCurrentTime
    hPutStrLn stderr $ " in " <> show (diffUTCTime packTime sampleTime)

    hPutStrLn stderr $ "Packing speed: " <> showSpeed (L.length packed) (realToFrac (diffUTCTime packTime sampleTime))

    L.putStr packed