diff --git a/servant-examples/wai-middleware/wai-middleware.hs b/servant-examples/wai-middleware/wai-middleware.hs
index 52368c00..7ad34c3f 100644
--- a/servant-examples/wai-middleware/wai-middleware.hs
+++ b/servant-examples/wai-middleware/wai-middleware.hs
@@ -41,7 +41,7 @@ server = return products
-- logStdout :: Middleware
-- i.e, logStdout :: Application -> Application
--- serve :: Proxy api -> Config a -> Server api -> Application
+-- serve :: Proxy api -> Config config -> Server api -> Application
-- so applying a middleware is really as simple as
-- applying a function to the result of 'serve'
app :: Application
diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs
index b8de9cf5..ea78a969 100644
--- a/servant-server/src/Servant/Server.hs
+++ b/servant-server/src/Servant/Server.hs
@@ -38,7 +38,10 @@ module Servant.Server
-- * Config
, Config(..)
+ , HasConfigEntry(getConfigEntry)
+ -- ** NamedConfig
, NamedConfig(..)
+ , descendIntoNamedConfig
-- * Default error type
, ServantErr(..)
diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs
index 17ecbbac..1b2c19a2 100644
--- a/servant-server/src/Servant/Server/Internal.hs
+++ b/servant-server/src/Servant/Server/Internal.hs
@@ -33,7 +33,6 @@ import Data.String (fromString)
import Data.String.Conversions (cs, (<>))
import Data.Text (Text)
import Data.Typeable
-import GHC.Exts (Constraint)
import GHC.TypeLits (KnownNat, KnownSymbol, natVal,
symbolVal)
import Network.HTTP.Types hiding (Header, ResponseHeaders)
diff --git a/servant-server/src/Servant/Server/Internal/Config.hs b/servant-server/src/Servant/Server/Internal/Config.hs
index e710de4b..c162494b 100644
--- a/servant-server/src/Servant/Server/Internal/Config.hs
+++ b/servant-server/src/Servant/Server/Internal/Config.hs
@@ -15,8 +15,18 @@ module Servant.Server.Internal.Config where
import Data.Proxy
import GHC.TypeLits
--- | The entire configuration.
-data Config a where
+-- | When calling 'Servant.Server.serve' you have to supply a configuration
+-- value of type @'Config' configTypes@. This parameter is used to pass values
+-- to combinators. (It shouldn't be confused with general configuration
+-- parameters for your web app, like the port, etc.). If you don't use
+-- combinators that require any config entries, you can just pass 'EmptyConfig'.
+-- To create a config with entries, use the operator @(':.')@. The parameter of
+-- the type 'Config' is a type-level list reflecting the types of the contained
+-- config entries:
+--
+-- >>> :type True :. () :. EmptyConfig
+-- True :. () :. EmptyConfig :: Config '[Bool, ()]
+data Config configTypes where
EmptyConfig :: Config '[]
(:.) :: x -> Config xs -> Config (x ': xs)
infixr 5 :.
@@ -33,6 +43,19 @@ instance Eq (Config '[]) where
instance (Eq a, Eq (Config as)) => Eq (Config (a ': as)) where
x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2
+-- | This class is used to access config entries in 'Config's. 'getConfigEntry'
+-- returns the first value where the type matches:
+--
+-- >>> getConfigEntry (True :. False :. EmptyConfig) :: Bool
+-- True
+--
+-- If the 'Config' does not contain an entry of the requested type, you'll get
+-- an error:
+--
+-- >>> getConfigEntry (True :. False :. EmptyConfig) :: String
+-- ...
+-- No instance for (HasConfigEntry '[] [Char])
+-- ...
class HasConfigEntry (config :: [*]) (val :: *) where
getConfigEntry :: Config config -> val
@@ -46,9 +69,28 @@ instance OVERLAPPING_
-- * support for named subconfigs
+-- | Normally config entries are accessed by their types. In case you need
+-- to have multiple values of the same type in your 'Config' and need to access
+-- them, we provide 'NamedConfig'. You can think of it as sub-namespaces for
+-- 'Config's.
data NamedConfig (name :: Symbol) (subConfig :: [*])
= NamedConfig (Config subConfig)
+-- | 'descendIntoNamedConfig' allows you to access `NamedConfig's. Usually you
+-- won't have to use it yourself but instead use a combinator like
+-- 'Servant.API.WithNamedConfig.WithNamedConfig'.
+--
+-- This is how 'descendIntoNamedConfig' works:
+--
+-- >>> :set -XFlexibleContexts
+-- >>> let subConfig = True :. EmptyConfig
+-- >>> :type subConfig
+-- subConfig :: Config '[Bool]
+-- >>> let parentConfig = False :. (NamedConfig subConfig :: NamedConfig "subConfig" '[Bool]) :. EmptyConfig
+-- >>> :type parentConfig
+-- parentConfig :: Config '[Bool, NamedConfig "subConfig" '[Bool]]
+-- >>> descendIntoNamedConfig (Proxy :: Proxy "subConfig") parentConfig :: Config '[Bool]
+-- True :. EmptyConfig
descendIntoNamedConfig :: forall config name subConfig .
HasConfigEntry config (NamedConfig name subConfig) =>
Proxy (name :: Symbol) -> Config config -> Config subConfig
diff --git a/servant/src/Servant/API/WithNamedConfig.hs b/servant/src/Servant/API/WithNamedConfig.hs
index 1beb3b8d..72b59e2f 100644
--- a/servant/src/Servant/API/WithNamedConfig.hs
+++ b/servant/src/Servant/API/WithNamedConfig.hs
@@ -6,20 +6,16 @@ module Servant.API.WithNamedConfig where
import GHC.TypeLits
-- | 'WithNamedConfig' names a specific tagged configuration to use for the
--- combinators in the API. For example:
+-- combinators in the API. (See also in @servant-server@,
+-- @Servant.Server.Config@.) For example:
--
--- > type UseNamedConfigAPI1 = WithNamedConfig "myConfig" '[String] (
+-- > type UseNamedConfigAPI = WithNamedConfig "myConfig" '[String] (
-- > ReqBody '[JSON] Int :> Get '[JSON] Int)
--
-- Both the 'ReqBody' and 'Get' combinators will use the 'NamedConfig' with
--- type tag "myConfig" as their configuration. In constrast, in (notice
--- parentesizing):
+-- type tag "myConfig" as their configuration.
--
--- > type UseNamedConfigAPI2 = WithNamedConfig "myConfig" '[String] (
--- > ReqBody '[JSON] Int) :> Get '[JSON] Int
---
--- Only the 'ReqBody' combinator will use this configuration, and 'Get' will
--- maintain the default configuration.
+-- 'Config's are only relevant for @servant-server@.
--
-- For more information, see the tutorial.
data WithNamedConfig (name :: Symbol) (subConfig :: [*]) subApi