server/config: some refactoring

servant-server/test/Servant/Server/Internal/ConfigSpec.hs

@@ -11,42 +11,39 @@ import           Servant.Server.Internal.Config
 
 spec :: Spec
 spec = do
-  getConfigEntrySpec
+  describe "getConfigEntry" $ do
+    it "gets the config if a matching one exists" $ do
+      let config = 'a' :. EmptyConfig
+      getConfigEntry (Proxy :: Proxy ()) config `shouldBe` 'a'
 
-getConfigEntrySpec :: Spec
-getConfigEntrySpec = describe "getConfigEntry" $ do
+    it "gets the first matching config" $ do
+      let config = 'a' :. 'b' :. EmptyConfig
+      getConfigEntry (Proxy :: Proxy ()) config `shouldBe` 'a'
 
-  let cfg1 = (0 :: Int) :. EmptyConfig
-      cfg2 = (1 :: Int) :. cfg1
+    it "allows to distinguish between different config entries with the same type by tag" $ do
+      let config = 'a' :. (Tag 'b' :: Tagged "second" Char) :. EmptyConfig
+      getConfigEntry (Proxy :: Proxy ()) config `shouldBe` 'a'
+      getConfigEntry (Proxy :: Proxy "second") config `shouldBe` 'b'
 
-  it "gets the config if a matching one exists" $ do
-    getConfigEntry (Proxy :: Proxy ()) cfg1 `shouldBe` (0 :: Int)
+    it "does not typecheck if type does not exist" $ do
+      let config = 'a' :. EmptyConfig
+          x = getConfigEntry (Proxy :: Proxy ()) config :: Bool
+      shouldNotTypecheck x
 
-  it "gets the first matching config" $ do
-    getConfigEntry (Proxy :: Proxy ()) cfg2 `shouldBe` (1 :: Int)
+    it "does not typecheck if tag does not exist" $ do
+      let config = (Tag 'a' :: Tagged "foo" Char) :. EmptyConfig
+          x = getConfigEntry (Proxy :: Proxy "bar") config :: Char
+      shouldNotTypecheck x
 
-  it "allows to distinguish between different config entries with the same type by tag" $ do
-    let cfg = 'a' :. (Tag 'b' :: Tagged "second" Char) :. EmptyConfig
-    getConfigEntry (Proxy :: Proxy ()) cfg `shouldBe` 'a'
-    getConfigEntry (Proxy :: Proxy "second") cfg `shouldBe` 'b'
+    context "Show instance" $ do
+      let config = 'a' :. True :. EmptyConfig
+      it "has a Show instance" $ do
+        show config `shouldBe` "'a' :. True :. EmptyConfig"
 
-  it "does not typecheck if type does not exist" $ do
-    let x = getConfigEntry (Proxy :: Proxy ()) cfg1 :: Bool
-    shouldNotTypecheck x
+      context "bracketing" $ do
+        it "works" $ do
+          show (Just config) `shouldBe` "Just ('a' :. True :. EmptyConfig)"
 
-  it "does not typecheck if tag does not exist" $ do
-    let cfg = (Tag 'a' :: Tagged "foo" Char) :. EmptyConfig
-        x = getConfigEntry (Proxy :: Proxy "bar") cfg :: Char
-    shouldNotTypecheck x
-
-  context "Show instance" $ do
-    let cfg = 1 :. 2 :. EmptyConfig
-    it "has a Show instance" $ do
-      show cfg `shouldBe` "1 :. 2 :. EmptyConfig"
-
-    it "bracketing works" $ do
-      show (Just cfg) `shouldBe` "Just (1 :. 2 :. EmptyConfig)"
-
-    it "bracketing works with operators" $ do
-      let cfg = (1 :. 'a' :. EmptyConfig) :<|> ('b' :. True :. EmptyConfig)
-      show cfg `shouldBe` "(1 :. 'a' :. EmptyConfig) :<|> ('b' :. True :. EmptyConfig)"
+        it "works with operators" $ do
+          let config = (1 :. 'a' :. EmptyConfig) :<|> ('b' :. True :. EmptyConfig)
+          show config `shouldBe` "(1 :. 'a' :. EmptyConfig) :<|> ('b' :. True :. EmptyConfig)"

servant-server/test/Servant/Server/UsingConfigSpec.hs

@@ -24,7 +24,7 @@ oneEntryApp :: Application
 oneEntryApp =
   serve (Proxy :: Proxy OneEntryAPI) config testServer
   where
-    config = ("configValue" :: String) :. EmptyConfig
+    config = 'a' :. EmptyConfig
 
 type OneEntryTwiceAPI =
   "foo" :> CustomCombinator () :> Get '[JSON] String :<|>
@@ -35,7 +35,7 @@ oneEntryTwiceApp = serve (Proxy :: Proxy OneEntryTwiceAPI) config $
   testServer :<|>
   testServer
   where
-    config = ("configValueTwice" :: String) :. EmptyConfig
+    config = '2' :. EmptyConfig
 
 type TwoDifferentEntries =
   "foo" :> CustomCombinator "foo" :> Get '[JSON] String :<|>
@@ -47,8 +47,8 @@ twoDifferentEntries = serve (Proxy :: Proxy TwoDifferentEntries) config $
   testServer
   where
     config =
-      (Tag "firstConfigValue" :: Tagged "foo" String) :.
-      (Tag "secondConfigValue" :: Tagged "bar" String) :.
+      (Tag 'x' :: Tagged "foo" Char) :.
+      (Tag 'y' :: Tagged "bar" Char) :.
       EmptyConfig
 
 -- * tests
@@ -58,14 +58,14 @@ spec = do
   describe "using Config in a custom combinator" $ do
     with (return oneEntryApp) $ do
       it "allows to retrieve a ConfigEntry" $ do
-        get "/" `shouldRespondWith` "\"configValue\""
+        get "/" `shouldRespondWith` "\"a\""
 
     with (return oneEntryTwiceApp) $ do
       it "allows to retrieve the same ConfigEntry twice" $ do
-        get "/foo" `shouldRespondWith` "\"configValueTwice\""
-        get "/bar" `shouldRespondWith` "\"configValueTwice\""
+        get "/foo" `shouldRespondWith` "\"2\""
+        get "/bar" `shouldRespondWith` "\"2\""
 
     with (return twoDifferentEntries) $ do
       it "allows to retrieve different ConfigEntries for the same combinator" $ do
-        get "/foo" `shouldRespondWith` "\"firstConfigValue\""
-        get "/bar" `shouldRespondWith` "\"secondConfigValue\""
+        get "/foo" `shouldRespondWith` "\"x\""
+        get "/bar" `shouldRespondWith` "\"y\""

servant-server/test/Servant/Server/UsingConfigSpec/CustomCombinator.hs

@@ -25,7 +25,7 @@ instance forall subApi (c :: [*]) tag .
   type ServerT (CustomCombinator tag :> subApi) m =
     String -> ServerT subApi m
   type HasCfg (CustomCombinator tag :> subApi) c =
-    (HasConfigEntry c tag String, HasCfg subApi c)
+    (HasConfigEntry c tag Char, HasCfg subApi c)
 
   route Proxy config delayed =
     route subProxy config (fmap (inject config) delayed :: Delayed (Server subApi))
@@ -33,4 +33,4 @@ instance forall subApi (c :: [*]) tag .
       subProxy :: Proxy subApi
       subProxy = Proxy
 
-      inject config f = f (getConfigEntry (Proxy :: Proxy tag) config)
+      inject config f = f [getConfigEntry (Proxy :: Proxy tag) config]