{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}

module Eventium.Store.Queries
  ( QueryRange (..),
    QueryStart (..),
    QueryLimit (..),
    allEvents,
    eventsUntil,
    eventsStartingAt,
    eventsStartingAtUntil,
    eventsStartingAtTakeLimit,
  )
where

-- | This type defines how to query an event stream. It defines the stream key
-- and the start/stop points for the query.
data QueryRange key position
  = QueryRange
  { forall key position. QueryRange key position -> key
queryRangeKey :: key,
    forall key position. QueryRange key position -> QueryStart position
queryRangeStart :: QueryStart position,
    forall key position. QueryRange key position -> QueryLimit position
queryRangeLimit :: QueryLimit position
  }
  deriving (Int -> QueryRange key position -> ShowS
[QueryRange key position] -> ShowS
QueryRange key position -> String
(Int -> QueryRange key position -> ShowS)
-> (QueryRange key position -> String)
-> ([QueryRange key position] -> ShowS)
-> Show (QueryRange key position)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall key position.
(Show key, Show position) =>
Int -> QueryRange key position -> ShowS
forall key position.
(Show key, Show position) =>
[QueryRange key position] -> ShowS
forall key position.
(Show key, Show position) =>
QueryRange key position -> String
$cshowsPrec :: forall key position.
(Show key, Show position) =>
Int -> QueryRange key position -> ShowS
showsPrec :: Int -> QueryRange key position -> ShowS
$cshow :: forall key position.
(Show key, Show position) =>
QueryRange key position -> String
show :: QueryRange key position -> String
$cshowList :: forall key position.
(Show key, Show position) =>
[QueryRange key position] -> ShowS
showList :: [QueryRange key position] -> ShowS
Show, QueryRange key position -> QueryRange key position -> Bool
(QueryRange key position -> QueryRange key position -> Bool)
-> (QueryRange key position -> QueryRange key position -> Bool)
-> Eq (QueryRange key position)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall key position.
(Eq key, Eq position) =>
QueryRange key position -> QueryRange key position -> Bool
$c== :: forall key position.
(Eq key, Eq position) =>
QueryRange key position -> QueryRange key position -> Bool
== :: QueryRange key position -> QueryRange key position -> Bool
$c/= :: forall key position.
(Eq key, Eq position) =>
QueryRange key position -> QueryRange key position -> Bool
/= :: QueryRange key position -> QueryRange key position -> Bool
Eq)

-- | This type defines where an event store query starts.
data QueryStart position
  = StartFromBeginning
  | StartQueryAt position
  deriving (Int -> QueryStart position -> ShowS
[QueryStart position] -> ShowS
QueryStart position -> String
(Int -> QueryStart position -> ShowS)
-> (QueryStart position -> String)
-> ([QueryStart position] -> ShowS)
-> Show (QueryStart position)
forall position.
Show position =>
Int -> QueryStart position -> ShowS
forall position. Show position => [QueryStart position] -> ShowS
forall position. Show position => QueryStart position -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall position.
Show position =>
Int -> QueryStart position -> ShowS
showsPrec :: Int -> QueryStart position -> ShowS
$cshow :: forall position. Show position => QueryStart position -> String
show :: QueryStart position -> String
$cshowList :: forall position. Show position => [QueryStart position] -> ShowS
showList :: [QueryStart position] -> ShowS
Show, QueryStart position -> QueryStart position -> Bool
(QueryStart position -> QueryStart position -> Bool)
-> (QueryStart position -> QueryStart position -> Bool)
-> Eq (QueryStart position)
forall position.
Eq position =>
QueryStart position -> QueryStart position -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall position.
Eq position =>
QueryStart position -> QueryStart position -> Bool
== :: QueryStart position -> QueryStart position -> Bool
$c/= :: forall position.
Eq position =>
QueryStart position -> QueryStart position -> Bool
/= :: QueryStart position -> QueryStart position -> Bool
Eq, (forall a b. (a -> b) -> QueryStart a -> QueryStart b)
-> (forall a b. a -> QueryStart b -> QueryStart a)
-> Functor QueryStart
forall a b. a -> QueryStart b -> QueryStart a
forall a b. (a -> b) -> QueryStart a -> QueryStart b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> QueryStart a -> QueryStart b
fmap :: forall a b. (a -> b) -> QueryStart a -> QueryStart b
$c<$ :: forall a b. a -> QueryStart b -> QueryStart a
<$ :: forall a b. a -> QueryStart b -> QueryStart a
Functor)

