server/config: renamings
This commit is contained in:
parent
9dc022bcdd
commit
88dda2f9c6
5 changed files with 32 additions and 39 deletions
|
@ -37,7 +37,6 @@ module Servant.Server
|
||||||
|
|
||||||
-- * Config
|
-- * Config
|
||||||
, Config(..)
|
, Config(..)
|
||||||
, (.:.)
|
|
||||||
|
|
||||||
-- * Default error type
|
-- * Default error type
|
||||||
, ServantErr(..)
|
, ServantErr(..)
|
||||||
|
|
|
@ -26,31 +26,28 @@ import Data.Typeable (Typeable)
|
||||||
-- | The entire configuration.
|
-- | The entire configuration.
|
||||||
data Config a where
|
data Config a where
|
||||||
EmptyConfig :: Config '[]
|
EmptyConfig :: Config '[]
|
||||||
ConsConfig :: x -> Config xs -> Config (x ': xs)
|
(:.) :: x -> Config xs -> Config (x ': xs)
|
||||||
|
infixr 5 :.
|
||||||
|
|
||||||
instance Show (Config '[]) where
|
instance Show (Config '[]) where
|
||||||
show EmptyConfig = "EmptyConfig"
|
show EmptyConfig = "EmptyConfig"
|
||||||
instance (Show a, Show (Config as)) => Show (Config (a ': as)) where
|
instance (Show a, Show (Config as)) => Show (Config (a ': as)) where
|
||||||
showsPrec outerPrecedence (ConsConfig a as) =
|
showsPrec outerPrecedence (a :. as) =
|
||||||
showParen (outerPrecedence > 5) $
|
showParen (outerPrecedence > 5) $
|
||||||
shows a . showString " .:. " . shows as
|
shows a . showString " :. " . shows as
|
||||||
|
|
||||||
instance Eq (Config '[]) where
|
instance Eq (Config '[]) where
|
||||||
_ == _ = True
|
_ == _ = True
|
||||||
instance (Eq a, Eq (Config as)) => Eq (Config (a ': as)) where
|
instance (Eq a, Eq (Config as)) => Eq (Config (a ': as)) where
|
||||||
ConsConfig x1 y1 == ConsConfig x2 y2 = x1 == x2 && y1 == y2
|
x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2
|
||||||
|
|
||||||
(.:.) :: x -> Config xs -> Config (x ': xs)
|
|
||||||
e .:. cfg = ConsConfig e cfg
|
|
||||||
infixr 5 .:.
|
|
||||||
|
|
||||||
class HasConfigEntry (cfg :: [*]) (val :: *) where
|
class HasConfigEntry (cfg :: [*]) (val :: *) where
|
||||||
getConfigEntry :: Config cfg -> val
|
getConfigEntry :: Config cfg -> val
|
||||||
|
|
||||||
instance OVERLAPPABLE_
|
instance OVERLAPPABLE_
|
||||||
HasConfigEntry xs val => HasConfigEntry (notIt ': xs) val where
|
HasConfigEntry xs val => HasConfigEntry (notIt ': xs) val where
|
||||||
getConfigEntry (ConsConfig _ xs) = getConfigEntry xs
|
getConfigEntry (_ :. xs) = getConfigEntry xs
|
||||||
|
|
||||||
instance OVERLAPPABLE_
|
instance OVERLAPPABLE_
|
||||||
HasConfigEntry (val ': xs) val where
|
HasConfigEntry (val ': xs) val where
|
||||||
getConfigEntry (ConsConfig x _) = x
|
getConfigEntry (x :. _) = x
|
||||||
|
|
|
@ -18,8 +18,8 @@ newtype Wrapped a = Wrap { unwrap :: a }
|
||||||
getConfigEntrySpec :: Spec
|
getConfigEntrySpec :: Spec
|
||||||
getConfigEntrySpec = describe "getConfigEntry" $ do
|
getConfigEntrySpec = describe "getConfigEntry" $ do
|
||||||
|
|
||||||
let cfg1 = 0 .:. EmptyConfig :: Config '[Int]
|
let cfg1 = 0 :. EmptyConfig :: Config '[Int]
|
||||||
cfg2 = 1 .:. cfg1 :: Config '[Int, Int]
|
cfg2 = 1 :. cfg1 :: Config '[Int, Int]
|
||||||
|
|
||||||
it "gets the config if a matching one exists" $ do
|
it "gets the config if a matching one exists" $ do
|
||||||
|
|
||||||
|
@ -30,20 +30,20 @@ getConfigEntrySpec = describe "getConfigEntry" $ do
|
||||||
getConfigEntry cfg2 `shouldBe` (1 :: Int)
|
getConfigEntry cfg2 `shouldBe` (1 :: Int)
|
||||||
|
|
||||||
it "allows to distinguish between different config entries with the same type by tag" $ do
|
it "allows to distinguish between different config entries with the same type by tag" $ do
|
||||||
let cfg = 'a' .:. Wrap 'b' .:. EmptyConfig :: Config '[Char, Wrapped Char]
|
let cfg = 'a' :. Wrap 'b' :. EmptyConfig :: Config '[Char, Wrapped Char]
|
||||||
getConfigEntry cfg `shouldBe` 'a'
|
getConfigEntry cfg `shouldBe` 'a'
|
||||||
|
|
||||||
context "Show instance" $ do
|
context "Show instance" $ do
|
||||||
let cfg = 1 .:. 2 .:. EmptyConfig
|
let cfg = 1 :. 2 :. EmptyConfig
|
||||||
it "has a Show instance" $ do
|
it "has a Show instance" $ do
|
||||||
show cfg `shouldBe` "1 .:. 2 .:. EmptyConfig"
|
show cfg `shouldBe` "1 :. 2 :. EmptyConfig"
|
||||||
|
|
||||||
it "bracketing works" $ do
|
it "bracketing works" $ do
|
||||||
show (Just cfg) `shouldBe` "Just (1 .:. 2 .:. EmptyConfig)"
|
show (Just cfg) `shouldBe` "Just (1 :. 2 :. EmptyConfig)"
|
||||||
|
|
||||||
it "bracketing works with operators" $ do
|
it "bracketing works with operators" $ do
|
||||||
let cfg = (1 .:. 'a' .:. EmptyConfig) :<|> ('b' .:. True .:. EmptyConfig)
|
let cfg = (1 :. 'a' :. EmptyConfig) :<|> ('b' :. True :. EmptyConfig)
|
||||||
show cfg `shouldBe` "(1 .:. 'a' .:. EmptyConfig) :<|> ('b' .:. True .:. EmptyConfig)"
|
show cfg `shouldBe` "(1 :. 'a' :. EmptyConfig) :<|> ('b' :. True :. EmptyConfig)"
|
||||||
|
|
||||||
it "does not typecheck if type does not exist" $ do
|
it "does not typecheck if type does not exist" $ do
|
||||||
|
|
||||||
|
|
|
@ -16,47 +16,47 @@ import Servant.Server.UsingConfigSpec.CustomCombinator
|
||||||
|
|
||||||
newtype Wrapped a = Wrap { unwrap :: a }
|
newtype Wrapped a = Wrap { unwrap :: a }
|
||||||
|
|
||||||
instance ToCustomConfig (Wrapped CustomConfig) where
|
instance ToCustomConfig (Wrapped String) where
|
||||||
toCustomConfig = unwrap
|
toCustomConfig = unwrap
|
||||||
|
|
||||||
type OneEntryAPI =
|
type OneEntryAPI =
|
||||||
CustomCombinator CustomConfig :> Get '[JSON] String
|
CustomCombinator String :> Get '[JSON] String
|
||||||
|
|
||||||
testServer :: Server OneEntryAPI
|
testServer :: Server OneEntryAPI
|
||||||
testServer (CustomConfig s) = return s
|
testServer s = return s
|
||||||
|
|
||||||
oneEntryApp :: Application
|
oneEntryApp :: Application
|
||||||
oneEntryApp =
|
oneEntryApp =
|
||||||
serve (Proxy :: Proxy OneEntryAPI) config testServer
|
serve (Proxy :: Proxy OneEntryAPI) config testServer
|
||||||
where
|
where
|
||||||
config :: Config '[CustomConfig]
|
config :: Config '[String]
|
||||||
config = CustomConfig "configValue" .:. EmptyConfig
|
config = "configValue" :. EmptyConfig
|
||||||
|
|
||||||
type OneEntryTwiceAPI =
|
type OneEntryTwiceAPI =
|
||||||
"foo" :> CustomCombinator CustomConfig :> Get '[JSON] String :<|>
|
"foo" :> CustomCombinator String :> Get '[JSON] String :<|>
|
||||||
"bar" :> CustomCombinator CustomConfig :> Get '[JSON] String
|
"bar" :> CustomCombinator String :> Get '[JSON] String
|
||||||
|
|
||||||
oneEntryTwiceApp :: Application
|
oneEntryTwiceApp :: Application
|
||||||
oneEntryTwiceApp = serve (Proxy :: Proxy OneEntryTwiceAPI) config $
|
oneEntryTwiceApp = serve (Proxy :: Proxy OneEntryTwiceAPI) config $
|
||||||
testServer :<|>
|
testServer :<|>
|
||||||
testServer
|
testServer
|
||||||
where
|
where
|
||||||
config :: Config '[CustomConfig]
|
config :: Config '[String]
|
||||||
config = CustomConfig "configValueTwice" .:. EmptyConfig
|
config = "configValueTwice" :. EmptyConfig
|
||||||
|
|
||||||
type TwoDifferentEntries =
|
type TwoDifferentEntries =
|
||||||
"foo" :> CustomCombinator CustomConfig :> Get '[JSON] String :<|>
|
"foo" :> CustomCombinator String :> Get '[JSON] String :<|>
|
||||||
"bar" :> CustomCombinator (Wrapped CustomConfig) :> Get '[JSON] String
|
"bar" :> CustomCombinator (Wrapped String) :> Get '[JSON] String
|
||||||
|
|
||||||
twoDifferentEntries :: Application
|
twoDifferentEntries :: Application
|
||||||
twoDifferentEntries = serve (Proxy :: Proxy TwoDifferentEntries) config $
|
twoDifferentEntries = serve (Proxy :: Proxy TwoDifferentEntries) config $
|
||||||
testServer :<|>
|
testServer :<|>
|
||||||
testServer
|
testServer
|
||||||
where
|
where
|
||||||
config :: Config '[CustomConfig, Wrapped CustomConfig]
|
config :: Config '[String, Wrapped String]
|
||||||
config =
|
config =
|
||||||
CustomConfig "firstConfigValue" .:.
|
"firstConfigValue" :.
|
||||||
Wrap (CustomConfig "secondConfigValue") .:.
|
Wrap "secondConfigValue" :.
|
||||||
EmptyConfig
|
EmptyConfig
|
||||||
|
|
||||||
-- * tests
|
-- * tests
|
||||||
|
|
|
@ -19,12 +19,10 @@ import Servant.Server.Internal.RoutingApplication
|
||||||
|
|
||||||
data CustomCombinator (entryType :: *)
|
data CustomCombinator (entryType :: *)
|
||||||
|
|
||||||
data CustomConfig = CustomConfig String
|
|
||||||
|
|
||||||
class ToCustomConfig entryType where
|
class ToCustomConfig entryType where
|
||||||
toCustomConfig :: entryType -> CustomConfig
|
toCustomConfig :: entryType -> String
|
||||||
|
|
||||||
instance ToCustomConfig CustomConfig where
|
instance ToCustomConfig String where
|
||||||
toCustomConfig = id
|
toCustomConfig = id
|
||||||
|
|
||||||
instance forall subApi (c :: [*]) entryType .
|
instance forall subApi (c :: [*]) entryType .
|
||||||
|
@ -32,7 +30,7 @@ instance forall subApi (c :: [*]) entryType .
|
||||||
HasServer (CustomCombinator entryType :> subApi) where
|
HasServer (CustomCombinator entryType :> subApi) where
|
||||||
|
|
||||||
type ServerT (CustomCombinator entryType :> subApi) m =
|
type ServerT (CustomCombinator entryType :> subApi) m =
|
||||||
CustomConfig -> ServerT subApi m
|
String -> ServerT subApi m
|
||||||
type HasCfg (CustomCombinator entryType :> subApi) c =
|
type HasCfg (CustomCombinator entryType :> subApi) c =
|
||||||
(HasConfigEntry c entryType, HasCfg subApi c)
|
(HasConfigEntry c entryType, HasCfg subApi c)
|
||||||
|
|
||||||
|
@ -43,4 +41,3 @@ instance forall subApi (c :: [*]) entryType .
|
||||||
subProxy = Proxy
|
subProxy = Proxy
|
||||||
|
|
||||||
inject config f = f (toCustomConfig (getConfigEntry config :: entryType))
|
inject config f = f (toCustomConfig (getConfigEntry config :: entryType))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue