Safe Haskell | None |
---|---|
Language | Haskell2010 |
- data Serializer a b = Serializer {
- serialize :: a -> b
- deserialize :: b -> Maybe a
- deserializeEither :: b -> Either String a
- simpleSerializer :: (a -> b) -> (b -> Maybe a) -> Serializer a b
- composeSerializers :: Serializer a b -> Serializer b c -> Serializer a c
- idSerializer :: Serializer a a
- jsonSerializer :: (ToJSON a, FromJSON a) => Serializer a Value
- jsonTextSerializer :: (ToJSON a, FromJSON a) => Serializer a Text
- dynamicSerializer :: Typeable a => Serializer a Dynamic
- serializedEventStore :: Monad m => Serializer event serialized -> EventStore serialized m -> EventStore event m
- serializedGloballyOrderedEventStore :: Monad m => Serializer event serialized -> GloballyOrderedEventStore serialized m -> GloballyOrderedEventStore event m
- class EventSumType a where
- eventSumTypeSerializer :: (Typeable a, EventSumType a, EventSumType b) => Serializer a b
Class
data Serializer a b Source #
A Serializer
describes the injective conversion between types a
and
b
. In plain English, this means that you can go from a
to b
, and you
can Maybe
go from b
back to a
. This is often used to serialize events
to an event store, and then deserialize them back.
Serializer | |
|
simpleSerializer :: (a -> b) -> (b -> Maybe a) -> Serializer a b Source #
Simple constructor to just use deserialize
to construct
deserializeEither
.
composeSerializers :: Serializer a b -> Serializer b c -> Serializer a c Source #
Apply an intermediate Serializer
to a serializer to go from type a
to
c
with b
in the middle. Note that with deserializing, if the conversion
from c
to b
or from b
to a
fails, the whole deserialization fails.
Common serializers
idSerializer :: Serializer a a Source #
Simple "serializer" using id
. Useful for when an API requires a
serializer but you don't need to actually change types.
jsonSerializer :: (ToJSON a, FromJSON a) => Serializer a Value Source #
A Serializer
for aeson Value
s.
jsonTextSerializer :: (ToJSON a, FromJSON a) => Serializer a Text Source #
A Serializer
to convert JSON to/from lazy text. Useful for Sql event
stores that store JSON values as text.
dynamicSerializer :: Typeable a => Serializer a Dynamic Source #
A Serializer
for Dynamic
values using toDyn
and fromDynamic
.
Serialized event store
serializedEventStore :: Monad m => Serializer event serialized -> EventStore serialized m -> EventStore event m Source #
Wraps an EventStore
and transparently serializes/deserializes events for
you. Note that in this implementation deserialization errors when using
getEvents
are simply ignored (the event is not returned).
serializedGloballyOrderedEventStore :: Monad m => Serializer event serialized -> GloballyOrderedEventStore serialized m -> GloballyOrderedEventStore event m Source #
Like serializedEventStore
except for GloballyOrderedEventStore
.
Sum types
class EventSumType a where Source #
This is a type class for serializing sum types of events to Dynamic
without the associated constructor. This is useful when transforming between
two sum types of events. A common pattern is to put all the events in an
application in one big event sum type, and then have a smaller sum type for
each Projection
. Then, you can use eventSumTypeSerializer
to transform
between the two.
It is meant to be derived with Generic
. For example:
data EventA = EventA deriving (Show) data EventB = EventB deriving (Show) data EventC = EventC deriving (Show) data AllEvents = AllEventsEventA EventA | AllEventsEventB EventB | AllEventsEventC EventC deriving (Show, Generic) instance EventSumType AllEvents data MyEvents = MyEventsEventA EventA | MyEventsEventB EventB deriving (Show, Generic) instance EventSumType MyEvents
Now we can serialize to Dynamic
without a constructor tag:
>>>
eventToDyn (MyEventsEventA EventA)
<<EventA>>
We can also go from a MyEvents
value to an AllEvents
value:
>>>
eventFromDyn (eventToDyn (MyEventsEventA EventA)) :: Maybe AllEvents
Just (AllEventsEventA EventA)
eventToDyn :: a -> Dynamic Source #
Convert an event to a Dynamic
without the constructor tag
eventFromDyn :: Dynamic -> Maybe a Source #
Go from a Dynamic
to an event with the constructor tag. Note, this
function is O(n)
to the number of constructors.
eventToDyn :: (Generic a, EventSumType' (Rep a)) => a -> Dynamic Source #
Convert an event to a Dynamic
without the constructor tag
eventFromDyn :: (Generic a, EventSumType' (Rep a)) => Dynamic -> Maybe a Source #
Go from a Dynamic
to an event with the constructor tag. Note, this
function is O(n)
to the number of constructors.
eventSumTypeSerializer :: (Typeable a, EventSumType a, EventSumType b) => Serializer a b Source #
A Serializer
from one EventSumType
instance to another. WARNING: If
not all events in the source EventSumType
are in the serialized
EventSumType
, then this function will be partial!