Browse Source

Review fixes.

Julian K. Arni 9 years ago
parent
commit
c7dcdcd39f

+ 2 - 2
frameworks/Haskell/servant/benchmark_config.json

@@ -12,8 +12,8 @@
       "port": 7041,
       "port": 7041,
       "approach": "Realistic",
       "approach": "Realistic",
       "classification": "Micro",
       "classification": "Micro",
-      "database": "None",
-      "framework": "servant",
+      "database": "Postgres",
+      "framework": "None",
       "language": "Haskell",
       "language": "Haskell",
       "orm": "Raw",
       "orm": "Raw",
       "platform": "Wai",
       "platform": "Wai",

+ 1 - 0
frameworks/Haskell/servant/servant-bench.cabal

@@ -33,6 +33,7 @@ library
                      , transformers
                      , transformers
                      , text == 1.2.*
                      , text == 1.2.*
                      , contravariant == 1.4.*
                      , contravariant == 1.4.*
+                     , http-media == 0.6.*
   hs-source-dirs:      src
   hs-source-dirs:      src
   default-language:    Haskell2010
   default-language:    Haskell2010
 
 

+ 10 - 4
frameworks/Haskell/servant/src/ServantBench.hs

@@ -27,6 +27,7 @@ import qualified Hasql.Query                as Hasql
 import           Hasql.Session              (query)
 import           Hasql.Session              (query)
 import           Lucid
 import           Lucid
 import qualified Network.Wai.Handler.Warp   as Warp
 import qualified Network.Wai.Handler.Warp   as Warp
+import           Network.HTTP.Media         ((//))
 import           Servant
 import           Servant
 import           Servant.HTML.Lucid         (HTML)
 import           Servant.HTML.Lucid         (HTML)
 import           System.Random.MWC          (GenIO, createSystemRandom,
 import           System.Random.MWC          (GenIO, createSystemRandom,
@@ -38,7 +39,7 @@ type API =
   :<|> "queries" :> QueryParam "queries" Int :> Get '[JSON] [World]
   :<|> "queries" :> QueryParam "queries" Int :> Get '[JSON] [World]
   :<|> "fortune" :> Get '[HTML] (Html ())
   :<|> "fortune" :> Get '[HTML] (Html ())
   :<|> "updates" :> QueryParam "queries" Int :> Get '[JSON] [World]
   :<|> "updates" :> QueryParam "queries" Int :> Get '[JSON] [World]
-  :<|> "plaintext" :> Get '[PlainText] ByteString
+  :<|> "plaintext" :> Get '[Plain] ByteString
 
 
 api :: Proxy API
 api :: Proxy API
 api = Proxy
 api = Proxy
@@ -61,9 +62,6 @@ run port dbSettings = do
     halfSecond = 0.5
     halfSecond = 0.5
     settings = (30, halfSecond, dbSettings)
     settings = (30, halfSecond, dbSettings)
 
 
-instance MimeRender PlainText ByteString where
-  mimeRender _ = id
-  {-# INLINE mimeRender #-}
 
 
 data World = World { wId :: !Int32 , wRandomNumber :: !Int32 }
 data World = World { wId :: !Int32 , wRandomNumber :: !Int32 }
   deriving (Show, Generic)
   deriving (Show, Generic)
@@ -88,6 +86,14 @@ intValEnc = HasqlEnc.value HasqlEnc.int4
 intValDec :: HasqlDec.Row Int32
 intValDec :: HasqlDec.Row Int32
 intValDec = HasqlDec.value HasqlDec.int4
 intValDec = HasqlDec.value HasqlDec.int4
 
 
+-- * PlainText without charset
+
+data Plain
+instance Accept Plain where contentType _ = "text" // "plain"
+instance MimeRender Plain ByteString where
+  mimeRender _ = id
+  {-# INLINE mimeRender #-}
+
 ------------------------------------------------------------------------------
 ------------------------------------------------------------------------------
 
 
 -- * Test 1: JSON serialization
 -- * Test 1: JSON serialization