{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

{- | Unified test suite API for event store backends

This module provides a single import point for backend test writers.
It re-exports all test infrastructure, test suites, and utilities.

= Typical Usage

> import Test.Hindsight.Store
>
> myStoreRunner :: EventStoreTestRunner MyBackend
> myStoreRunner = EventStoreTestRunner { ... }
>
> tests = testGroup "My Backend Tests"
>   [ testGroup "Generic Tests" (genericEventStoreTests myStoreRunner)
>   , testGroup "Multi-Instance Tests" (multiInstanceTests myStoreRunner)
>   , testGroup "Stress Tests" (stressTests myStoreRunner)
>   , propertyTests myStoreRunner
>   , testGroup "Ordering Tests" (orderingTests myStoreRunner)
>   ]
-}
module Test.Hindsight.Store (
    -- * Test Infrastructure
    EventStoreTestRunner (..),

    -- * Test Suite Composition
    genericEventStoreTests,
    multiInstanceTests,

    -- * Individual Test Suites
    basicTests,
    consistencyTests,
    cursorTests,
    streamVersionTests,
    multiInstanceEventOrderingTests,
    orderingTests,
    propertyTests,
    stressTests,

    -- * Test Utilities
    module Test.Hindsight.Store.Common,
)
where

import Hindsight.Store (Cursor, EventStore, StoreConstraints)
import Test.Hindsight.Store.BasicTests (basicTests)
import Test.Hindsight.Store.Common
import Test.Hindsight.Store.ConsistencyTests (consistencyTests)
import Test.Hindsight.Store.CursorTests (cursorTests)
import Test.Hindsight.Store.MultiInstanceEventOrderingTests (multiInstanceEventOrderingTests)
import Test.Hindsight.Store.OrderingTests (orderingTests)
import Test.Hindsight.Store.PropertyTests (propertyTests)
import Test.Hindsight.Store.StreamVersionTests (streamVersionTests)
import Test.Hindsight.Store.StressTests (stressTests)
import Test.Hindsight.Store.TestRunner (EventStoreTestRunner (..))
import Test.Tasty

-- * Test Suite Composition

-- | Common event store test cases split into focused test groups
genericEventStoreTests ::
    forall backend.
    (EventStore backend, StoreConstraints backend IO, Show (Cursor backend), Ord (Cursor backend)) =>
    EventStoreTestRunner backend ->
    [TestTree]
genericEventStoreTests :: forall backend.
(EventStore backend, StoreConstraints backend IO,
 Show (Cursor backend), Ord (Cursor backend)) =>
EventStoreTestRunner backend -> [TestTree]
genericEventStoreTests EventStoreTestRunner backend
runner =
    [ TestName -> [TestTree] -> TestTree
testGroup TestName
"Basic Tests" (EventStoreTestRunner backend -> [TestTree]
forall backend.
(EventStore backend, StoreConstraints backend IO,
 Show (Cursor backend)) =>
EventStoreTestRunner backend -> [TestTree]
basicTests EventStoreTestRunner backend
runner)
    , TestName -> [TestTree] -> TestTree
testGroup TestName
"Stream Version Tests" (EventStoreTestRunner backend -> [TestTree]
forall backend.
(EventStore backend, StoreConstraints backend IO) =>
EventStoreTestRunner backend -> [TestTree]
streamVersionTests EventStoreTestRunner backend
runner)
    , TestName -> [TestTree] -> TestTree
testGroup TestName
"Consistency Tests" (EventStoreTestRunner backend -> [TestTree]
forall backend.
(EventStore backend, StoreConstraints backend IO,
 Show (Cursor backend), Show (EventStoreError backend)) =>
EventStoreTestRunner backend -> [TestTree]
consistencyTests EventStoreTestRunner backend
runner)
    , TestName -> [TestTree] -> TestTree
testGroup TestName
"Per-Stream Cursor Tests" (EventStoreTestRunner backend -> [TestTree]
forall backend.
(EventStore backend, StoreConstraints backend IO,
 Show (Cursor backend), Ord (Cursor backend)) =>
EventStoreTestRunner backend -> [TestTree]
cursorTests EventStoreTestRunner backend
runner)
    ]

-- | Multi-instance test cases (for backends that support cross-process subscriptions)
multiInstanceTests ::
    forall backend.
    (EventStore backend, StoreConstraints backend IO, Show (Cursor backend), Ord (Cursor backend)) =>
    EventStoreTestRunner backend ->
    [TestTree]
multiInstanceTests :: forall backend.
(EventStore backend, StoreConstraints backend IO,
 Show (Cursor backend), Ord (Cursor backend)) =>
EventStoreTestRunner backend -> [TestTree]
multiInstanceTests EventStoreTestRunner backend
runner = EventStoreTestRunner backend -> [TestTree]
forall backend.
(EventStore backend, StoreConstraints backend IO,
 Show (Cursor backend), Ord (Cursor backend)) =>
EventStoreTestRunner backend -> [TestTree]
multiInstanceEventOrderingTests EventStoreTestRunner backend
runner