fc30c7e · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Merge branch 'master' into canonical-types

fc30c7eAlp Mestanogullari12 years ago

CHANGELOG.md+1−1

compare with master

unifiedsplit

@@ -5,7 +5,7 @@

5* Support for `Accept`/`Content-type` headers and for the content-type aware combinators in *servant-0.3*

6* Export `toApplication` from `Servant.Server` (https://github.com/haskell-servant/servant-server/pull/29)

7* Support other Monads than just `EitherT (Int, String) IO` (https://github.com/haskell-servant/servant-server/pull/21)

8−* Canonicalize API types before generating the handler typesy

8+* Canonicalize API types before generating the handler types with `Server`

100.2.4

11-----

src/Servant/Server.hs+1−2

@@ -14,6 +14,7 @@ module Servant.Server

14 , -- * Handlers for all standard combinators

15 HasServer(..)

16 , Server

17+ , ServerT

17 ) where

18 ) where

19import Data.Proxy (Proxy)

20import Data.Proxy (Proxy)

@@ -46,5 +47,3 @@ import Servant.Server.Internal

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

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

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

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

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

49serve p server = toApplication (route (canonicalize p) server)

49−

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

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

@@ -30,7 +30,8 @@ import Network.Wai ( Response, Request, ResponseReceived, Application

30 rawQueryString, responseLBS)

31import Servant.API ( QueryParams, QueryParam, QueryFlag, ReqBody, Header

32 , MatrixParams, MatrixParam, MatrixFlag

33− , Capture, Get, Delete, Put, Post, Patch, Raw, (:>), (:<|>)(..))

33+ , Capture, Get, Delete, Put, Post, Patch, Raw, (:>), (:<|>)(..)

34+ , Canonicalize)

34import Servant.API.ContentTypes ( AllCTRender(..), AcceptHeader(..)

35import Servant.API.ContentTypes ( AllCTRender(..), AcceptHeader(..)

35 , AllCTUnrender(..),)

36 , AllCTUnrender(..),)

36import Servant.Common.Text (FromText, fromText)

37import Servant.Common.Text (FromText, fromText)

@@ -160,10 +161,13 @@ processedPathInfo r =

160 where pinfo = parsePathInfo r

161 where pinfo = parsePathInfo r

161

162

162class HasServer layout where

163class HasServer layout where

163− type ServerT layout (m :: * -> *) :: *

164+ type ServerT' layout (m :: * -> *) :: *

165+

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

166 route :: Proxy layout -> Server' layout -> RoutingApplication

165

167

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

166−type Server' layout = ServerT layout (EitherT (Int, String) IO)

169+type Server' layout = ServerT' layout (EitherT (Int, String) IO)

170+type ServerT layout m = ServerT' (Canonicalize layout) m

167

171

168-- * Instances

172-- * Instances

169

173

@@ -180,7 +184,7 @@ type Server' layout = ServerT layout (EitherT (Int, String) IO)

180-- > postBook book = ...

184-- > postBook book = ...

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

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

182

186

183− type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m

187+ type ServerT' (a :<|> b) m = ServerT' a m :<|> ServerT' b m

184

188

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

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

186 route pa a request $ \mResponse ->

190 route pa a request $ \mResponse ->

@@ -214,8 +218,8 @@ captured _ = fromText

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

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

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

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

216

220

217− type ServerT (Capture capture a :> sublayout) m =

221+ type ServerT' (Capture capture a :> sublayout) m =

218− a -> ServerT sublayout m

222+ a -> ServerT' sublayout m

219

223

220 route Proxy subserver request respond = case processedPathInfo request of

224 route Proxy subserver request respond = case processedPathInfo request of

221 (first : rest)

225 (first : rest)

@@ -242,7 +246,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)

242-- are not met.

246-- are not met.

243instance HasServer Delete where

247instance HasServer Delete where

244

248

245− type ServerT Delete m = m ()

249+ type ServerT' Delete m = m ()

246

250

247 route Proxy action request respond

251 route Proxy action request respond

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

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

@@ -272,7 +276,7 @@ instance HasServer Delete where

272instance ( AllCTRender ctypes a

276instance ( AllCTRender ctypes a

273 ) => HasServer (Get ctypes a) where

277 ) => HasServer (Get ctypes a) where

274

278

275− type ServerT (Get ctypes a) m = m a

279+ type ServerT' (Get ctypes a) m = m a

276

280

277 route Proxy action request respond

281 route Proxy action request respond

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

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

@@ -313,8 +317,8 @@ instance ( AllCTRender ctypes a

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

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

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

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

315

319

316− type ServerT (Header sym a :> sublayout) m =

320+ type ServerT' (Header sym a :> sublayout) m =

317− Maybe a -> ServerT sublayout m

321+ Maybe a -> ServerT' sublayout m

318

322

319 route Proxy subserver request respond = do

323 route Proxy subserver request respond = do

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

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

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

338instance ( AllCTRender ctypes a

342instance ( AllCTRender ctypes a

339 ) => HasServer (Post ctypes a) where

343 ) => HasServer (Post ctypes a) where

340

344

341− type ServerT (Post ctypes a) m = m a

345+ type ServerT' (Post ctypes a) m = m a

342

346

343 route Proxy action request respond

347 route Proxy action request respond

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

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

@@ -372,7 +376,7 @@ instance ( AllCTRender ctypes a

372instance ( AllCTRender ctypes a

376instance ( AllCTRender ctypes a

373 ) => HasServer (Put ctypes a) where

377 ) => HasServer (Put ctypes a) where

374

378

375− type ServerT (Put ctypes a) m = m a

379+ type ServerT' (Put ctypes a) m = m a

376

380

377 route Proxy action request respond

381 route Proxy action request respond

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

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

@@ -406,7 +410,7 @@ instance ( AllCTRender ctypes a

406 , Typeable a

410 , Typeable a

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

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

408

412

409− type ServerT (Patch ctypes a) m = m a

413+ type ServerT' (Patch ctypes a) m = m a

410

414

411 route Proxy action request respond

415 route Proxy action request respond

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

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

@@ -450,8 +454,8 @@ instance ( AllCTRender ctypes a

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

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

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

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

452

456

453− type ServerT (QueryParam sym a :> sublayout) m =

457+ type ServerT' (QueryParam sym a :> sublayout) m =

454− Maybe a -> ServerT sublayout m

458+ Maybe a -> ServerT' sublayout m

455

459

456 route Proxy subserver request respond = do

460 route Proxy subserver request respond = do

457 let querytext = parseQueryText $ rawQueryString request

461 let querytext = parseQueryText $ rawQueryString request

@@ -488,8 +492,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

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

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

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

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

490

494

491− type ServerT (QueryParams sym a :> sublayout) m =

495+ type ServerT' (QueryParams sym a :> sublayout) m =

492− [a] -> ServerT sublayout m

496+ [a] -> ServerT' sublayout m

493

497

494 route Proxy subserver request respond = do

498 route Proxy subserver request respond = do

495 let querytext = parseQueryText $ rawQueryString request

499 let querytext = parseQueryText $ rawQueryString request

@@ -521,8 +525,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

521instance (KnownSymbol sym, HasServer sublayout)

525instance (KnownSymbol sym, HasServer sublayout)

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

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

523

527

524− type ServerT (QueryFlag sym :> sublayout) m =

528+ type ServerT' (QueryFlag sym :> sublayout) m =

525− Bool -> ServerT sublayout m

529+ Bool -> ServerT' sublayout m

526

530

527 route Proxy subserver request respond = do

531 route Proxy subserver request respond = do

528 let querytext = parseQueryText $ rawQueryString request

532 let querytext = parseQueryText $ rawQueryString request

@@ -564,8 +568,8 @@ parseMatrixText = parseQueryText

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

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

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

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

566

570

567− type ServerT (MatrixParam sym a :> sublayout) m =

571+ type ServerT' (MatrixParam sym a :> sublayout) m =

568− Maybe a -> ServerT sublayout m

572+ Maybe a -> ServerT' sublayout m

569

573

570 route Proxy subserver request respond = case parsePathInfo request of

574 route Proxy subserver request respond = case parsePathInfo request of

571 (first : _)

575 (first : _)

@@ -602,8 +606,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

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

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

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

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

604

608

605− type ServerT (MatrixParams sym a :> sublayout) m =

609+ type ServerT' (MatrixParams sym a :> sublayout) m =

606− [a] -> ServerT sublayout m

610+ [a] -> ServerT' sublayout m

607

611

608 route Proxy subserver request respond = case parsePathInfo request of

612 route Proxy subserver request respond = case parsePathInfo request of

609 (first : _)

613 (first : _)

@@ -636,8 +640,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

636instance (KnownSymbol sym, HasServer sublayout)

640instance (KnownSymbol sym, HasServer sublayout)

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

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

638

642

639− type ServerT (MatrixFlag sym :> sublayout) m =

643+ type ServerT' (MatrixFlag sym :> sublayout) m =

640− Bool -> ServerT sublayout m

644+ Bool -> ServerT' sublayout m

641

645

642 route Proxy subserver request respond = case parsePathInfo request of

646 route Proxy subserver request respond = case parsePathInfo request of

643 (first : _)

647 (first : _)

@@ -665,7 +669,7 @@ instance (KnownSymbol sym, HasServer sublayout)

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

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

666instance HasServer Raw where

670instance HasServer Raw where

667

671

668− type ServerT Raw m = Application

672+ type ServerT' Raw m = Application

669

673

670 route Proxy rawApplication request respond =

674 route Proxy rawApplication request respond =

671 rawApplication request (respond . succeedWith)

675 rawApplication request (respond . succeedWith)

@@ -693,8 +697,8 @@ instance HasServer Raw where

693instance ( AllCTUnrender list a, HasServer sublayout

697instance ( AllCTUnrender list a, HasServer sublayout

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

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

695

699

696− type ServerT (ReqBody list a :> sublayout) m =

700+ type ServerT' (ReqBody list a :> sublayout) m =

697− a -> ServerT sublayout m

701+ a -> ServerT' sublayout m

698

702

699 route Proxy subserver request respond = do

703 route Proxy subserver request respond = do

700 -- See HTTP RFC 2616, section 7.2.1

704 -- See HTTP RFC 2616, section 7.2.1

@@ -714,7 +718,7 @@ instance ( AllCTUnrender list a, HasServer sublayout

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

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

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

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

716

720

717− type ServerT (path :> sublayout) m = ServerT sublayout m

721+ type ServerT' (path :> sublayout) m = ServerT' sublayout m

718

722

719 route Proxy subserver request respond = case processedPathInfo request of

723 route Proxy subserver request respond = case processedPathInfo request of

720 (first : rest)

724 (first : rest)