1ccb0ef · typeable/servant

git.iko.soy/typeable/servant

Merge pull request #753 from DaveCTurner/issue-753

Add a type representing an empty API

commit1ccb0ef812644c3349d6aeb09fa50679c56ab008 authorOleg Grenrus <oleg.grenrus@iki.fi> dateWed 17 May 2017, 11:54 (9 years ago) parent02fad69 8b993b9

19 files changed+154−12

compare with master

unifiedsplit

doc/tutorial/ApiType.lhs+24−2 doc/tutorial/Client.lhs+13 doc/tutorial/Docs.lhs+2 doc/tutorial/Javascript.lhs+3 doc/tutorial/Server.lhs+11 servant-client/src/Servant/Client.hs+18 servant-client/test/Servant/ClientSpec.hs+6−2 servant-docs/src/Servant/Docs/Internal.hs+4 servant-docs/test/Servant/DocsSpec.hs+4 servant-foreign/src/Servant/Foreign/Internal.hs+10 servant-foreign/test/Servant/ForeignSpec.hs+2−1 servant-server/src/Servant/Server.hs+4−2 servant-server/src/Servant/Server/Internal.hs+21−2 servant-server/test/Servant/ServerSpec.hs+7−2 servant/servant.cabal+1 servant/src/Servant/API.hs+3 servant/src/Servant/API/Empty.hs+12 servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs+2−1 servant/test/Servant/Utils/LinksSpec.hs+7

doc/tutorial/ApiType.lhs+24−2

@@ -321,11 +321,33 @@ data BasicAuth (realm :: Symbol) (userData :: *)

321321Which is used like so:

322322

323323``` haskell

324−type ProtectedAPI12

324+type ProtectedAPI11

325325 = UserAPI -- this is public

326326 :<|> BasicAuth "my-realm" User :> UserAPI2 -- this is protected by auth

327327```

328328

329+### Empty APIs

330+

331+Sometimes it is useful to be able to generalise an API over the type of some

332+part of it:

333+

334+``` haskell

335+type UserAPI12 innerAPI

336+ = UserAPI -- this is the fixed bit of the API

337+ :<|> "inner" :> innerAPI -- this lets us put various other APIs under /inner

338+```

339+

340+If there is a case where you do not have anything extra to serve, you can use

341+the `EmptyAPI` combinator to indicate this:

342+

343+``` haskell

344+type UserAPI12Alone = UserAPI12 EmptyAPI

345+```

346+

347+This also works well as a placeholder for unfinished parts of an API while it

348+is under development, for when you know that there should be _something_ there

349+but you don't yet know what. Think of it as similar to the unit type `()`.

350+

329351### Interoperability with `wai`: `Raw`

330352

331353Finally, we also include a combinator named `Raw` that provides an escape hatch

