{-# 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 b a = SetupFunc
{ SetupFunc b a -> forall r. (a -> IO r) -> b -> IO r
unSetupFunc :: forall r. (a -> IO r) -> (b -> IO r)
}
instance Functor (SetupFunc c) where
fmap :: (a -> b) -> SetupFunc c a -> SetupFunc c b
fmap a -> b
f (SetupFunc forall r. (a -> IO r) -> c -> IO r
provideA) = (forall r. (b -> IO r) -> c -> IO r) -> SetupFunc c b
forall b a. (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
SetupFunc ((forall r. (b -> IO r) -> c -> IO r) -> SetupFunc c b)
-> (forall r. (b -> IO r) -> c -> IO r) -> SetupFunc c b
forall a b. (a -> b) -> a -> b
$ \b -> IO r
takeB c
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) -> c -> IO r
forall r. (a -> IO r) -> c -> IO r
provideA a -> IO r
takeA c
c
instance Applicative (SetupFunc c) where
pure :: a -> SetupFunc c a
pure a
a = (forall r. (a -> IO r) -> c -> IO r) -> SetupFunc c a
forall b a. (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
SetupFunc ((forall r. (a -> IO r) -> c -> IO r) -> SetupFunc c a)
-> (forall r. (a -> IO r) -> c -> IO r) -> SetupFunc c a
forall a b. (a -> b) -> a -> b
$ \a -> IO r
aFunc c
_ -> a -> IO r
aFunc a
a
(SetupFunc forall r. ((a -> b) -> IO r) -> c -> IO r
provideF) <*> :: SetupFunc c (a -> b) -> SetupFunc c a -> SetupFunc c b
<*> (SetupFunc forall r. (a -> IO r) -> c -> IO r
provideA) = (forall r. (b -> IO r) -> c -> IO r) -> SetupFunc c b
forall b a. (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
SetupFunc ((forall r. (b -> IO r) -> c -> IO r) -> SetupFunc c b)
-> (forall r. (b -> IO r) -> c -> IO r) -> SetupFunc c b
forall a b. (a -> b) -> a -> b
$ \b -> IO r
takeB c
c ->
((a -> b) -> IO r) -> c -> IO r
forall r. ((a -> b) -> IO r) -> c -> IO r
provideF
( \a -> b
f ->
(a -> IO r) -> c -> IO r
forall r. (a -> IO r) -> c -> IO r
provideA
( \a
a ->
b -> IO r
takeB (a -> b
f a
a)
)
c
c
)
c
c
instance Monad (SetupFunc c) where
(SetupFunc forall r. (a -> IO r) -> c -> IO r
provideA) >>= :: SetupFunc c a -> (a -> SetupFunc c b) -> SetupFunc c b
>>= a -> SetupFunc c b
m = (forall r. (b -> IO r) -> c -> IO r) -> SetupFunc c b
forall b a. (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
SetupFunc ((forall r. (b -> IO r) -> c -> IO r) -> SetupFunc c b)
-> (forall r. (b -> IO r) -> c -> IO r) -> SetupFunc c b
forall a b. (a -> b) -> a -> b
$ \b -> IO r
takeB c
c ->
(a -> IO r) -> c -> IO r
forall r. (a -> IO r) -> c -> IO r
provideA
( \a
a ->
let (SetupFunc forall r. (b -> IO r) -> c -> IO r
provideB) = a -> SetupFunc c b
m a
a
in (b -> IO r) -> c -> IO r
forall r. (b -> IO r) -> c -> IO r
provideB (\b
b -> b -> IO r
takeB b
b) c
c
)
c
c
instance MonadIO (SetupFunc c) where
liftIO :: IO a -> SetupFunc c a
liftIO IO a
ioFunc = (forall r. (a -> IO r) -> c -> IO r) -> SetupFunc c a
forall b a. (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
SetupFunc ((forall r. (a -> IO r) -> c -> IO r) -> SetupFunc c a)
-> (forall r. (a -> IO r) -> c -> IO r) -> SetupFunc c a
forall a b. (a -> b) -> a -> b
$ \a -> IO r
takeA c
_ -> 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 b a. (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
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 r. (a -> IO r) -> IO r) -> SetupFunc () a
makeSimpleSetupFunc :: (forall r. (a -> IO r) -> IO r) -> SetupFunc () a
makeSimpleSetupFunc forall r. (a -> IO r) -> IO r
provideA = (forall r. (a -> IO r) -> () -> IO r) -> SetupFunc () a
forall b a. (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
SetupFunc ((forall r. (a -> IO r) -> () -> IO r) -> SetupFunc () a)
-> (forall r. (a -> IO r) -> () -> IO r) -> SetupFunc () a
forall a b. (a -> b) -> a -> b
$ \a -> IO r
takeA () -> (a -> IO r) -> IO r
forall r. (a -> IO r) -> IO r
provideA ((a -> IO r) -> IO r) -> (a -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \a
a -> a -> IO r
takeA a
a
useSimpleSetupFunc :: SetupFunc () a -> (forall r. (a -> IO r) -> IO r)
useSimpleSetupFunc :: SetupFunc () a -> forall r. (a -> IO r) -> IO r
useSimpleSetupFunc (SetupFunc forall r. (a -> IO r) -> () -> IO r
provideAWithUnit) a -> IO r
takeA = (a -> IO r) -> () -> IO r
forall r. (a -> IO r) -> () -> IO r
provideAWithUnit (\a
a -> a -> IO r
takeA a
a) ()
wrapSetupFunc :: (b -> SetupFunc () a) -> SetupFunc b a
wrapSetupFunc :: (b -> SetupFunc () a) -> SetupFunc b a
wrapSetupFunc b -> SetupFunc () a
bFunc = (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
forall b a. (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
SetupFunc ((forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a)
-> (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
forall a b. (a -> b) -> a -> b
$ \a -> IO r
takeA b
b ->
let SetupFunc forall r. (a -> IO r) -> () -> IO r
provideAWithUnit = b -> SetupFunc () a
bFunc b
b
in (a -> IO r) -> () -> IO r
forall r. (a -> IO r) -> () -> IO r
provideAWithUnit (\a
a -> a -> IO r
takeA a
a) ()
unwrapSetupFunc :: SetupFunc b a -> (b -> SetupFunc () a)
unwrapSetupFunc :: SetupFunc b a -> b -> SetupFunc () a
unwrapSetupFunc (SetupFunc forall r. (a -> IO r) -> b -> IO r
provideAWithB) b
b = (forall r. (a -> IO r) -> () -> IO r) -> SetupFunc () a
forall b a. (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
SetupFunc ((forall r. (a -> IO r) -> () -> IO r) -> SetupFunc () a)
-> (forall r. (a -> IO r) -> () -> IO r) -> SetupFunc () a
forall a b. (a -> b) -> a -> b
$ \a -> IO r
takeA () ->
(a -> IO r) -> b -> IO r
forall r. (a -> IO r) -> b -> IO r
provideAWithB (\a
a -> a -> IO r
takeA a
a) b
b
composeSetupFunc :: SetupFunc b a -> SetupFunc c b -> SetupFunc c a
composeSetupFunc :: SetupFunc b a -> SetupFunc c b -> SetupFunc c a
composeSetupFunc (SetupFunc forall r. (a -> IO r) -> b -> IO r
provideAWithB) (SetupFunc forall r. (b -> IO r) -> c -> IO r
provideBWithC) = (forall r. (a -> IO r) -> c -> IO r) -> SetupFunc c a
forall b a. (forall r. (a -> IO r) -> b -> IO r) -> SetupFunc b a
SetupFunc ((forall r. (a -> IO r) -> c -> IO r) -> SetupFunc c a)
-> (forall r. (a -> IO r) -> c -> IO r) -> SetupFunc c a
forall a b. (a -> b) -> a -> b
$ \a -> IO r
takeA c
c ->
(b -> IO r) -> c -> IO r
forall r. (b -> IO r) -> c -> IO r
provideBWithC
( \b
b ->
(a -> IO r) -> b -> IO r
forall r. (a -> IO r) -> b -> IO r
provideAWithB
( \a
a -> a -> IO r
takeA a
a
)
b
b
)
c
c
connectSetupFunc :: SetupFunc c b -> SetupFunc b a -> SetupFunc c a
connectSetupFunc :: SetupFunc c b -> SetupFunc b a -> SetupFunc c a
connectSetupFunc = (SetupFunc b a -> SetupFunc c b -> SetupFunc c a)
-> SetupFunc c b -> SetupFunc b a -> SetupFunc c a
forall a b c. (a -> b -> c) -> b -> a -> c
flip SetupFunc b a -> SetupFunc c b -> SetupFunc c a
forall b c a. SetupFunc b c -> SetupFunc a b -> SetupFunc a c
composeSetupFunc
setupAround :: SetupFunc () c -> TestDefM a c e -> TestDefM a () e
setupAround :: SetupFunc () c -> TestDefM a c e -> TestDefM a () e
setupAround = SetupFunc () c -> TestDefM a c e -> TestDefM a () e
forall d c (a :: [*]) e.
SetupFunc d c -> TestDefM a c e -> TestDefM a d e
setupAroundWith
setupAroundWith :: SetupFunc d c -> TestDefM a c e -> TestDefM a d e
setupAroundWith :: SetupFunc d c -> TestDefM a c e -> TestDefM a d e
setupAroundWith (SetupFunc forall r. (c -> IO r) -> d -> IO r
f) = ((c -> IO ()) -> d -> IO ()) -> TestDefM a c e -> TestDefM a d e
forall (a :: [*]) c d r.
((c -> IO ()) -> d -> IO ()) -> TestDefM a c r -> TestDefM a d r
aroundWith (c -> IO ()) -> d -> IO ()
forall r. (c -> IO r) -> d -> IO r
f
setupAroundWith' :: HContains l a => (a -> SetupFunc d c) -> TestDefM l c e -> TestDefM l d e
setupAroundWith' :: (a -> SetupFunc d c) -> TestDefM l c e -> TestDefM l d e
setupAroundWith' a -> SetupFunc d c
setupFuncFunc = ((a -> c -> IO ()) -> a -> d -> IO ())
-> TestDefM l c e -> TestDefM l d e
forall a c d r (u :: [*]).
HContains u a =>
((a -> c -> IO ()) -> a -> d -> IO ())
-> TestDefM u c r -> TestDefM u d r
aroundWith' (((a -> c -> IO ()) -> a -> d -> IO ())
-> TestDefM l c e -> TestDefM l d e)
-> ((a -> c -> IO ()) -> a -> d -> IO ())
-> TestDefM l c e
-> TestDefM l d e
forall a b. (a -> b) -> a -> b
$ \a -> c -> IO ()
takeAC a
a d
d ->
let (SetupFunc forall r. (c -> IO r) -> d -> IO r
provideCWithD) = a -> SetupFunc d c
setupFuncFunc a
a
in (c -> IO ()) -> d -> IO ()
forall r. (c -> IO r) -> d -> IO r
provideCWithD (\c
c -> a -> c -> IO ()
takeAC a
a c
c) d
d