Merge pull request #381 from haskell-servant/jkarni/default-config-for-serve

Add 'serveWithConfig'.

servant-client/test/Servant/ClientSpec.hs

@@ -115,7 +115,7 @@ api :: Proxy Api
 api = Proxy
 
 server :: Application
-server = serve api EmptyConfig (
+server = serve api (
        return alice
   :<|> return NoContent
   :<|> (\ name -> return $ Person name 0)
@@ -142,7 +142,7 @@ failApi :: Proxy FailApi
 failApi = Proxy
 
 failServer :: Application
-failServer = serve failApi EmptyConfig (
+failServer = serve failApi (
        (\ _request respond -> respond $ responseLBS ok200 [] "")
   :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
   :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
@@ -232,7 +232,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
 
 wrappedApiSpec :: Spec
 wrappedApiSpec = describe "error status codes" $ do
-  let serveW api = serve api EmptyConfig $ throwE $ ServantErr 500 "error message" "" []
+  let serveW api = serve api $ throwE $ ServantErr 500 "error message" "" []
   context "are correctly handled by the client" $
     let test :: (WrappedApi, String) -> Spec
         test (WrappedApi api, desc) =

servant-examples/auth-combinator/auth-combinator.hs

@@ -82,7 +82,7 @@ main :: IO ()
 main = do
   dbConnection <- initDB
   let config = dbConnection :. EmptyConfig
-  run 8080 (serve api config server)
+  run 8080 (serveWithConfig api config server)
 
 {- Sample session:
 $ curl http://localhost:8080/

servant-examples/socket-io-chat/socket-io-chat.hs

@@ -38,7 +38,7 @@ server sHandler = socketIOHandler
 
 
 app :: WaiMonad () -> Application
-app sHandler = serve api EmptyConfig $ server sHandler
+app sHandler = serve api $ server sHandler
 
 port :: Int
 port = 3001

servant-examples/tutorial/T1.hs

@@ -42,4 +42,4 @@ server :: Server UserAPI
 server = return users
 
 app :: Application
-app = serve userAPI EmptyConfig server
+app = serve userAPI server

servant-examples/tutorial/T10.hs

@@ -68,4 +68,4 @@ server = T3.server :<|> serveDocs
         plain = ("Content-Type", "text/plain")
 
 app :: Application
-app = serve api EmptyConfig server
+app = serve api server

servant-examples/tutorial/T2.hs

@@ -49,4 +49,4 @@ server = return users
     :<|> return isaac
 
 app :: Application
-app = serve userAPI EmptyConfig server
+app = serve userAPI server

servant-examples/tutorial/T3.hs

@@ -81,4 +81,4 @@ server = position
         marketing clientinfo = return (emailForClient clientinfo)
 
 app :: Application
-app = serve api EmptyConfig server
+app = serve api server

servant-examples/tutorial/T4.hs

@@ -60,4 +60,4 @@ server :: Server PersonAPI
 server = return persons
 
 app :: Application
-app = serve personAPI EmptyConfig server
+app = serve personAPI server

servant-examples/tutorial/T5.hs

@@ -34,4 +34,4 @@ server = do
   where custom404Err = err404 { errBody = "myfile.txt just isn't there, please leave this server alone." }
 
 app :: Application
-app = serve ioAPI EmptyConfig server
+app = serve ioAPI server

servant-examples/tutorial/T6.hs

@@ -15,4 +15,4 @@ server :: Server API
 server = serveDirectory "tutorial"
 
 app :: Application
-app = serve api EmptyConfig server
+app = serve api server

servant-examples/tutorial/T7.hs

@@ -30,4 +30,4 @@ readerServer = enter readerToEither readerServerT
         readerToEither = Nat $ \r -> return (runReader r "hi")
 
 app :: Application
-app = serve readerAPI EmptyConfig readerServer
+app = serve readerAPI readerServer

servant-examples/tutorial/T9.hs

@@ -102,4 +102,4 @@ writeJSFiles = do
   TIO.writeFile "tutorial/t9/jq.js" jq
 
 app :: Application
-app = serve api' EmptyConfig server'
+app = serve api' server'

servant-examples/wai-middleware/wai-middleware.hs

@@ -45,7 +45,7 @@ server = return products
 -- so applying a middleware is really as simple as
 -- applying a function to the result of 'serve'
 app :: Application
-app = logStdout (serve simpleAPI EmptyConfig server)
+app = logStdout (serve simpleAPI server)
 
 main :: IO ()
 main = run 8080 app

servant-mock/example/main.hs

@@ -20,4 +20,4 @@ api :: Proxy API
 api = Proxy
 
 main :: IO ()
-main = run 8080 (serve api EmptyConfig $ mock api Proxy)
+main = run 8080 (serve api $ mock api Proxy)

servant-mock/src/Servant/Mock.hs

@@ -1,12 +1,12 @@
-{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE CPP                   #-}
-{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PolyKinds           #-}
+{-# LANGUAGE PolyKinds             #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE TypeOperators         #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 #include "overlapping-compat.h"
@@ -67,7 +67,6 @@ import           Network.HTTP.Types.Status
 import           Network.Wai
 import           Servant
 import           Servant.API.ContentTypes
-import           Servant.Server.Internal.Config
 import           Test.QuickCheck.Arbitrary  (Arbitrary (..), vector)
 import           Test.QuickCheck.Gen        (Gen, generate)
 

servant-mock/test/Servant/MockSpec.hs

@@ -52,7 +52,7 @@ spec = do
     context "Get" $ do
       let api :: Proxy (Get '[JSON] Body)
           api = Proxy
-          app = serve api EmptyConfig (mock api Proxy)
+          app = serve api (mock api Proxy)
       with (return app) $ do
         it "serves arbitrary response bodies" $ do
           get "/" `shouldRespondWith` 200{
@@ -65,7 +65,7 @@ spec = do
           withoutHeader :: Proxy (Get '[JSON] (Headers '[] Body))
           withoutHeader = Proxy
           toApp :: (HasMock api '[]) => Proxy api -> IO Application
-          toApp api = return $ serve api EmptyConfig (mock api (Proxy :: Proxy '[]))
+          toApp api = return $ serve api (mock api (Proxy :: Proxy '[]))
       with (toApp withHeader) $ do
         it "serves arbitrary response bodies" $ do
           get "/" `shouldRespondWith` 200{

servant-server/example/greet.hs

@@ -59,7 +59,7 @@ server = helloH :<|> postGreetH :<|> deleteGreetH
 -- Turn the server into a WAI app. 'serve' is provided by servant,
 -- more precisely by the Servant.Server module.
 test :: Application
-test = serve testApi EmptyConfig server
+test = serve testApi server
 
 -- Run the server.
 --

servant-server/src/Servant/Server.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ConstraintKinds   #-}
+{-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies      #-}
@@ -8,6 +9,7 @@
 module Servant.Server
   ( -- * Run a wai application from an API
     serve
+  , serveWithConfig
 
   , -- * Construct a wai Application from an API
     toApplication
@@ -104,18 +106,18 @@ import           Servant.Server.Internal.Enter
 -- > myApi :: Proxy MyApi
 -- > myApi = Proxy
 -- >
--- > config :: Config '[]
--- > config = EmptyConfig
--- >
 -- > app :: Application
--- > app = serve myApi config server
+-- > app = serve myApi server
 -- >
 -- > main :: IO ()
 -- > main = Network.Wai.Handler.Warp.run 8080 app
 --
-serve :: (HasServer layout config)
+serve :: (HasServer layout '[]) => Proxy layout -> Server layout -> Application
+serve p = serveWithConfig p EmptyConfig
+
+serveWithConfig :: (HasServer layout config)
     => Proxy layout -> Config config -> Server layout -> Application
-serve p config server = toApplication (runRouter (route p config d))
+serveWithConfig p config server = toApplication (runRouter (route p config d))
   where
     d = Delayed r r r (\ _ _ -> Route server)
     r = return (Route ())

servant-server/src/Servant/Server/Internal/RoutingApplication.hs

@@ -11,14 +11,8 @@ module Servant.Server.Internal.RoutingApplication where
 import           Control.Applicative                ((<$>))
 #endif
 import           Control.Monad.Trans.Except         (ExceptT, runExceptT)
-import qualified Data.ByteString                    as B
-import qualified Data.ByteString.Lazy               as BL
-import           Data.IORef                         (newIORef, readIORef,
-                                                     writeIORef)
 import           Network.Wai                        (Application, Request,
-                                                     Response, ResponseReceived,
+                                                     Response, ResponseReceived)
-                                                     requestBody,
-                                                     strictRequestBody)
 import           Servant.Server.Internal.ServantErr
 
 type RoutingApplication =

servant-server/test/Servant/Server/ErrorSpec.hs

@@ -42,7 +42,7 @@ errorOrderServer = \_ _ -> throwE err402
 
 errorOrderSpec :: Spec
 errorOrderSpec = describe "HTTP error order"
-           $ with (return $ serve errorOrderApi EmptyConfig errorOrderServer) $ do
+           $ with (return $ serve errorOrderApi errorOrderServer) $ do
   let badContentType  = (hContentType, "text/plain")
       badAccept       = (hAccept, "text/plain")
       badMethod       = methodGet
@@ -89,7 +89,7 @@ prioErrorsApi = Proxy
 prioErrorsSpec :: Spec
 prioErrorsSpec = describe "PrioErrors" $ do
   let server = return
-  with (return $ serve prioErrorsApi EmptyConfig server) $ do
+  with (return $ serve prioErrorsApi server) $ do
     let check (mdescr, method) path (cdescr, ctype, body) resp =
           it fulldescr $
             Test.Hspec.Wai.request method path [(hContentType, ctype)] body
@@ -154,7 +154,7 @@ errorRetryServer
 
 errorRetrySpec :: Spec
 errorRetrySpec = describe "Handler search"
-           $ with (return $ serve errorRetryApi EmptyConfig errorRetryServer) $ do
+           $ with (return $ serve errorRetryApi errorRetryServer) $ do
 
   let jsonCT      = (hContentType, "application/json")
       jsonAccept  = (hAccept, "application/json")
@@ -198,7 +198,7 @@ errorChoiceServer = return 0
 
 errorChoiceSpec :: Spec
 errorChoiceSpec = describe "Multiple handlers return errors"
-                $ with (return $ serve errorChoiceApi EmptyConfig errorChoiceServer) $ do
+                $ with (return $ serve errorChoiceApi errorChoiceServer) $ do
 
   it "should respond with 404 if no path matches" $ do
     request methodGet "" [] "" `shouldRespondWith` 404

servant-server/test/Servant/Server/Internal/EnterSpec.hs

@@ -48,12 +48,12 @@ combinedReaderServer = enter fReader combinedReaderServer'
 
 enterSpec :: Spec
 enterSpec = describe "Enter" $ do
-  with (return (serve readerAPI EmptyConfig readerServer)) $ do
+  with (return (serve readerAPI readerServer)) $ do
 
     it "allows running arbitrary monads" $ do
       get "int" `shouldRespondWith` "1797"
       post "string" "3" `shouldRespondWith` "\"hi\""{ matchStatus = 200 }
 
-  with (return (serve combinedAPI EmptyConfig combinedReaderServer)) $ do
+  with (return (serve combinedAPI combinedReaderServer)) $ do
     it "allows combnation of enters" $ do
       get "bool" `shouldRespondWith` "true"

servant-server/test/Servant/Server/UsingConfigSpec.hs

@@ -30,7 +30,7 @@ testServer s = return s
 
 oneEntryApp :: Application
 oneEntryApp =
-  serve (Proxy :: Proxy OneEntryAPI) config testServer
+  serveWithConfig (Proxy :: Proxy OneEntryAPI) config testServer
   where
     config :: Config '[String]
     config = "configEntry" :. EmptyConfig
@@ -40,7 +40,7 @@ type OneEntryTwiceAPI =
   "bar" :> ExtractFromConfig :> Get '[JSON] String
 
 oneEntryTwiceApp :: Application
-oneEntryTwiceApp = serve (Proxy :: Proxy OneEntryTwiceAPI) config $
+oneEntryTwiceApp = serveWithConfig (Proxy :: Proxy OneEntryTwiceAPI) config $
   testServer :<|>
   testServer
   where
@@ -68,7 +68,7 @@ type InjectAPI =
     Get '[JSON] String
 
 injectApp :: Application
-injectApp = serve (Proxy :: Proxy InjectAPI) config $
+injectApp = serveWithConfig (Proxy :: Proxy InjectAPI) config $
   (\ s -> return s) :<|>
   (\ s -> return ("tagged: " ++ s))
   where
@@ -90,7 +90,7 @@ type WithBirdfaceAPI =
     "bar" :> ExtractFromConfig :> Get '[JSON] String
 
 withBirdfaceApp :: Application
-withBirdfaceApp = serve (Proxy :: Proxy WithBirdfaceAPI) config $
+withBirdfaceApp = serveWithConfig (Proxy :: Proxy WithBirdfaceAPI) config $
   testServer :<|>
   testServer
   where
@@ -112,7 +112,7 @@ type NamedConfigAPI =
     ExtractFromConfig :> Get '[JSON] String)
 
 namedConfigApp :: Application
-namedConfigApp = serve (Proxy :: Proxy NamedConfigAPI) config return
+namedConfigApp = serveWithConfig (Proxy :: Proxy NamedConfigAPI) config return
   where
     config :: Config '[NamedConfig "sub" '[String]]
     config = NamedConfig ("descend" :. EmptyConfig) :. EmptyConfig

servant-server/test/Servant/ServerSpec.hs

@@ -49,7 +49,7 @@ import           Servant.API                ((:<|>) (..), (:>), Capture, Delete,
                                              StdMethod (..), Verb, addHeader)
 import           Servant.API.Internal.Test.ComprehensiveAPI
 import           Servant.Server             (ServantErr (..), Server, err404,
-                                             serve, Config(EmptyConfig))
+                                             serve, serveWithConfig, Config(EmptyConfig))
 import           Test.Hspec                 (Spec, context, describe, it,
                                              shouldBe, shouldContain)
 import           Test.Hspec.Wai             (get, liftIO, matchHeaders,
@@ -67,7 +67,7 @@ import           Servant.Server.Internal.Config
 -- * comprehensive api test
 
 -- This declaration simply checks that all instances are in place.
-_ = serve comprehensiveAPI comprehensiveApiConfig
+_ = serveWithConfig comprehensiveAPI comprehensiveApiConfig
 
 comprehensiveApiConfig :: Config '[NamedConfig "foo" '[]]
 comprehensiveApiConfig = NamedConfig EmptyConfig :. EmptyConfig
@@ -112,7 +112,7 @@ verbSpec = describe "Servant.API.Verb" $ do
       wrongMethod m = if m == methodPatch then methodPost else methodPatch
       test desc api method (status :: Int) = context desc $
 
-        with (return $ serve api EmptyConfig server) $ do
+        with (return $ serve api server) $ do
 
           -- HEAD and 214/215 need not return bodies
           unless (status `elem` [214, 215] || method == methodHead) $
@@ -187,7 +187,7 @@ captureServer legs = case legs of
 captureSpec :: Spec
 captureSpec = do
   describe "Servant.API.Capture" $ do
-    with (return (serve captureApi EmptyConfig captureServer)) $ do
+    with (return (serve captureApi captureServer)) $ do
 
       it "can capture parts of the 'pathInfo'" $ do
         response <- get "/2"
@@ -198,7 +198,6 @@ captureSpec = do
 
     with (return (serve
         (Proxy :: Proxy (Capture "captured" String :> Raw))
-        EmptyConfig
         (\ "captured" request_ respond ->
             respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ do
       it "strips the captured path snippet from pathInfo" $ do
@@ -232,7 +231,7 @@ queryParamSpec :: Spec
 queryParamSpec = do
   describe "Servant.API.QueryParam" $ do
       it "allows retrieving simple GET parameters" $
-        (flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do
+        (flip runSession) (serve queryParamApi qpServer) $ do
           let params1 = "?name=bob"
           response1 <- Network.Wai.Test.request defaultRequest{
             rawQueryString = params1,
@@ -244,7 +243,7 @@ queryParamSpec = do
              }
 
       it "allows retrieving lists in GET parameters" $
-        (flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do
+        (flip runSession) (serve queryParamApi qpServer) $ do
           let params2 = "?names[]=bob&names[]=john"
           response2 <- Network.Wai.Test.request defaultRequest{
             rawQueryString = params2,
@@ -258,7 +257,7 @@ queryParamSpec = do
 
 
       it "allows retrieving value-less GET parameters" $
-        (flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do
+        (flip runSession) (serve queryParamApi qpServer) $ do
           let params3 = "?capitalize"
           response3 <- Network.Wai.Test.request defaultRequest{
             rawQueryString = params3,
@@ -310,7 +309,7 @@ reqBodySpec = describe "Servant.API.ReqBody" $ do
       mkReq method x = Test.Hspec.Wai.request method x
          [(hContentType, "application/json;charset=utf-8")]
 
-  with (return $ serve reqBodyApi EmptyConfig server) $ do
+  with (return $ serve reqBodyApi server) $ do
 
     it "passes the argument to the handler" $ do
       response <- mkReq methodPost "" (encode alice)
@@ -343,13 +342,13 @@ headerSpec = describe "Servant.API.Header" $ do
         expectsString (Just x) = when (x /= "more from you") $ error "Expected more from you"
         expectsString Nothing  = error "Expected a string"
 
-    with (return (serve headerApi EmptyConfig expectsInt)) $ do
+    with (return (serve headerApi expectsInt)) $ do
         let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader", "5")]
 
         it "passes the header to the handler (Int)" $
             delete' "/" "" `shouldRespondWith` 200
 
-    with (return (serve headerApi EmptyConfig expectsString)) $ do
+    with (return (serve headerApi expectsString)) $ do
         let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader", "more from you")]
 
         it "passes the header to the handler (String)" $
@@ -373,7 +372,7 @@ rawSpec :: Spec
 rawSpec = do
   describe "Servant.API.Raw" $ do
     it "runs applications" $ do
-      (flip runSession) (serve rawApi EmptyConfig (rawApplication (const (42 :: Integer)))) $ do
+      (flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do
         response <- Network.Wai.Test.request defaultRequest{
           pathInfo = ["foo"]
          }
@@ -381,7 +380,7 @@ rawSpec = do
           simpleBody response `shouldBe` "42"
 
     it "gets the pathInfo modified" $ do
-      (flip runSession) (serve rawApi EmptyConfig (rawApplication pathInfo)) $ do
+      (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do
         response <- Network.Wai.Test.request defaultRequest{
           pathInfo = ["foo", "bar"]
          }
@@ -415,7 +414,7 @@ alternativeServer =
 alternativeSpec :: Spec
 alternativeSpec = do
   describe "Servant.API.Alternative" $ do
-    with (return $ serve alternativeApi EmptyConfig alternativeServer) $ do
+    with (return $ serve alternativeApi alternativeServer) $ do
 
       it "unions endpoints" $ do
         response <- get "/foo"
@@ -450,7 +449,7 @@ responseHeadersServer = let h = return $ addHeader 5 $ addHeader "kilroy" "hi"
 
 responseHeadersSpec :: Spec
 responseHeadersSpec = describe "ResponseHeaders" $ do
-  with (return $ serve (Proxy :: Proxy ResponseHeadersApi) EmptyConfig responseHeadersServer) $ do
+  with (return $ serve (Proxy :: Proxy ResponseHeadersApi) responseHeadersServer) $ do
 
     let methods = [methodGet, methodPost, methodPut, methodPatch]
 
@@ -516,7 +515,7 @@ miscServ = versionHandler
         hostHandler = return . show
 
 miscCombinatorSpec :: Spec
-miscCombinatorSpec = with (return $ serve miscApi EmptyConfig miscServ) $
+miscCombinatorSpec = with (return $ serve miscApi miscServ) $
   describe "Misc. combinators for request inspection" $ do
     it "Successfully gets the HTTP version specified in the request" $
       go "/version" "\"HTTP/1.0\""

servant-server/test/Servant/Utils/StaticFilesSpec.hs

@@ -16,7 +16,7 @@ import           Test.Hspec                (Spec, around_, describe, it)
 import           Test.Hspec.Wai            (get, shouldRespondWith, with)
 
 import           Servant.API               ((:<|>) ((:<|>)), Capture, Get, Raw, (:>), JSON)
-import           Servant.Server            (Server, serve, Config(EmptyConfig))
+import           Servant.Server            (Server, serve)
 import           Servant.ServerSpec        (Person (Person))
 import           Servant.Utils.StaticFiles (serveDirectory)
 
@@ -29,7 +29,7 @@ api :: Proxy Api
 api = Proxy
 
 app :: Application
-app = serve api EmptyConfig server
+app = serve api server
 
 server :: Server Api
 server =