-- | Event store data types.
module Data.CQRS.EventStore
       ( EventStore(..)
       , withEventStore
       ) where

import Control.Exception (bracket)
import Data.ByteString (ByteString)
import Data.CQRS.GUID

-- | Event stores are the backend used for reading and storing all the
-- information about recorded events.
data EventStore =
  EventStore {
    -- | Store a sequence of events for aggregate identified by GUID
    -- into the event store, starting at the provided version number.
    -- If the version number does not match the expected value, a
    -- failure occurs.
    storeEvents :: forall a. GUID a -> Int -> [ByteString] -> IO (),
    -- | Retrieve the sequence of events associated with the aggregate
    -- identified by the given GUID. Only events at or after the given
    -- version number are retrieved. The events are returned in
    -- increasing order of version number. The version number of the
    -- last event is returned as well.
    retrieveEvents :: forall a. GUID a -> Int -> IO (Int,[ByteString]),
    -- | Read events and pass them to the provided monadic action.
    readAllEvents :: Int -> Int -> (ByteString -> IO ()) -> IO (),
    -- | Write snapshot for aggregate identified by GUID and
    -- the given version number. The version number is NOT checked
    -- for validity. If the event store does not support snapshots
    -- this function may do nothing.
    writeSnapshot :: forall a. GUID a -> (Int,ByteString) -> IO (),
    -- | Get latest snapshot of an aggregate identified by GUID.
    -- Returns the version number of the snapshot in addition to the
    -- data. An event store which does not support snapshots is
    -- permitted to return 'Nothing' in all cases.
    getLatestSnapshot :: forall a. GUID a -> IO (Maybe (Int,ByteString)),
    -- | Run transaction against the event store. The transaction is
    -- expected to commit if the supplied IO action runs to completion
    -- (i.e. doesn't throw an exception) and to rollback otherwise.
    withTransaction :: forall a . IO a -> IO a,
    -- | Close the event store.
    closeEventStore :: IO ()
    }

-- | Perform an IO action with an open event store.
withEventStore :: (IO EventStore) -> (EventStore -> IO a) -> IO a
withEventStore open action = bracket open closeEventStore action