{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
module Database.EventStore.Internal.Operation.Read.Common where
import Control.Applicative
import Data.Foldable
import Data.Monoid
import Data.Traversable
import Data.Int
import Database.EventStore.Internal.Prelude
import Database.EventStore.Internal.Stream
import Database.EventStore.Internal.Types
import Prelude
data ReadResult :: StreamType -> * -> * where
ReadSuccess :: a -> ReadResult t a
ReadNoStream :: ReadResult 'RegularStream a
ReadStreamDeleted :: Text -> ReadResult 'RegularStream a
ReadNotModified :: ReadResult t a
ReadError :: Maybe Text -> ReadResult t a
ReadAccessDenied :: StreamName -> ReadResult t a
instance Eq a => Eq (ReadResult t a) where
ReadSuccess a == ReadSuccess b = a == b
ReadNoStream == ReadNoStream = True
ReadStreamDeleted s == ReadStreamDeleted v = s == v
ReadNotModified == ReadNotModified = True
ReadError e == ReadError u = e == u
ReadAccessDenied s == ReadAccessDenied v = s == v
_ == _ = False
instance Show a => Show (ReadResult t a) where
show (ReadSuccess a) = "ReadSuccess " ++ show a
show ReadNoStream = "ReadNoStream"
show (ReadStreamDeleted s) = "ReadStreamDeleted" ++ show s
show ReadNotModified = "ReadNoModified"
show (ReadError e) = "ReadError" ++ show e
show (ReadAccessDenied s) = "ReadAccessDenied " ++ show s
instance Functor (ReadResult t) where
fmap f (ReadSuccess a) = ReadSuccess (f a)
fmap _ ReadNoStream = ReadNoStream
fmap _ (ReadStreamDeleted s) = ReadStreamDeleted s
fmap _ ReadNotModified = ReadNotModified
fmap _ (ReadError e) = ReadError e
fmap _ (ReadAccessDenied s) = ReadAccessDenied s
instance Foldable (ReadResult t) where
foldMap f (ReadSuccess a) = f a
foldMap _ _ = mempty
instance Traversable (ReadResult t) where
traverse f (ReadSuccess a) = fmap ReadSuccess $ f a
traverse _ ReadNoStream = pure ReadNoStream
traverse _ (ReadStreamDeleted s) = pure $ ReadStreamDeleted s
traverse _ ReadNotModified = pure ReadNotModified
traverse _ (ReadError e) = pure $ ReadError e
traverse _ (ReadAccessDenied s) = pure $ ReadAccessDenied s
class Slice a where
type Loc a
sliceEvents :: a -> [ResolvedEvent]
sliceDirection :: a -> ReadDirection
sliceEOS :: a -> Bool
sliceFrom :: a -> Loc a
sliceNext :: a -> Loc a
toSlice :: a -> SomeSlice
data StreamSlice =
StreamSlice
{ sliceStream :: !Text
, sliceLast :: !Int64
, _ssDir :: !ReadDirection
, _ssFrom :: !Int64
, _ssNext :: !Int64
, _ssEvents :: ![ResolvedEvent]
, _ssEOS :: !Bool
} deriving Show
instance Slice StreamSlice where
type Loc StreamSlice = Int64
sliceEvents = _ssEvents
sliceDirection = _ssDir
sliceEOS = _ssEOS
sliceFrom = _ssFrom
sliceNext = _ssNext
toSlice s =
SomeSlice
{ __events = sliceEvents s
, __eos = sliceEOS s
, __dir = sliceDirection s
, __from = StreamEventNumber $ sliceFrom s
, __next = StreamEventNumber $ sliceNext s
}
data AllSlice =
AllSlice
{ _saFrom :: !Position
, _saNext :: !Position
, _saDir :: !ReadDirection
, _saEvents :: ![ResolvedEvent]
, _saEOS :: !Bool
} deriving Show
instance Slice AllSlice where
type Loc AllSlice = Position
sliceEvents = _saEvents
sliceDirection = _saDir
sliceEOS = _saEOS
sliceFrom = _saFrom
sliceNext = _saNext
toSlice s =
SomeSlice
{ __events = sliceEvents s
, __eos = sliceEOS s
, __dir = sliceDirection s
, __from = StreamPosition $ sliceFrom s
, __next = StreamPosition $ sliceNext s
}
data Location
= StreamEventNumber !Int64
| StreamPosition !Position
deriving Show
data SomeSlice =
SomeSlice
{ __events :: ![ResolvedEvent]
, __eos :: !Bool
, __dir :: !ReadDirection
, __from :: !Location
, __next :: !Location
} deriving Show
instance Slice SomeSlice where
type Loc SomeSlice = Location
sliceEvents = __events
sliceDirection = __dir
sliceEOS = __eos
sliceFrom = __from
sliceNext = __next
toSlice = id