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

-- |
-- Module        : Data.Fixtures.Adhoc.Hspec
-- Copyright     : Gautier DI FOLCO
-- License       : ISC
--
-- Maintainer    : Gautier DI FOLCO <gautier.difolco@gmail.com>
-- Stability     : Unstable
-- Portability   : not portable
--
-- Fixtures builder and runner
--
-- Example:
--
-- > aroundAllWith (withFixtureAppendLift @"tracker" @_ @"box" boxFixture) $ do
-- >   it "Tracker should have one key (added)" $ \fixture ->
-- >     readIORef fixture.tracker `shouldReturn` [("box00", 42)]
module Data.Fixtures.Adhoc.Hspec
  ( withFixtureAppendLift,
    withFixtureAppend,
  )
where

import Data.Fixtures.Adhoc
import Data.Records.Yarl.LinkedList
import GHC.TypeLits
import Test.Hspec

-- | Fixture builder (should be used directly with care)
withFixtureAppendLift ::
  forall (name :: Symbol) a (builderName :: Symbol) b.
  HasNotField builderName '[Field name a] =>
  BuilderWith '[Field name a] IO builderName b ->
  ActionWith (Record '[Field builderName b, Field name a]) ->
  ActionWith a
withFixtureAppendLift :: forall (name :: Symbol) a (builderName :: Symbol) b.
HasNotField builderName '[Field name a] =>
BuilderWith '[Field name a] IO builderName b
-> ActionWith (Record '[Field builderName b, Field name a])
-> ActionWith a
withFixtureAppendLift BuilderWith '[Field name a] IO builderName b
builderWith ActionWith (Record '[Field builderName b, Field name a])
runTest a
previousArgs =
  forall (m :: * -> *) (items :: [*]) a.
MonadMask m =>
Builder m items -> (Record items -> m a) -> m a
runWithFixtures (BuilderWith '[Field name a] IO builderName b
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 (name :: Symbol) a (m :: * -> *) (items :: [*]).
(Monad m, HasNotField name items) =>
m a -> BuilderWith items m name a
build @name (forall (m :: * -> *) a. Monad m => a -> m a
return a
previousArgs) 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 :: * -> *). Monad m => Builder m '[]
nullBuilder) ActionWith (Record '[Field builderName b, Field name a])
runTest

withFixtureAppend ::
  forall (builderName :: Symbol) b items.
  HasNotField builderName items =>
  BuilderWith items IO builderName b ->
  ActionWith (Record (Field builderName b ': items)) ->
  ActionWith (Record items)
withFixtureAppend :: forall (builderName :: Symbol) b (items :: [*]).
HasNotField builderName items =>
BuilderWith items IO builderName b
-> ActionWith (Record (Field builderName b : items))
-> ActionWith (Record items)
withFixtureAppend BuilderWith items IO builderName b
builderWith ActionWith (Record (Field builderName b : items))
runTest Record items
previousArgs =
  forall (m :: * -> *) (items :: [*]) a.
MonadMask m =>
Builder m items -> (Record items -> m a) -> m a
runWithFixtures (BuilderWith items IO builderName b
builderWith forall (name :: Symbol) (items :: [*]) (m :: * -> *) a.
(HasNotField name items, Monad m) =>
BuilderWith items m name a
-> Record items -> Builder m (Field name a : items)
&> Record items
previousArgs) ActionWith (Record (Field builderName b : items))
runTest