Merge pull request #753 from DaveCTurner/issue-753

Add a type representing an empty API

doc/tutorial/ApiType.lhs

@@ -321,11 +321,33 @@ data BasicAuth (realm :: Symbol) (userData :: *)
 Which is used like so:
 
 ``` haskell
-type ProtectedAPI12
+type ProtectedAPI11
      = UserAPI                              -- this is public
  :<|> BasicAuth "my-realm" User :> UserAPI2 -- this is protected by auth
 ```
 
+### Empty APIs
+
+Sometimes it is useful to be able to generalise an API over the type of some
+part of it:
+
+``` haskell
+type UserAPI12 innerAPI
+     = UserAPI             -- this is the fixed bit of the API
+ :<|> "inner" :> innerAPI  -- this lets us put various other APIs under /inner
+```
+
+If there is a case where you do not have anything extra to serve, you can use
+the `EmptyAPI` combinator to indicate this:
+
+``` haskell
+type UserAPI12Alone = UserAPI12 EmptyAPI
+```
+
+This also works well as a placeholder for unfinished parts of an API while it
+is under development, for when you know that there should be _something_ there
+but you don't yet know what. Think of it as similar to the unit type `()`.
+
 ### Interoperability with `wai`: `Raw`
 
 Finally, 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)
 into your webservice:
 
 ``` haskell
-type UserAPI11 = "users" :> Get '[JSON] [User]
+type UserAPI13 = "users" :> Get '[JSON] [User]
                  -- a /users endpoint
 
             :<|> Raw

doc/tutorial/Client.lhs

@@ -93,6 +93,19 @@ position :<|> hello :<|> marketing = client api
 
 `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.
 
+If you have an `EmptyAPI` in your API, servant-client will hand you a value of
+type `EmptyClient` in the corresponding slot, where `data EmptyClient =
+EmptyClient`, as a way to indicate that you can't do anything useful with it.
+
+``` haskell ignore
+type API' = API :<|> EmptyAPI
+
+api' :: Proxy API'
+api' = Proxy
+
+(position' :<|> hello' :<|> marketing') :<|> EmptyClient = client api'
+```
+
 ``` haskell ignore
 -- | URI scheme to use
 data Scheme =

doc/tutorial/Docs.lhs

@@ -89,6 +89,8 @@ instance ToSample Email where
 ```
 
 Types 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.
+The `EmptyAPI` combinator needs no special treatment as it generates no
+documentation: an empty API has no endpoints to document.
 
 With all of this, we can derive docs for our API.
 

doc/tutorial/Javascript.lhs

@@ -149,6 +149,9 @@ Why two different API types, proxies and servers though? Simply because we
 don't want to generate javascript functions for the `Raw` part of our API type,
 so we need a `Proxy` for our API type `API'` without its `Raw` endpoint.
 
+The `EmptyAPI` combinator needs no special treatment as it generates no
+Javascript functions: an empty API has no endpoints to access.
+
 Very similarly to how one can derive haskell functions, we can derive the
 javascript with just a simple function call to `jsForAPI` from
 `Servant.JS`.

doc/tutorial/Server.lhs

