2014-10-25 01:27:39 +02:00
|
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
2014-10-30 11:37:58 +01:00
|
|
|
module Servant.API.Alternative where
|
2014-10-25 01:27:39 +02:00
|
|
|
|
|
|
|
import Data.Proxy
|
|
|
|
import Servant.Client
|
2014-10-28 09:04:27 +01:00
|
|
|
import Servant.Docs
|
2014-10-25 01:27:39 +02:00
|
|
|
import Servant.Server
|
|
|
|
|
|
|
|
-- | Union of two APIs, first takes precedence in case of overlap.
|
|
|
|
data a :<|> b = a :<|> b
|
|
|
|
infixr 8 :<|>
|
|
|
|
|
|
|
|
instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
|
|
|
|
type Server (a :<|> b) = Server a :<|> Server b
|
2014-10-28 14:34:28 +01:00
|
|
|
route Proxy (a :<|> b) request respond =
|
|
|
|
route pa a request $ \ mResponse ->
|
2014-10-28 16:50:42 +01:00
|
|
|
if isMismatch mResponse
|
|
|
|
then route pb b request $ \mResponse' -> respond (mResponse <> mResponse')
|
|
|
|
else respond mResponse
|
2014-10-28 14:34:28 +01:00
|
|
|
|
|
|
|
where pa = Proxy :: Proxy a
|
|
|
|
pb = Proxy :: Proxy b
|
2014-10-25 01:27:39 +02:00
|
|
|
|
|
|
|
instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
|
|
|
|
type Client (a :<|> b) = Client a :<|> Client b
|
|
|
|
clientWithRoute Proxy req =
|
|
|
|
clientWithRoute (Proxy :: Proxy a) req :<|>
|
2014-10-27 11:24:20 +01:00
|
|
|
clientWithRoute (Proxy :: Proxy b) req
|
2014-10-28 09:04:27 +01:00
|
|
|
|
|
|
|
instance (HasDocs layout1, HasDocs layout2)
|
|
|
|
=> HasDocs (layout1 :<|> layout2) where
|
|
|
|
|
|
|
|
docsFor Proxy (ep, action) = docsFor p1 (ep, action) <> docsFor p2 (ep, action)
|
|
|
|
|
|
|
|
where p1 :: Proxy layout1
|
|
|
|
p1 = Proxy
|
|
|
|
|
|
|
|
p2 :: Proxy layout2
|
|
|
|
p2 = Proxy
|