From 88dda2f9c6111f745d38b67984bd6251c945f2c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B6nke=20Hahn?= Date: Sun, 10 Jan 2016 16:50:17 +0100 Subject: [PATCH] server/config: renamings --- servant-server/src/Servant/Server.hs | 1 - .../src/Servant/Server/Internal/Config.hs | 17 +++++------ .../Servant/Server/Internal/ConfigSpec.hs | 16 +++++------ .../test/Servant/Server/UsingConfigSpec.hs | 28 +++++++++---------- .../UsingConfigSpec/CustomCombinator.hs | 9 ++---- 5 files changed, 32 insertions(+), 39 deletions(-) diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs index 33f1c7ab..c557785e 100644 --- a/servant-server/src/Servant/Server.hs +++ b/servant-server/src/Servant/Server.hs @@ -37,7 +37,6 @@ module Servant.Server -- * Config , Config(..) - , (.:.) -- * Default error type , ServantErr(..) diff --git a/servant-server/src/Servant/Server/Internal/Config.hs b/servant-server/src/Servant/Server/Internal/Config.hs index e5c39fec..bbd0736d 100644 --- a/servant-server/src/Servant/Server/Internal/Config.hs +++ b/servant-server/src/Servant/Server/Internal/Config.hs @@ -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 diff --git a/servant-server/test/Servant/Server/Internal/ConfigSpec.hs b/servant-server/test/Servant/Server/Internal/ConfigSpec.hs index f78b2229..6a854fbf 100644 --- a/servant-server/test/Servant/Server/Internal/ConfigSpec.hs +++ b/servant-server/test/Servant/Server/Internal/ConfigSpec.hs @@ -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 diff --git a/servant-server/test/Servant/Server/UsingConfigSpec.hs b/servant-server/test/Servant/Server/UsingConfigSpec.hs index 5f7519ee..f151d314 100644 --- a/servant-server/test/Servant/Server/UsingConfigSpec.hs +++ b/servant-server/test/Servant/Server/UsingConfigSpec.hs @@ -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 diff --git a/servant-server/test/Servant/Server/UsingConfigSpec/CustomCombinator.hs b/servant-server/test/Servant/Server/UsingConfigSpec/CustomCombinator.hs index 2161e50a..9b7ed5ff 100644 --- a/servant-server/test/Servant/Server/UsingConfigSpec/CustomCombinator.hs +++ b/servant-server/test/Servant/Server/UsingConfigSpec/CustomCombinator.hs @@ -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)) -