Skip to content

Instantly share code, notes, and snippets.

@soenkehahn
Created January 9, 2016 13:41
Show Gist options
  • Save soenkehahn/65deb33992d2d616fd11 to your computer and use it in GitHub Desktop.
Save soenkehahn/65deb33992d2d616fd11 to your computer and use it in GitHub Desktop.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Servant.Server.UsingConfigSpec where
import Network.Wai
import Test.Hspec (Spec, describe, it)
import Test.Hspec.Wai
import Servant
import Servant.Server.Internal.Router
import Servant.Server.Internal.RoutingApplication
-- * custom test combinator
data CustomCombinator
data FromCombinator = FromCombinator String
instance forall subApi (c :: [*]) . (HasServer subApi) =>
HasServer (CustomCombinator :> subApi) where
type ServerT (CustomCombinator :> subApi) m =
FromCombinator -> ServerT subApi m
type HasCfg (CustomCombinator :> subApi) c = (HasCfg subApi c)
route :: Proxy (CustomCombinator :> subApi) -> Config c
-> Delayed (Server (CustomCombinator :> subApi))
-> Router
route Proxy config delayed =
route subProxy config (fmap inject delayed :: Delayed (Server subApi))
where
subProxy :: Proxy subApi
subProxy = Proxy
inject :: (FromCombinator -> a) -> a
inject f = f (FromCombinator "jujuju")
-- * API
type API =
CustomCombinator :> Get '[JSON] String
api :: Proxy API
api = Proxy
testServer :: Server API
testServer (FromCombinator s) = return s
app :: Application
app = serve api EmptyConfig testServer
-- * tests
spec :: Spec
spec = do
describe "using Config in a custom combinator" $ do
with (return app) $ do
it "allows to retrieve the ConfigEntry" $ do
get "/" `shouldRespondWith` "bla"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment