-
Notifications
You must be signed in to change notification settings - Fork 322
/
AesonEncode.hs
47 lines (43 loc) · 1.45 KB
/
AesonEncode.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}
import Control.Exception
import Control.Monad
import Data.Aeson
import Data.Attoparsec (IResult(..), parseWith)
import Data.Char (isDigit)
import Data.Time.Clock
import System.Environment (getArgs)
import System.IO
import qualified Data.ByteString as B
import Control.DeepSeq
#if !MIN_VERSION_bytestring(0,10,0)
import qualified Data.ByteString.Lazy.Internal as L
instance NFData L.ByteString where
rnf = go
where go (L.Chunk _ cs) = go cs
go L.Empty = ()
{-# INLINE rnf #-}
#endif
main :: IO ()
main = do
args0 <- getArgs
let (cnt,args) = case args0 of
(i:c:a) | all isDigit i && all isDigit c -> (c,a)
(c:a) -> (c,a)
let count = read cnt :: Int
forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
putStrLn $ arg ++ ":"
let refill = B.hGet h 16384
result0 <- parseWith refill json =<< refill
r0 <- case result0 of
Done _ r -> return r
_ -> fail $ "failed to read " ++ show arg
start <- getCurrentTime
let loop !n r
| n >= count = return ()
| otherwise = {-# SCC "loop" #-} do
rnf (encode r) `seq` loop (n+1) r
loop 0 r0
delta <- flip diffUTCTime start `fmap` getCurrentTime
let rate = fromIntegral count / realToFrac delta :: Double
putStrLn $ " " ++ cnt ++ " good, " ++ show delta
putStrLn $ " " ++ show (round rate :: Int) ++ " per second"