rere-0.1: bench/JSON.hs

{-# LANGUAGE CPP                 #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main (main, jsonRE, jsonRE', jsonNames, jsonCFG, jsonDerp, derp) where

import Prelude hiding (exponent)

import Criterion.Main (bench, defaultMain, whnf)
import Data.Either    (isRight)
import System.Clock   (Clock (Monotonic), diffTimeSpec, getTime)

import qualified Data.Aeson.Parser          as A
import qualified Data.Attoparsec.ByteString as Atto
import qualified Data.ByteString            as BS
import qualified Data.Set                   as Set
import qualified Text.Derp                  as D

#ifdef MIN_VERSION_saison
import qualified Saison.Decoding.Parser as S
import qualified Saison.Decoding.Tokens as S
#endif

import RERE
import RERE.Examples.JSON

import DerpConv

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<*))
#endif

derp :: D.Parser Char () -> String -> Bool
derp p s = not $ Set.null $ D.runParse p [ D.Token c [c] | c <- s]

aeson :: BS.ByteString -> Bool
aeson bs = isRight (Atto.parseOnly (A.json <* Atto.endOfInput) bs)

#ifdef MIN_VERSION_saison
saison :: BS.ByteString -> Bool
saison = go end . S.tokens where
    end :: BS.ByteString -> Bool
    end = BS.null . S.skipSpace

    go :: (k -> Bool) -> S.Tokens k e -> Bool
    go kont (S.TkLit _ k)        = kont k
    go kont (S.TkText _ k)       = kont k
    go kont (S.TkNumber _ k)     = kont k
    go kont (S.TkArrayOpen arr)  = goArr kont arr
    go kont (S.TkRecordOpen obj) = goObj kont obj
    go _    (S.TkErr _)          = False

    goArr :: (k -> Bool) -> S.TkArray k e -> Bool
    goArr kont (S.TkItem k)     = go (goArr kont) k
    goArr kont (S.TkArrayEnd k) = kont k
    goArr _    (S.TkArrayErr _) = False

    goObj :: (k -> Bool) -> S.TkRecord k e -> Bool
    goObj kont (S.TkPair _ k)    = go (goObj kont) k
    goObj kont (S.TkRecordEnd k) = kont k
    goObj _    (S.TkRecordErr _) = False
#endif

main :: IO ()
main = do
    contents <- readFile    "jsverify.json"
    bs       <- BS.readFile "jsverify.json"

    do
        putStrLn "Ref run"
        start <- getTime Monotonic
        print $ matchR jsonRE contents
        end <- getTime Monotonic
        print $ diffTimeSpec end start

    do
        putStrLn "ST run"
        start <- getTime Monotonic
        print $ matchST jsonRE contents
        end <- getTime Monotonic
        print $ diffTimeSpec end start

--    do
--        putStrLn "derp run"
--        start <- getTime Monotonic
--        print $ derp jsonDerp $ take 0 contents
--        end <- getTime Monotonic
--        print $ diffTimeSpec end start

    putStrLn "Criterion"
    defaultMain
        [ bench "aeson"  $ whnf aeson bs
#ifdef MIN_VERSION_saison
        , bench "saison" $ whnf saison bs
#endif
        -- , bench "rere"  $ whnf (matchR jsonRE) contents
        ]

-------------------------------------------------------------------------------
-- JSON definition
-------------------------------------------------------------------------------

jsonDerp :: D.Parser Char ()
jsonDerp = rere2derp jsonRE