From 6f129e331db6741e8800eac73b47dd9f3d85a91e Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Fri, 13 May 2016 16:15:03 +0200
Subject: [PATCH] Benchmarking

---
 bench/Main.hs      | 42 ++++++++++++++++++++++++++++++++++++++++++
 bench/wrk.lua      |  7 +++++++
 lib/Servant/Ekg.hs |  6 ++++--
 servant-ekg.cabal  | 15 +++++++++++++++
 4 files changed, 68 insertions(+), 2 deletions(-)
 create mode 100644 bench/Main.hs
 create mode 100644 bench/wrk.lua

diff --git a/bench/Main.hs b/bench/Main.hs
new file mode 100644
index 0000000..e9f42fe
--- /dev/null
+++ b/bench/Main.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE PolyKinds            #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeOperators        #-}
+module Main (main) where
+
+import           Control.Concurrent
+import           Data.Text                (Text)
+import           Network.Wai              (Application)
+import           Network.Wai.Handler.Warp
+import           Servant
+import           Servant.Ekg
+import           System.Metrics
+import           System.Process
+
+
+type BenchApi = "hello" :> Capture "name" Text :> Get '[JSON] Text
+
+benchApi :: Proxy BenchApi
+benchApi = Proxy
+
+server :: Server BenchApi
+server = return
+
+servantEkgServer :: IO Application
+servantEkgServer = do
+  store <- newStore
+  ms <- newMVar mempty
+  return $ monitorEndpoints benchApi store ms (serve benchApi server)
+
+benchApp :: IO Application -> IO ()
+benchApp app = withApplication app $ \port ->
+  callCommand $ "wrk -c 2 -d 10s -s bench/wrk.lua -t 2 'http://localhost:" ++ show port ++ "'"
+
+main :: IO ()
+main = do
+  putStrLn "Benchmarking servant-ekg"
+  benchApp servantEkgServer
+  putStrLn "Benchmarking without servant-ekg"
+  benchApp . return $ serve benchApi server
diff --git a/bench/wrk.lua b/bench/wrk.lua
new file mode 100644
index 0000000..ed19231
--- /dev/null
+++ b/bench/wrk.lua
@@ -0,0 +1,7 @@
+counter = 0
+
+request = function()
+   path = "/hello/" .. counter
+   counter = counter + 1
+   return wrk.format(nil, path)
+end
diff --git a/lib/Servant/Ekg.hs b/lib/Servant/Ekg.hs
index 40a70f9..f1845e8 100644
--- a/lib/Servant/Ekg.hs
+++ b/lib/Servant/Ekg.hs
@@ -103,7 +103,8 @@ instance (HasEndpoint (a :: *), HasEndpoint (b :: *)) => HasEndpoint (a :<|> b)
         getEndpoint (Proxy :: Proxy a) req `mplus`
         getEndpoint (Proxy :: Proxy b) req
 
-instance (KnownSymbol (path :: Symbol), HasEndpoint (sub :: *)) => HasEndpoint (path :> sub) where
+instance (KnownSymbol (path :: Symbol), HasEndpoint (sub :: *))
+    => HasEndpoint (path :> sub) where
     getEndpoint _ req =
         case pathInfo req of
             p:ps | p == T.pack (symbolVal (Proxy :: Proxy path)) -> do
@@ -111,7 +112,8 @@ instance (KnownSymbol (path :: Symbol), HasEndpoint (sub :: *)) => HasEndpoint (
                 return (p:end, method)
             _ -> Nothing
 
-instance (KnownSymbol (capture :: Symbol), HasEndpoint (sub :: *)) => HasEndpoint (Capture capture a :> sub) where
+instance (KnownSymbol (capture :: Symbol), HasEndpoint (sub :: *))
+    => HasEndpoint (Capture capture a :> sub) where
     getEndpoint _ req =
         case pathInfo req of
             _:ps -> do
diff --git a/servant-ekg.cabal b/servant-ekg.cabal
index 95a7c64..62cf5ad 100644
--- a/servant-ekg.cabal
+++ b/servant-ekg.cabal
@@ -47,3 +47,18 @@ test-suite spec
                     , hspec == 2.*
                     , unordered-containers
                     , transformers
+
+executable bench
+  hs-source-dirs: bench
+  main-is: Main.hs
+  ghc-options: -Wall -threaded -O2
+  build-depends:      base == 4.*
+                    , aeson
+                    , ekg
+                    , ekg-core
+                    , servant-ekg
+                    , servant-server
+                    , text
+                    , wai
+                    , warp >= 3.2.4 && < 3.3
+                    , process