c98c7db · typeable/servant

src/Servant/API/Capture.hs+2−2

compare with master

unifiedsplit

@@ -28,11 +28,11 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)

28 type Server (Capture capture a :> sublayout) =

29 a -> Server sublayout

30

31− route Proxy subserver globalPathInfo request respond = case pathInfo request of

31+ route Proxy subserver request respond = case pathInfo request of

32 (first : rest)

33 -> case captured captureProxy first of

34 Nothing -> respond Nothing

35− Just v -> route (Proxy :: Proxy sublayout) (subserver v) globalPathInfo request{

35+ Just v -> route (Proxy :: Proxy sublayout) (subserver v) request{

36 pathInfo = rest

37 } respond

38 _ -> respond Nothing

src/Servant/API/Delete.hs+1−1

@@ -23,7 +23,7 @@ data Delete

23instance HasServer Delete where

24 type Server Delete = EitherT (Int, String) IO ()

25

26− route Proxy action _globalPathInfo request respond

26+ route Proxy action request respond

27 | null (pathInfo request) && requestMethod request == methodDelete = do

28 e <- runEitherT action

29 respond $ Just $ case e of

src/Servant/API/Get.hs+1−1

@@ -24,7 +24,7 @@ data Get a

24

25instance ToJSON result => HasServer (Get result) where

26 type Server (Get result) = EitherT (Int, String) IO result

27− route Proxy action _globalPathInfo request respond

27+ route Proxy action request respond

28 | null (pathInfo request) && requestMethod request == methodGet = do

29 e <- runEitherT action

30 respond $ Just $ case e of

src/Servant/API/GetParam.hs+2−2

@@ -27,7 +27,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

27 type Server (GetParam sym a :> sublayout) =

28 Maybe a -> Server sublayout

29

30− route Proxy subserver globalPathInfo request respond = do

30+ route Proxy subserver request respond = do

31 let querytext = parseQueryText $ rawQueryString request

32 param =

33 case lookup paramname querytext of

@@ -36,7 +36,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

36 Just (Just v) -> fromText v -- if present, we try to convert to

37 -- the right type

38

39− route (Proxy :: Proxy sublayout) (subserver param) globalPathInfo request respond

39+ route (Proxy :: Proxy sublayout) (subserver param) request respond

40

41 where paramname = cs $ symbolVal (Proxy :: Proxy sym)

42

src/Servant/API/Post.hs+1−1

@@ -26,7 +26,7 @@ data Post a

26instance ToJSON a => HasServer (Post a) where

27 type Server (Post a) = EitherT (Int, String) IO a

28

29− route Proxy action _globalPathInfo request respond

29+ route Proxy action request respond

30 | null (pathInfo request) && requestMethod request == methodPost = do

31 e <- runEitherT action

32 respond $ Just $ case e of

src/Servant/API/Put.hs+1−1

@@ -24,7 +24,7 @@ data Put a

24instance ToJSON a => HasServer (Put a) where

25 type Server (Put a) = EitherT (Int, String) IO a

26

27− route Proxy action _globalPathInfo request respond

27+ route Proxy action request respond

28 | null (pathInfo request) && requestMethod request == methodPut = do

29 e <- runEitherT action

30 respond $ Just $ case e of

src/Servant/API/RQBody.hs+2−2

@@ -23,11 +23,11 @@ instance (FromJSON a, HasServer sublayout)

23 type Server (RQBody a :> sublayout) =

24 a -> Server sublayout

25

26− route Proxy subserver globalPathInfo request respond = do

26+ route Proxy subserver request respond = do

27 mrqbody <- decode' <$> lazyRequestBody request

28 case mrqbody of

29 Nothing -> respond Nothing

30− Just v -> route (Proxy :: Proxy sublayout) (subserver v) globalPathInfo request respond

30+ Just v -> route (Proxy :: Proxy sublayout) (subserver v) request respond

31

32instance (ToJSON a, HasClient sublayout)

33 => HasClient (RQBody a :> sublayout) where

src/Servant/API/Raw.hs+5−4

@@ -7,11 +7,12 @@ import Network.Wai

7import Servant.Server

8

9-- | Endpoint for plugging in your own Wai 'Application's.

10+--

10−-- The given Application will get the original request received by the server

11+-- The given 'Application' will get the request as received by the server, potentially with

11−-- (i.e. with unmodified 'pathInfo', etc.)

12+-- a modified (stripped) 'pathInfo' if the 'Application' is being routed with 'Servant.API.Sub.:>'.

12data Raw

13data Raw

13

14

14instance HasServer Raw where

15instance HasServer Raw where

15 type Server Raw = Application

16 type Server Raw = Application

16− route Proxy rawApplication globalPathInfo request respond =

17+ route Proxy rawApplication request respond =

17− rawApplication request{pathInfo = globalPathInfo} (respond . Just)

18+ rawApplication request (respond . Just)

src/Servant/API/Sub.hs+2−2

@@ -19,10 +19,10 @@ infixr 9 :>

19

20instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where

21 type Server (path :> sublayout) = Server sublayout

22− route Proxy subserver globalPathInfo request respond = case pathInfo request of

22+ route Proxy subserver request respond = case pathInfo request of

23 (first : rest)

24 | first == cs (symbolVal proxyPath)

25− -> route (Proxy :: Proxy sublayout) subserver globalPathInfo request{

25+ -> route (Proxy :: Proxy sublayout) subserver request{

26 pathInfo = rest

27 } respond

28 _ -> respond Nothing

src/Servant/API/Union.hs+3−3

@@ -14,10 +14,10 @@ infixr 8 :<|>

14

15instance (HasServer a, HasServer b) => HasServer (a :<|> b) where

16 type Server (a :<|> b) = Server a :<|> Server b

17− route Proxy (a :<|> b) globalPathInfo request respond = do

17+ route Proxy (a :<|> b) request respond = do

18− route (Proxy :: Proxy a) a globalPathInfo request $ \ mResponse ->

18+ route (Proxy :: Proxy a) a request $ \ mResponse ->

19 case mResponse of

20− Nothing -> route (Proxy :: Proxy b) b globalPathInfo request respond

20+ Nothing -> route (Proxy :: Proxy b) b request respond

21 Just resp -> respond $ Just resp

22

23instance (HasClient a, HasClient b) => HasClient (a :<|> b) where

src/Servant/Server.hs+2−4

@@ -8,7 +8,6 @@

8module Servant.Server where

9

10import Data.Proxy

11−import Data.Text

12import Network.HTTP.Types

11import Network.HTTP.Types

13import Network.Wai

12import Network.Wai

14

13

@@ -20,7 +19,7 @@ serve p server = toApplication (route p server)

20

19

21toApplication :: RoutingApplication -> Application

20toApplication :: RoutingApplication -> Application

22toApplication ra request respond = do

21toApplication ra request respond = do

23− ra (pathInfo request) request routingRespond

22+ ra request routingRespond

24 where

23 where

25 routingRespond :: Maybe Response -> IO ResponseReceived

24 routingRespond :: Maybe Response -> IO ResponseReceived

26 routingRespond Nothing =

25 routingRespond Nothing =

@@ -29,8 +28,7 @@ toApplication ra request respond = do

29 respond response

28 respond response

30

29

31type RoutingApplication =

30type RoutingApplication =

32− [Text] -- ^ the unmodified 'pathInfo'

33− -> Request -- ^ the request, the field 'pathInfo' may be modified by url routing

31+ Request -- ^ the request, the field 'pathInfo' may be modified by url routing

34 -> (Maybe Response -> IO ResponseReceived) -> IO ResponseReceived

32 -> (Maybe Response -> IO ResponseReceived) -> IO ResponseReceived

35

33

36class HasServer layout where

34class HasServer layout where

test/Servant/ServerSpec.hs+3−3

@@ -164,13 +164,13 @@ rawSpec = do

164 liftIO $ do

165 simpleBody response `shouldBe` "42"

166

167− it "gets the pathInfo unmodified" $ do

167+ it "gets the pathInfo modified" $ do

168 (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do

169 response <- Network.Wai.Test.request defaultRequest{

170− pathInfo = ["foo"]

170+ pathInfo = ["foo", "bar"]

171 }

172 liftIO $ do

173− simpleBody response `shouldBe` cs (show ["foo" :: String])

173+ simpleBody response `shouldBe` cs (show ["bar" :: String])

174

175

176type UnionApi =