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

module Test.Syd.Process.Typed where

import System.Process.Typed
import Test.Syd

-- | Run a given process while a test is running and give access to a process handle as an inner resource.
--
-- See 'typedProcessSetupFunc'.
typedProcessSpec :: ProcessConfig stdin stdout stderr -> TestDefM outers (Process stdin stdout stderr) result -> TestDefM outers () result
typedProcessSpec :: ProcessConfig stdin stdout stderr
-> TestDefM outers (Process stdin stdout stderr) result
-> TestDefM outers () result
typedProcessSpec ProcessConfig stdin stdout stderr
pc = SetupFunc (Process stdin stdout stderr)
-> TestDefM outers (Process stdin stdout stderr) result
-> TestDefM outers () result
forall inner (outers :: [*]) result.
SetupFunc inner
-> TestDefM outers inner result -> TestDefM outers () result
setupAround (SetupFunc (Process stdin stdout stderr)
 -> TestDefM outers (Process stdin stdout stderr) result
 -> TestDefM outers () result)
-> SetupFunc (Process stdin stdout stderr)
-> TestDefM outers (Process stdin stdout stderr) result
-> TestDefM outers () result
forall a b. (a -> b) -> a -> b
$ ProcessConfig stdin stdout stderr
-> SetupFunc (Process stdin stdout stderr)
forall stdin stdout stderr.
ProcessConfig stdin stdout stderr
-> SetupFunc (Process stdin stdout stderr)
typedProcessSetupFunc ProcessConfig stdin stdout stderr
pc

-- | Run a given process while a group of tests is running and give access to a process handle as an outer resource.
--
-- See 'typedProcessSetupFunc'.
--
-- == __FOOTGUN__
--
-- The process will be shared accross multiple tests.
-- This may well be a good idea because starting the process can be prohibitively expensive to do around every test.
-- However, sharing the process means that tests could be sharing state.
-- When using this function, it is important to implement some form of cleaning the state before every test.
-- It is also important to use 'sequential' if some such state is maintained (and cleaned) so that the state is not cleaned while another test is running.
outerTypedProcessSpec :: ProcessConfig stdin stdout stderr -> TestDefM (Process stdin stdout stderr ': outers) inner result -> TestDefM outers inner result
outerTypedProcessSpec :: ProcessConfig stdin stdout stderr
-> TestDefM (Process stdin stdout stderr : outers) inner result
-> TestDefM outers inner result
outerTypedProcessSpec ProcessConfig stdin stdout stderr
pc = SetupFunc (Process stdin stdout stderr)
-> TestDefM (Process stdin stdout stderr : outers) inner result
-> TestDefM outers inner result
forall outer (outers :: [*]) inner result.
SetupFunc outer
-> TestDefM (outer : outers) inner result
-> TestDefM outers inner result
setupAroundAll (SetupFunc (Process stdin stdout stderr)
 -> TestDefM (Process stdin stdout stderr : outers) inner result
 -> TestDefM outers inner result)
-> SetupFunc (Process stdin stdout stderr)
-> TestDefM (Process stdin stdout stderr : outers) inner result
-> TestDefM outers inner result
forall a b. (a -> b) -> a -> b
$ ProcessConfig stdin stdout stderr
-> SetupFunc (Process stdin stdout stderr)
forall stdin stdout stderr.
ProcessConfig stdin stdout stderr
-> SetupFunc (Process stdin stdout stderr)
typedProcessSetupFunc ProcessConfig stdin stdout stderr
pc

-- | Set up a process beforehand and stop it afterwards.
--
-- The process will be terminated using 'stopProcess'.
typedProcessSetupFunc :: ProcessConfig stdin stdout stderr -> SetupFunc (Process stdin stdout stderr)
typedProcessSetupFunc :: ProcessConfig stdin stdout stderr
-> SetupFunc (Process stdin stdout stderr)
typedProcessSetupFunc ProcessConfig stdin stdout stderr
pc = IO (Process stdin stdout stderr)
-> (Process stdin stdout stderr -> IO ())
-> SetupFunc (Process stdin stdout stderr)
forall resource r.
IO resource -> (resource -> IO r) -> SetupFunc resource
bracketSetupFunc (ProcessConfig stdin stdout stderr
-> IO (Process stdin stdout stderr)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess ProcessConfig stdin stdout stderr
pc) Process stdin stdout stderr -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess