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)

commit9a33fa7812aab6751575a9667ca661f0bcf090c3 authorAlp Mestanogullari <alpmestan@gmail.com> dateMon 9 Mar 2015, 15:16 (12 years ago) parent947815e

3 files changed+38−33

compare with master

unifiedsplit

src/Servant/Server.hs+7−3 src/Servant/Server/Internal.hs+30−29 src/Servant/Utils/StaticFiles.hs+1−1

src/Servant/Server.hs+7−3

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

11{-# LANGUAGE TypeFamilies #-}

2+{-# LANGUAGE FlexibleContexts #-}

23{-# LANGUAGE OverloadedStrings #-}

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

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

1213

1314 , -- * Handlers for all standard combinators

1415 HasServer(..)

16+ , Server

1517 ) where

1618

1719import Data.Proxy (Proxy)

1820import Network.Wai (Application)

19−

21+import Servant.API (Canonicalize)

2022import Servant.Server.Internal

2123

2224

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

4244-- >

4345-- > main :: IO ()

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

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

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

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

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 =

160160 where pinfo = parsePathInfo r

161161

162162class HasServer layout where

163− type Server layout :: *

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

165−

163+ type Server' layout :: *

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

166165

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

167+canonicalize Proxy = Proxy

167168

168169-- * Instances

169170

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

179180-- > where listAllBooks = ...

180181-- > postBook book = ...

181182instance (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

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

184185 route pa a request $ \ mResponse ->

185186 if isMismatch mResponse

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

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

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

214215

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

216− a -> Server sublayout

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

217+ a -> Server' sublayout

217218

218219 route Proxy subserver request respond = case processedPathInfo request of

219220 (first : rest)

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

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

240241-- are not met.

241242instance HasServer Delete where

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

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

243244

244245 route Proxy action request respond

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

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

268269-- list.

269270instance ( AllCTRender ctypes a

270271 ) => 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

272273 route Proxy action request respond

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

274275 e <- runEitherT action

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

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

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

310311

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

312− Maybe a -> Server sublayout

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

313+ Maybe a -> Server' sublayout

313314

314315 route Proxy subserver request respond = do

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

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

332333-- list.

333334instance ( AllCTRender ctypes a

334335 ) => 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

336337

337338 route Proxy action request respond

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

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

365366-- list.

366367instance ( AllCTRender ctypes a

367368 ) => 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

369370

370371 route Proxy action request respond

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

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

398399instance ( AllCTRender ctypes a

399400 , Typeable a

400401 , 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

402403

403404 route Proxy action request respond

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

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

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

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

444445

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

446− Maybe a -> Server sublayout

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

447+ Maybe a -> Server' sublayout

447448

448449 route Proxy subserver request respond = do

449450 let querytext = parseQueryText $ rawQueryString request

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

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

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

482483

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

484− [a] -> Server sublayout

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

485+ [a] -> Server' sublayout

485486

486487 route Proxy subserver request respond = do

487488 let querytext = parseQueryText $ rawQueryString request

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

513514instance (KnownSymbol sym, HasServer sublayout)

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

515516

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

517− Bool -> Server sublayout

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

518+ Bool -> Server' sublayout

518519

519520 route Proxy subserver request respond = do

520521 let querytext = parseQueryText $ rawQueryString request

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

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

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

558559

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

560− Maybe a -> Server sublayout

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

561+ Maybe a -> Server' sublayout

561562

562563 route Proxy subserver request respond = case parsePathInfo request of

563564 (first : _)

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

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

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

596597

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

598− [a] -> Server sublayout

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

599+ [a] -> Server' sublayout

599600

600601 route Proxy subserver request respond = case parsePathInfo request of

601602 (first : _)

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

628629instance (KnownSymbol sym, HasServer sublayout)

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

630631

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

632− Bool -> Server sublayout

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

633+ Bool -> Server' sublayout

633634

634635 route Proxy subserver request respond = case parsePathInfo request of

635636 (first : _)

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

656657-- > server :: Server MyApi

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

658659instance HasServer Raw where

659− type Server Raw = Application

660+ type Server' Raw = Application

660661 route Proxy rawApplication request respond =

661662 rawApplication request (respond . succeedWith)

662663

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

683684instance ( AllCTUnrender list a, HasServer sublayout

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

685686

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

687− a -> Server sublayout

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

688+ a -> Server' sublayout

688689

689690 route Proxy subserver request respond = do

690691 -- See HTTP RFC 2616, section 7.2.1

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

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

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

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

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

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

707708 route Proxy subserver request respond = case processedPathInfo request of

708709 (first : rest)

709710 | first == cs (symbolVal proxyPath)

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

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

99import Filesystem.Path.CurrentOS (decodeString)

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

1111import Servant.API.Raw (Raw)

12−import Servant.Server.Internal (Server)

12+import Servant.Server (Server)

1313

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

1515--