{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}

module Test.Syd.Wai where

import Network.HTTP.Client as HTTP
import Network.Wai as Wai
import Network.Wai.Handler.Warp as Warp
import Test.Syd

-- | Run a given 'Wai.Application' around every test.
--
-- This provides the port on which the application is running.
waiSpec :: Wai.Application -> TestDef l Port -> TestDef l ()
waiSpec :: Application -> TestDef l Port -> TestDef l ()
waiSpec Application
application = SetupFunc () Application -> TestDef l Port -> TestDef l ()
forall a (l :: [*]).
SetupFunc a Application -> TestDef l Port -> TestDef l a
waiSpecWithSetupFunc (SetupFunc () Application -> TestDef l Port -> TestDef l ())
-> SetupFunc () Application -> TestDef l Port -> TestDef l ()
forall a b. (a -> b) -> a -> b
$ Application -> SetupFunc () Application
forall (f :: * -> *) a. Applicative f => a -> f a
pure Application
application

-- | Run a 'Wai.Application' around every test by setting it up with the given setup function.
--
-- This provides the port on which the application is running.
waiSpecWith :: (forall r. (Application -> IO r) -> IO r) -> TestDef l Port -> TestDef l ()
waiSpecWith :: (forall r. (Application -> IO r) -> IO r)
-> TestDef l Port -> TestDef l ()
waiSpecWith forall r. (Application -> IO r) -> IO r
appFunc = SetupFunc () Application -> TestDef l Port -> TestDef l ()
forall a (l :: [*]).
SetupFunc a Application -> TestDef l Port -> TestDef l a
waiSpecWithSetupFunc (SetupFunc () Application -> TestDef l Port -> TestDef l ())
-> SetupFunc () Application -> TestDef l Port -> TestDef l ()
forall a b. (a -> b) -> a -> b
$ (forall r. (Application -> IO r) -> IO r)
-> SetupFunc () Application
forall resource.
(forall result. (resource -> IO result) -> IO result)
-> SetupFunc () resource
makeSimpleSetupFunc forall r. (Application -> IO r) -> IO r
appFunc

-- | Run a 'Wai.Application' around every test by setting it up with the given setup function that can take an argument.
-- a
-- This provides the port on which the application is running.
waiSpecWith' :: (forall r. (Application -> IO r) -> (a -> IO r)) -> TestDef l Port -> TestDef l a
waiSpecWith' :: (forall r. (Application -> IO r) -> a -> IO r)
-> TestDef l Port -> TestDef l a
waiSpecWith' forall r. (Application -> IO r) -> a -> IO r
appFunc = SetupFunc a Application -> TestDef l Port -> TestDef l a
forall a (l :: [*]).
SetupFunc a Application -> TestDef l Port -> TestDef l a
waiSpecWithSetupFunc (SetupFunc a Application -> TestDef l Port -> TestDef l a)
-> SetupFunc a Application -> TestDef l Port -> TestDef l a
forall a b. (a -> b) -> a -> b
$ (forall r. (Application -> IO r) -> a -> IO r)
-> SetupFunc a Application
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc forall r. (Application -> IO r) -> a -> IO r
appFunc

-- | Run a 'Wai.Application' around every test by setting it up with the given 'SetupFunc'.
-- a
-- This provides the port on which the application is running.
waiSpecWithSetupFunc :: SetupFunc a Application -> TestDef l Port -> TestDef l a
waiSpecWithSetupFunc :: SetupFunc a Application -> TestDef l Port -> TestDef l a
waiSpecWithSetupFunc SetupFunc a Application
setupFunc = SetupFunc a Port -> TestDef l Port -> TestDef l a
forall oldInner newInner (outers :: [*]) result.
SetupFunc oldInner newInner
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith (SetupFunc a Application
setupFunc SetupFunc a Application
-> SetupFunc Application Port -> SetupFunc a Port
forall old newer newest.
SetupFunc old newer
-> SetupFunc newer newest -> SetupFunc old newest
`connectSetupFunc` SetupFunc Application Port
applicationSetupFunc)

-- | A 'SetupFunc' to run an application and provide its port.
applicationSetupFunc :: SetupFunc Application Port
applicationSetupFunc :: SetupFunc Application Port
applicationSetupFunc = (forall r. (Port -> IO r) -> Application -> IO r)
-> SetupFunc Application Port
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc ((forall r. (Port -> IO r) -> Application -> IO r)
 -> SetupFunc Application Port)
-> (forall r. (Port -> IO r) -> Application -> IO r)
-> SetupFunc Application Port
forall a b. (a -> b) -> a -> b
$ \Port -> IO r
func Application
application ->
  IO Application -> (Port -> IO r) -> IO r
forall a. IO Application -> (Port -> IO a) -> IO a
Warp.testWithApplication (Application -> IO Application
forall (f :: * -> *) a. Applicative f => a -> f a
pure Application
application) ((Port -> IO r) -> IO r) -> (Port -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Port
p ->
    Port -> IO r
func Port
p

-- | Create a 'HTTP.Manager' before all tests in the given group.
managerSpec :: TestDef (HTTP.Manager ': l) a -> TestDef l a
managerSpec :: TestDef (Manager : l) a -> TestDef l a
managerSpec = IO Manager -> TestDef (Manager : l) a -> TestDef l a
forall outer (otherOuters :: [*]) inner result.
IO outer
-> TestDefM (outer : otherOuters) inner result
-> TestDefM otherOuters inner result
beforeAll (IO Manager -> TestDef (Manager : l) a -> TestDef l a)
-> IO Manager -> TestDef (Manager : l) a -> TestDef l a
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
HTTP.newManager ManagerSettings
HTTP.defaultManagerSettings