{-# LANGUAGE OverloadedStrings #-}

  Copyright ( C ) 2010 - 2011   <  >
--
  Licensed under the Apache License , Version 2.0 ( the " License " ) ;
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     -2.0
--
-- Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an " AS IS " BASIS ,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

module Main (benchmarks, main) where

import Criterion.Types
import Data.Word (Word32)
import Unsafe.Coerce (unsafeCoerce)
import qualified Criterion.Main

import DBus

serial :: Word32 -> Serial
serial = unsafeCoerce -- FIXME: should the Serial constructor be exposed to
                      -- clients?

empty_MethodCall :: MethodCall
empty_MethodCall = methodCall "/" "org.i" "m"

empty_MethodReturn :: MethodReturn
empty_MethodReturn = methodReturn (serial 0)

benchMarshal :: Message msg => String -> msg -> Benchmark
benchMarshal name msg = bench name (whnf (marshal LittleEndian (serial 0)) msg)

benchUnmarshal :: Message msg => String -> msg -> Benchmark
benchUnmarshal name msg = bench name (whnf unmarshal bytes) where
    Right bytes = marshal LittleEndian (serial 0) msg

parseSig :: String -> Maybe Signature
parseSig = parseSignature

benchmarks :: [Benchmark]
benchmarks =
    [  bgroup "Types"
        [ bgroup "Signature"
            [ bench "parseSignature/small" (nf parseSig "y")
            , bench "parseSignature/medium" (nf parseSig "yyyyuua(yv)")
            , bench "parseSignature/large" (nf parseSig "a{s(asiiiiasa(siiia{s(iiiiv)}))}")
            ]
        , bgroup "ObjectPath"
            [ bench "objectPath_/small" (nf objectPath_ "/")
            , bench "objectPath_/medium" (nf objectPath_ "/foo/bar")
            , bench "objectPath_/large" (nf objectPath_ "/f0OO/b4R/baz_qux/blahblahblah")
            ]
        , bgroup "InterfaceName"
            [ bench "interfaceName_/small" (nf interfaceName_ "f.b")
            , bench "interfaceName_/medium" (nf interfaceName_ "foo.bar.baz")
            , bench "interfaceName_/large" (nf interfaceName_ "f0OOO.b4R.baz_qux.blahblahblah")
            ]
        , bgroup "MemberName"
            [ bench "memberName_/small" (nf memberName_ "f")
            , bench "memberName_/medium" (nf memberName_ "FooBar")
            , bench "memberName_/large" (nf memberName_ "f0OOOb4RBazQuxBlahBlahBlah")
            ]
        , bgroup "ErrorName"
            [ bench "errorName_/small" (nf errorName_ "f.b")
            , bench "errorName_/medium" (nf errorName_ "foo.bar.baz")
            , bench "errorName_/large" (nf errorName_ "f0OOO.b4R.baz_qux.blahblahblah")
            ]
        , bgroup "BusName"
            [ bench "busName_/small" (nf busName_ "f.b")
            , bench "busName_/medium" (nf busName_ "foo.bar.baz")
            , bench "busName_/large" (nf busName_ "f0OOO.b4R.baz-qux.blahblahblah")
            ]
        ]
    ,  bgroup "Marshal"
        [ benchMarshal "MethodCall/empty" empty_MethodCall
        , benchMarshal "MethodReturn/empty" empty_MethodReturn
        ]
    , bgroup "Unmarshal"
        [ benchUnmarshal "MethodCall/empty" empty_MethodCall
        , benchUnmarshal "MethodReturn/empty" empty_MethodReturn
        ]
    ]

main :: IO ()
main = Criterion.Main.defaultMain benchmarks

# LANGUAGE OverloadedStrings #

 you may not use this file except in compliance with the License.
 You may obtain a copy of the License at

     -2.0

 Unless required by applicable law or agreed to in writing, software
 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 See the License for the specific language governing permissions and
 limitations under the License.
 FIXME: should the Serial constructor be exposed to
 clients?

  Copyright ( C ) 2010 - 2011   <  >
  Licensed under the Apache License , Version 2.0 ( the " License " ) ;
  distributed under the License is distributed on an " AS IS " BASIS ,

module Main (benchmarks, main) where

import Criterion.Types
import Data.Word (Word32)
import Unsafe.Coerce (unsafeCoerce)
import qualified Criterion.Main

import DBus

serial :: Word32 -> Serial

empty_MethodCall :: MethodCall
empty_MethodCall = methodCall "/" "org.i" "m"

empty_MethodReturn :: MethodReturn
empty_MethodReturn = methodReturn (serial 0)

benchMarshal :: Message msg => String -> msg -> Benchmark
benchMarshal name msg = bench name (whnf (marshal LittleEndian (serial 0)) msg)

benchUnmarshal :: Message msg => String -> msg -> Benchmark
benchUnmarshal name msg = bench name (whnf unmarshal bytes) where
    Right bytes = marshal LittleEndian (serial 0) msg

parseSig :: String -> Maybe Signature
parseSig = parseSignature

benchmarks :: [Benchmark]
benchmarks =
    [  bgroup "Types"
        [ bgroup "Signature"
            [ bench "parseSignature/small" (nf parseSig "y")
            , bench "parseSignature/medium" (nf parseSig "yyyyuua(yv)")
            , bench "parseSignature/large" (nf parseSig "a{s(asiiiiasa(siiia{s(iiiiv)}))}")
            ]
        , bgroup "ObjectPath"
            [ bench "objectPath_/small" (nf objectPath_ "/")
            , bench "objectPath_/medium" (nf objectPath_ "/foo/bar")
            , bench "objectPath_/large" (nf objectPath_ "/f0OO/b4R/baz_qux/blahblahblah")
            ]
        , bgroup "InterfaceName"
            [ bench "interfaceName_/small" (nf interfaceName_ "f.b")
            , bench "interfaceName_/medium" (nf interfaceName_ "foo.bar.baz")
            , bench "interfaceName_/large" (nf interfaceName_ "f0OOO.b4R.baz_qux.blahblahblah")
            ]
        , bgroup "MemberName"
            [ bench "memberName_/small" (nf memberName_ "f")
            , bench "memberName_/medium" (nf memberName_ "FooBar")
            , bench "memberName_/large" (nf memberName_ "f0OOOb4RBazQuxBlahBlahBlah")
            ]
        , bgroup "ErrorName"
            [ bench "errorName_/small" (nf errorName_ "f.b")
            , bench "errorName_/medium" (nf errorName_ "foo.bar.baz")
            , bench "errorName_/large" (nf errorName_ "f0OOO.b4R.baz_qux.blahblahblah")
            ]
        , bgroup "BusName"
            [ bench "busName_/small" (nf busName_ "f.b")
            , bench "busName_/medium" (nf busName_ "foo.bar.baz")
            , bench "busName_/large" (nf busName_ "f0OOO.b4R.baz-qux.blahblahblah")
            ]
        ]
    ,  bgroup "Marshal"
        [ benchMarshal "MethodCall/empty" empty_MethodCall
        , benchMarshal "MethodReturn/empty" empty_MethodReturn
        ]
    , bgroup "Unmarshal"
        [ benchUnmarshal "MethodCall/empty" empty_MethodCall
        , benchUnmarshal "MethodReturn/empty" empty_MethodReturn
        ]
    ]

main :: IO ()
main = Criterion.Main.defaultMain benchmarks
