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

jkarni · jkarni · commit bfb64cda0b3a · 2016-02-19T15:29:54.000+01:00
Add 'serveWithConfig'.
diff --git a/servant-client/test/Servant/ClientSpec.hs b/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) =
diff --git a/servant-examples/auth-combinator/auth-combinator.hs b/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/
diff --git a/servant-examples/socket-io-chat/socket-io-chat.hs b/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
diff --git a/servant-examples/tutorial/T1.hs b/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
diff --git a/servant-examples/tutorial/T10.hs b/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
diff --git a/servant-examples/tutorial/T2.hs b/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
diff --git a/servant-examples/tutorial/T3.hs b/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
diff --git a/servant-examples/tutorial/T4.hs b/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
diff --git a/servant-examples/tutorial/T5.hs b/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
diff --git a/servant-examples/tutorial/T6.hs b/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
diff --git a/servant-examples/tutorial/T7.hs b/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
diff --git a/servant-examples/tutorial/T9.hs b/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'
diff --git a/servant-examples/wai-middleware/wai-middleware.hs b/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
diff --git a/servant-mock/example/main.hs b/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)
diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PolyKinds           #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE PolyKinds             #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# 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)
 
diff --git a/servant-mock/test/Servant/MockSpec.hs b/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{
diff --git a/servant-server/example/greet.hs b/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.
 --
diff --git a/servant-server/src/Servant/Server.hs b/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 ())
diff --git a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs b/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,
-                                                     requestBody,
-                                                     strictRequestBody)
+                                                     Response, ResponseReceived)
 import           Servant.Server.Internal.ServantErr
 
 type RoutingApplication =
diff --git a/servant-server/test/Servant/Server/ErrorSpec.hs b/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
diff --git a/servant-server/test/Servant/Server/Internal/EnterSpec.hs b/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"
diff --git a/servant-server/test/Servant/Server/UsingConfigSpec.hs b/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
diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs
diff --git a/servant-server/test/Servant/Utils/StaticFilesSpec.hs b/servant-server/test/Servant/Utils/StaticFilesSpec.hs
