damnpacket-0.1.0.0: benchmarks/parse.hs

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}

import Control.Exception (evaluate)
import Criterion.Main
import Text.Damn.Packet
import Data.Map          (fromList)
import Data.Monoid
import Data.Text         (Text)

main :: IO ()
main = do
    let mypkt = samplePacket
    evaluate mypkt
    defaultMain [
          bench "phony"            $ nf parse ""
        , bench "cmd"              $ nf parse cmd
        , bench "cmdParam"         $ nf parse cmdParam
        , bench "cmdArgs"          $ nf parse cmdArgs
        , bench "cmdParamArgs"     $ nf parse cmdParamArgs
        , bench "cmdBody"          $ nf parse cmdBody
        , bench "cmdParamBody"     $ nf parse cmdParamBody
        , bench "cmdArgsBody"      $ nf parse cmdArgsBody
        , bench "cmdParamArgsBody" $ nf parse cmdParamArgsBody
        , bench "render"           $ nf render mypkt
      ]

cmd, cmdParam, cmdArgs, cmdParamArgs,
    cmdBody, cmdParamBody, cmdArgsBody, cmdParamArgsBody :: Text
cmd = "ping"
cmdParam = "ping foobar"
cmdArgs = "ping\nfoo=bar\nbaz=qux"
cmdParamArgs = "ping foobar\nfoo=bar\nbaz=qux"
cmdBody = cmd <> "\n\nfoobar"
cmdParamBody = cmdParam <> "\n\nfoobar"
cmdArgsBody = cmdArgs <> "\n\nfoobar"
cmdParamArgsBody = cmdParamArgs <> "\n\nfoobar"

samplePacket :: Packet
samplePacket = Packet { pktCommand = "property"
                      , pktParameter = Just "chat:WriteRoom"
                      , pktArgs = fromList [("p", "title"), ("body", "someBody")]
                      , pktBody = Just "this is the property"
                      }