{-# LANGUAGE RankNTypes #-}
module Test.Syd.Def.SetupFunc where
import Control.Category as Cat
import Control.Monad.IO.Class
import Test.Syd.Def.Around
import Test.Syd.Def.TestDefM
import Test.Syd.HList
newtype SetupFunc old new = SetupFunc
{ SetupFunc old new -> forall r. (new -> IO r) -> old -> IO r
unSetupFunc :: forall r. (new -> IO r) -> (old -> IO r)
}
instance Functor (SetupFunc old) where
fmap :: (a -> b) -> SetupFunc old a -> SetupFunc old b
fmap a -> b
f (SetupFunc forall r. (a -> IO r) -> old -> IO r
provideA) = (forall r. (b -> IO r) -> old -> IO r) -> SetupFunc old b
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc ((forall r. (b -> IO r) -> old -> IO r) -> SetupFunc old b)
-> (forall r. (b -> IO r) -> old -> IO r) -> SetupFunc old b
forall a b. (a -> b) -> a -> b
$ \b -> IO r
takeB old
c ->
let takeA :: a -> IO r
takeA = \a
a -> b -> IO r
takeB (b -> IO r) -> b -> IO r
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
in (a -> IO r) -> old -> IO r
forall r. (a -> IO r) -> old -> IO r
provideA a -> IO r
takeA old
c
instance Applicative (SetupFunc old) where
pure :: a -> SetupFunc old a
pure a
a = (forall r. (a -> IO r) -> old -> IO r) -> SetupFunc old a
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc ((forall r. (a -> IO r) -> old -> IO r) -> SetupFunc old a)
-> (forall r. (a -> IO r) -> old -> IO r) -> SetupFunc old a
forall a b. (a -> b) -> a -> b
$ \a -> IO r
aFunc old
_ -> a -> IO r
aFunc a
a
(SetupFunc forall r. ((a -> b) -> IO r) -> old -> IO r
provideF) <*> :: SetupFunc old (a -> b) -> SetupFunc old a -> SetupFunc old b
<*> (SetupFunc forall r. (a -> IO r) -> old -> IO r
provideA) = (forall r. (b -> IO r) -> old -> IO r) -> SetupFunc old b
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc ((forall r. (b -> IO r) -> old -> IO r) -> SetupFunc old b)
-> (forall r. (b -> IO r) -> old -> IO r) -> SetupFunc old b
forall a b. (a -> b) -> a -> b
$ \b -> IO r
takeB old
c ->
((a -> b) -> IO r) -> old -> IO r
forall r. ((a -> b) -> IO r) -> old -> IO r
provideF
( \a -> b
f ->
(a -> IO r) -> old -> IO r
forall r. (a -> IO r) -> old -> IO r
provideA
( \a
a ->
b -> IO r
takeB (a -> b
f a
a)
)
old
c
)
old
c
instance Monad (SetupFunc old) where
(SetupFunc forall r. (a -> IO r) -> old -> IO r
provideA) >>= :: SetupFunc old a -> (a -> SetupFunc old b) -> SetupFunc old b
>>= a -> SetupFunc old b
m = (forall r. (b -> IO r) -> old -> IO r) -> SetupFunc old b
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc ((forall r. (b -> IO r) -> old -> IO r) -> SetupFunc old b)
-> (forall r. (b -> IO r) -> old -> IO r) -> SetupFunc old b
forall a b. (a -> b) -> a -> b
$ \b -> IO r
takeB old
c ->
(a -> IO r) -> old -> IO r
forall r. (a -> IO r) -> old -> IO r
provideA
( \a
a ->
let (SetupFunc forall r. (b -> IO r) -> old -> IO r
provideB) = a -> SetupFunc old b
m a
a
in (b -> IO r) -> old -> IO r
forall r. (b -> IO r) -> old -> IO r
provideB (\b
b -> b -> IO r
takeB b
b) old
c
)
old
c
instance MonadIO (SetupFunc old) where
liftIO :: IO a -> SetupFunc old a
liftIO IO a
ioFunc = (forall r. (a -> IO r) -> old -> IO r) -> SetupFunc old a
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc ((forall r. (a -> IO r) -> old -> IO r) -> SetupFunc old a)
-> (forall r. (a -> IO r) -> old -> IO r) -> SetupFunc old a
forall a b. (a -> b) -> a -> b
$ \a -> IO r
takeA old
_ -> do
IO a
ioFunc IO a -> (a -> IO r) -> IO r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO r
takeA
instance Category SetupFunc where
id :: SetupFunc a a
id = (forall r. (a -> IO r) -> a -> IO r) -> SetupFunc a a
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc forall a. a -> a
forall r. (a -> IO r) -> a -> IO r
Prelude.id
. :: SetupFunc b c -> SetupFunc a b -> SetupFunc a c
(.) = SetupFunc b c -> SetupFunc a b -> SetupFunc a c
forall b c a. SetupFunc b c -> SetupFunc a b -> SetupFunc a c
composeSetupFunc
makeSimpleSetupFunc ::
(forall result. (resource -> IO result) -> IO result) ->
SetupFunc () resource
makeSimpleSetupFunc :: (forall result. (resource -> IO result) -> IO result)
-> SetupFunc () resource
makeSimpleSetupFunc forall result. (resource -> IO result) -> IO result
provideA = (forall r. (resource -> IO r) -> () -> IO r)
-> SetupFunc () resource
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc ((forall r. (resource -> IO r) -> () -> IO r)
-> SetupFunc () resource)
-> (forall r. (resource -> IO r) -> () -> IO r)
-> SetupFunc () resource
forall a b. (a -> b) -> a -> b
$ \resource -> IO r
takeA () -> (resource -> IO r) -> IO r
forall result. (resource -> IO result) -> IO result
provideA ((resource -> IO r) -> IO r) -> (resource -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \resource
a -> resource -> IO r
takeA resource
a
useSimpleSetupFunc ::
SetupFunc () resource -> (forall result. (resource -> IO result) -> IO result)
useSimpleSetupFunc :: SetupFunc () resource
-> forall result. (resource -> IO result) -> IO result
useSimpleSetupFunc (SetupFunc forall r. (resource -> IO r) -> () -> IO r
provideAWithUnit) resource -> IO result
takeA = (resource -> IO result) -> () -> IO result
forall r. (resource -> IO r) -> () -> IO r
provideAWithUnit (\resource
a -> resource -> IO result
takeA resource
a) ()
wrapSetupFunc ::
(old -> SetupFunc () new) ->
SetupFunc old new
wrapSetupFunc :: (old -> SetupFunc () new) -> SetupFunc old new
wrapSetupFunc old -> SetupFunc () new
bFunc = (forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc ((forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new)
-> (forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
forall a b. (a -> b) -> a -> b
$ \new -> IO r
takeA old
b ->
let SetupFunc forall r. (new -> IO r) -> () -> IO r
provideAWithUnit = old -> SetupFunc () new
bFunc old
b
in (new -> IO r) -> () -> IO r
forall r. (new -> IO r) -> () -> IO r
provideAWithUnit (\new
a -> new -> IO r
takeA new
a) ()
unwrapSetupFunc ::
SetupFunc old new -> (old -> SetupFunc () new)
unwrapSetupFunc :: SetupFunc old new -> old -> SetupFunc () new
unwrapSetupFunc (SetupFunc forall r. (new -> IO r) -> old -> IO r
provideAWithB) old
b = (forall r. (new -> IO r) -> () -> IO r) -> SetupFunc () new
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc ((forall r. (new -> IO r) -> () -> IO r) -> SetupFunc () new)
-> (forall r. (new -> IO r) -> () -> IO r) -> SetupFunc () new
forall a b. (a -> b) -> a -> b
$ \new -> IO r
takeA () ->
(new -> IO r) -> old -> IO r
forall r. (new -> IO r) -> old -> IO r
provideAWithB (\new
a -> new -> IO r
takeA new
a) old
b
composeSetupFunc ::
SetupFunc newer newest ->
SetupFunc old newer ->
SetupFunc old newest
composeSetupFunc :: SetupFunc newer newest
-> SetupFunc old newer -> SetupFunc old newest
composeSetupFunc (SetupFunc forall r. (newest -> IO r) -> newer -> IO r
provideAWithB) (SetupFunc forall r. (newer -> IO r) -> old -> IO r
provideBWithC) = (forall r. (newest -> IO r) -> old -> IO r) -> SetupFunc old newest
forall old new.
(forall r. (new -> IO r) -> old -> IO r) -> SetupFunc old new
SetupFunc ((forall r. (newest -> IO r) -> old -> IO r)
-> SetupFunc old newest)
-> (forall r. (newest -> IO r) -> old -> IO r)
-> SetupFunc old newest
forall a b. (a -> b) -> a -> b
$ \newest -> IO r
takeA old
c ->
(newer -> IO r) -> old -> IO r
forall r. (newer -> IO r) -> old -> IO r
provideBWithC
( \newer
b ->
(newest -> IO r) -> newer -> IO r
forall r. (newest -> IO r) -> newer -> IO r
provideAWithB
( \newest
a -> newest -> IO r
takeA newest
a
)
newer
b
)
old
c
connectSetupFunc ::
SetupFunc old newer ->
SetupFunc newer newest ->
SetupFunc old newest
connectSetupFunc :: SetupFunc old newer
-> SetupFunc newer newest -> SetupFunc old newest
connectSetupFunc = (SetupFunc newer newest
-> SetupFunc old newer -> SetupFunc old newest)
-> SetupFunc old newer
-> SetupFunc newer newest
-> SetupFunc old newest
forall a b c. (a -> b -> c) -> b -> a -> c
flip SetupFunc newer newest
-> SetupFunc old newer -> SetupFunc old newest
forall b c a. SetupFunc b c -> SetupFunc a b -> SetupFunc a c
composeSetupFunc
setupAround ::
SetupFunc () inner ->
TestDefM outers inner result ->
TestDefM outers () result
setupAround :: SetupFunc () inner
-> TestDefM outers inner result -> TestDefM outers () result
setupAround = SetupFunc () inner
-> TestDefM outers inner result -> TestDefM outers () result
forall oldInner newInner (outers :: [*]) result.
SetupFunc oldInner newInner
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith
setupAroundWith ::
SetupFunc oldInner newInner ->
TestDefM outers newInner result ->
TestDefM outers oldInner result
setupAroundWith :: SetupFunc oldInner newInner
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith (SetupFunc forall r. (newInner -> IO r) -> oldInner -> IO r
f) = ((newInner -> IO ()) -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
forall newInner oldInner (outers :: [*]) result.
((newInner -> IO ()) -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
aroundWith (newInner -> IO ()) -> oldInner -> IO ()
forall r. (newInner -> IO r) -> oldInner -> IO r
f
setupAroundWith' ::
HContains outers outer =>
(outer -> SetupFunc oldInner newInner) ->
TestDefM outers newInner result ->
TestDefM outers oldInner result
setupAroundWith' :: (outer -> SetupFunc oldInner newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' outer -> SetupFunc oldInner newInner
setupFuncFunc = ((outer -> newInner -> IO ()) -> outer -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
forall newInner oldInner outer result (outers :: [*]).
HContains outers outer =>
((outer -> newInner -> IO ()) -> outer -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
aroundWith' (((outer -> newInner -> IO ()) -> outer -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result)
-> ((outer -> newInner -> IO ()) -> outer -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
forall a b. (a -> b) -> a -> b
$ \outer -> newInner -> IO ()
takeAC outer
a oldInner
d ->
let (SetupFunc forall r. (newInner -> IO r) -> oldInner -> IO r
provideCWithD) = outer -> SetupFunc oldInner newInner
setupFuncFunc outer
a
in (newInner -> IO ()) -> oldInner -> IO ()
forall r. (newInner -> IO r) -> oldInner -> IO r
provideCWithD (\newInner
c -> outer -> newInner -> IO ()
takeAC outer
a newInner
c) oldInner
d