server/config: remove general tagging from Config

servant-server/src/Servant/Server.hs

@@ -38,8 +38,6 @@ module Servant.Server
 
   -- * Config
   , Config(..)
-  , (.:.)
-  , Tagged(..)
 
     -- * Default error type
   , ServantErr(..)

servant-server/src/Servant/Server/Internal/Config.hs

@@ -28,10 +28,6 @@ data Config a where
     (:.) :: x -> Config xs -> Config (x ': xs)
 infixr 5 :.
 
-(.:.) :: forall x xs . x -> Config xs -> Config (Tagged () x ': xs)
-x .:. xs = (Tag x :: Tagged () x) :. xs
-infixr 5 .:.
-
 instance Show (Config '[]) where
   show EmptyConfig = "EmptyConfig"
 instance (Show a, Show (Config as)) => Show (Config (a ': as)) where
@@ -44,16 +40,13 @@ instance Eq (Config '[]) where
 instance (Eq a, Eq (Config as)) => Eq (Config (a ': as)) where
     x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2
 
-newtype Tagged tag a = Tag a
-  deriving (Show, Eq)
-
-class HasConfigEntry (cfg :: [*]) tag (val :: *) where
-    getConfigEntry :: Proxy tag -> Config cfg -> val
+class HasConfigEntry (cfg :: [*]) (val :: *) where
+    getConfigEntry :: Config cfg -> val
 
 instance OVERLAPPABLE_
-         HasConfigEntry xs tag val => HasConfigEntry (Tagged notItTag notIt ': xs) tag val where
-    getConfigEntry proxy (_ :. xs) = getConfigEntry proxy xs
+         HasConfigEntry xs val => HasConfigEntry (notIt ': xs) val where
+    getConfigEntry (_ :. xs) = getConfigEntry xs
 
 instance OVERLAPPABLE_
-         HasConfigEntry (Tagged tag val ': xs) tag val where
-    getConfigEntry Proxy (Tag x :. _) = x
+         HasConfigEntry (val ': xs) val where
+    getConfigEntry (x :. _) = x

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

@@ -13,21 +13,16 @@ spec :: Spec
 spec = do
   describe "getConfigEntry" $ do
     it "gets the config if a matching one exists" $ do
-      let config = 'a' .:. EmptyConfig
-      getConfigEntry (Proxy :: Proxy ()) config `shouldBe` 'a'
+      let config = 'a' :. EmptyConfig
+      getConfigEntry config `shouldBe` 'a'
 
     it "gets the first matching config" $ do
-      let config = 'a' .:. 'b' .:. EmptyConfig
-      getConfigEntry (Proxy :: Proxy ()) config `shouldBe` 'a'
-
-    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'
+      let config = 'a' :. 'b' :. EmptyConfig
+      getConfigEntry config `shouldBe` 'a'
 
     it "does not typecheck if type does not exist" $ do
-      let config = 'a' .:. EmptyConfig
-          x = getConfigEntry (Proxy :: Proxy ()) config :: Bool
+      let config = 'a' :. EmptyConfig
+          x = getConfigEntry config :: Bool
       shouldNotTypecheck x
 
     it "does not typecheck if tag does not exist" $ do

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

@@ -16,7 +16,7 @@ import           Servant.Server.UsingConfigSpec.TestCombinators
 -- * API
 
 type OneEntryAPI =
-  ExtractFromConfig () :> Get '[JSON] String
+  ExtractFromConfig :> Get '[JSON] String
 
 testServer :: String -> ExceptT ServantErr IO String
 testServer s = return s
@@ -25,32 +25,18 @@ oneEntryApp :: Application
 oneEntryApp =
   serve (Proxy :: Proxy OneEntryAPI) config testServer
   where
-    config = ("configEntry" :: String) .:. EmptyConfig
+    config = ("configEntry" :: String) :. EmptyConfig
 
 type OneEntryTwiceAPI =
-  "foo" :> ExtractFromConfig () :> Get '[JSON] String :<|>
-  "bar" :> ExtractFromConfig () :> Get '[JSON] String
+  "foo" :> ExtractFromConfig :> Get '[JSON] String :<|>
+  "bar" :> ExtractFromConfig :> Get '[JSON] String
 
 oneEntryTwiceApp :: Application
 oneEntryTwiceApp = serve (Proxy :: Proxy OneEntryTwiceAPI) config $
   testServer :<|>
   testServer
   where
-    config = ("configEntryTwice" :: String) .:. EmptyConfig
-
-type TwoDifferentEntries =
-  "foo" :> ExtractFromConfig "foo" :> Get '[JSON] String :<|>
-  "bar" :> ExtractFromConfig "bar" :> Get '[JSON] String
-
-twoDifferentEntries :: Application
-twoDifferentEntries = serve (Proxy :: Proxy TwoDifferentEntries) config $
-  testServer :<|>
-  testServer
-  where
-    config =
-      (Tag "firstEntry" :: Tagged "foo" String) :.
-      (Tag "secondEntry" :: Tagged "bar" String) :.
-      EmptyConfig
+    config = ("configEntryTwice" :: String) :. EmptyConfig
 
 -- * tests
 
@@ -66,17 +52,12 @@ spec = do
         get "/foo" `shouldRespondWith` "\"configEntryTwice\""
         get "/bar" `shouldRespondWith` "\"configEntryTwice\""
 
-    with (return twoDifferentEntries) $ do
-      it "allows to retrieve different ConfigEntries for the same combinator" $ do
-        get "/foo" `shouldRespondWith` "\"firstEntry\""
-        get "/bar" `shouldRespondWith` "\"secondEntry\""
-
   spec2
 
 type InjectAPI =
-  InjectIntoConfig () :> "untagged" :> ExtractFromConfig () :>
+  InjectIntoConfig :> "untagged" :> ExtractFromConfig :>
     Get '[JSON] String :<|>
-  InjectIntoConfig "tag" :> "tagged" :> ExtractFromConfig "tag" :>
+  InjectIntoConfig :> "tagged" :> ExtractFromConfig :>
     Get '[JSON] String
 
 injectApp :: Application
@@ -99,21 +80,22 @@ spec2 = do
   spec3
 
 type SubConfigAPI =
-  "foo" :> ExtractFromConfig () :> Get '[JSON] String :<|>
-  SubConfig "sub" '[Tagged () String] :>
-    "bar" :> ExtractFromConfig () :> Get '[JSON] String
+  "foo" :> ExtractFromConfig :> Get '[JSON] String :<|>
+  SubConfig "sub" '[String] :>
+    "bar" :> ExtractFromConfig :> Get '[JSON] String
 
 subConfigApp :: Application
 subConfigApp = serve (Proxy :: Proxy SubConfigAPI) config $
   testServer :<|>
   testServer
   where
-    config :: Config '[Tagged () String, Tagged () (Tagged "sub" (Config '[Tagged () String]))]
+    config :: Config '[String, (Tagged "sub" (Config '[String]))]
     config =
-      ("firstEntry" :: String) .:.
-      (Tag (("secondEntry") .:. EmptyConfig)) .:.
+      ("firstEntry" :: String) :.
+      (Tag (("secondEntry" :: String) :. EmptyConfig)) :.
       EmptyConfig
 
+spec3 :: Spec
 spec3 = do
   with (return subConfigApp) $ do
     it "allows to retrieve different ConfigEntries for the same combinator" $ do

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

@@ -19,16 +19,16 @@ import           Servant
 import           Servant.Server.Internal.Config
 import           Servant.Server.Internal.RoutingApplication
 
-data ExtractFromConfig (tag :: k)
+data ExtractFromConfig
 
-instance forall subApi (c :: [*]) tag .
+instance forall subApi (c :: [*]) .
   (HasServer subApi) =>
-  HasServer (ExtractFromConfig tag :> subApi) where
+  HasServer (ExtractFromConfig :> subApi) where
 
-  type ServerT (ExtractFromConfig tag :> subApi) m =
+  type ServerT (ExtractFromConfig :> subApi) m =
     String -> ServerT subApi m
-  type HasCfg (ExtractFromConfig tag :> subApi) c =
-    (HasConfigEntry c tag String, HasCfg subApi c)
+  type HasCfg (ExtractFromConfig :> subApi) c =
+    (HasConfigEntry c String, HasCfg subApi c)
 
   route Proxy config delayed =
     route subProxy config (fmap (inject config) delayed :: Delayed (Server subApi))
@@ -36,17 +36,17 @@ instance forall subApi (c :: [*]) tag .
       subProxy :: Proxy subApi
       subProxy = Proxy
 
-      inject config f = f (getConfigEntry (Proxy :: Proxy tag) config)
+      inject config f = f (getConfigEntry config)
 
-data InjectIntoConfig (tag :: k)
+data InjectIntoConfig
 
 instance (HasServer subApi) =>
-  HasServer (InjectIntoConfig (tag :: k) :> subApi) where
+  HasServer (InjectIntoConfig :> subApi) where
 
-  type ServerT (InjectIntoConfig tag :> subApi) m =
+  type ServerT (InjectIntoConfig :> subApi) m =
     ServerT subApi m
-  type HasCfg (InjectIntoConfig tag :> subApi) c =
-    (HasCfg subApi (Tagged tag String ': c))
+  type HasCfg (InjectIntoConfig :> subApi) c =
+    (HasCfg subApi (String ': c))
 
   route Proxy config delayed =
     route subProxy newConfig delayed
@@ -54,17 +54,20 @@ instance (HasServer subApi) =>
       subProxy :: Proxy subApi
       subProxy = Proxy
 
-      newConfig = (Tag "injected" :: Tagged tag String) :. config
+      newConfig = ("injected" :: String) :. config
 
 data SubConfig (name :: Symbol) (subConfig :: [*])
 
+newtype Tagged tag a = Tag a
+  deriving (Show, Eq)
+
 instance (HasServer subApi) =>
   HasServer (SubConfig name subConfig :> subApi) where
 
   type ServerT (SubConfig name subConfig :> subApi) m =
     ServerT subApi m
   type HasCfg (SubConfig name subConfig :> subApi) config =
-    (HasConfigEntry config () (Tagged name (Config subConfig)), HasCfg subApi subConfig)
+    (HasConfigEntry config (Tagged name (Config subConfig)), HasCfg subApi subConfig)
 
   route Proxy config delayed =
     route subProxy subConfig delayed
@@ -74,5 +77,5 @@ instance (HasServer subApi) =>
 
       subConfig :: Config subConfig
       subConfig =
-        let Tag x = (getConfigEntry (Proxy :: Proxy ()) config) :: Tagged name (Config subConfig)
+        let Tag x = getConfigEntry config :: Tagged name (Config subConfig)
         in x