9a33fa7 · servant · git.iko.soy

git.iko.soy/servant

Canonicalize the API type to make sure that the following 'law' holds: Server (a :> (b :<|> c)) ~ Server (a :> b) :<|> Server (a :> c)

9a33fa7Alp Mestanogullari12 years ago

src/Servant/Server.hs+7−3

compare with master

unifiedsplit

@@ -1,4 +1,5 @@

1{-# LANGUAGE TypeFamilies #-}

2+{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE OverloadedStrings #-}

4-- | This module lets you implement 'Server's for defined APIs. You'll

5-- | This module lets you implement 'Server's for defined APIs. You'll

@@ -12,11 +13,12 @@ module Servant.Server

13 , -- * Handlers for all standard combinators

14 , -- * Handlers for all standard combinators

14 HasServer(..)

15 HasServer(..)

16+ , Server

15 ) where

17 ) where

17import Data.Proxy (Proxy)

19import Data.Proxy (Proxy)

18import Network.Wai (Application)

20import Network.Wai (Application)

19−

21+import Servant.API (Canonicalize)

20import Servant.Server.Internal

22import Servant.Server.Internal

@@ -42,5 +44,7 @@ import Servant.Server.Internal

42-- >

44-- >

43-- > main :: IO ()

45-- > main :: IO ()

44-- > main = Network.Wai.Handler.Warp.run 8080 app

46-- > main = Network.Wai.Handler.Warp.run 8080 app

45−serve :: HasServer layout => Proxy layout -> Server layout -> Application

47+serve :: HasServer (Canonicalize layout) => Proxy layout -> Server layout -> Application

46−serve p server = toApplication (route p server)

48+serve p server = toApplication (route (canonicalize p) server)

49+

50+type Server layout = Server' (Canonicalize layout)

src/Servant/Server/Internal.hs+30−29

@@ -160,10 +160,11 @@ processedPathInfo r =

160 where pinfo = parsePathInfo r

161

162class HasServer layout where

163− type Server layout :: *

163+ type Server' layout :: *

164− route :: Proxy layout -> Server layout -> RoutingApplication

164+ route :: Proxy layout -> Server' layout -> RoutingApplication

165−

166

165

166+canonicalize :: Canonicalize layout ~ t => Proxy layout -> Proxy t

167+canonicalize Proxy = Proxy

167

168

168-- * Instances

169-- * Instances

169

170

@@ -179,7 +180,7 @@ class HasServer layout where

179-- > where listAllBooks = ...

180-- > where listAllBooks = ...

180-- > postBook book = ...

181-- > postBook book = ...

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

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

182− type Server (a :<|> b) = Server a :<|> Server b

183+ type Server' (a :<|> b) = Server' a :<|> Server' b

183 route Proxy (a :<|> b) request respond =

184 route Proxy (a :<|> b) request respond =

184 route pa a request $ \ mResponse ->

185 route pa a request $ \ mResponse ->

185 if isMismatch mResponse

186 if isMismatch mResponse

@@ -212,8 +213,8 @@ captured _ = fromText

212instance (KnownSymbol capture, FromText a, HasServer sublayout)

213instance (KnownSymbol capture, FromText a, HasServer sublayout)

213 => HasServer (Capture capture a :> sublayout) where

214 => HasServer (Capture capture a :> sublayout) where

214

215

215− type Server (Capture capture a :> sublayout) =

216+ type Server' (Capture capture a :> sublayout) =

216− a -> Server sublayout

217+ a -> Server' sublayout

217

218

218 route Proxy subserver request respond = case processedPathInfo request of

219 route Proxy subserver request respond = case processedPathInfo request of

219 (first : rest)

220 (first : rest)

@@ -239,7 +240,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)

239-- painlessly error out if the conditions for a successful deletion

240-- painlessly error out if the conditions for a successful deletion

240-- are not met.

241-- are not met.

241instance HasServer Delete where

242instance HasServer Delete where

242− type Server Delete = EitherT (Int, String) IO ()

243+ type Server' Delete = EitherT (Int, String) IO ()

243

244

244 route Proxy action request respond

245 route Proxy action request respond

245 | pathIsEmpty request && requestMethod request == methodDelete = do

246 | pathIsEmpty request && requestMethod request == methodDelete = do

@@ -268,7 +269,7 @@ instance HasServer Delete where

268-- list.

269-- list.

269instance ( AllCTRender ctypes a

270instance ( AllCTRender ctypes a

270 ) => HasServer (Get ctypes a) where

271 ) => HasServer (Get ctypes a) where

271− type Server (Get ctypes a) = EitherT (Int, String) IO a

272+ type Server' (Get ctypes a) = EitherT (Int, String) IO a

272 route Proxy action request respond

273 route Proxy action request respond

273 | pathIsEmpty request && requestMethod request == methodGet = do

