git.iko.soy/servant
on 54ba459 help sign in
servant/src/Servant/API/Alternative.hs
72 lines 2.5 kB history raw
1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE TypeOperators #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4module Servant.API.Alternative where
6import Data.Proxy
7import Servant.Client
8import Servant.Docs
9import Servant.Server
11-- | Union of two APIs, first takes precedence in case of overlap.
12--
13-- Example:
14--
15-- > type MyApi = "books" :> Get [Book] -- GET /books
16-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books
17data a :<|> b = a :<|> b
18infixr 8 :<|>
20-- | A server for @a ':<|>' b@ first tries to match the request again the route
21-- represented by @a@ and if it fails tries @b@. You must provide a request
22-- handler for each route.
23--
24-- > type MyApi = "books" :> Get [Book] -- GET /books
25-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books
26-- >
27-- > server :: Server MyApi
28-- > server = listAllBooks :<|> postBook
29-- > where listAllBooks = ...
30-- > postBook book = ...
31instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
32 type Server (a :<|> b) = Server a :<|> Server b
33 route Proxy (a :<|> b) request respond =
34 route pa a request $ \ mResponse ->
35 if isMismatch mResponse
36 then route pb b request $ \mResponse' -> respond (mResponse <> mResponse')
37 else respond mResponse
39 where pa = Proxy :: Proxy a
40 pb = Proxy :: Proxy b
42-- | A client querying function for @a ':<|>' b@ will actually hand you
43-- one function for querying @a@ and another one for querying @b@,
44-- stitching them together with ':<|>', which really is just like a pair.
45--
46-- > type MyApi = "books" :> Get [Book] -- GET /books
47-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books
48-- >
49-- > myApi :: Proxy MyApi
50-- > myApi = Proxy
51-- >
52-- > getAllBooks :: BaseUrl -> EitherT String IO [Book]
53-- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book
54-- > (getAllBooks :<|> postNewBook) = client myApi
55instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
56 type Client (a :<|> b) = Client a :<|> Client b
57 clientWithRoute Proxy req =
58 clientWithRoute (Proxy :: Proxy a) req :<|>
59 clientWithRoute (Proxy :: Proxy b) req
61-- | The generated docs for @a ':<|>' b@ just appends the docs
62-- for @a@ with the docs for @b@.
63instance (HasDocs layout1, HasDocs layout2)
64 => HasDocs (layout1 :<|> layout2) where
66 docsFor Proxy (ep, action) = docsFor p1 (ep, action) <> docsFor p2 (ep, action)
68 where p1 :: Proxy layout1
69 p1 = Proxy
71 p2 :: Proxy layout2
72 p2 = Proxy