{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module Test.Syd.Wai.Def where

import Network.HTTP.Client as HTTP
import Network.Socket (PortNumber)
import Network.Wai as Wai
import Network.Wai.Handler.Warp as Warp
import Test.Syd
import Test.Syd.Wai.Client

-- | Run a given 'Wai.Application' around every test.
--
-- This provides a 'WaiClient ()' which contains the port of the running application.
waiClientSpec :: Wai.Application -> TestDefM (HTTP.Manager ': outers) (WaiClient ()) result -> TestDefM outers oldInner result
waiClientSpec :: forall (outers :: [*]) result oldInner.
Application
-> TestDefM (Manager : outers) (WaiClient ()) result
-> TestDefM outers oldInner result
waiClientSpec Application
application = forall (outers :: [*]) result oldInner.
IO Application
-> TestDefM (Manager : outers) (WaiClient ()) result
-> TestDefM outers oldInner result
waiClientSpecWith forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Application
application

-- | Run a given 'Wai.Application', as built by the given action, around every test.
waiClientSpecWith :: IO Application -> TestDefM (HTTP.Manager ': outers) (WaiClient ()) result -> TestDefM outers oldInner result
waiClientSpecWith :: forall (outers :: [*]) result oldInner.
IO Application
-> TestDefM (Manager : outers) (WaiClient ()) result
-> TestDefM outers oldInner result
waiClientSpecWith IO Application
application = forall oldInner env (outers :: [*]) result.
(Manager -> oldInner -> SetupFunc (Application, env))
-> TestDefM (Manager : outers) (WaiClient env) result
-> TestDefM outers oldInner result
waiClientSpecWithSetupFunc (\Manager
_ oldInner
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Application
application forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Run a given 'Wai.Application', as built by the given 'SetupFunc', around every test.
waiClientSpecWithSetupFunc ::
  (HTTP.Manager -> oldInner -> SetupFunc (Application, env)) ->
  TestDefM (HTTP.Manager ': outers) (WaiClient env) result ->
  TestDefM outers oldInner result
waiClientSpecWithSetupFunc :: forall oldInner env (outers :: [*]) result.
(Manager -> oldInner -> SetupFunc (Application, env))
-> TestDefM (Manager : outers) (WaiClient env) result
-> TestDefM outers oldInner result
waiClientSpecWithSetupFunc Manager -> oldInner -> SetupFunc (Application, env)
setupFunc = forall (outers :: [*]) inner result.
TestDefM (Manager : outers) inner result
-> TestDefM outers inner result
managerSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall oldInner env (outers :: [*]) result.
(Manager -> oldInner -> SetupFunc (Application, env))
-> TestDefM (Manager : outers) (WaiClient env) result
-> TestDefM (Manager : outers) oldInner result
waiClientSpecWithSetupFunc' Manager -> oldInner -> SetupFunc (Application, env)
setupFunc

-- | Run a given 'Wai.Application', as built by the given 'SetupFunc', around every test.
--
-- This function doesn't set up the 'HTTP.Manager' like 'waiClientSpecWithSetupFunc' does.
waiClientSpecWithSetupFunc' ::
  (HTTP.Manager -> oldInner -> SetupFunc (Application, env)) ->
  TestDefM (HTTP.Manager ': outers) (WaiClient env) result ->
  TestDefM (HTTP.Manager ': outers) oldInner result
waiClientSpecWithSetupFunc' :: forall oldInner env (outers :: [*]) result.
(Manager -> oldInner -> SetupFunc (Application, env))
-> TestDefM (Manager : outers) (WaiClient env) result
-> TestDefM (Manager : outers) oldInner result
waiClientSpecWithSetupFunc' Manager -> oldInner -> SetupFunc (Application, env)
setupFunc = forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' forall a b. (a -> b) -> a -> b
$ \Manager
man oldInner
oldInner -> do
  (Application
application, env
env) <- Manager -> oldInner -> SetupFunc (Application, env)
setupFunc Manager
man oldInner
oldInner
  forall env.
Manager -> Application -> env -> SetupFunc (WaiClient env)
waiClientSetupFunc Manager
man Application
application env
env

-- | A 'SetupFunc' for a 'WaiClient', given an 'Application' and user-defined @env@.
waiClientSetupFunc :: HTTP.Manager -> Application -> env -> SetupFunc (WaiClient env)
waiClientSetupFunc :: forall env.
Manager -> Application -> env -> SetupFunc (WaiClient env)
waiClientSetupFunc Manager
man Application
application env
env = do
  PortNumber
p <- Application -> SetupFunc PortNumber
applicationSetupFunc Application
application
  let client :: WaiClient env
client =
        WaiClient
          { waiClientManager :: Manager
waiClientManager = Manager
man,
            waiClientEnv :: env
waiClientEnv = env
env,
            waiClientPort :: PortNumber
waiClientPort = PortNumber
p
          }
  forall (f :: * -> *) a. Applicative f => a -> f a
pure WaiClient env
client

-- | Run a given 'Wai.Application' around every test.
--
-- This provides the port on which the application is running.
waiSpec :: Wai.Application -> TestDef outers PortNumber -> TestDef outers ()
waiSpec :: forall (outers :: [*]).
Application -> TestDef outers PortNumber -> TestDef outers ()
waiSpec Application
application = forall (outers :: [*]).
SetupFunc Application
-> TestDef outers PortNumber -> TestDef outers ()
waiSpecWithSetupFunc forall a b. (a -> b) -> a -> b
$ 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 outers PortNumber -> TestDef outers ()
waiSpecWith :: forall (outers :: [*]).
(forall r. (Application -> IO r) -> IO r)
-> TestDef outers PortNumber -> TestDef outers ()
waiSpecWith forall r. (Application -> IO r) -> IO r
appFunc = forall (outers :: [*]).
SetupFunc Application
-> TestDef outers PortNumber -> TestDef outers ()
waiSpecWithSetupFunc forall a b. (a -> b) -> a -> b
$ forall resource.
(forall r. (resource -> IO r) -> IO r) -> SetupFunc resource
SetupFunc forall a b. (a -> b) -> a -> b
$ \Application -> IO r
takeApp -> forall r. (Application -> IO r) -> IO r
appFunc Application -> IO r
takeApp

-- | 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) -> (inner -> IO r)) -> TestDef outers PortNumber -> TestDef outers inner
waiSpecWith' :: forall inner (outers :: [*]).
(forall r. (Application -> IO r) -> inner -> IO r)
-> TestDef outers PortNumber -> TestDef outers inner
waiSpecWith' forall r. (Application -> IO r) -> inner -> IO r
appFunc = forall inner (outers :: [*]).
(inner -> SetupFunc Application)
-> TestDef outers PortNumber -> TestDef outers inner
waiSpecWithSetupFunc' forall a b. (a -> b) -> a -> b
$ \inner
inner -> forall resource.
(forall r. (resource -> IO r) -> IO r) -> SetupFunc resource
SetupFunc forall a b. (a -> b) -> a -> b
$ \Application -> IO r
takeApp -> forall r. (Application -> IO r) -> inner -> IO r
appFunc Application -> IO r
takeApp inner
inner

-- | 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 Application -> TestDef outers PortNumber -> TestDef outers ()
waiSpecWithSetupFunc :: forall (outers :: [*]).
SetupFunc Application
-> TestDef outers PortNumber -> TestDef outers ()
waiSpecWithSetupFunc SetupFunc Application
setupFunc = forall inner (outers :: [*]).
(inner -> SetupFunc Application)
-> TestDef outers PortNumber -> TestDef outers inner
waiSpecWithSetupFunc' forall a b. (a -> b) -> a -> b
$ \() -> SetupFunc Application
setupFunc

-- | Run a 'Wai.Application' around every test by setting it up with the given 'SetupFunc' and inner resource.
-- a
-- This provides the port on which the application is running.
waiSpecWithSetupFunc' :: (inner -> SetupFunc Application) -> TestDef outers PortNumber -> TestDef outers inner
waiSpecWithSetupFunc' :: forall inner (outers :: [*]).
(inner -> SetupFunc Application)
-> TestDef outers PortNumber -> TestDef outers inner
waiSpecWithSetupFunc' inner -> SetupFunc Application
setupFunc = forall oldInner newInner (outers :: [*]) result.
(oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith forall a b. (a -> b) -> a -> b
$ \inner
inner -> do
  Application
application <- inner -> SetupFunc Application
setupFunc inner
inner
  Application -> SetupFunc PortNumber
applicationSetupFunc Application
application

-- | A 'SetupFunc' to run an application and provide its port.
applicationSetupFunc :: Application -> SetupFunc PortNumber
applicationSetupFunc :: Application -> SetupFunc PortNumber
applicationSetupFunc Application
application = forall resource.
(forall r. (resource -> IO r) -> IO r) -> SetupFunc resource
SetupFunc forall a b. (a -> b) -> a -> b
$ \PortNumber -> IO r
func ->
  forall a. IO Application -> (Port -> IO a) -> IO a
Warp.testWithApplication (forall (f :: * -> *) a. Applicative f => a -> f a
pure Application
application) forall a b. (a -> b) -> a -> b
$ \Port
p ->
    PortNumber -> IO r
func (forall a b. (Integral a, Num b) => a -> b
fromIntegral Port
p) -- Hopefully safe, because 'testWithApplication' should give us sensible port numbers

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