@@ -334,7 +356,7 @@ you want to plug a [wai `Application`](http://hackage.haskell.org/package/wai)

334356into your webservice:

335357

336358``` haskell

337−type UserAPI11 = "users" :> Get '[JSON] [User]

359+type UserAPI13 = "users" :> Get '[JSON] [User]

338360 -- a /users endpoint

339361

340362 :<|> Raw

doc/tutorial/Client.lhs+13

@@ -93,6 +93,19 @@ position :<|> hello :<|> marketing = client api

9393

9494`client api` returns client functions for our _entire_ API, combined with `:<|>`, which we can pattern match on as above. You could say `client` "calculates" the correct type and number of client functions for the API type it is given (via a `Proxy`), as well as their implementations.

9595

96+If you have an `EmptyAPI` in your API, servant-client will hand you a value of

97+type `EmptyClient` in the corresponding slot, where `data EmptyClient =

98+EmptyClient`, as a way to indicate that you can't do anything useful with it.

99+

100+``` haskell ignore

101+type API' = API :<|> EmptyAPI

102+

103+api' :: Proxy API'

104+api' = Proxy

105+

106+(position' :<|> hello' :<|> marketing') :<|> EmptyClient = client api'

107+```

108+

96109``` haskell ignore

97110-- | URI scheme to use

98111data Scheme =

doc/tutorial/Docs.lhs+2

@@ -89,6 +89,8 @@ instance ToSample Email where

8989```

9090

9191Types that are used as request or response bodies have to instantiate the `ToSample` typeclass which lets you specify one or more examples of values. `Capture`s and `QueryParam`s have to instantiate their respective `ToCapture` and `ToParam` classes and provide a name and some information about the concrete meaning of that argument, as illustrated in the code above.

92+The `EmptyAPI` combinator needs no special treatment as it generates no

93+documentation: an empty API has no endpoints to document.

9294

9395With all of this, we can derive docs for our API.

9496

doc/tutorial/Javascript.lhs+3

@@ -149,6 +149,9 @@ Why two different API types, proxies and servers though? Simply because we

149149don't want to generate javascript functions for the `Raw` part of our API type,

150150so we need a `Proxy` for our API type `API'` without its `Raw` endpoint.

151151

152+The `EmptyAPI` combinator needs no special treatment as it generates no

153+Javascript functions: an empty API has no endpoints to access.

154+

152155Very similarly to how one can derive haskell functions, we can derive the

153156javascript with just a simple function call to `jsForAPI` from

154157`Servant.JS`.

doc/tutorial/Server.lhs+11

@@ -1020,6 +1020,17 @@ serverFor = error "..."

10201020-- or the mailing list if you get stuck!

10211021```

10221022

1023+When your API contains the `EmptyAPI` combinator, you'll want to use

1024+`emptyServer` in the corresponding slot for your server, which will simply fail

1025+with 404 whenever a request reaches it:

1026+

1027+``` haskell

1028+type CombinedAPI2 = API :<|> "empty" :> EmptyAPI

1029+

1030+server11 :: Server CombinedAPI2

1031+server11 = server3 :<|> emptyServer

1032+```

1033+

10231034## Using another monad for your handlers

10241035

10251036Remember how `Server` turns combinators for HTTP methods into `Handler`? Well, actually, there's more to that. `Server` is actually a

servant-client/src/Servant/Client.hs+18

@@ -24,6 +24,7 @@ module Servant.Client

2424 , ClientEnv (ClientEnv)

2525 , mkAuthenticateReq

2626 , ServantError(..)

27+ , EmptyClient(..)

2728 , module Servant.Common.BaseUrl

2829 ) where

2930

@@ -88,6 +89,23 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where

8889 clientWithRoute (Proxy :: Proxy a) req :<|>

8990 clientWithRoute (Proxy :: Proxy b) req

9091

92+-- | Singleton type representing a client for an empty API.

93+data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)

94+

95+-- | The client for 'EmptyAPI' is simply 'EmptyClient'.

96+--

97+-- > type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books

98+-- > :<|> "nothing" :> EmptyAPI

99+-- >

100+-- > myApi :: Proxy MyApi

101+-- > myApi = Proxy

102+-- >

103+-- > getAllBooks :: ClientM [Book]

104+-- > (getAllBooks :<|> EmptyClient) = client myApi

105+instance HasClient EmptyAPI where

106+ type Client EmptyAPI = EmptyClient

107+ clientWithRoute Proxy _ = EmptyClient

108+

91109-- | If you use a 'Capture' in one of your endpoints in your API,

92110-- the corresponding querying function will automatically take

93111-- an additional argument of the type specified by your 'Capture'.

servant-client/test/Servant/ClientSpec.hs+6−2

@@ -111,6 +111,8 @@ type Api =

111111 Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])

112112 :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)

113113 :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent

114+ :<|> "empty" :> EmptyAPI

115+

114116api :: Proxy Api

115117api = Proxy

116118

@@ -130,6 +132,7 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

130132 -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])

131133getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool)

132134getDeleteContentType :: SCR.ClientM NoContent

135+

133136getGet

134137 :<|> getDeleteEmpty

135138 :<|> getCapture

@@ -142,7 +145,8 @@ getGet

142145 :<|> getRawFailure

143146 :<|> getMultiple

144147 :<|> getRespHeaders

145− :<|> getDeleteContentType = client api

148+ :<|> getDeleteContentType

149+ :<|> EmptyClient = client api

146150

147151server :: Application

148152server = serve api (

@@ -162,7 +166,7 @@ server = serve api (

162166 :<|> (\ a b c d -> return (a, b, c, d))

163167 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)

164168 :<|> return NoContent

165− )

169+ :<|> emptyServer)

166170

167171

168172type FailApi =

servant-docs/src/Servant/Docs/Internal.hs+4

@@ -683,6 +683,10 @@ instance OVERLAPPABLE_

683683 p2 :: Proxy b

684684 p2 = Proxy

685685

686+-- | The generated docs for @'EmptyAPI'@ are empty.

687+instance HasDocs EmptyAPI where

688+ docsFor Proxy _ _ = emptyAPI

689+

686690-- | @"books" :> 'Capture' "isbn" Text@ will appear as

687691-- @/books/:isbn@ in the docs.

688692instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)

servant-docs/test/Servant/DocsSpec.hs+4

@@ -104,6 +104,9 @@ spec = describe "Servant.Docs" $ do

104104 it "contains request body samples" $

105105 md `shouldContain` "17"

106106

107+ it "does not generate any docs mentioning the 'empty-api' path" $

108+ md `shouldNotContain` "empty-api"

109+

107110

108111-- * APIs

109112

@@ -128,6 +131,7 @@ instance MimeRender PlainText Int where

128131type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)

129132 :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1

130133 :<|> Header "X-Test" Int :> Put '[JSON] Int

134+ :<|> "empty-api" :> EmptyAPI

131135

132136data TT = TT1 | TT2 deriving (Show, Eq)

133137data UT = UT1 | UT2 deriving (Show, Eq)

servant-foreign/src/Servant/Foreign/Internal.hs+10

@@ -187,6 +187,13 @@ instance (HasForeign lang ftype a, HasForeign lang ftype b)

187187 foreignFor lang ftype (Proxy :: Proxy a) req

188188 :<|> foreignFor lang ftype (Proxy :: Proxy b) req

189189

190+data EmptyForeignAPI = EmptyForeignAPI

191+

192+instance HasForeign lang ftype EmptyAPI where

193+ type Foreign ftype EmptyAPI = EmptyForeignAPI

194+

195+ foreignFor Proxy Proxy Proxy _ = EmptyForeignAPI

196+

190197instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype api)

191198 => HasForeign lang ftype (Capture sym t :> api) where

192199 type Foreign ftype (Capture sym t :> api) = Foreign ftype api

@@ -349,6 +356,9 @@ instance HasForeign lang ftype api

349356class GenerateList ftype reqs where

350357 generateList :: reqs -> [Req ftype]

351358

359+instance GenerateList ftype EmptyForeignAPI where

360+ generateList _ = []

361+

352362instance GenerateList ftype (Req ftype) where

353363 generateList r = [r]

354364

servant-foreign/test/Servant/ForeignSpec.hs+2−1

@@ -57,13 +57,14 @@ type TestApi

5757 :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent

5858 :<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent

5959 :<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]

60+ :<|> "test" :> EmptyAPI

6061

6162testApi :: [Req String]

6263testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)

6364

6465listFromAPISpec :: Spec

6566listFromAPISpec = describe "listFromAPI" $ do

66− it "generates 4 endpoints for TestApi" $ do

67+ it "generates 5 endpoints for TestApi" $ do

6768 length testApi `shouldBe` 5

6869

6970 let [getReq, postReq, putReq, deleteReq, captureAllReq] = testApi

servant-server/src/Servant/Server.hs+4−2

@@ -17,6 +17,8 @@ module Servant.Server

1717 , -- * Handlers for all standard combinators

1818 HasServer(..)

1919 , Server

20+ , EmptyServer

21+ , emptyServer

2022 , Handler (..)

2123 , runHandler

2224

@@ -219,8 +221,8 @@ layoutWithContext p context =

219221--

220222-- >>> import Control.Monad.Reader

221223-- >>> import qualified Control.Category as C

222−-- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw

223−-- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :: ServerT ReaderAPI (Reader String)

224+-- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw :<|> EmptyAPI

225+-- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :<|> emptyServer :: ServerT ReaderAPI (Reader String)

224226-- >>> let nt = generalizeNat C.. (runReaderTNat "hi") :: Reader String :~> Handler

225227-- >>> let mainServer = enter nt readerServer :: Server ReaderAPI

226228--

servant-server/src/Servant/Server/Internal.hs+21−2

@@ -1,6 +1,7 @@

11{-# LANGUAGE CPP #-}

22{-# LANGUAGE ConstraintKinds #-}

33{-# LANGUAGE DataKinds #-}

4+{-# LANGUAGE DeriveDataTypeable #-}

45{-# LANGUAGE FlexibleContexts #-}

56{-# LANGUAGE FlexibleInstances #-}

67{-# LANGUAGE GeneralizedNewtypeDeriving #-}

@@ -32,7 +33,7 @@ import Data.Maybe (fromMaybe, mapMaybe)

3233import Data.Either (partitionEithers)

3334import Data.String (fromString)

3435import Data.String.Conversions (cs, (<>))

35−import Data.Tagged (Tagged, untag)

36+import Data.Tagged (Tagged(..), untag)

3637import qualified Data.Text as T

3738import Data.Typeable

3839import GHC.TypeLits (KnownNat, KnownSymbol, natVal,

@@ -52,7 +53,7 @@ import Web.HttpApiData (FromHttpApiData, parseHeader,

5253 parseUrlPieceMaybe,

5354 parseUrlPieces)

5455import Servant.API ((:<|>) (..), (:>), BasicAuth, Capture,

55− CaptureAll, Verb,

56+ CaptureAll, Verb, EmptyAPI,

5657 ReflectMethod(reflectMethod),

5758 IsSecure(..), Header, QueryFlag,

5859 QueryParam, QueryParams, Raw,

@@ -532,6 +533,24 @@ instance HasServer api context => HasServer (HttpVersion :> api) context where

532533 route Proxy context subserver =

533534 route (Proxy :: Proxy api) context (passToServer subserver httpVersion)

534535

536+-- | Singleton type representing a server that serves an empty API.

537+data EmptyServer = EmptyServer deriving (Typeable, Eq, Show, Bounded, Enum)

538+

539+-- | Server for `EmptyAPI`

540+emptyServer :: ServerT EmptyAPI m

541+emptyServer = Tagged EmptyServer

542+

543+-- | The server for an `EmptyAPI` is `emptyAPIServer`.

544+--

545+-- > type MyApi = "nothing" :> EmptyApi

546+-- >

547+-- > server :: Server MyApi

548+-- > server = emptyAPIServer

549+instance HasServer EmptyAPI context where

550+ type ServerT EmptyAPI m = Tagged m EmptyServer

551+

552+ route Proxy _ _ = StaticRouter mempty mempty

553+

535554-- | Basic Authentication

536555instance ( KnownSymbol realm

537556 , HasServer api context

servant-server/test/Servant/ServerSpec.hs+7−2

@@ -42,14 +42,14 @@ import Servant.API ((:<|>) (..), (:>), AuthProtect,

4242 Headers, HttpVersion,

4343 IsSecure (..), JSON,

4444 NoContent (..), Patch, PlainText,

45− Post, Put,

45+ Post, Put, EmptyAPI,

4646 QueryFlag, QueryParam, QueryParams,

4747 Raw, RemoteHost, ReqBody,

4848 StdMethod (..), Verb, addHeader)

4949import Servant.API.Internal.Test.ComprehensiveAPI

5050import Servant.Server (Server, Handler, Tagged (..), err401, err403,

5151 err404, serve, serveWithContext,

52− Context((:.), EmptyContext))

52+ Context((:.), EmptyContext), emptyServer)

5353import Test.Hspec (Spec, context, describe, it,

5454 shouldBe, shouldContain)

5555import qualified Test.Hspec.Wai as THW

@@ -609,6 +609,7 @@ type MiscCombinatorsAPI

609609 = "version" :> HttpVersion :> Get '[JSON] String

610610 :<|> "secure" :> IsSecure :> Get '[JSON] String

611611 :<|> "host" :> RemoteHost :> Get '[JSON] String

612+ :<|> "empty" :> EmptyAPI

612613

613614miscApi :: Proxy MiscCombinatorsAPI

614615miscApi = Proxy

@@ -617,6 +618,7 @@ miscServ :: Server MiscCombinatorsAPI

617618miscServ = versionHandler

618619 :<|> secureHandler

619620 :<|> hostHandler

621+ :<|> emptyServer

620622

621623 where versionHandler = return . show

622624 secureHandler Secure = return "secure"

@@ -635,6 +637,9 @@ miscCombinatorSpec = with (return $ serve miscApi miscServ) $

635637 it "Checks that hspec-wai issues request from 0.0.0.0" $

636638 go "/host" "\"0.0.0.0:0\""

637639

640+ it "Doesn't serve anything from the empty API" $

641+ Test.Hspec.Wai.get "empty" `shouldRespondWith` 404

642+

638643 where go path res = Test.Hspec.Wai.get path `shouldRespondWith` res

639644

640645-- }}}

servant/servant.cabal+1

@@ -36,6 +36,7 @@ library

3636 Servant.API.BasicAuth

3737 Servant.API.Capture

3838 Servant.API.ContentTypes

39+ Servant.API.Empty

3940 Servant.API.Experimental.Auth

4041 Servant.API.Header

4142 Servant.API.HttpVersion

servant/src/Servant/API.hs+3

@@ -5,6 +5,8 @@ module Servant.API (

55 -- | Type-level combinator for expressing subrouting: @':>'@

66 module Servant.API.Alternative,

77 -- | Type-level combinator for alternative endpoints: @':<|>'@

8+ module Servant.API.Empty,

9+ -- | Type-level combinator for an empty API: @'EmptyAPI'@

810

911 -- * Accessing information from the request

1012 module Servant.API.Capture,

@@ -66,6 +68,7 @@ import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,

6668 MimeRender (..), NoContent (NoContent),

6769 MimeUnrender (..), OctetStream,

6870 PlainText)

71+import Servant.API.Empty (EmptyAPI (..))

6972import Servant.API.Experimental.Auth (AuthProtect)

7073import Servant.API.Header (Header (..))

7174import Servant.API.HttpVersion (HttpVersion (..))

servant/src/Servant/API/Empty.hsnew file+12

@@ -0,0 +1,12 @@

1+{-# LANGUAGE DeriveDataTypeable #-}

2+{-# OPTIONS_HADDOCK not-home #-}

3+module Servant.API.Empty(EmptyAPI(..)) where

5+import Data.Typeable (Typeable)

6+import Prelude ()

7+import Prelude.Compat

9+-- | An empty API: one which serves nothing. Morally speaking, this should be

10+-- the unit of ':<|>'. Implementors of interpretations of API types should

11+-- treat 'EmptyAPI' as close to the unit as possible.

12+data EmptyAPI = EmptyAPI deriving (Typeable, Eq, Show, Bounded, Enum)

servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs+2−1

@@ -37,7 +37,8 @@ type ComprehensiveAPIWithoutRaw =

3737 Verb 'POST 204 '[JSON] NoContent :<|>

3838 Verb 'POST 204 '[JSON] Int :<|>

3939 WithNamedContext "foo" '[] GET :<|>

40− CaptureAll "foo" Int :> GET

40+ CaptureAll "foo" Int :> GET :<|>

41+ EmptyAPI

4142

4243comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw

4344comprehensiveAPIWithoutRaw = Proxy

servant/test/Servant/Utils/LinksSpec.hs+7

@@ -25,6 +25,7 @@ type TestApi =

2525 :<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] NoContent

2626 :<|> "delete" :> Header "ponies" String :> Delete '[JSON] NoContent

2727 :<|> "raw" :> Raw

28+ :<|> NoEndpoint

2829

2930

3031apiLink :: (IsElem endpoint TestApi, HasLink endpoint)

@@ -98,6 +99,11 @@ spec = describe "Servant.Utils.Links" $ do

9899-- ...Could not deduce...

99100-- ...

100101--

102+-- >>> apiLink (Proxy :: Proxy NoEndpoint)

103+-- ...

104+-- ...No instance for...

105+-- ...

106+--

101107-- sanity check

102108-- >>> toUrlPiece $ apiLink (Proxy :: Proxy AllGood)

103109-- "get"

@@ -107,3 +113,4 @@ type WrongContentType = "get" :> Get '[OctetStream] NoContent

107113type WrongMethod = "get" :> Post '[JSON] NoContent

108114type NotALink = "hello" :> ReqBody '[JSON] 'True :> Get '[JSON] Bool

109115type AllGood = "get" :> Get '[JSON] NoContent

116+type NoEndpoint = "empty" :> EmptyAPI