server/config: added more documentation
This commit is contained in:
parent
df09f8616e
commit
09b22452aa
5 changed files with 53 additions and 13 deletions
|
@ -41,7 +41,7 @@ server = return products
|
||||||
|
|
||||||
-- logStdout :: Middleware
|
-- logStdout :: Middleware
|
||||||
-- i.e, logStdout :: Application -> Application
|
-- 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
|
-- so applying a middleware is really as simple as
|
||||||
-- applying a function to the result of 'serve'
|
-- applying a function to the result of 'serve'
|
||||||
app :: Application
|
app :: Application
|
||||||
|
|
|
@ -38,7 +38,10 @@ module Servant.Server
|
||||||
|
|
||||||
-- * Config
|
-- * Config
|
||||||
, Config(..)
|
, Config(..)
|
||||||
|
, HasConfigEntry(getConfigEntry)
|
||||||
|
-- ** NamedConfig
|
||||||
, NamedConfig(..)
|
, NamedConfig(..)
|
||||||
|
, descendIntoNamedConfig
|
||||||
|
|
||||||
-- * Default error type
|
-- * Default error type
|
||||||
, ServantErr(..)
|
, ServantErr(..)
|
||||||
|
|
|
@ -33,7 +33,6 @@ import Data.String (fromString)
|
||||||
import Data.String.Conversions (cs, (<>))
|
import Data.String.Conversions (cs, (<>))
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
import GHC.Exts (Constraint)
|
|
||||||
import GHC.TypeLits (KnownNat, KnownSymbol, natVal,
|
import GHC.TypeLits (KnownNat, KnownSymbol, natVal,
|
||||||
symbolVal)
|
symbolVal)
|
||||||
import Network.HTTP.Types hiding (Header, ResponseHeaders)
|
import Network.HTTP.Types hiding (Header, ResponseHeaders)
|
||||||
|
|
|
@ -15,8 +15,18 @@ module Servant.Server.Internal.Config where
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import GHC.TypeLits
|
import GHC.TypeLits
|
||||||
|
|
||||||
-- | The entire configuration.
|
-- | When calling 'Servant.Server.serve' you have to supply a configuration
|
||||||
data Config a where
|
-- 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 '[]
|
EmptyConfig :: Config '[]
|
||||||
(:.) :: x -> Config xs -> Config (x ': xs)
|
(:.) :: x -> Config xs -> Config (x ': xs)
|
||||||
infixr 5 :.
|
infixr 5 :.
|
||||||
|
@ -33,6 +43,19 @@ instance Eq (Config '[]) where
|
||||||
instance (Eq a, Eq (Config as)) => Eq (Config (a ': as)) where
|
instance (Eq a, Eq (Config as)) => Eq (Config (a ': as)) where
|
||||||
x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2
|
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
|
class HasConfigEntry (config :: [*]) (val :: *) where
|
||||||
getConfigEntry :: Config config -> val
|
getConfigEntry :: Config config -> val
|
||||||
|
|
||||||
|
@ -46,9 +69,28 @@ instance OVERLAPPING_
|
||||||
|
|
||||||
-- * support for named subconfigs
|
-- * 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 :: [*])
|
data NamedConfig (name :: Symbol) (subConfig :: [*])
|
||||||
= NamedConfig (Config 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 .
|
descendIntoNamedConfig :: forall config name subConfig .
|
||||||
HasConfigEntry config (NamedConfig name subConfig) =>
|
HasConfigEntry config (NamedConfig name subConfig) =>
|
||||||
Proxy (name :: Symbol) -> Config config -> Config subConfig
|
Proxy (name :: Symbol) -> Config config -> Config subConfig
|
||||||
|
|
|
@ -6,20 +6,16 @@ module Servant.API.WithNamedConfig where
|
||||||
import GHC.TypeLits
|
import GHC.TypeLits
|
||||||
|
|
||||||
-- | 'WithNamedConfig' names a specific tagged configuration to use for the
|
-- | '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)
|
-- > ReqBody '[JSON] Int :> Get '[JSON] Int)
|
||||||
--
|
--
|
||||||
-- Both the 'ReqBody' and 'Get' combinators will use the 'NamedConfig' with
|
-- Both the 'ReqBody' and 'Get' combinators will use the 'NamedConfig' with
|
||||||
-- type tag "myConfig" as their configuration. In constrast, in (notice
|
-- type tag "myConfig" as their configuration.
|
||||||
-- parentesizing):
|
|
||||||
--
|
--
|
||||||
-- > type UseNamedConfigAPI2 = WithNamedConfig "myConfig" '[String] (
|
-- 'Config's are only relevant for @servant-server@.
|
||||||
-- > ReqBody '[JSON] Int) :> Get '[JSON] Int
|
|
||||||
--
|
|
||||||
-- Only the 'ReqBody' combinator will use this configuration, and 'Get' will
|
|
||||||
-- maintain the default configuration.
|
|
||||||
--
|
--
|
||||||
-- For more information, see the tutorial.
|
-- For more information, see the tutorial.
|
||||||
data WithNamedConfig (name :: Symbol) (subConfig :: [*]) subApi
|
data WithNamedConfig (name :: Symbol) (subConfig :: [*]) subApi
|
||||||
|
|
Loading…
Reference in a new issue