From 09b22452aa62ed1d562bb8fceec953d0b3bac16d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B6nke=20Hahn?= Date: Thu, 21 Jan 2016 17:51:40 +0100 Subject: [PATCH] server/config: added more documentation --- .../wai-middleware/wai-middleware.hs | 2 +- servant-server/src/Servant/Server.hs | 3 ++ servant-server/src/Servant/Server/Internal.hs | 1 - .../src/Servant/Server/Internal/Config.hs | 46 ++++++++++++++++++- servant/src/Servant/API/WithNamedConfig.hs | 14 ++---- 5 files changed, 53 insertions(+), 13 deletions(-) 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