From f5a08199900c8d3748f1d46b5be8862e73cbf31f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=B6nke=20Hahn?= <soenkehahn@gmail.com>
Date: Sun, 10 Jan 2016 15:59:33 +0100
Subject: [PATCH] server: add test cases for config using combinators

---
 .../test/Servant/Server/UsingConfigSpec.hs    | 59 +++++++++++++++----
 .../UsingConfigSpec/CustomCombinator.hs       | 21 +++----
 2 files changed, 55 insertions(+), 25 deletions(-)

diff --git a/servant-server/test/Servant/Server/UsingConfigSpec.hs b/servant-server/test/Servant/Server/UsingConfigSpec.hs
index b2d04f76..32f7d4e2 100644
--- a/servant-server/test/Servant/Server/UsingConfigSpec.hs
+++ b/servant-server/test/Servant/Server/UsingConfigSpec.hs
@@ -13,27 +13,64 @@ import           Servant.Server.UsingConfigSpec.CustomCombinator
 
 -- * API
 
-type API =
-  CustomCombinator :> Get '[JSON] String
+data Tag1
+data Tag2
 
-api :: Proxy API
-api = Proxy
+type OneEntryAPI =
+  CustomCombinator Tag1 :> Get '[JSON] String
 
-testServer :: Server API
+testServer :: Server OneEntryAPI
 testServer (CustomConfig s) = return s
 
-app :: Application
-app =
-  serve api config testServer
+oneEntryApp :: Application
+oneEntryApp =
+  serve (Proxy :: Proxy OneEntryAPI) config testServer
   where
-    config :: Config '[ConfigEntry Tag CustomConfig]
+    config :: Config '[ConfigEntry Tag1 CustomConfig]
     config = CustomConfig "configValue" .:. EmptyConfig
 
+type OneEntryTwiceAPI =
+  "foo" :> CustomCombinator Tag1 :> Get '[JSON] String :<|>
+  "bar" :> CustomCombinator Tag1 :> Get '[JSON] String
+
+oneEntryTwiceApp :: Application
+oneEntryTwiceApp = serve (Proxy :: Proxy OneEntryTwiceAPI) config $
+  testServer :<|>
+  testServer
+  where
+    config :: Config '[ConfigEntry Tag1 CustomConfig]
+    config = CustomConfig "configValueTwice" .:. EmptyConfig
+
+type TwoDifferentEntries =
+  "foo" :> CustomCombinator Tag1 :> Get '[JSON] String :<|>
+  "bar" :> CustomCombinator Tag2 :> Get '[JSON] String
+
+twoDifferentEntries :: Application
+twoDifferentEntries = serve (Proxy :: Proxy TwoDifferentEntries) config $
+  testServer :<|>
+  testServer
+  where
+    config :: Config '[ConfigEntry Tag1 CustomConfig, ConfigEntry Tag2 CustomConfig]
+    config =
+      CustomConfig "firstConfigValue" .:.
+      CustomConfig "secondConfigValue" .:.
+      EmptyConfig
+
 -- * tests
 
 spec :: Spec
 spec = do
   describe "using Config in a custom combinator" $ do
-    with (return app) $ do
-      it "allows to retrieve the ConfigEntry" $ do
+    with (return oneEntryApp) $ do
+      it "allows to retrieve a ConfigEntry" $ do
         get "/" `shouldRespondWith` "\"configValue\""
+
+    with (return oneEntryTwiceApp) $ do
+      it "allows to retrieve the same ConfigEntry twice" $ do
+        get "/foo" `shouldRespondWith` "\"configValueTwice\""
+        get "/bar" `shouldRespondWith` "\"configValueTwice\""
+
+    with (return twoDifferentEntries) $ do
+      it "allows to retrieve different ConfigEntries for the same combinator" $ do
+        get "/foo" `shouldRespondWith` "\"firstConfigValue\""
+        get "/bar" `shouldRespondWith` "\"secondConfigValue\""
diff --git a/servant-server/test/Servant/Server/UsingConfigSpec/CustomCombinator.hs b/servant-server/test/Servant/Server/UsingConfigSpec/CustomCombinator.hs
index 7af63c42..95f47588 100644
--- a/servant-server/test/Servant/Server/UsingConfigSpec/CustomCombinator.hs
+++ b/servant-server/test/Servant/Server/UsingConfigSpec/CustomCombinator.hs
@@ -13,29 +13,22 @@
 -- the config.
 module Servant.Server.UsingConfigSpec.CustomCombinator where
 
--- import           Network.Wai
--- import           Test.Hspec (Spec, describe, it)
--- import           Test.Hspec.Wai
-
 import           Servant
 import           Servant.Server.Internal.Config
--- import           Servant.Server.Internal.Router
 import           Servant.Server.Internal.RoutingApplication
 
-data CustomCombinator
+data CustomCombinator (tag :: *)
 
 data CustomConfig = CustomConfig String
 
-data Tag
-
-instance forall subApi (c :: [*]) .
+instance forall subApi (c :: [*]) tag .
   (HasServer subApi) =>
-  HasServer (CustomCombinator :> subApi) where
+  HasServer (CustomCombinator tag :> subApi) where
 
-  type ServerT (CustomCombinator :> subApi) m =
+  type ServerT (CustomCombinator tag :> subApi) m =
     CustomConfig -> ServerT subApi m
-  type HasCfg (CustomCombinator :> subApi) c =
-    (HasConfigEntry c Tag CustomConfig, HasCfg subApi c)
+  type HasCfg (CustomCombinator tag :> subApi) c =
+    (HasConfigEntry c tag CustomConfig, HasCfg subApi c)
 
   route Proxy config delayed =
     route subProxy config (fmap (inject config) delayed :: Delayed (Server subApi))
@@ -43,5 +36,5 @@ instance forall subApi (c :: [*]) .
       subProxy :: Proxy subApi
       subProxy = Proxy
 
-      inject config f = f (getConfigEntry (Proxy :: Proxy Tag) config)
+      inject config f = f (getConfigEntry (Proxy :: Proxy tag) config)