on 1.0.2.0 help sign in
typeable/aeson/benchmarks/AesonEncode.hs
44 lines 1.4 kB history raw
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE OverloadedStrings #-}
4module Main (main) where
6import Prelude ()
7import Prelude.Compat
9import Control.DeepSeq
10import Control.Exception
11import Control.Monad
12import Data.Aeson
13import Data.Attoparsec.ByteString (IResult(..), parseWith)
14import Data.Char (isDigit)
15import Data.Time.Clock
16import System.Environment (getArgs)
17import System.IO
18import qualified Data.ByteString as B
20main :: IO ()
21main = do
22 args0 <- getArgs
23 let (cnt,args) = case args0 of
24 (i:c:a) | all isDigit i && all isDigit c -> (c,a)
25 (c:a) -> (c,a)
26 [] -> error "Unexpected empty list"
27 let count = read cnt :: Int
28 forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
29 putStrLn $ arg ++ ":"
30 let refill = B.hGet h 16384
31 result0 <- parseWith refill json =<< refill
32 r0 <- case result0 of
33 Done _ r -> return r
34 _ -> fail $ "failed to read " ++ show arg
35 start <- getCurrentTime
36 let loop !n r
37 | n >= count = return ()
38 | otherwise = {-# SCC "loop" #-} do
39 rnf (encode r) `seq` loop (n+1) r
40 loop 0 r0
41 delta <- flip diffUTCTime start `fmap` getCurrentTime
42 let rate = fromIntegral count / realToFrac delta :: Double
43 putStrLn $ " " ++ cnt ++ " good, " ++ show delta
44 putStrLn $ " " ++ show (round rate :: Int) ++ " per second"