server/config: always tag, but provide (.:.) for convenience

servant-server/src/Servant/Server.hs

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

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

@@ -28,6 +28,10 @@ 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
@@ -40,20 +44,16 @@ 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 :: Symbol) a = Tag a
+newtype Tagged tag a = Tag a
   deriving (Show, Eq)
 
 class HasConfigEntry (cfg :: [*]) tag (val :: *) where
     getConfigEntry :: Proxy tag -> Config cfg -> val
 
 instance OVERLAPPABLE_
-         HasConfigEntry xs tag val => HasConfigEntry (notIt ': xs) tag val where
+         HasConfigEntry xs tag val => HasConfigEntry (Tagged notItTag notIt ': xs) tag val where
     getConfigEntry proxy (_ :. xs) = getConfigEntry proxy xs
 
-instance OVERLAPPABLE_
-         HasConfigEntry (val ': xs) () val where
-    getConfigEntry proxy (x :. _) = x
-
 instance OVERLAPPABLE_
          HasConfigEntry (Tagged tag val ': xs) tag val where
-    getConfigEntry proxy (Tag x :. _) = x
+    getConfigEntry Proxy (Tag x :. _) = x

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

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

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

@@ -24,7 +24,7 @@ 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 :<|>
@@ -35,7 +35,7 @@ oneEntryTwiceApp = serve (Proxy :: Proxy OneEntryTwiceAPI) config $
   testServer :<|>
   testServer
   where
-    config = ("configEntryTwice" :: String) :. EmptyConfig
+    config = ("configEntryTwice" :: String) .:. EmptyConfig
 
 type TwoDifferentEntries =
   "foo" :> ExtractFromConfig "foo" :> Get '[JSON] String :<|>

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

@@ -41,7 +41,7 @@ instance forall subApi (c :: [*]) tag .
 data InjectIntoConfig (tag :: k)
 
 instance (HasServer subApi) =>
-  HasServer (InjectIntoConfig (tag :: Symbol) :> subApi) where
+  HasServer (InjectIntoConfig (tag :: k) :> subApi) where
 
   type ServerT (InjectIntoConfig tag :> subApi) m =
     ServerT subApi m
@@ -55,19 +55,3 @@ instance (HasServer 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 =
-    route subProxy newConfig delayed
-    where
-      subProxy :: Proxy subApi
-      subProxy = Proxy
-
-      newConfig = "injected" :. config