added comments
This commit is contained in:
parent
5329aa015e
commit
8f7dedd90c
2 changed files with 29 additions and 11 deletions
|
@ -1,8 +1,5 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
|
||||
-- | Testing works very differently under ghc and ghcjs. This module acts as a
|
||||
-- CPP switch and import different modules depending on the used compiler (ghc
|
||||
-- or ghcjs). Both imported modules provide the same API.
|
||||
module Servant.Client.TestServer (
|
||||
buildTestServer,
|
||||
TestServer(..),
|
||||
|
|
|
@ -59,6 +59,28 @@ spec = do
|
|||
failSpec
|
||||
errorSpec
|
||||
|
||||
-- | Run a test-server (identified by name) while performing the given action.
|
||||
-- The provided 'BaseUrl' points to the running server.
|
||||
--
|
||||
-- Running the test-servers is done differently depending on the compiler
|
||||
-- (ghc or ghcjs).
|
||||
--
|
||||
-- With ghc it's somewhat straight-forward: a wai 'Application' is being started
|
||||
-- on a free port inside the same process using 'warp'.
|
||||
--
|
||||
-- When running the test-suite with ghcjs all the test-servers are compiled into
|
||||
-- a single external executable (with ghc and warp). This is done through
|
||||
-- 'buildTestServer' once at the start of the test-suite. This built executable
|
||||
-- will provide all the test-servers on a free port under a path that
|
||||
-- corresponds to the test-servers name, for example under
|
||||
-- 'http://localhost:82923/failServer'. 'withTestServer' will then
|
||||
-- start this executable as an external process while the given action is being
|
||||
-- executed and provide it with the correct BaseUrl.
|
||||
-- This rather cumbersome approach is taken because it's not easy to run a wai
|
||||
-- Application as a http server when using ghcjs.
|
||||
withTestServer :: String -> (BaseUrl -> IO a) -> IO a
|
||||
withTestServer = withServer . lookupTestServer
|
||||
|
||||
lookupTestServer :: String -> TestServer
|
||||
lookupTestServer name = case lookup name mapping of
|
||||
Nothing -> error ("test server not found: " ++ name)
|
||||
|
@ -67,14 +89,13 @@ lookupTestServer name = case lookup name mapping of
|
|||
mapping :: [(String, TestServer)]
|
||||
mapping = map (\ server -> (testServerName server, server)) allTestServers
|
||||
|
||||
allTestServers =
|
||||
server :
|
||||
errorServer :
|
||||
failServer :
|
||||
[]
|
||||
|
||||
withTestServer :: String -> (BaseUrl -> IO a) -> IO a
|
||||
withTestServer = withServer . lookupTestServer
|
||||
-- | All test-servers must be registered here.
|
||||
allTestServers :: [TestServer]
|
||||
allTestServers =
|
||||
server :
|
||||
errorServer :
|
||||
failServer :
|
||||
[]
|
||||
|
||||
-- * test data types
|
||||
|
||||
|
|
Loading…
Reference in a new issue