274 | pathIsEmpty request && requestMethod request == methodGet = do

274 e <- runEitherT action

275 e <- runEitherT action

@@ -308,8 +309,8 @@ instance ( AllCTRender ctypes a

308instance (KnownSymbol sym, FromText a, HasServer sublayout)

309instance (KnownSymbol sym, FromText a, HasServer sublayout)

309 => HasServer (Header sym a :> sublayout) where

310 => HasServer (Header sym a :> sublayout) where

310

311

311− type Server (Header sym a :> sublayout) =

312+ type Server' (Header sym a :> sublayout) =

312− Maybe a -> Server sublayout

313+ Maybe a -> Server' sublayout

313

314

314 route Proxy subserver request respond = do

315 route Proxy subserver request respond = do

315 let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)

316 let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)

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

332-- list.

333-- list.

333instance ( AllCTRender ctypes a

334instance ( AllCTRender ctypes a

334 ) => HasServer (Post ctypes a) where

335 ) => HasServer (Post ctypes a) where

335− type Server (Post ctypes a) = EitherT (Int, String) IO a

336+ type Server' (Post ctypes a) = EitherT (Int, String) IO a

336

337

337 route Proxy action request respond

338 route Proxy action request respond

338 | pathIsEmpty request && requestMethod request == methodPost = do

339 | pathIsEmpty request && requestMethod request == methodPost = do

@@ -365,7 +366,7 @@ instance ( AllCTRender ctypes a

365-- list.

366-- list.

366instance ( AllCTRender ctypes a

367instance ( AllCTRender ctypes a

367 ) => HasServer (Put ctypes a) where

368 ) => HasServer (Put ctypes a) where

368− type Server (Put ctypes a) = EitherT (Int, String) IO a

369+ type Server' (Put ctypes a) = EitherT (Int, String) IO a

369

370

370 route Proxy action request respond

371 route Proxy action request respond

371 | pathIsEmpty request && requestMethod request == methodPut = do

372 | pathIsEmpty request && requestMethod request == methodPut = do

@@ -398,7 +399,7 @@ instance ( AllCTRender ctypes a

398instance ( AllCTRender ctypes a

399instance ( AllCTRender ctypes a

399 , Typeable a

400 , Typeable a

400 , ToJSON a) => HasServer (Patch ctypes a) where

401 , ToJSON a) => HasServer (Patch ctypes a) where

401− type Server (Patch ctypes a) = EitherT (Int, String) IO a

402+ type Server' (Patch ctypes a) = EitherT (Int, String) IO a

402

403

403 route Proxy action request respond

404 route Proxy action request respond

404 | pathIsEmpty request && requestMethod request == methodPost = do

405 | pathIsEmpty request && requestMethod request == methodPost = do

@@ -442,8 +443,8 @@ instance ( AllCTRender ctypes a

442instance (KnownSymbol sym, FromText a, HasServer sublayout)

443instance (KnownSymbol sym, FromText a, HasServer sublayout)

443 => HasServer (QueryParam sym a :> sublayout) where

444 => HasServer (QueryParam sym a :> sublayout) where

444

445

445− type Server (QueryParam sym a :> sublayout) =

446+ type Server' (QueryParam sym a :> sublayout) =

446− Maybe a -> Server sublayout

447+ Maybe a -> Server' sublayout

447

448

448 route Proxy subserver request respond = do

449 route Proxy subserver request respond = do

449 let querytext = parseQueryText $ rawQueryString request

450 let querytext = parseQueryText $ rawQueryString request

@@ -480,8 +481,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

480instance (KnownSymbol sym, FromText a, HasServer sublayout)

481instance (KnownSymbol sym, FromText a, HasServer sublayout)

481 => HasServer (QueryParams sym a :> sublayout) where

482 => HasServer (QueryParams sym a :> sublayout) where

482

483

483− type Server (QueryParams sym a :> sublayout) =

484+ type Server' (QueryParams sym a :> sublayout) =

484− [a] -> Server sublayout

485+ [a] -> Server' sublayout

485

486

486 route Proxy subserver request respond = do

487 route Proxy subserver request respond = do

487 let querytext = parseQueryText $ rawQueryString request

488 let querytext = parseQueryText $ rawQueryString request

@@ -513,8 +514,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

513instance (KnownSymbol sym, HasServer sublayout)

514instance (KnownSymbol sym, HasServer sublayout)

514 => HasServer (QueryFlag sym :> sublayout) where

515 => HasServer (QueryFlag sym :> sublayout) where

515

516

516− type Server (QueryFlag sym :> sublayout) =

517+ type Server' (QueryFlag sym :> sublayout) =

517− Bool -> Server sublayout

518+ Bool -> Server' sublayout

518

519

519 route Proxy subserver request respond = do

520 route Proxy subserver request respond = do

520 let querytext = parseQueryText $ rawQueryString request

521 let querytext = parseQueryText $ rawQueryString request

@@ -556,8 +557,8 @@ parseMatrixText = parseQueryText

556instance (KnownSymbol sym, FromText a, HasServer sublayout)

557instance (KnownSymbol sym, FromText a, HasServer sublayout)

557 => HasServer (MatrixParam sym a :> sublayout) where

558 => HasServer (MatrixParam sym a :> sublayout) where

558

559

559− type Server (MatrixParam sym a :> sublayout) =

560+ type Server' (MatrixParam sym a :> sublayout) =

560− Maybe a -> Server sublayout

561+ Maybe a -> Server' sublayout

561

562

562 route Proxy subserver request respond = case parsePathInfo request of

563 route Proxy subserver request respond = case parsePathInfo request of

563 (first : _)

564 (first : _)

@@ -594,8 +595,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

594instance (KnownSymbol sym, FromText a, HasServer sublayout)

595instance (KnownSymbol sym, FromText a, HasServer sublayout)

595 => HasServer (MatrixParams sym a :> sublayout) where

596 => HasServer (MatrixParams sym a :> sublayout) where

596

597

597− type Server (MatrixParams sym a :> sublayout) =

598+ type Server' (MatrixParams sym a :> sublayout) =

598− [a] -> Server sublayout

599+ [a] -> Server' sublayout

599

600

600 route Proxy subserver request respond = case parsePathInfo request of

601 route Proxy subserver request respond = case parsePathInfo request of

601 (first : _)

602 (first : _)

@@ -628,8 +629,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

628instance (KnownSymbol sym, HasServer sublayout)

629instance (KnownSymbol sym, HasServer sublayout)

629 => HasServer (MatrixFlag sym :> sublayout) where

630 => HasServer (MatrixFlag sym :> sublayout) where

630

631

631− type Server (MatrixFlag sym :> sublayout) =

632+ type Server' (MatrixFlag sym :> sublayout) =

632− Bool -> Server sublayout

633+ Bool -> Server' sublayout

633

634

634 route Proxy subserver request respond = case parsePathInfo request of

635 route Proxy subserver request respond = case parsePathInfo request of

635 (first : _)

636 (first : _)

@@ -656,7 +657,7 @@ instance (KnownSymbol sym, HasServer sublayout)

656-- > server :: Server MyApi

657-- > server :: Server MyApi

657-- > server = serveDirectory "/var/www/images"

658-- > server = serveDirectory "/var/www/images"

658instance HasServer Raw where

659instance HasServer Raw where

659− type Server Raw = Application

660+ type Server' Raw = Application

660 route Proxy rawApplication request respond =

661 route Proxy rawApplication request respond =

661 rawApplication request (respond . succeedWith)

662 rawApplication request (respond . succeedWith)

662

663

@@ -683,8 +684,8 @@ instance HasServer Raw where

683instance ( AllCTUnrender list a, HasServer sublayout

684instance ( AllCTUnrender list a, HasServer sublayout

684 ) => HasServer (ReqBody list a :> sublayout) where

685 ) => HasServer (ReqBody list a :> sublayout) where

685

686

686− type Server (ReqBody list a :> sublayout) =

687+ type Server' (ReqBody list a :> sublayout) =

687− a -> Server sublayout

688+ a -> Server' sublayout

688

689

689 route Proxy subserver request respond = do

690 route Proxy subserver request respond = do

690 -- See HTTP RFC 2616, section 7.2.1

691 -- See HTTP RFC 2616, section 7.2.1

@@ -703,7 +704,7 @@ instance ( AllCTUnrender list a, HasServer sublayout

703-- | Make sure the incoming request starts with @"/path"@, strip it and

704-- | Make sure the incoming request starts with @"/path"@, strip it and

704-- pass the rest of the request path to @sublayout@.

705-- pass the rest of the request path to @sublayout@.

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

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

706− type Server (path :> sublayout) = Server sublayout

707+ type Server' (path :> sublayout) = Server' sublayout

707 route Proxy subserver request respond = case processedPathInfo request of

708 route Proxy subserver request respond = case processedPathInfo request of

708 (first : rest)

709 (first : rest)

709 | first == cs (symbolVal proxyPath)

710 | first == cs (symbolVal proxyPath)

src/Servant/Utils/StaticFiles.hs+1−1

@@ -9,7 +9,7 @@ module Servant.Utils.StaticFiles (

9import Filesystem.Path.CurrentOS (decodeString)

10import Network.Wai.Application.Static (staticApp, defaultFileServerSettings)

11import Servant.API.Raw (Raw)

12−import Servant.Server.Internal (Server)

12+import Servant.Server (Server)

14-- | Serve anything under the specified directory as a 'Raw' endpoint.

15--