{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
module Database.EventStore.Internal.Communication where
import Data.Typeable
import Database.EventStore.Internal.Operation (Mailbox, Lifetime)
import Database.EventStore.Internal.Prelude
import Database.EventStore.Internal.Types
data SystemInit = SystemInit deriving Typeable
data SystemShutdown = SystemShutdown deriving Typeable
data Service
= ConnectionManager
| TimerService
deriving (Int -> Service -> ShowS
[Service] -> ShowS
Service -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Service] -> ShowS
$cshowList :: [Service] -> ShowS
show :: Service -> String
$cshow :: Service -> String
showsPrec :: Int -> Service -> ShowS
$cshowsPrec :: Int -> Service -> ShowS
Show, Service -> Service -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Service -> Service -> Bool
$c/= :: Service -> Service -> Bool
== :: Service -> Service -> Bool
$c== :: Service -> Service -> Bool
Eq, Int -> Service
Service -> Int
Service -> [Service]
Service -> Service
Service -> Service -> [Service]
Service -> Service -> Service -> [Service]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Service -> Service -> Service -> [Service]
$cenumFromThenTo :: Service -> Service -> Service -> [Service]
enumFromTo :: Service -> Service -> [Service]
$cenumFromTo :: Service -> Service -> [Service]
enumFromThen :: Service -> Service -> [Service]
$cenumFromThen :: Service -> Service -> [Service]
enumFrom :: Service -> [Service]
$cenumFrom :: Service -> [Service]
fromEnum :: Service -> Int
$cfromEnum :: Service -> Int
toEnum :: Int -> Service
$ctoEnum :: Int -> Service
pred :: Service -> Service
$cpred :: Service -> Service
succ :: Service -> Service
$csucc :: Service -> Service
Enum, Service
forall a. a -> a -> Bounded a
maxBound :: Service
$cmaxBound :: Service
minBound :: Service
$cminBound :: Service
Bounded, Typeable, forall x. Rep Service x -> Service
forall x. Service -> Rep Service x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Service x -> Service
$cfrom :: forall x. Service -> Rep Service x
Generic)
instance Hashable Service
data Initialized = Initialized Service deriving Typeable
data InitFailed = InitFailed Service deriving Typeable
data FatalException
= forall e. Exception e => FatalException e
| FatalCondition Text
deriving Typeable
data ServiceTerminated = ServiceTerminated Service deriving Typeable
data NewTimer =
forall e. Typeable e => NewTimer e Duration Bool
deriving Typeable
newtype SendPackage = SendPackage Package deriving Typeable
data Transmit = Transmit Mailbox Lifetime Package deriving Typeable