{-# LANGUAGE ConstraintKinds #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- |
-- Module        : Data.Fixtures.Adhoc
-- Copyright     : Gautier DI FOLCO
-- License       : ISC
--
-- Maintainer    : Gautier DI FOLCO <gautier.difolco@gmail.com>
-- Stability     : Unstable
-- Portability   : not portable
--
-- Fixtures builder and runner
--
-- Example:
--
-- > boxFixture ::
-- >   HasFixture items "tracker" Tracker =>
-- >   BuilderWith items IO "box" Box
-- > boxFixture =
-- >   buildWithClean
-- >   (\prev -> let box = Box 42 "box00" in addId box.boxKey box.boxId prev.tracker >> return box)
-- >   (\prev box -> rmId box.boxKey prev.tracker)
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

-- | Fixture builder (should be used directly with care)
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 ()
  }

-- | Builder relying on other builder(s)
type BuilderWith items m (name :: Symbol) a =
  HasNotField name items =>
  Builder m items ->
  Builder m (Field name a ': items)

-- | Helper around 'HasRecord'
type HasFixture items (name :: Symbol) a = HasField name (Record items) a

-- | Simple builder, no clean operation
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 ()

-- | Builder with cleaning operation
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
    }

-- | Simple builder without dependency, no clean operation
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 ()

-- | Builder without dependency with cleaning operation
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
    }

-- | Base builder
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 ()
    }

-- | Pure builder
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 ()
    }

-- | Chain builders
(&:) :: 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 &:

-- | Nest builders
(&>) :: (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 &>

-- | Run fixtures with clean up (bracket)
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

-- | Create fixtures (no clean up)
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