From ec0431d9308661657bcc97191c039149c2717092 Mon Sep 17 00:00:00 2001
From: Catherine Galkina <catherine@getshoptv.com>
Date: Thu, 8 Jun 2017 18:27:36 +0300
Subject: [PATCH] Add instances for new combinators

---
 servant-client/src/Servant/Client.hs          | 12 +++++++++++
 servant-docs/src/Servant/Docs/Internal.hs     | 21 +++++++++++++++++++
 .../src/Servant/Foreign/Internal.hs           | 14 +++++++++++++
 servant-server/src/Servant/Server/Internal.hs | 15 ++++++++++++-
 4 files changed, 61 insertions(+), 1 deletion(-)

diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs
index dfe2721c..b79fcf08 100644
--- a/servant-client/src/Servant/Client.hs
+++ b/servant-client/src/Servant/Client.hs
@@ -263,6 +263,18 @@ instance HasClient api
   clientWithRoute Proxy =
     clientWithRoute (Proxy :: Proxy api)
 
+-- | Ignore @'Summary'@ in client functions.
+instance HasClient api => HasClient (Summary desc :> api) where
+  type Client (Summary desc :> api) = Client api
+
+  clientWithRoute _ = clientWithRoute (Proxy :: Proxy api)
+
+-- | Ignore @'Description'@ in client functions.
+instance HasClient api => HasClient (Description desc :> api) where
+  type Client (Description desc :> api) = Client api
+
+  clientWithRoute _ = clientWithRoute (Proxy :: Proxy api)
+
 -- | If you use a 'QueryParam' in one of your endpoints in your API,
 -- the corresponding querying function will automatically take
 -- an additional argument of the type specified by your 'QueryParam',
diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs
index 7cdbef80..db29ab86 100644
--- a/servant-docs/src/Servant/Docs/Internal.hs
+++ b/servant-docs/src/Servant/Docs/Internal.hs
@@ -798,6 +798,27 @@ instance HasDocs Raw where
   docsFor _proxy (endpoint, action) _ =
     single endpoint action
 
+
+instance (KnownSymbol desc, HasDocs api)
+  => HasDocs (Description desc :> api) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor subApiP (endpoint, action')
+
+    where subApiP = Proxy :: Proxy api
+          action' = over notes (|> note) action
+          note = DocNote (symbolVal (Proxy :: Proxy desc)) []
+
+instance (KnownSymbol desc, HasDocs api)
+  => HasDocs (Summary desc :> api) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor subApiP (endpoint, action')
+
+    where subApiP = Proxy :: Proxy api
+          action' = over notes (|> note) action
+          note = DocNote (symbolVal (Proxy :: Proxy desc)) []
+
 -- TODO: We use 'AllMimeRender' here because we need to be able to show the
 -- example data. However, there's no reason to believe that the instances of
 -- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs
index fd12befd..b0a3410f 100644
--- a/servant-foreign/src/Servant/Foreign/Internal.hs
+++ b/servant-foreign/src/Servant/Foreign/Internal.hs
@@ -350,6 +350,20 @@ instance HasForeign lang ftype api
   foreignFor lang ftype Proxy req =
     foreignFor lang ftype (Proxy :: Proxy api) req
 
+instance HasForeign lang ftype api
+  => HasForeign lang ftype (Summary desc :> api) where
+  type Foreign ftype (Summary desc :> api) = Foreign ftype api
+
+  foreignFor lang ftype Proxy req =
+    foreignFor lang ftype (Proxy :: Proxy api) req
+
+instance HasForeign lang ftype api
+  => HasForeign lang ftype (Description desc :> api) where
+  type Foreign ftype (Description desc :> api) = Foreign ftype api
+
+  foreignFor lang ftype Proxy req =
+    foreignFor lang ftype (Proxy :: Proxy api) req
+
 -- | Utility class used by 'listFromAPI' which computes
 --   the data needed to generate a function for each endpoint
 --   and hands it all back in a list.
diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs
index d336fb0f..b6656fb8 100644
--- a/servant-server/src/Servant/Server/Internal.hs
+++ b/servant-server/src/Servant/Server/Internal.hs
@@ -58,7 +58,8 @@ import           Servant.API                 ((:<|>) (..), (:>), BasicAuth, Capt
                                               IsSecure(..), Header, QueryFlag,
                                               QueryParam, QueryParams, Raw,
                                               RemoteHost, ReqBody, Vault,
-                                              WithNamedContext)
+                                              WithNamedContext,
+                                              Description, Summary)
 import           Servant.API.ContentTypes    (AcceptHeader (..),
                                               AllCTRender (..),
                                               AllCTUnrender (..),
@@ -533,6 +534,18 @@ instance HasServer api context => HasServer (HttpVersion :> api) context where
   route Proxy context subserver =
     route (Proxy :: Proxy api) context (passToServer subserver httpVersion)
 
+-- | Ignore @'Summary'@ in server handlers.
+instance HasServer api ctx => HasServer (Summary desc :> api) ctx where
+  type ServerT (Summary desc :> api) m = ServerT api m
+
+  route _ = route (Proxy :: Proxy api)
+
+-- | Ignore @'Description'@ in server handlers.
+instance HasServer api ctx => HasServer (Description desc :> api) ctx where
+  type ServerT (Description desc :> api) m = ServerT api m
+
+  route _ = route (Proxy :: Proxy api)
+
 -- | Singleton type representing a server that serves an empty API.
 data EmptyServer = EmptyServer deriving (Typeable, Eq, Show, Bounded, Enum)