{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Syd.Servant
  ( servantSpec,
    servantSpecWithSetupFunc,
    clientEnvSetupFunc,
    testClient,
    testClientOrError,
  )
where

import Network.HTTP.Client as HTTP
import Servant
import Servant.Client
import Test.Syd
import Test.Syd.Wai

type ServantSpec = TestDef '[HTTP.Manager] ClientEnv

-- | Run a given servant server around every test
servantSpec :: forall api. HasServer api '[] => Servant.Proxy api -> ServerT api Handler -> ServantSpec -> Spec
servantSpec :: Proxy api -> ServerT api Handler -> ServantSpec -> Spec
servantSpec Proxy api
py ServerT api Handler
server = Proxy api
-> SetupFunc () (ServerT api Handler) -> ServantSpec -> Spec
forall api a.
HasServer api '[] =>
Proxy api
-> SetupFunc a (ServerT api Handler) -> ServantSpec -> SpecWith a
servantSpecWithSetupFunc Proxy api
py (ServerT api Handler -> SetupFunc () (ServerT api Handler)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerT api Handler
server)

-- | Run a servant server around every test, based around the given 'SetupFunc'
servantSpecWithSetupFunc :: forall api a. HasServer api '[] => Servant.Proxy api -> SetupFunc a (ServerT api Handler) -> ServantSpec -> SpecWith a
servantSpecWithSetupFunc :: Proxy api
-> SetupFunc a (ServerT api Handler) -> ServantSpec -> SpecWith a
servantSpecWithSetupFunc Proxy api
py SetupFunc a (ServerT api Handler)
serverSetupFunc =
  IO Manager -> TestDefM '[Manager] a () -> SpecWith a
forall outer (otherOuters :: [*]) inner result.
IO outer
-> TestDefM (outer : otherOuters) inner result
-> TestDefM otherOuters inner result
beforeAll (ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings)
    (TestDefM '[Manager] a () -> SpecWith a)
-> (ServantSpec -> TestDefM '[Manager] a ())
-> ServantSpec
-> SpecWith a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Manager -> SetupFunc a ClientEnv)
-> ServantSpec -> TestDefM '[Manager] a ()
forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> SetupFunc oldInner newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' (\Manager
man -> SetupFunc a (ServerT api Handler)
serverSetupFunc SetupFunc a (ServerT api Handler)
-> SetupFunc (ServerT api Handler) ClientEnv
-> SetupFunc a ClientEnv
forall old newer newest.
SetupFunc old newer
-> SetupFunc newer newest -> SetupFunc old newest
`connectSetupFunc` Proxy api -> Manager -> SetupFunc (ServerT api Handler) ClientEnv
forall api.
HasServer api '[] =>
Proxy api -> Manager -> SetupFunc (ServerT api Handler) ClientEnv
clientEnvSetupFunc Proxy api
py Manager
man)

clientEnvSetupFunc :: forall api. HasServer api '[] => Servant.Proxy api -> HTTP.Manager -> SetupFunc (ServerT api Handler) ClientEnv
clientEnvSetupFunc :: Proxy api -> Manager -> SetupFunc (ServerT api Handler) ClientEnv
clientEnvSetupFunc Proxy api
py Manager
man = (ServerT api Handler -> SetupFunc () ClientEnv)
-> SetupFunc (ServerT api Handler) ClientEnv
forall old new. (old -> SetupFunc () new) -> SetupFunc old new
wrapSetupFunc ((ServerT api Handler -> SetupFunc () ClientEnv)
 -> SetupFunc (ServerT api Handler) ClientEnv)
-> (ServerT api Handler -> SetupFunc () ClientEnv)
-> SetupFunc (ServerT api Handler) ClientEnv
forall a b. (a -> b) -> a -> b
$ \ServerT api Handler
server -> do
  let application :: Application
application = Proxy api -> ServerT api Handler -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve Proxy api
py ServerT api Handler
server
  Port
p <- SetupFunc Application Port -> Application -> SetupFunc () Port
forall old new. SetupFunc old new -> old -> SetupFunc () new
unwrapSetupFunc SetupFunc Application Port
applicationSetupFunc Application
application
  ClientEnv -> SetupFunc () ClientEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientEnv -> SetupFunc () ClientEnv)
-> ClientEnv -> SetupFunc () ClientEnv
forall a b. (a -> b) -> a -> b
$ Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
man (Scheme -> String -> Port -> String -> BaseUrl
BaseUrl Scheme
Http String
"127.0.0.1" Port
p String
"")

testClient :: ClientEnv -> ClientM a -> IO a
testClient :: ClientEnv -> ClientM a -> IO a
testClient ClientEnv
cenv ClientM a
func = do
  Either ClientError a
errOrRes <- ClientEnv -> ClientM a -> IO (Either ClientError a)
forall a. ClientEnv -> ClientM a -> IO (Either ClientError a)
testClientOrError ClientEnv
cenv ClientM a
func
  case Either ClientError a
errOrRes of
    Left ClientError
err -> String -> IO a
forall a. HasCallStack => String -> IO a
expectationFailure (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ ClientError -> String
forall a. Show a => a -> String
show ClientError
err
    Right a
r -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r

#if MIN_VERSION_servant_client(0,16,0)
testClientOrError :: ClientEnv -> ClientM a -> IO (Either ClientError a)
testClientOrError :: ClientEnv -> ClientM a -> IO (Either ClientError a)
testClientOrError = (ClientM a -> ClientEnv -> IO (Either ClientError a))
-> ClientEnv -> ClientM a -> IO (Either ClientError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
#else
testClientOrError :: ClientEnv -> ClientM a -> IO (Either ServantError a)
testClientOrError = flip runClientM
#endif