-- | This type is used to limit the results of a query from an event store.
data QueryLimit position
  = NoQueryLimit
  | MaxNumberOfEvents Int
  | StopQueryAt position
  deriving (Int -> QueryLimit position -> ShowS
[QueryLimit position] -> ShowS
QueryLimit position -> String
(Int -> QueryLimit position -> ShowS)
-> (QueryLimit position -> String)
-> ([QueryLimit position] -> ShowS)
-> Show (QueryLimit position)
forall position.
Show position =>
Int -> QueryLimit position -> ShowS
forall position. Show position => [QueryLimit position] -> ShowS
forall position. Show position => QueryLimit position -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall position.
Show position =>
Int -> QueryLimit position -> ShowS
showsPrec :: Int -> QueryLimit position -> ShowS
$cshow :: forall position. Show position => QueryLimit position -> String
show :: QueryLimit position -> String
$cshowList :: forall position. Show position => [QueryLimit position] -> ShowS
showList :: [QueryLimit position] -> ShowS
Show, QueryLimit position -> QueryLimit position -> Bool
(QueryLimit position -> QueryLimit position -> Bool)
-> (QueryLimit position -> QueryLimit position -> Bool)
-> Eq (QueryLimit position)
forall position.
Eq position =>
QueryLimit position -> QueryLimit position -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall position.
Eq position =>
QueryLimit position -> QueryLimit position -> Bool
== :: QueryLimit position -> QueryLimit position -> Bool
$c/= :: forall position.
Eq position =>
QueryLimit position -> QueryLimit position -> Bool
/= :: QueryLimit position -> QueryLimit position -> Bool
Eq, (forall a b. (a -> b) -> QueryLimit a -> QueryLimit b)
-> (forall a b. a -> QueryLimit b -> QueryLimit a)
-> Functor QueryLimit
forall a b. a -> QueryLimit b -> QueryLimit a
forall a b. (a -> b) -> QueryLimit a -> QueryLimit b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> QueryLimit a -> QueryLimit b
fmap :: forall a b. (a -> b) -> QueryLimit a -> QueryLimit b
$c<$ :: forall a b. a -> QueryLimit b -> QueryLimit a
<$ :: forall a b. a -> QueryLimit b -> QueryLimit a
Functor)

allEvents :: key -> QueryRange key position
allEvents :: forall key position. key -> QueryRange key position
allEvents key
key = key
-> QueryStart position
-> QueryLimit position
-> QueryRange key position
forall key position.
key
-> QueryStart position
-> QueryLimit position
-> QueryRange key position
QueryRange key
key QueryStart position
forall position. QueryStart position
StartFromBeginning QueryLimit position
forall position. QueryLimit position
NoQueryLimit

eventsUntil :: key -> position -> QueryRange key position
eventsUntil :: forall key position. key -> position -> QueryRange key position
eventsUntil key
key position
end = key
-> QueryStart position
-> QueryLimit position
-> QueryRange key position
forall key position.
key
-> QueryStart position
-> QueryLimit position
-> QueryRange key position
QueryRange key
key QueryStart position
forall position. QueryStart position
StartFromBeginning (position -> QueryLimit position
forall position. position -> QueryLimit position
StopQueryAt position
end)

eventsStartingAt :: key -> position -> QueryRange key position
eventsStartingAt :: forall key position. key -> position -> QueryRange key position
eventsStartingAt key
key position
start = key
-> QueryStart position
-> QueryLimit position
-> QueryRange key position
forall key position.
key
-> QueryStart position
-> QueryLimit position
-> QueryRange key position
QueryRange key
key (position -> QueryStart position
forall position. position -> QueryStart position
StartQueryAt position
start) QueryLimit position
forall position. QueryLimit position
NoQueryLimit

eventsStartingAtUntil :: key -> position -> position -> QueryRange key position
eventsStartingAtUntil :: forall key position.
key -> position -> position -> QueryRange key position
eventsStartingAtUntil key
key position
start position
end = key
-> QueryStart position
-> QueryLimit position
-> QueryRange key position
forall key position.
key
-> QueryStart position
-> QueryLimit position
-> QueryRange key position
QueryRange key
key (position -> QueryStart position
forall position. position -> QueryStart position
StartQueryAt position
start) (position -> QueryLimit position
forall position. position -> QueryLimit position
StopQueryAt position
end)

eventsStartingAtTakeLimit :: key -> position -> Int -> QueryRange key position
eventsStartingAtTakeLimit :: forall key position.
key -> position -> Int -> QueryRange key position
eventsStartingAtTakeLimit key
key position
start Int
maxNum = key
-> QueryStart position
-> QueryLimit position
-> QueryRange key position
forall key position.
key
-> QueryStart position
-> QueryLimit position
-> QueryRange key position
QueryRange key
key (position -> QueryStart position
forall position. position -> QueryStart position
StartQueryAt position
start) (Int -> QueryLimit position
forall position. Int -> QueryLimit position
MaxNumberOfEvents Int
maxNum)