{-# LANGUAGE ConstraintKinds #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Data.Fixtures.Adhoc
( Builder (..),
BuilderWith,
HasFixture,
buildWith,
buildWithClean,
build,
buildClean,
nullBuilder,
pureBuilder,
(&:),
(&>),
runWithFixtures,
createFixtures,
)
where
import Control.Exception.Safe (MonadMask, bracket)
import Data.Records.Yarl.LinkedList
import GHC.TypeLits
data Builder m items = Builder
{ forall (m :: * -> *) (items :: [*]).
Builder m items -> m (Record items)
create :: m (Record items),
forall (m :: * -> *) (items :: [*]).
Builder m items -> Record items -> m ()
clean :: Record items -> m ()
}
type BuilderWith items m (name :: Symbol) a =
HasNotField name items =>
Builder m items ->
Builder m (Field name a ': items)
type HasFixture items (name :: Symbol) a = HasField name (Record items) a
buildWith ::
forall (name :: Symbol) a m items.
(Monad m, HasNotField name items) =>
(Record items -> m a) ->
BuilderWith items m name a
buildWith :: forall (name :: Symbol) a (m :: * -> *) (items :: [*]).
(Monad m, HasNotField name items) =>
(Record items -> m a) -> BuilderWith items m name a
buildWith Record items -> m a
f = forall (name :: Symbol) a (m :: * -> *) (items :: [*]).
(Monad m, HasNotField name items) =>
(Record items -> m a)
-> (Record items -> a -> m ()) -> BuilderWith items m name a
buildWithClean Record items -> m a
f forall a b. (a -> b) -> a -> b
$ \Record items
_ a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
buildWithClean ::
forall (name :: Symbol) a m items.
(Monad m, HasNotField name items) =>
(Record items -> m a) ->
(Record items -> a -> m ()) ->
BuilderWith items m name a
buildWithClean :: forall (name :: Symbol) a (m :: * -> *) (items :: [*]).
(Monad m, HasNotField name items) =>
(Record items -> m a)
-> (Record items -> a -> m ()) -> BuilderWith items m name a
buildWithClean Record items -> m a
create' Record items -> a -> m ()
clean' Builder m items
previous =
Builder
{ $sel:create:Builder :: m (Record (Field name a : items))
create = do
Record items
xs <- Builder m items
previous.create
a
x <- Record items -> m a
create' Record items
xs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol) a. a -> Field name a
Field a
x forall (fieldName :: Symbol) (fields :: [*]) a1.
HasNotField fieldName fields =>
Field fieldName a1
-> Record fields -> Record (Field fieldName a1 : fields)
:> Record items
xs,
$sel:clean:Builder :: Record (Field name a : items) -> m ()
clean =
\(Field a1
x :> Record fields
xs) ->
Record items -> a -> m ()
clean' Record fields
xs a1
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder m items
previous.clean Record fields
xs
}
build ::
forall (name :: Symbol) a m items.
(Monad m, HasNotField name items) =>
m a ->
BuilderWith items m name a
build :: forall (name :: Symbol) a (m :: * -> *) (items :: [*]).
(Monad m, HasNotField name items) =>
m a -> BuilderWith items m name a
build m a
f = forall (name :: Symbol) a (m :: * -> *) (items :: [*]).
(Monad m, HasNotField name items) =>
m a -> (a -> m ()) -> BuilderWith items m name a
buildClean m a
f forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
buildClean ::
forall (name :: Symbol) a m items.
(Monad m, HasNotField name items) =>
m a ->
(a -> m ()) ->
BuilderWith items m name a
buildClean :: forall (name :: Symbol) a (m :: * -> *) (items :: [*]).
(Monad m, HasNotField name items) =>
m a -> (a -> m ()) -> BuilderWith items m name a
buildClean m a
create' a -> m ()
clean' Builder m items
previous =
Builder
{ $sel:create:Builder :: m (Record (Field name a : items))
create = do
Record items
xs <- Builder m items
previous.create
a
x <- m a
create'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol) a. a -> Field name a
Field a
x forall (fieldName :: Symbol) (fields :: [*]) a1.
HasNotField fieldName fields =>
Field fieldName a1
-> Record fields -> Record (Field fieldName a1 : fields)
:> Record items
xs,
$sel:clean:Builder :: Record (Field name a : items) -> m ()
clean =
\(Field a1
x :> Record fields
xs) ->
a -> m ()
clean' a1
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder m items
previous.clean Record fields
xs
}
nullBuilder :: Monad m => Builder m '[]
nullBuilder :: forall (m :: * -> *). Monad m => Builder m '[]
nullBuilder =
Builder
{ $sel:create:Builder :: m (Record '[])
create = forall (m :: * -> *) a. Monad m => a -> m a
return Record '[]
RNil,
$sel:clean:Builder :: Record '[] -> m ()
clean = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
}
pureBuilder :: Monad m => Record items -> Builder m items
pureBuilder :: forall (m :: * -> *) (items :: [*]).
Monad m =>
Record items -> Builder m items
pureBuilder Record items
built =
Builder
{ $sel:create:Builder :: m (Record items)
create = forall (m :: * -> *) a. Monad m => a -> m a
return Record items
built,
$sel:clean:Builder :: Record items -> m ()
clean = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
}
(&:) :: HasNotField name items => BuilderWith items m name a -> Builder m items -> Builder m (Field name a ': items)
&: :: forall (name :: Symbol) (items :: [*]) (m :: * -> *) a.
HasNotField name items =>
BuilderWith items m name a
-> Builder m items -> Builder m (Field name a : items)
(&:) = forall a b. (a -> b) -> a -> b
($)
infixr 5 &:
(&>) :: (HasNotField name items, Monad m) => BuilderWith items m name a -> Record items -> Builder m (Field name a ': items)
&> :: forall (name :: Symbol) (items :: [*]) (m :: * -> *) a.
(HasNotField name items, Monad m) =>
BuilderWith items m name a
-> Record items -> Builder m (Field name a : items)
(&>) BuilderWith items m name a
builderWith Record items
built = BuilderWith items m name a
builderWith forall (name :: Symbol) (items :: [*]) (m :: * -> *) a.
HasNotField name items =>
BuilderWith items m name a
-> Builder m items -> Builder m (Field name a : items)
&: forall (m :: * -> *) (items :: [*]).
Monad m =>
Record items -> Builder m items
pureBuilder Record items
built
infixr 5 &>
runWithFixtures :: MonadMask m => Builder m items -> (Record items -> m a) -> m a
runWithFixtures :: forall (m :: * -> *) (items :: [*]) a.
MonadMask m =>
Builder m items -> (Record items -> m a) -> m a
runWithFixtures Builder m items
builder = forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket Builder m items
builder.create Builder m items
builder.clean
createFixtures :: Monad m => Builder m items -> (Record items -> m a) -> m a
createFixtures :: forall (m :: * -> *) (items :: [*]) a.
Monad m =>
Builder m items -> (Record items -> m a) -> m a
createFixtures Builder m items
builder Record items -> m a
act = Builder m items
builder.create forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Record items -> m a
act