@@ -1,3 +1,11 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE KindSignatures #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE ScopedTypeVariables #-}
7+{-# LANGUAGE TypeFamilies #-}
8+{-# LANGUAGE TypeOperators #-}
19module Servant.Server.Internal.RoutingApplicationSpec (spec) where
210
311import Prelude ()
@@ -6,11 +14,16 @@ import Prelude.Compat
614import Control.Exception hiding (Handler)
715import Control.Monad.Trans.Resource (register)
816import Control.Monad.IO.Class
9−import Data.Maybe (isJust)
1017import Data.IORef
11−import Servant.Server
18+import Data.Maybe (isJust)
19+import Data.Proxy
20+import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
21+import Servant
1222import Servant.Server.Internal.RoutingApplication
1323import Test.Hspec
24+import Test.Hspec.Wai (request, shouldRespondWith, with)
25+
26+import qualified Data.Text as T
1427
1528import System.IO.Unsafe (unsafePerformIO)
1629
@@ -38,6 +51,36 @@ simpleRun d = fmap (either ignoreE id) . try $
3851 where ignoreE :: SomeException -> ()
3952 ignoreE = const ()
4053
54+-------------------------------------------------------------------------------
55+-- Combinator example
56+-------------------------------------------------------------------------------
57+
58+-- | This data types writes 'sym' to 'delayedTestRef'.
59+data Res (sym :: Symbol)
60+
61+instance (KnownSymbol sym, HasServer api ctx) => HasServer (Res sym :> api) ctx where
62+ type ServerT (Res sym :> api) m = IORef (Maybe String) -> ServerT api m
63+ route Proxy ctx server = route (Proxy :: Proxy api) ctx $
64+ server `addBodyCheck` check
65+ where
66+ sym = symbolVal (Proxy :: Proxy sym)
67+ check = do
68+ liftIO $ writeIORef delayedTestRef (Just sym)
69+ _ <- register (writeIORef delayedTestRef Nothing)
70+ return delayedTestRef
71+
72+type ResApi = "foobar" :> Res "foobar" :> Get '[PlainText] T.Text
73+
74+resApi :: Proxy ResApi
75+resApi = Proxy
76+
77+resServer :: Server ResApi
78+resServer ref = liftIO $ fmap (maybe "<empty>" T.pack) $ readIORef ref
79+
80+-------------------------------------------------------------------------------
81+-- Spec
82+-------------------------------------------------------------------------------
83+
4184spec :: Spec
4285spec = do
4386 describe "Delayed" $ do
@@ -57,3 +100,10 @@ spec = do
57100 _ <- simpleRun $ delayed (liftIO $ throwIO DivideByZero) (Route $ return ())
58101 cleanUpDone <- isJust <$> readIORef delayedTestRef
59102 cleanUpDone `shouldBe` False
103+ describe "ResApi" $
104+ with (return $ serve resApi resServer) $ do
105+ it "writes and cleanups resources" $ do
106+ request "GET" "foobar" [] "" `shouldRespondWith` "foobar"
107+ liftIO $ do
108+ cleanUpDone <- isJust <$> readIORef delayedTestRef
109+ cleanUpDone `shouldBe` False