{-# LANGUAGE DeriveGeneric #-} module CQRSExample.Events ( Event(..) , TaskEvent(..) ) where import Control.DeepSeq (NFData(..)) import Data.Serialize (Serialize(..), putWord8, getWord8) import Data.Text (Text) import qualified Data.Text as T import Data.Typeable (Typeable) import GHC.Generics (Generic) data Event = TaskEvent TaskEvent deriving (Typeable, Show, Generic) data TaskEvent = TaskAdded Text | TaskCompleted | TaskReopened | TaskArchived deriving (Typeable, Show, Generic) -- NFData instances. instance NFData TaskEvent instance NFData Event -- Serialize instances. We use manual serialization here since it is -- extremely important that events remain forward-compatible for -- (essentially) all time. You could also use e.g. Protocol Buffers -- and be very careful about only expanding the schema in -- backward-compatible ways. instance Serialize TaskEvent where put (TaskAdded t) = do putWord8 1 put $ T.unpack t put TaskCompleted = do putWord8 2 put TaskReopened = do putWord8 3 put TaskArchived = do putWord8 4 get = do i <- getWord8 case i of 1 -> fmap (TaskAdded . T.pack) get 2 -> return TaskCompleted 3 -> return TaskReopened 4 -> return TaskArchived _ -> fail $ "Unrecognized TaskEvent tag value" ++ show i instance Serialize Event where put (TaskEvent taskEvent) = do putWord8 1 -- Marker for future expansion put $ taskEvent get = do i <- getWord8 case i of 1 -> fmap TaskEvent get _ -> fail $ "Unrecognized TaskEvent tag value: " ++ show i