@@ -1020,6 +1020,17 @@ serverFor = error "..."
 -- or the mailing list if you get stuck!
 ```
 
+When your API contains the `EmptyAPI` combinator, you'll want to use
+`emptyServer` in the corresponding slot for your server, which will simply fail
+with 404 whenever a request reaches it:
+
+``` haskell
+type CombinedAPI2 = API :<|> "empty" :> EmptyAPI
+
+server11 :: Server CombinedAPI2
+server11 = server3 :<|> emptyServer
+```
+
 ## Using another monad for your handlers
 
 Remember 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

@@ -24,6 +24,7 @@ module Servant.Client
   , ClientEnv (ClientEnv)
   , mkAuthenticateReq
   , ServantError(..)
+  , EmptyClient(..)
   , module Servant.Common.BaseUrl
   ) where
 
@@ -88,6 +89,23 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
     clientWithRoute (Proxy :: Proxy a) req :<|>
     clientWithRoute (Proxy :: Proxy b) req
 
+-- | Singleton type representing a client for an empty API.
+data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
+
+-- | The client for 'EmptyAPI' is simply 'EmptyClient'.
+--
+-- > type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books
+-- >         :<|> "nothing" :> EmptyAPI
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getAllBooks :: ClientM [Book]
+-- > (getAllBooks :<|> EmptyClient) = client myApi
+instance HasClient EmptyAPI where
+  type Client EmptyAPI = EmptyClient
+  clientWithRoute Proxy _ = EmptyClient
+
 -- | If you use a 'Capture' in one of your endpoints in your API,
 -- the corresponding querying function will automatically take
 -- an additional argument of the type specified by your 'Capture'.

servant-client/test/Servant/ClientSpec.hs

@@ -111,6 +111,8 @@ type Api =
             Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])
   :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)
   :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent
+  :<|> "empty" :> EmptyAPI
+
 api :: Proxy Api
 api = Proxy
 
@@ -130,6 +132,7 @@ getMultiple     :: String -> Maybe Int -> Bool -> [(String, [Rational])]
   -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])
 getRespHeaders  :: SCR.ClientM (Headers TestHeaders Bool)
 getDeleteContentType :: SCR.ClientM NoContent
+
 getGet
   :<|> getDeleteEmpty
   :<|> getCapture
@@ -142,7 +145,8 @@ getGet
   :<|> getRawFailure
   :<|> getMultiple
   :<|> getRespHeaders
-  :<|> getDeleteContentType = client api
+  :<|> getDeleteContentType
+  :<|> EmptyClient = client api
 
 server :: Application
 server = serve api (
@@ -162,7 +166,7 @@ server = serve api (
   :<|> (\ a b c d -> return (a, b, c, d))
   :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
   :<|> return NoContent
- )
+  :<|> emptyServer)
 
 
 type FailApi =

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

@@ -683,6 +683,10 @@ instance OVERLAPPABLE_
           p2 :: Proxy b
           p2 = Proxy
 
+-- | The generated docs for @'EmptyAPI'@ are empty.
+instance HasDocs EmptyAPI where
+  docsFor Proxy _ _ = emptyAPI
+
 -- | @"books" :> 'Capture' "isbn" Text@ will appear as
 -- @/books/:isbn@ in the docs.
 instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)

servant-docs/test/Servant/DocsSpec.hs

@@ -104,6 +104,9 @@ spec = describe "Servant.Docs" $ do
     it "contains request body samples" $
       md `shouldContain` "17"
 
+    it "does not generate any docs mentioning the 'empty-api' path" $
+      md `shouldNotContain` "empty-api"
+
 
 -- * APIs
 
@@ -128,6 +131,7 @@ instance MimeRender PlainText Int where
 type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)
            :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
            :<|> Header "X-Test" Int :> Put '[JSON] Int
+           :<|> "empty-api" :> EmptyAPI
 
 data TT = TT1 | TT2 deriving (Show, Eq)
 data UT = UT1 | UT2 deriving (Show, Eq)

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

@@ -187,6 +187,13 @@ instance (HasForeign lang ftype a, HasForeign lang ftype b)
          foreignFor lang ftype (Proxy :: Proxy a) req
     :<|> foreignFor lang ftype (Proxy :: Proxy b) req
 
+data EmptyForeignAPI = EmptyForeignAPI
+
+instance HasForeign lang ftype EmptyAPI where
+  type Foreign ftype EmptyAPI = EmptyForeignAPI
+
+  foreignFor Proxy Proxy Proxy _ = EmptyForeignAPI
+
 instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype api)
   => HasForeign lang ftype (Capture sym t :> api) where
   type Foreign ftype (Capture sym t :> api) = Foreign ftype api
@@ -349,6 +356,9 @@ instance HasForeign lang ftype api
 class GenerateList ftype reqs where
   generateList :: reqs -> [Req ftype]
 
+instance GenerateList ftype EmptyForeignAPI where
+  generateList _ = []
+
 instance GenerateList ftype (Req ftype) where
   generateList r = [r]
 

servant-foreign/test/Servant/ForeignSpec.hs

@@ -57,13 +57,14 @@ type TestApi
  :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent
  :<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent
  :<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]
+ :<|> "test" :> EmptyAPI
 
 testApi :: [Req String]
 testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)
 
 listFromAPISpec :: Spec
 listFromAPISpec = describe "listFromAPI" $ do
-  it "generates 4 endpoints for TestApi" $ do
+  it "generates 5 endpoints for TestApi" $ do
     length testApi `shouldBe` 5
 
   let [getReq, postReq, putReq, deleteReq, captureAllReq] = testApi

servant-server/src/Servant/Server.hs

@@ -17,6 +17,8 @@ module Servant.Server
   , -- * Handlers for all standard combinators
     HasServer(..)
   , Server
+  , EmptyServer
+  , emptyServer
   , Handler (..)
   , runHandler
 
@@ -219,8 +221,8 @@ layoutWithContext p context =
 --
 -- >>> import Control.Monad.Reader
 -- >>> import qualified Control.Category as C
--- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw
+-- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw :<|> EmptyAPI
--- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :: ServerT ReaderAPI (Reader String)
+-- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :<|> emptyServer :: ServerT ReaderAPI (Reader String)
 -- >>> let nt = generalizeNat C.. (runReaderTNat "hi") :: Reader String :~> Handler
 -- >>> let mainServer = enter nt readerServer :: Server ReaderAPI
 --

servant-server/src/Servant/Server/Internal.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP                        #-}
 {-# LANGUAGE ConstraintKinds            #-}
 {-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -32,7 +33,7 @@ import           Data.Maybe                 (fromMaybe, mapMaybe)
 import           Data.Either                (partitionEithers)
 import           Data.String                (fromString)
 import           Data.String.Conversions    (cs, (<>))
-import           Data.Tagged                (Tagged, untag)
+import           Data.Tagged                (Tagged(..), untag)
 import qualified Data.Text                  as T
 import           Data.Typeable
 import           GHC.TypeLits               (KnownNat, KnownSymbol, natVal,
@@ -52,7 +53,7 @@ import           Web.HttpApiData            (FromHttpApiData, parseHeader,
                                              parseUrlPieceMaybe,
                                              parseUrlPieces)
 import           Servant.API                 ((:<|>) (..), (:>), BasicAuth, Capture,
-                                              CaptureAll, Verb,
+                                              CaptureAll, Verb, EmptyAPI,
                                               ReflectMethod(reflectMethod),
                                               IsSecure(..), Header, QueryFlag,
                                               QueryParam, QueryParams, Raw,
@@ -532,6 +533,24 @@ instance HasServer api context => HasServer (HttpVersion :> api) context where
   route Proxy context subserver =
     route (Proxy :: Proxy api) context (passToServer subserver httpVersion)
 
+-- | Singleton type representing a server that serves an empty API.
+data EmptyServer = EmptyServer deriving (Typeable, Eq, Show, Bounded, Enum)
+
+-- | Server for `EmptyAPI`
+emptyServer :: ServerT EmptyAPI m
+emptyServer = Tagged EmptyServer
+
+-- | The server for an `EmptyAPI` is `emptyAPIServer`.
+--
+-- > type MyApi = "nothing" :> EmptyApi
+-- >
+-- > server :: Server MyApi
+-- > server = emptyAPIServer
+instance HasServer EmptyAPI context where
+  type ServerT EmptyAPI m = Tagged m EmptyServer
+
+  route Proxy _ _ = StaticRouter mempty mempty
+
 -- | Basic Authentication
 instance ( KnownSymbol realm
          , HasServer api context

servant-server/test/Servant/ServerSpec.hs

@@ -42,14 +42,14 @@ import           Servant.API                ((:<|>) (..), (:>), AuthProtect,
                                              Headers, HttpVersion,
                                              IsSecure (..), JSON,
                                              NoContent (..), Patch, PlainText,
-                                             Post, Put,
+                                             Post, Put, EmptyAPI,
                                              QueryFlag, QueryParam, QueryParams,
                                              Raw, RemoteHost, ReqBody,
                                              StdMethod (..), Verb, addHeader)
 import           Servant.API.Internal.Test.ComprehensiveAPI
 import           Servant.Server             (Server, Handler, Tagged (..), err401, err403,
                                              err404, serve, serveWithContext,
-                                             Context((:.), EmptyContext))
+                                             Context((:.), EmptyContext), emptyServer)
 import           Test.Hspec                 (Spec, context, describe, it,
                                              shouldBe, shouldContain)
 import qualified Test.Hspec.Wai             as THW
@@ -609,6 +609,7 @@ type MiscCombinatorsAPI
   =    "version" :> HttpVersion :> Get '[JSON] String
   :<|> "secure"  :> IsSecure :> Get '[JSON] String
   :<|> "host"    :> RemoteHost :> Get '[JSON] String
+  :<|> "empty"   :> EmptyAPI
 
 miscApi :: Proxy MiscCombinatorsAPI
 miscApi = Proxy
@@ -617,6 +618,7 @@ miscServ :: Server MiscCombinatorsAPI
 miscServ = versionHandler
       :<|> secureHandler
       :<|> hostHandler
+      :<|> emptyServer
 
   where versionHandler = return . show
         secureHandler Secure = return "secure"
@@ -635,6 +637,9 @@ miscCombinatorSpec = with (return $ serve miscApi miscServ) $
     it "Checks that hspec-wai issues request from 0.0.0.0" $
       go "/host" "\"0.0.0.0:0\""
 
+    it "Doesn't serve anything from the empty API" $
+      Test.Hspec.Wai.get "empty" `shouldRespondWith` 404
+
   where go path res = Test.Hspec.Wai.get path `shouldRespondWith` res
 
 -- }}}

servant/servant.cabal

@@ -36,6 +36,7 @@ library
     Servant.API.BasicAuth
     Servant.API.Capture
     Servant.API.ContentTypes
+    Servant.API.Empty
     Servant.API.Experimental.Auth
     Servant.API.Header
     Servant.API.HttpVersion

servant/src/Servant/API.hs

@@ -5,6 +5,8 @@ module Servant.API (
   -- | Type-level combinator for expressing subrouting: @':>'@
   module Servant.API.Alternative,
   -- | Type-level combinator for alternative endpoints: @':<|>'@
+  module Servant.API.Empty,
+  -- | Type-level combinator for an empty API: @'EmptyAPI'@
 
   -- * Accessing information from the request
   module Servant.API.Capture,
@@ -66,6 +68,7 @@ import           Servant.API.ContentTypes    (Accept (..), FormUrlEncoded,
                                               MimeRender (..), NoContent (NoContent),
                                               MimeUnrender (..), OctetStream,
                                               PlainText)
+import           Servant.API.Empty           (EmptyAPI (..))
 import           Servant.API.Experimental.Auth (AuthProtect)
 import           Servant.API.Header          (Header (..))
 import           Servant.API.HttpVersion     (HttpVersion (..))

servant/src/Servant/API/Empty.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# OPTIONS_HADDOCK not-home    #-}
+module Servant.API.Empty(EmptyAPI(..)) where
+
+import           Data.Typeable    (Typeable)
+import           Prelude ()
+import           Prelude.Compat
+
+-- | An empty API: one which serves nothing. Morally speaking, this should be
+-- the unit of ':<|>'. Implementors of interpretations of API types should
+-- treat 'EmptyAPI' as close to the unit as possible.
+data EmptyAPI = EmptyAPI deriving (Typeable, Eq, Show, Bounded, Enum)

servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs

@@ -37,7 +37,8 @@ type ComprehensiveAPIWithoutRaw =
   Verb 'POST 204 '[JSON] NoContent :<|>
   Verb 'POST 204 '[JSON] Int :<|>
   WithNamedContext "foo" '[] GET :<|>
-  CaptureAll "foo" Int :> GET
+  CaptureAll "foo" Int :> GET :<|>
+  EmptyAPI
 
 comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw
 comprehensiveAPIWithoutRaw = Proxy

servant/test/Servant/Utils/LinksSpec.hs

@@ -25,6 +25,7 @@ type TestApi =
   :<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] NoContent
   :<|> "delete" :> Header "ponies" String :> Delete '[JSON] NoContent
   :<|> "raw" :> Raw
+  :<|> NoEndpoint
 
 
 apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
@@ -98,6 +99,11 @@ spec = describe "Servant.Utils.Links" $ do
 -- ...Could not deduce...
 -- ...
 --
+-- >>> apiLink (Proxy :: Proxy NoEndpoint)
+-- ...
+-- ...No instance for...
+-- ...
+--
 -- sanity check
 -- >>> toUrlPiece $ apiLink (Proxy :: Proxy AllGood)
 -- "get"
@@ -107,3 +113,4 @@ type WrongContentType = "get" :> Get '[OctetStream] NoContent
 type WrongMethod = "get" :> Post '[JSON] NoContent
 type NotALink = "hello" :> ReqBody '[JSON] 'True :> Get '[JSON] Bool
 type AllGood = "get" :> Get '[JSON] NoContent
+type NoEndpoint = "empty" :> EmptyAPI