on 1.2.0.0 help sign in
40 lines 1.1 kB history raw
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# OPTIONS_GHC -fno-warn-orphans #-}
5module Main (main) where
7import Prelude ()
8import Prelude.Compat
10import Control.DeepSeq
11import Control.Monad
12import Data.Time.Clock
13import System.Environment (getArgs)
14import Text.JSON
16instance NFData JSValue where
17 rnf JSNull = ()
18 rnf (JSBool b) = rnf b
19 rnf (JSRational b r) = rnf b `seq` rnf r `seq` ()
20 rnf (JSString s) = rnf (fromJSString s)
21 rnf (JSArray vs) = rnf vs
22 rnf (JSObject kvs) = rnf (fromJSObject kvs)
24main :: IO ()
25main = do
26 (cnt:args) <- getArgs
27 let count = read cnt :: Int
28 forM_ args $ \arg -> do
29 putStrLn $ arg ++ ":"
30 start <- getCurrentTime
31 let loop !good !bad
32 | good+bad >= count = return (good, bad)
33 | otherwise = do
34 s <- readFile arg
35 case decodeStrict s of
36 Ok (_::JSValue) -> loop (good+1) 0
37 _ -> loop 0 (bad+1)
38 (good, _) <- loop 0 0
39 end <- getCurrentTime
40 putStrLn $ " " ++ show good ++ " good, " ++ show (diffUTCTime end start)