From 5e7d1c108161bd4dca1625b35e40f0c6d8a2b5fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=B6nke=20Hahn?= <soenkehahn@gmail.com>
Date: Wed, 13 Jan 2016 15:40:40 +0100
Subject: [PATCH] server/config: allow injecting tagged config entries

---
 .../test/Servant/Server/UsingConfigSpec.hs    | 12 ++++++---
 .../Server/UsingConfigSpec/TestCombinators.hs | 26 ++++++++++++++++---
 2 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/servant-server/test/Servant/Server/UsingConfigSpec.hs b/servant-server/test/Servant/Server/UsingConfigSpec.hs
index 66e7ac38..8eab507a 100644
--- a/servant-server/test/Servant/Server/UsingConfigSpec.hs
+++ b/servant-server/test/Servant/Server/UsingConfigSpec.hs
@@ -73,12 +73,15 @@ spec = do
   spec2
 
 type InjectAPI =
-  InjectIntoConfig :> "somePath" :> ExtractFromConfig () :>
+  InjectIntoConfig () :> "untagged" :> ExtractFromConfig () :>
+    Get '[JSON] String :<|>
+  InjectIntoConfig "tag" :> "tagged" :> ExtractFromConfig "tag" :>
     Get '[JSON] String
 
 injectApp :: Application
 injectApp = serve (Proxy :: Proxy InjectAPI) config $
-  \ s -> return s
+  (\ s -> return s) :<|>
+  (\ s -> return ("tagged: " ++ s))
   where
     config = EmptyConfig
 
@@ -87,4 +90,7 @@ spec2 = do
   with (return injectApp) $ do
     describe "inserting config entries with custom combinators" $ do
       it "allows to inject config entries" $ do
-        get "/somePath" `shouldRespondWith` "\"injected\""
+        get "/untagged" `shouldRespondWith` "\"injected\""
+
+      it "allows to inject tagged config entries" $ do
+        get "/tagged" `shouldRespondWith` "\"tagged: injected\""
diff --git a/servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs b/servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs
index 9d6ebd2a..442fc86f 100644
--- a/servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs
+++ b/servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs
@@ -13,6 +13,8 @@
 -- the config.
 module Servant.Server.UsingConfigSpec.TestCombinators where
 
+import           GHC.TypeLits
+
 import           Servant
 import           Servant.Server.Internal.Config
 import           Servant.Server.Internal.RoutingApplication
@@ -36,14 +38,30 @@ instance forall subApi (c :: [*]) tag .
 
       inject config f = f (getConfigEntry (Proxy :: Proxy tag) config)
 
-data InjectIntoConfig
+data InjectIntoConfig (tag :: k)
 
 instance (HasServer subApi) =>
-  HasServer (InjectIntoConfig :> subApi) where
+  HasServer (InjectIntoConfig (tag :: Symbol) :> subApi) where
 
-  type ServerT (InjectIntoConfig :> subApi) m =
+  type ServerT (InjectIntoConfig tag :> subApi) m =
     ServerT subApi m
-  type HasCfg (InjectIntoConfig :> subApi) c =
+  type HasCfg (InjectIntoConfig tag :> subApi) c =
+    (HasCfg subApi (Tagged tag String ': c))
+
+  route Proxy config delayed =
+    route subProxy newConfig delayed
+    where
+      subProxy :: Proxy subApi
+      subProxy = Proxy
+
+      newConfig = (Tag "injected" :: Tagged tag String) :. config
+
+instance (HasServer subApi) =>
+  HasServer (InjectIntoConfig () :> subApi) where
+
+  type ServerT (InjectIntoConfig () :> subApi) m =
+    ServerT subApi m
+  type HasCfg (InjectIntoConfig () :> subApi) c =
     (HasCfg subApi (String ': c))
 
   route Proxy config delayed =