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(..)
|
||||
, (.:.)
|
||||
|
||||
-- * Default error type
|
||||
, ServantErr(..)
|
||||
|
|
|
@ -26,31 +26,28 @@ import Data.Typeable (Typeable)
|
|||
-- | The entire configuration.
|
||||
data Config a where
|
||||
EmptyConfig :: Config '[]
|
||||
ConsConfig :: x -> Config xs -> Config (x ': xs)
|
||||
(:.) :: x -> Config xs -> Config (x ': xs)
|
||||
infixr 5 :.
|
||||
|
||||
instance Show (Config '[]) where
|
||||
show EmptyConfig = "EmptyConfig"
|
||||
instance (Show a, Show (Config as)) => Show (Config (a ': as)) where
|
||||
showsPrec outerPrecedence (ConsConfig a as) =
|
||||
showsPrec outerPrecedence (a :. as) =
|
||||
showParen (outerPrecedence > 5) $
|
||||
shows a . showString " .:. " . shows as
|
||||
shows a . showString " :. " . shows as
|
||||
|
||||
instance Eq (Config '[]) where
|
||||
_ == _ = True
|
||||
instance (Eq a, Eq (Config as)) => Eq (Config (a ': as)) where
|
||||
ConsConfig x1 y1 == ConsConfig x2 y2 = x1 == x2 && y1 == y2
|
||||
|
||||
(.:.) :: x -> Config xs -> Config (x ': xs)
|
||||
e .:. cfg = ConsConfig e cfg
|
||||
infixr 5 .:.
|
||||
x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2
|
||||
|
||||
class HasConfigEntry (cfg :: [*]) (val :: *) where
|
||||
getConfigEntry :: Config cfg -> val
|
||||
|
||||
instance OVERLAPPABLE_
|
||||
HasConfigEntry xs val => HasConfigEntry (notIt ': xs) val where
|
||||
getConfigEntry (ConsConfig _ xs) = getConfigEntry xs
|
||||
getConfigEntry (_ :. xs) = getConfigEntry xs
|
||||
|
||||
instance OVERLAPPABLE_
|
||||
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 = describe "getConfigEntry" $ do
|
||||
|
||||
let cfg1 = 0 .:. EmptyConfig :: Config '[Int]
|
||||
cfg2 = 1 .:. cfg1 :: Config '[Int, Int]
|
||||
let cfg1 = 0 :. EmptyConfig :: Config '[Int]
|
||||
cfg2 = 1 :. cfg1 :: Config '[Int, Int]
|
||||
|
||||
it "gets the config if a matching one exists" $ do
|
||||
|
||||
|
@ -30,20 +30,20 @@ getConfigEntrySpec = describe "getConfigEntry" $ do
|
|||
getConfigEntry cfg2 `shouldBe` (1 :: Int)
|
||||
|
||||
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'
|
||||
|
||||
context "Show instance" $ do
|
||||
let cfg = 1 .:. 2 .:. EmptyConfig
|
||||
let cfg = 1 :. 2 :. EmptyConfig
|
||||
it "has a Show instance" $ do
|
||||
show cfg `shouldBe` "1 .:. 2 .:. EmptyConfig"
|
||||
show cfg `shouldBe` "1 :. 2 :. EmptyConfig"
|
||||
|
||||
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
|
||||
let cfg = (1 .:. 'a' .:. EmptyConfig) :<|> ('b' .:. True .:. EmptyConfig)
|
||||
show cfg `shouldBe` "(1 .:. 'a' .:. EmptyConfig) :<|> ('b' .:. True .:. EmptyConfig)"
|
||||
let cfg = (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
|
||||
|
||||
|
|
|
@ -16,47 +16,47 @@ import Servant.Server.UsingConfigSpec.CustomCombinator
|
|||
|
||||
newtype Wrapped a = Wrap { unwrap :: a }
|
||||
|
||||
instance ToCustomConfig (Wrapped CustomConfig) where
|
||||
instance ToCustomConfig (Wrapped String) where
|
||||
toCustomConfig = unwrap
|
||||
|
||||
type OneEntryAPI =
|
||||
CustomCombinator CustomConfig :> Get '[JSON] String
|
||||
CustomCombinator String :> Get '[JSON] String
|
||||
|
||||
testServer :: Server OneEntryAPI
|
||||
testServer (CustomConfig s) = return s
|
||||
testServer s = return s
|
||||
|
||||
oneEntryApp :: Application
|
||||
oneEntryApp =
|
||||
serve (Proxy :: Proxy OneEntryAPI) config testServer
|
||||
where
|
||||
config :: Config '[CustomConfig]
|
||||
config = CustomConfig "configValue" .:. EmptyConfig
|
||||
config :: Config '[String]
|
||||
config = "configValue" :. EmptyConfig
|
||||
|
||||
type OneEntryTwiceAPI =
|
||||
"foo" :> CustomCombinator CustomConfig :> Get '[JSON] String :<|>
|
||||
"bar" :> CustomCombinator CustomConfig :> Get '[JSON] String
|
||||
"foo" :> CustomCombinator String :> Get '[JSON] String :<|>
|
||||
"bar" :> CustomCombinator String :> Get '[JSON] String
|
||||
|
||||
oneEntryTwiceApp :: Application
|
||||
oneEntryTwiceApp = serve (Proxy :: Proxy OneEntryTwiceAPI) config $
|
||||
testServer :<|>
|
||||
testServer
|
||||
where
|
||||
config :: Config '[CustomConfig]
|
||||
config = CustomConfig "configValueTwice" .:. EmptyConfig
|
||||
config :: Config '[String]
|
||||
config = "configValueTwice" :. EmptyConfig
|
||||
|
||||
type TwoDifferentEntries =
|
||||
"foo" :> CustomCombinator CustomConfig :> Get '[JSON] String :<|>
|
||||
"bar" :> CustomCombinator (Wrapped CustomConfig) :> Get '[JSON] String
|
||||
"foo" :> CustomCombinator String :> Get '[JSON] String :<|>
|
||||
"bar" :> CustomCombinator (Wrapped String) :> Get '[JSON] String
|
||||
|
||||
twoDifferentEntries :: Application
|
||||
twoDifferentEntries = serve (Proxy :: Proxy TwoDifferentEntries) config $
|
||||
testServer :<|>
|
||||
testServer
|
||||
where
|
||||
config :: Config '[CustomConfig, Wrapped CustomConfig]
|
||||
config :: Config '[String, Wrapped String]
|
||||
config =
|
||||
CustomConfig "firstConfigValue" .:.
|
||||
Wrap (CustomConfig "secondConfigValue") .:.
|
||||
"firstConfigValue" :.
|
||||
Wrap "secondConfigValue" :.
|
||||
EmptyConfig
|
||||
|
||||
-- * tests
|
||||
|
|
|
@ -19,12 +19,10 @@ import Servant.Server.Internal.RoutingApplication
|
|||
|
||||
data CustomCombinator (entryType :: *)
|
||||
|
||||
data CustomConfig = CustomConfig String
|
||||
|
||||
class ToCustomConfig entryType where
|
||||
toCustomConfig :: entryType -> CustomConfig
|
||||
toCustomConfig :: entryType -> String
|
||||
|
||||
instance ToCustomConfig CustomConfig where
|
||||
instance ToCustomConfig String where
|
||||
toCustomConfig = id
|
||||
|
||||
instance forall subApi (c :: [*]) entryType .
|
||||
|
@ -32,7 +30,7 @@ instance forall subApi (c :: [*]) entryType .
|
|||
HasServer (CustomCombinator entryType :> subApi) where
|
||||
|
||||
type ServerT (CustomCombinator entryType :> subApi) m =
|
||||
CustomConfig -> ServerT subApi m
|
||||
String -> ServerT subApi m
|
||||
type HasCfg (CustomCombinator entryType :> subApi) c =
|
||||
(HasConfigEntry c entryType, HasCfg subApi c)
|
||||
|
||||
|
@ -43,4 +41,3 @@ instance forall subApi (c :: [*]) entryType .
|
|||
subProxy = Proxy
|
||||
|
||||
inject config f = f (toCustomConfig (getConfigEntry config :: entryType))
|
||||
|
||||
|
|
Loading…
Reference in a new issue