fc30c7e · servant · git.iko.soy

git.iko.soy/servant

Merge branch 'master' into canonical-types

Conflicts: CHANGELOG.md src/Servant/Server/Internal.hs

commitfc30c7e24229a7c182e5c78f6453d99aff8d94ec authorAlp Mestanogullari <alpmestan@gmail.com> dateSun 19 Apr 2015, 10:59 (11 years ago) parentc1ed47b bd98844

3 files changed+35−32

compare with master

unifiedsplit

CHANGELOG.md+1−1 src/Servant/Server.hs+1−2 src/Servant/Server/Internal.hs+33−29

CHANGELOG.md+1−1

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

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

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

77* 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`

10100.2.4

1111-----

src/Servant/Server.hs+1−2

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

1414 , -- * Handlers for all standard combinators

1515 HasServer(..)

1616 , Server

17+ , ServerT

1718 ) where

1819

1920import Data.Proxy (Proxy)

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

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

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

4849serve 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

3030 rawQueryString, responseLBS)

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

3232 , MatrixParams, MatrixParam, MatrixFlag

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

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

34+ , Canonicalize)

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

3536 , AllCTUnrender(..),)

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

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

160161 where pinfo = parsePathInfo r

161162

162163class HasServer layout where

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

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

165+

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

165167

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

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

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

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

167171

168172-- * Instances

169173

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

180184-- > postBook book = ...

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

182186

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

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

184188

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

186190 route pa a request $ \mResponse ->

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

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

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

216220

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

218− a -> ServerT sublayout m

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

222+ a -> ServerT' sublayout m

219223

220224 route Proxy subserver request respond = case processedPathInfo request of

221225 (first : rest)

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

242246-- are not met.

243247instance HasServer Delete where

244248

245− type ServerT Delete m = m ()

249+ type ServerT' Delete m = m ()

246250

247251 route Proxy action request respond

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

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

272276instance ( AllCTRender ctypes a

273277 ) => HasServer (Get ctypes a) where

274278

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

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

276280

277281 route Proxy action request respond

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

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

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

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

315319

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

317− Maybe a -> ServerT sublayout m

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

321+ Maybe a -> ServerT' sublayout m

318322

319323 route Proxy subserver request respond = do

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

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

338342instance ( AllCTRender ctypes a

339343 ) => HasServer (Post ctypes a) where

340344

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

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

342346

343347 route Proxy action request respond

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

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

372376instance ( AllCTRender ctypes a

373377 ) => HasServer (Put ctypes a) where

374378

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

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

376380

377381 route Proxy action request respond

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

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

406410 , Typeable a

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

408412

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

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

410414

411415 route Proxy action request respond

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

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

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

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

452456

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

454− Maybe a -> ServerT sublayout m

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

458+ Maybe a -> ServerT' sublayout m

455459

456460 route Proxy subserver request respond = do

457461 let querytext = parseQueryText $ rawQueryString request

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

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

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

490494

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

492− [a] -> ServerT sublayout m

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

496+ [a] -> ServerT' sublayout m

493497

494498 route Proxy subserver request respond = do

495499 let querytext = parseQueryText $ rawQueryString request

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

521525instance (KnownSymbol sym, HasServer sublayout)

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

523527

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

525− Bool -> ServerT sublayout m

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

529+ Bool -> ServerT' sublayout m

526530

527531 route Proxy subserver request respond = do

528532 let querytext = parseQueryText $ rawQueryString request

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

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

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

566570

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

568− Maybe a -> ServerT sublayout m

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

572+ Maybe a -> ServerT' sublayout m

569573

570574 route Proxy subserver request respond = case parsePathInfo request of

571575 (first : _)

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

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

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

604608

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

606− [a] -> ServerT sublayout m

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

610+ [a] -> ServerT' sublayout m

607611

608612 route Proxy subserver request respond = case parsePathInfo request of

609613 (first : _)

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

636640instance (KnownSymbol sym, HasServer sublayout)

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

638642

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

640− Bool -> ServerT sublayout m

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

644+ Bool -> ServerT' sublayout m

641645

642646 route Proxy subserver request respond = case parsePathInfo request of

643647 (first : _)

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

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

666670instance HasServer Raw where

667671

668− type ServerT Raw m = Application

672+ type ServerT' Raw m = Application

669673

670674 route Proxy rawApplication request respond =

671675 rawApplication request (respond . succeedWith)

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

693697instance ( AllCTUnrender list a, HasServer sublayout

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

695699

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

697− a -> ServerT sublayout m

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

701+ a -> ServerT' sublayout m

698702

699703 route Proxy subserver request respond = do

700704 -- See HTTP RFC 2616, section 7.2.1

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

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

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

716720

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

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

718722

719723 route Proxy subserver request respond = case processedPathInfo request of

720724 (first : rest)