{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}

module Skeletest.Internal.Fixtures (
  Fixture (..),
  FixtureScope (..),
  FixtureScopeKey (..),
  getFixture,

  -- * Cleanup
  FixtureCleanup (..),
  noCleanup,
  withCleanup,
  cleanupFixtures,

  -- * Built-in fixtures
  FixtureTmpDir (..),
) where

import Control.Concurrent (ThreadId, myThreadId)
import Control.Monad (forM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.IORef (IORef, atomicModifyIORef, newIORef)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Map.Ordered (OMap)
import Data.Map.Ordered qualified as OMap
import Data.Maybe (catMaybes)
import Data.Proxy (Proxy (..))
import Data.Text qualified as Text
import Data.Typeable (TypeRep, Typeable, eqT, typeOf, typeRep, (:~:) (Refl))
import System.Directory (createDirectory, getTemporaryDirectory, removePathForcibly)
import System.FilePath ((</>))
import System.IO.Unsafe (unsafePerformIO)
import UnliftIO.Exception (throwIO, tryAny)

import Skeletest.Internal.Error (SkeletestError (..), invariantViolation)
import Skeletest.Internal.TestInfo (
  TestInfo (testFile),
  getTestInfo,
 )
import Skeletest.Internal.Utils.Map qualified as Map.Utils

class (Typeable a) => Fixture a where
  -- | The scope of the fixture, defaults to per-test
  fixtureScope :: FixtureScope
  fixtureScope = FixtureScope
PerTestFixture

  fixtureAction :: IO (a, FixtureCleanup)

data FixtureScope
  = PerTestFixture
  | PerFileFixture
  | PerSessionFixture
  deriving (Int -> FixtureScope -> ShowS
[FixtureScope] -> ShowS
FixtureScope -> FilePath
(Int -> FixtureScope -> ShowS)
-> (FixtureScope -> FilePath)
-> ([FixtureScope] -> ShowS)
-> Show FixtureScope
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixtureScope -> ShowS
showsPrec :: Int -> FixtureScope -> ShowS
$cshow :: FixtureScope -> FilePath
show :: FixtureScope -> FilePath
$cshowList :: [FixtureScope] -> ShowS
showList :: [FixtureScope] -> ShowS
Show)

data FixtureCleanup
  = NoCleanup
  | CleanupFunc (IO ())

data FixtureScopeKey
  = PerTestFixtureKey ThreadId
  | PerFileFixtureKey FilePath
  | PerSessionFixtureKey
  deriving (Int -> FixtureScopeKey -> ShowS
[FixtureScopeKey] -> ShowS
FixtureScopeKey -> FilePath
(Int -> FixtureScopeKey -> ShowS)
-> (FixtureScopeKey -> FilePath)
-> ([FixtureScopeKey] -> ShowS)
-> Show FixtureScopeKey
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixtureScopeKey -> ShowS
showsPrec :: Int -> FixtureScopeKey -> ShowS
$cshow :: FixtureScopeKey -> FilePath
show :: FixtureScopeKey -> FilePath
$cshowList :: [FixtureScopeKey] -> ShowS
showList :: [FixtureScopeKey] -> ShowS
Show)

-- | A helper for specifying no cleanup.
noCleanup :: a -> (a, FixtureCleanup)
noCleanup :: forall a. a -> (a, FixtureCleanup)
noCleanup a
a = (a
a, FixtureCleanup
NoCleanup)

-- | A helper for defining the cleanup function in-line.
withCleanup :: a -> IO () -> (a, FixtureCleanup)
withCleanup :: forall a. a -> IO () -> (a, FixtureCleanup)
withCleanup a
a IO ()
cleanup = (a
a, IO () -> FixtureCleanup
CleanupFunc IO ()
cleanup)

-- | Load a fixture, initializing it if it hasn't been cached already.
getFixture :: forall a m. (Fixture a, MonadIO m) => m a
getFixture :: forall a (m :: * -> *). (Fixture a, MonadIO m) => m a
getFixture = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
  (getScopedFixtures, updateScopedFixtures) <-
    (FixtureScopeKey
 -> (FixtureRegistry -> OMap TypeRep FixtureStatus,
     (OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus)
     -> FixtureRegistry -> FixtureRegistry))
-> IO FixtureScopeKey
-> IO
     (FixtureRegistry -> OMap TypeRep FixtureStatus,
      (OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus)
      -> FixtureRegistry -> FixtureRegistry)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FixtureScopeKey
-> (FixtureRegistry -> OMap TypeRep FixtureStatus,
    (OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus)
    -> FixtureRegistry -> FixtureRegistry)
getScopedAccessors (IO FixtureScopeKey
 -> IO
      (FixtureRegistry -> OMap TypeRep FixtureStatus,
       (OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus)
       -> FixtureRegistry -> FixtureRegistry))
-> IO FixtureScopeKey
-> IO
     (FixtureRegistry -> OMap TypeRep FixtureStatus,
      (OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus)
      -> FixtureRegistry -> FixtureRegistry)
forall a b. (a -> b) -> a -> b
$
      case forall a. Fixture a => FixtureScope
fixtureScope @a of
        FixtureScope
PerTestFixture -> ThreadId -> FixtureScopeKey
PerTestFixtureKey (ThreadId -> FixtureScopeKey) -> IO ThreadId -> IO FixtureScopeKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ThreadId
myThreadId
        FixtureScope
PerFileFixture -> FilePath -> FixtureScopeKey
PerFileFixtureKey (FilePath -> FixtureScopeKey)
-> (TestInfo -> FilePath) -> TestInfo -> FixtureScopeKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestInfo -> FilePath
testFile (TestInfo -> FixtureScopeKey) -> IO TestInfo -> IO FixtureScopeKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TestInfo
forall (m :: * -> *). MonadIO m => m TestInfo
getTestInfo
        FixtureScope
PerSessionFixture -> FixtureScopeKey -> IO FixtureScopeKey
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FixtureScopeKey
PerSessionFixtureKey

  let insertFixture FixtureStatus
state = (OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus)
-> FixtureRegistry -> FixtureRegistry
updateScopedFixtures (OMap TypeRep FixtureStatus
-> (TypeRep, FixtureStatus) -> OMap TypeRep FixtureStatus
forall k v. Ord k => OMap k v -> (k, v) -> OMap k v
OMap.>| (TypeRep
rep, FixtureStatus
state))

  cachedFixture <-
    modifyFixtureRegistry $ \FixtureRegistry
registry ->
      case TypeRep -> OMap TypeRep FixtureStatus -> Maybe FixtureStatus
forall k v. Ord k => k -> OMap k v -> Maybe v
OMap.lookup TypeRep
rep (OMap TypeRep FixtureStatus -> Maybe FixtureStatus)
-> OMap TypeRep FixtureStatus -> Maybe FixtureStatus
forall a b. (a -> b) -> a -> b
$ FixtureRegistry -> OMap TypeRep FixtureStatus
getScopedFixtures FixtureRegistry
registry of
        -- fixture has not been requested yet
        Maybe FixtureStatus
Nothing -> (FixtureStatus -> FixtureRegistry -> FixtureRegistry
insertFixture FixtureStatus
FixtureInProgress FixtureRegistry
registry, Maybe a -> Either SkeletestError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing)
        -- fixture has already been requested
        Just (FixtureLoaded (a
fixture :: ty, FixtureCleanup
_)) ->
          case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @a @ty of
            Just a :~: a
Refl -> (FixtureRegistry
registry, Maybe a -> Either SkeletestError (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either SkeletestError (Maybe a))
-> Maybe a -> Either SkeletestError (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a
fixture)
            Maybe (a :~: a)
Nothing ->
              FilePath -> (FixtureRegistry, Either SkeletestError (Maybe a))
forall a. FilePath -> a
invariantViolation (FilePath -> (FixtureRegistry, Either SkeletestError (Maybe a)))
-> ([FilePath] -> FilePath)
-> [FilePath]
-> (FixtureRegistry, Either SkeletestError (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unwords ([FilePath] -> (FixtureRegistry, Either SkeletestError (Maybe a)))
-> [FilePath] -> (FixtureRegistry, Either SkeletestError (Maybe a))
forall a b. (a -> b) -> a -> b
$
                [ FilePath
"fixture registry contained incorrect types."
                , FilePath
"Expected: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeRep -> FilePath
forall a. Show a => a -> FilePath
show TypeRep
rep FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"."
                , FilePath
"Got: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeRep -> FilePath
forall a. Show a => a -> FilePath
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
fixture)
                ]
        Just FixtureStatus
FixtureInProgress ->
          -- get list of fixtures causing a circular dependency
          let fixtures :: [TypeRep]
fixtures = ((TypeRep, FixtureStatus) -> TypeRep)
-> [(TypeRep, FixtureStatus)] -> [TypeRep]
forall a b. (a -> b) -> [a] -> [b]
map (TypeRep, FixtureStatus) -> TypeRep
forall a b. (a, b) -> a
fst ([(TypeRep, FixtureStatus)] -> [TypeRep])
-> (OMap TypeRep FixtureStatus -> [(TypeRep, FixtureStatus)])
-> OMap TypeRep FixtureStatus
-> [TypeRep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TypeRep, FixtureStatus) -> Bool)
-> [(TypeRep, FixtureStatus)] -> [(TypeRep, FixtureStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FixtureStatus -> Bool
isInProgress (FixtureStatus -> Bool)
-> ((TypeRep, FixtureStatus) -> FixtureStatus)
-> (TypeRep, FixtureStatus)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeRep, FixtureStatus) -> FixtureStatus
forall a b. (a, b) -> b
snd) ([(TypeRep, FixtureStatus)] -> [(TypeRep, FixtureStatus)])
-> (OMap TypeRep FixtureStatus -> [(TypeRep, FixtureStatus)])
-> OMap TypeRep FixtureStatus
-> [(TypeRep, FixtureStatus)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMap TypeRep FixtureStatus -> [(TypeRep, FixtureStatus)]
forall k v. OMap k v -> [(k, v)]
OMap.assocs (OMap TypeRep FixtureStatus -> [TypeRep])
-> OMap TypeRep FixtureStatus -> [TypeRep]
forall a b. (a -> b) -> a -> b
$ FixtureRegistry -> OMap TypeRep FixtureStatus
getScopedFixtures FixtureRegistry
registry
           in (FixtureRegistry
registry, SkeletestError -> Either SkeletestError (Maybe a)
forall a b. a -> Either a b
Left (SkeletestError -> Either SkeletestError (Maybe a))
-> SkeletestError -> Either SkeletestError (Maybe a)
forall a b. (a -> b) -> a -> b
$ [Text] -> SkeletestError
FixtureCircularDependency ([Text] -> SkeletestError) -> [Text] -> SkeletestError
forall a b. (a -> b) -> a -> b
$ (TypeRep -> Text) -> [TypeRep] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
Text.pack (FilePath -> Text) -> (TypeRep -> FilePath) -> TypeRep -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> FilePath
forall a. Show a => a -> FilePath
show) ([TypeRep]
fixtures [TypeRep] -> [TypeRep] -> [TypeRep]
forall a. Semigroup a => a -> a -> a
<> [TypeRep
rep]))

  case cachedFixture of
    -- error when getting fixture
    Left SkeletestError
e -> SkeletestError -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SkeletestError
e
    -- fixture was cached, return it
    Right (Just a
fixture) -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
fixture
    -- otherwise, execute it (allowing it to request other fixtures) and cache the result.
    Right Maybe a
Nothing -> do
      result@(fixture, _) <- forall a. Fixture a => IO (a, FixtureCleanup)
fixtureAction @a
      modifyFixtureRegistry $ \FixtureRegistry
registry -> (FixtureStatus -> FixtureRegistry -> FixtureRegistry
insertFixture ((a, FixtureCleanup) -> FixtureStatus
forall a. Typeable a => (a, FixtureCleanup) -> FixtureStatus
FixtureLoaded (a, FixtureCleanup)
result) FixtureRegistry
registry, ())
      pure fixture
  where
    rep :: TypeRep
rep = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
    isInProgress :: FixtureStatus -> Bool
isInProgress = \case
      FixtureStatus
FixtureInProgress -> Bool
True
      FixtureStatus
_ -> Bool
False

-- | Clean up fixtures in the given scope.
--
-- Clean up functions are run in the reverse order the fixtures finished in.
-- For example, if a test asks for fixtures A and C, A asks for B, and C asks
-- for D, the fixtures should finish loading in order: B, A, D, C.
-- Cleanup should then go in order: C, D, A, B.
cleanupFixtures :: FixtureScopeKey -> IO ()
cleanupFixtures :: FixtureScopeKey -> IO ()
cleanupFixtures FixtureScopeKey
scopeKey = do
  -- get fixtures in the given scope and clear
  fixtures <-
    (FixtureRegistry -> (FixtureRegistry, OMap TypeRep FixtureStatus))
-> IO (OMap TypeRep FixtureStatus)
forall a. (FixtureRegistry -> (FixtureRegistry, a)) -> IO a
modifyFixtureRegistry ((FixtureRegistry -> (FixtureRegistry, OMap TypeRep FixtureStatus))
 -> IO (OMap TypeRep FixtureStatus))
-> (FixtureRegistry
    -> (FixtureRegistry, OMap TypeRep FixtureStatus))
-> IO (OMap TypeRep FixtureStatus)
forall a b. (a -> b) -> a -> b
$ \FixtureRegistry
registry ->
      ((OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus)
-> FixtureRegistry -> FixtureRegistry
updateScopedFixtures (OMap TypeRep FixtureStatus
-> OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus
forall a b. a -> b -> a
const OMap TypeRep FixtureStatus
forall k v. OMap k v
OMap.empty) FixtureRegistry
registry, FixtureRegistry -> OMap TypeRep FixtureStatus
getScopedFixtures FixtureRegistry
registry)

  errors <-
    forM (reverse . map snd . OMap.assocs $ fixtures) $ \case
      FixtureStatus
FixtureInProgress -> Maybe SomeException -> IO (Maybe SomeException)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SomeException
forall a. Maybe a
Nothing
      FixtureLoaded (a
_, FixtureCleanup
NoCleanup) -> Maybe SomeException -> IO (Maybe SomeException)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SomeException
forall a. Maybe a
Nothing
      FixtureLoaded (a
_, CleanupFunc IO ()
io) -> Either SomeException () -> Maybe SomeException
forall {a} {b}. Either a b -> Maybe a
fromLeft (Either SomeException () -> Maybe SomeException)
-> IO (Either SomeException ()) -> IO (Maybe SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny IO ()
io

  -- throw the first error we encountered
  case catMaybes errors of
    SomeException
e : [SomeException]
_ -> SomeException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
e
    [] -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    (FixtureRegistry -> OMap TypeRep FixtureStatus
getScopedFixtures, (OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus)
-> FixtureRegistry -> FixtureRegistry
updateScopedFixtures) = FixtureScopeKey
-> (FixtureRegistry -> OMap TypeRep FixtureStatus,
    (OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus)
    -> FixtureRegistry -> FixtureRegistry)
getScopedAccessors FixtureScopeKey
scopeKey
    fromLeft :: Either a b -> Maybe a
fromLeft = \case
      Left a
x -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
      Right b
_ -> Maybe a
forall a. Maybe a
Nothing

{----- Fixtures registry -----}

-- | The registry of active fixtures, in order of activation.
data FixtureRegistry = FixtureRegistry
  { FixtureRegistry -> OMap TypeRep FixtureStatus
sessionFixtures :: FixtureMap
  , FixtureRegistry -> Map FilePath (OMap TypeRep FixtureStatus)
fileFixtures :: Map FilePath FixtureMap
  , FixtureRegistry -> Map ThreadId (OMap TypeRep FixtureStatus)
testFixtures :: Map ThreadId FixtureMap
  }

type FixtureMap = OMap TypeRep FixtureStatus

data FixtureStatus
  = FixtureInProgress
  | forall a. (Typeable a) => FixtureLoaded (a, FixtureCleanup)

fixtureRegistryRef :: IORef FixtureRegistry
fixtureRegistryRef :: IORef FixtureRegistry
fixtureRegistryRef = IO (IORef FixtureRegistry) -> IORef FixtureRegistry
forall a. IO a -> a
unsafePerformIO (IO (IORef FixtureRegistry) -> IORef FixtureRegistry)
-> IO (IORef FixtureRegistry) -> IORef FixtureRegistry
forall a b. (a -> b) -> a -> b
$ FixtureRegistry -> IO (IORef FixtureRegistry)
forall a. a -> IO (IORef a)
newIORef FixtureRegistry
emptyFixtureRegistry
  where
    emptyFixtureRegistry :: FixtureRegistry
emptyFixtureRegistry =
      FixtureRegistry
        { sessionFixtures :: OMap TypeRep FixtureStatus
sessionFixtures = OMap TypeRep FixtureStatus
forall k v. OMap k v
OMap.empty
        , fileFixtures :: Map FilePath (OMap TypeRep FixtureStatus)
fileFixtures = Map FilePath (OMap TypeRep FixtureStatus)
forall k a. Map k a
Map.empty
        , testFixtures :: Map ThreadId (OMap TypeRep FixtureStatus)
testFixtures = Map ThreadId (OMap TypeRep FixtureStatus)
forall k a. Map k a
Map.empty
        }
{-# NOINLINE fixtureRegistryRef #-}

modifyFixtureRegistry :: (FixtureRegistry -> (FixtureRegistry, a)) -> IO a
modifyFixtureRegistry :: forall a. (FixtureRegistry -> (FixtureRegistry, a)) -> IO a
modifyFixtureRegistry = IORef FixtureRegistry
-> (FixtureRegistry -> (FixtureRegistry, a)) -> IO a
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef FixtureRegistry
fixtureRegistryRef

getScopedAccessors ::
  FixtureScopeKey
  -> ( FixtureRegistry -> FixtureMap
     , (FixtureMap -> FixtureMap) -> FixtureRegistry -> FixtureRegistry
     )
getScopedAccessors :: FixtureScopeKey
-> (FixtureRegistry -> OMap TypeRep FixtureStatus,
    (OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus)
    -> FixtureRegistry -> FixtureRegistry)
getScopedAccessors FixtureScopeKey
scopeKey =
  case FixtureScopeKey
scopeKey of
    PerTestFixtureKey ThreadId
tid ->
      ( ThreadId
-> Map ThreadId (OMap TypeRep FixtureStatus)
-> OMap TypeRep FixtureStatus
forall {k1} k2 (t :: k1 -> *) (a :: k1).
(Ord k2, IsList (t a)) =>
k2 -> Map k2 (t a) -> t a
Map.Utils.findOrEmpty ThreadId
tid (Map ThreadId (OMap TypeRep FixtureStatus)
 -> OMap TypeRep FixtureStatus)
-> (FixtureRegistry -> Map ThreadId (OMap TypeRep FixtureStatus))
-> FixtureRegistry
-> OMap TypeRep FixtureStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixtureRegistry -> Map ThreadId (OMap TypeRep FixtureStatus)
testFixtures
      , \OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus
f FixtureRegistry
registry -> FixtureRegistry
registry{testFixtures = Map.Utils.adjustNested f tid (testFixtures registry)}
      )
    PerFileFixtureKey FilePath
fp ->
      ( FilePath
-> Map FilePath (OMap TypeRep FixtureStatus)
-> OMap TypeRep FixtureStatus
forall {k1} k2 (t :: k1 -> *) (a :: k1).
(Ord k2, IsList (t a)) =>
k2 -> Map k2 (t a) -> t a
Map.Utils.findOrEmpty FilePath
fp (Map FilePath (OMap TypeRep FixtureStatus)
 -> OMap TypeRep FixtureStatus)
-> (FixtureRegistry -> Map FilePath (OMap TypeRep FixtureStatus))
-> FixtureRegistry
-> OMap TypeRep FixtureStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixtureRegistry -> Map FilePath (OMap TypeRep FixtureStatus)
fileFixtures
      , \OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus
f FixtureRegistry
registry -> FixtureRegistry
registry{fileFixtures = Map.Utils.adjustNested f fp (fileFixtures registry)}
      )
    FixtureScopeKey
PerSessionFixtureKey ->
      ( FixtureRegistry -> OMap TypeRep FixtureStatus
sessionFixtures
      , \OMap TypeRep FixtureStatus -> OMap TypeRep FixtureStatus
f FixtureRegistry
registry -> FixtureRegistry
registry{sessionFixtures = f (sessionFixtures registry)}
      )

{----- Built-in fixtures -----}

-- | A fixture that provides a temporary directory that can be used in a test.
newtype FixtureTmpDir = FixtureTmpDir FilePath

instance Fixture FixtureTmpDir where
  fixtureAction :: IO (FixtureTmpDir, FixtureCleanup)
fixtureAction = do
    tmpdir <- IO FilePath
getTemporaryDirectory
    let dir = FilePath
tmpdir FilePath -> ShowS
</> FilePath
"skeletest-tmp-dir"
    removePathForcibly dir
    createDirectory dir
    pure . withCleanup (FixtureTmpDir dir) $
      removePathForcibly dir