# Playing with event-sourcing

I'm playing around with some ideas about how to read aggregates from events.

From a high-level view I would love to have this:

class Apply ev ag where
apply :: ag -> ev -> ag


which to define how an Event ev should change an Aggregate ag if there is an instance of this class for the pair (if there is none then the aggregate should ignore the event).

If you look at the code below it's not hard at all to do it (please forgive me the anti-pattern with the Event list there).

My problem starts when I want the events all serialized - or better: once I want them deserialized and applied again (to be honest: I don't care about the representations at all - but it should be possible to fold an aggregate from a heterogeneous list/stream of serialized events of course).

What I don't like about my solution is this ugly bit of boiler-plate:

instance DeserializableFor Person where
tryDeserialize (tn, sn)
| tn == typeOf (SetName "") = Just (App (read sn :: SetName))
| tn == typeOf (SetAge 0) = Just (App (read sn :: SetAge))
| otherwise = Nothing


which could probably be generated using TH but I would prefer a direct solution.

Any suggestions?

{-# LANGUAGE MultiParamTypeClasses, ExistentialQuantification #-}
{-# LANGUAGE DeriveDataTypeable #-}

module Test where

import Data.Data
import Data.Maybe (catMaybes)

class Apply ev ag where
apply :: ag -> ev -> ag

data Applicable a = forall e . (Show e, Read e, Typeable e, Apply e a) => App e

type Events a = [Applicable a]

fold :: Events a -> a -> a
fold [] a = a
fold ((App e):es) a = fold es $apply a e ----------------------------------------- -- nasty solution serialize :: Events a -> [(TypeRep, String)] serialize = map (\ (App e) -> (typeOf e, show e)) -- is there a way to get something like this from the Apply contexts? class DeserializableFor a where tryDeserialize :: (TypeRep, String) -> Maybe (Applicable a) -- because THIS is really ugly instance DeserializableFor Person where tryDeserialize (tn, sn) | tn == typeOf (SetName "") = Just (App (read sn :: SetName)) | tn == typeOf (SetAge 0) = Just (App (read sn :: SetAge)) | otherwise = Nothing deserialize :: DeserializableFor a => [(TypeRep, String)] -> Events a deserialize = catMaybes . map tryDeserialize -------------------------------------------------------- -- Example data SetName = SetName String deriving (Show, Read, Typeable) data SetAge = SetAge Int deriving (Show, Read, Typeable) data SomeOtherEvent = SomeOtherEvent deriving (Show, Read, Typeable) data Person = Person { name :: String, age :: Int } deriving Show nobody :: Person nobody = Person "" 0 instance Apply SetName Person where apply p (SetName n) = p { name = n } instance Apply SetAge Person where apply p (SetAge a) = p { age = a } events :: Events Person events = [App (SetName "Mr.Wrong"), App (SetAge 42)] serialized :: [(TypeRep, String)] serialized = (typeOf SomeOtherEvent, show SomeOtherEvent) : serialize events person :: Person -- is Person {name = "Mr.Wrong", age = 42} person = fold (deserialize serialized) nobody  • Being able for any event to potentially act on any aggregate is somewhat problematic. Haskell's polymorphism is uniform, so it's not really possible to say "act this way on all types but foo". But let me go deeper, why do you need this? Is it only because you want to serialize events? Otherwise it'd be simpler (and type- safer) to have one type of events for one type of aggregate. – Petr May 1 '16 at 9:04 • @PetrPudlák yes I know - usually that's what I (and everybody else it seems) end up with - I was just playing around with ideas and yes I want all events (not of the same type) to be in the same stream/storage - and want the same event to possible act on different aggregates - as you see it's not hard with runtime-dispatch (although manually) and my feeling is that you can get this with a bit of dependent types (not surprising it's easy to do with something like .net or Java where you have reflection) – Carsten May 1 '16 at 9:42 • That's not actually a bad sign, it's natural in Haskell. Existential types often (not always) tend to be an an antipattern. For example, if we consider only the Apply constraint Applicable a is isomorphic to function a -> a. When I have more time I'll try to come up with an alternative proposal. The idea is that as long as Events are in the same stream/storage, just keep them as ByteStrings or so. And once you need them typed, deserialize just those that match the corresponding aggregate. – Petr May 2 '16 at 20:17 • yes that's exactly what I'm trying to do (and I think I tried something similar too) - but maybe you get the last trick out which I'm missing (I could not work around the manual runtime-dispatch) – Carsten May 2 '16 at 20:32 ## 1 Answer Below is my attempt. I wrote generic serialization using Generics and cereal. So all that's needed is to derive Generic and add empty Serialize instances. Function save first writes the type of the value, which is then checked by load. So when loading a list of events, we can check wich ones belong to the given type we want to change and drop all others (deserializeMany). I dropped Applicable completely. Usually the problem with existential data types is that there is only a limited set of things you can do with them, so you can replace such a data type directly with the action, like a function that acts on a given object ag -> ag. See also my question Why (or why not) are existential types considered bad practice in functional programming?. I also changed the open class of events for a given type (open in the sense any module can define additional events for an object) to a closed one - every WithEvent instance has exactly one data type that describes its possible events. This makes it somewhat easier to handle, in particular avoids some cumbersome situations where it's necessary to explicitly give types when applying events, and it's also less verbose. {-# LANGUAGE DeriveDataTypeable, DeriveGeneric, ScopedTypeVariables, TypeFamilies, FlexibleContexts #-} module Test where import Control.Monad import qualified Data.ByteString as BS import Data.Maybe (catMaybes) import Data.Typeable import Data.Serialize import Data.Maybe (catMaybes) import GHC.Generics -- * Generic serialization of events -- ** Generic serialization of classes that know their type save :: (Serialize a, Typeable a) => a -> Put save x = put (show$ typeOf x) >> put x

-- | Returns 'Nothing' if the serialized event is of a different type.
-- Note that that's different from parsing error.
load :: forall a . (Serialize a, Typeable a) => Get (Maybe a)
then Just <$> get else return Nothing -- some other type serialize :: (Serialize a, Typeable a) => a -> BS.ByteString serialize = runPut . save -- | Read given events and returns the ones that apply to @a@. deserializeMany :: (Serialize a, Typeable a) => [BS.ByteString] -> Either String [a] deserializeMany = liftM catMaybes . mapM (runGet load) -- ** WithEvent class (Serialize (Event a), Typeable (Event a)) => WithEvent a where type family Event a apply :: Event a -> a -> a fold :: (WithEvent a) => [Event a] -> a -> a fold = flip (foldr apply) -- * Example -- ** Foo data Foo = Foo data SomeOtherEvent = SomeOtherEvent deriving (Show, Read, Typeable, Generic) instance Serialize SomeOtherEvent where instance WithEvent Foo where type Event Foo = SomeOtherEvent apply SomeOtherEvent Foo = Foo -- ** Person data Person = Person { name :: String, age :: Int } deriving Show data PersonEvent = SetName String | SetAge Int deriving (Show, Read, Typeable, Generic) instance Serialize PersonEvent where instance WithEvent Person where type Event Person = PersonEvent apply (SetName n) p = p { name = n } apply (SetAge a) p = p { age = a } -- ** Tests nobody :: Person nobody = Person "" 0 events :: [PersonEvent] events = [SetName "Mr.Wrong", SetAge 42] serialized :: [BS.ByteString] serialized = serialize SomeOtherEvent : map serialize events person :: Either String Person -- is Person {name = "Mr.Wrong", age = 42} person = flip fold nobody <$> deserializeMany serialized

• thank you for your effort - I have to take a closer look but on first glance it seems that this will only work as long as the aggregate (Person) implies the event-type PersonEvent - which is what you usually do (I think there is a Haskell version around where you have a aggregate-class with associated event-type which I think is very similar to this) - the main problem for me is that I want (which I surely did not communicate correctly) to be able to associate more events to one aggregate and the same event to multiple aggregates too - but don't sweat it - just playing around – Carsten May 8 '16 at 18:13