1
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ 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. \$\endgroup\$ – Petr Pudlák May 1 '16 at 9:04
  • \$\begingroup\$ @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) \$\endgroup\$ – Carsten May 1 '16 at 9:42
  • \$\begingroup\$ 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. \$\endgroup\$ – Petr Pudlák May 2 '16 at 20:17
  • \$\begingroup\$ 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) \$\endgroup\$ – Carsten May 2 '16 at 20:32
1
\$\begingroup\$

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)
load = do
    t <- get
    if t == show (typeRep (Proxy :: Proxy 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 
\$\endgroup\$
  • \$\begingroup\$ 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 \$\endgroup\$ – Carsten May 8 '16 at 18:13
  • \$\begingroup\$ Reversing the direction is quite easy, just define the type-class for events, not for aggregates, so the dependence goes the other way around. But then when deserializing you need to tell which type of event you want to deserialize, as it can't be deduced from the aggregate alone. And with MultiParamTypeClasses you can have many-to-many dependency. But then it's even more pain, you often have to explicitly give both types. My guess is that these two options aren't worth it. \$\endgroup\$ – Petr Pudlák May 8 '16 at 18:29

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.