From 5c4c95a5282a49657e80ce290e74a5f893ddc1e5 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Mon, 10 Aug 2015 17:21:06 +0200 Subject: [PATCH] switch params to raw --- servant-examples/socket-io-chat/socket-io-chat.hs | 4 ++-- servant-examples/tutorial/T10.hs | 2 +- servant-examples/tutorial/T6.hs | 2 +- servant-examples/tutorial/T9.hs | 2 +- servant-mock/src/Servant/Mock.hs | 2 +- servant-server/src/Servant/Server/Internal.hs | 4 ++-- servant-server/src/Servant/Server/Internal/Enter.hs | 11 +++++++---- servant-server/src/Servant/Utils/StaticFiles.hs | 4 ++-- servant/src/Servant/API/Raw.hs | 2 +- 9 files changed, 18 insertions(+), 15 deletions(-) diff --git a/servant-examples/socket-io-chat/socket-io-chat.hs b/servant-examples/socket-io-chat/socket-io-chat.hs index 600ba998..bb70e497 100644 --- a/servant-examples/socket-io-chat/socket-io-chat.hs +++ b/servant-examples/socket-io-chat/socket-io-chat.hs @@ -21,8 +21,8 @@ import qualified Network.SocketIO as SocketIO import Chat (ServerState (..), eioServer) -type API = "socket.io" :> Raw Application IO - :<|> Raw Application IO +type API = "socket.io" :> Raw IO Application + :<|> Raw IO Application api :: Proxy API diff --git a/servant-examples/tutorial/T10.hs b/servant-examples/tutorial/T10.hs index ca78d737..0b70ee57 100644 --- a/servant-examples/tutorial/T10.hs +++ b/servant-examples/tutorial/T10.hs @@ -15,7 +15,7 @@ import Servant import Servant.Docs import qualified T3 -type DocsAPI = T3.API :<|> Raw Application IO +type DocsAPI = T3.API :<|> Raw IO Application instance ToCapture (Capture "x" Int) where toCapture _ = DocCapture "x" "(integer) position on the x axis" diff --git a/servant-examples/tutorial/T6.hs b/servant-examples/tutorial/T6.hs index 79021d08..c59ce26b 100644 --- a/servant-examples/tutorial/T6.hs +++ b/servant-examples/tutorial/T6.hs @@ -6,7 +6,7 @@ module T6 where import Network.Wai import Servant -type API = "code" :> Raw Application IO +type API = "code" :> Raw IO Application api :: Proxy API api = Proxy diff --git a/servant-examples/tutorial/T9.hs b/servant-examples/tutorial/T9.hs index 014934ef..286fa56b 100644 --- a/servant-examples/tutorial/T9.hs +++ b/servant-examples/tutorial/T9.hs @@ -75,7 +75,7 @@ searchBook (Just q) = return (mkSearch q books') type API = "point" :> Get '[JSON] Point :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book) -type API' = API :<|> Raw Application IO +type API' = API :<|> Raw IO Application api :: Proxy API api = Proxy diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs index 2a5b8484..e4038c7d 100644 --- a/servant-mock/src/Servant/Mock.hs +++ b/servant-mock/src/Servant/Mock.hs @@ -166,7 +166,7 @@ instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Post ctypes a) where instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Put ctypes a) where mock _ = mockArbitrary -instance HasMock (Raw Application m) where +instance HasMock (Raw m Application) where mock _ = Raw (\req respond -> do bdy <- genBody respond $ responseLBS status200 [] bdy) diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index d920f6dc..85636d0c 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -677,8 +677,8 @@ class ToRawApplication a where instance ToRawApplication Application where toRawApplication = id -instance ToRawApplication a => HasServer (Raw a m) where - type ServerT (Raw a m) n = Raw a n +instance ToRawApplication a => HasServer (Raw m a) where + type ServerT (Raw m a) n = Raw n a route Proxy rawApplication = LeafRouter $ \ request respond -> do r <- rawApplication diff --git a/servant-server/src/Servant/Server/Internal/Enter.hs b/servant-server/src/Servant/Server/Internal/Enter.hs index 47255a2d..9b66ae49 100644 --- a/servant-server/src/Servant/Server/Internal/Enter.hs +++ b/servant-server/src/Servant/Server/Internal/Enter.hs @@ -7,6 +7,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE UndecidableInstances #-} module Servant.Server.Internal.Enter where @@ -30,13 +31,15 @@ import Servant.API class Enter typ arg ret | typ arg -> ret, typ ret -> arg where enter :: arg -> typ -> ret +data IsRaw + -- ** Servant combinators -instance ( Enter typ1 arg1 ret1, Enter typ2 arg2 ret2 +instance ( Enter typ1 arg1 ret1 , Enter typ2 arg2 ret2 , arg1 ~ arg2 ) => Enter (typ1 :<|> typ2) arg1 (ret1 :<|> ret2) where enter e (a :<|> b) = enter e a :<|> enter e b -instance (Enter b arg ret) => Enter (a -> b) arg (a -> ret) where +instance (Enter b arg ret) => Enter (a -> b) arg (a -> ret) where enter arg f a = enter arg (f a) -- ** Useful instances @@ -49,10 +52,10 @@ instance C.Category (:~>) where id = Nat id Nat f . Nat g = Nat (f . g) -instance Enter (Raw a m) (m :~> n) (Raw a n) where +instance (Raw m' ~ m, Raw n' ~ n) => Enter (m a) (m' :~> n') (n a) where enter _ (Raw a) = Raw a -instance Enter (m a) (m :~> n) (n a) where +instance Enter (m a) (m :~> n) (n a) where enter (Nat f) = f -- | Like `lift`. diff --git a/servant-server/src/Servant/Utils/StaticFiles.hs b/servant-server/src/Servant/Utils/StaticFiles.hs index 02e0f74d..3ac9a09b 100644 --- a/servant-server/src/Servant/Utils/StaticFiles.hs +++ b/servant-server/src/Servant/Utils/StaticFiles.hs @@ -38,10 +38,10 @@ import Filesystem.Path.CurrentOS (decodeString) -- behind a /\/static\// prefix. In that case, remember to put the 'serveDirectory' -- handler in the last position, because /servant/ will try to match the handlers -- in order. -serveDirectoryWith :: StaticSettings -> ServerT (Raw Application m) n +serveDirectoryWith :: StaticSettings -> ServerT (Raw m Application) n serveDirectoryWith settings = Raw (staticApp settings) -serveDirectory :: FilePath -> ServerT (Raw Application m) n +serveDirectory :: FilePath -> ServerT (Raw m Application) n serveDirectory = serveDirectoryWith . defaultFileServerSettings . #if !MIN_VERSION_wai_app_static(3,1,0) decodeString . diff --git a/servant/src/Servant/API/Raw.hs b/servant/src/Servant/API/Raw.hs index c22d0058..bd21934f 100644 --- a/servant/src/Servant/API/Raw.hs +++ b/servant/src/Servant/API/Raw.hs @@ -12,7 +12,7 @@ import Data.Typeable (Typeable) -- In addition to just letting you plug in your existing WAI 'Application's, -- this can also be used with 'Servant.Utils.StaticFiles.serveDirectory' to serve -- static files stored in a particular directory on your filesystem -newtype Raw a (m :: * -> *) = Raw { +newtype Raw (m :: * -> *) a = Raw { unRaw :: a } deriving (Eq, Show, Typeable)