module CQRSExample.Events ( Event(..) , TaskEvent(..) ) where import Control.DeepSeq (NFData(..)) import Data.CQRS.Serializable (Serializable(..)) import Data.DeriveTH (derive, makeNFData) import Data.Serialize (Serialize(..), putWord8, getWord8, encode, decode) import Data.Text (Text) import qualified Data.Text as T import Data.Typeable (Typeable) data Event = TaskEvent TaskEvent deriving (Typeable, Show) data TaskEvent = TaskAdded Text | TaskCompleted | TaskReopened | TaskArchived deriving (Typeable, Show) -- NFData instances. $(derive makeNFData ''TaskEvent) $(derive makeNFData ''Event) -- Serialize instances. We use manual serialization here -- since it is extremely important that events remain -- forward-compatible for (essentially) all time. 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 -- Serializable instance for event. instance Serializable Event where serialize = encode deserialize = either (const Nothing) Just . decode