module CQRSExample.Events ( Event(..) ) where import Control.Monad (liftM) import CQRSExample.Aggregates import Data.CQRS (GUID) import Data.Serialize (Serialize(..)) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Time.Calendar (Day) import Data.Typeable (Typeable) import Data.Word (Word8) data Event = ProjectCreated Text Text | ProjectRenamed Text | TaskAdded ProjectId Text | RecordedWorkUnit GUID Day Integer Text UserId | UserCreated Text Text Text Text | UserRegistered Text | TaskStarred UserId | TaskUnstarred UserId deriving (Typeable, Show) instance Serialize Event where put (ProjectCreated name shortDesc) = do put (0 :: Word8) put $ encodeUtf8 name put $ encodeUtf8 shortDesc put (ProjectRenamed name) = do put (1 :: Word8) put $ encodeUtf8 name put (TaskAdded pid tsd) = do put (2 :: Word8) put $ pid put $ encodeUtf8 tsd put (RecordedWorkUnit wuId wuDay wuDuration wuComment wuUserId) = do put (3 :: Word8) put $ wuId put $ wuDay put $ wuDuration put $ encodeUtf8 wuComment put wuUserId put (UserCreated ucUserName ucPassword ucFirst ucLast) = do put (4 :: Word8) put $ encodeUtf8 ucUserName put $ encodeUtf8 ucPassword -- FIXME: Should really hash the password, shouldn't we? put $ encodeUtf8 ucFirst put $ encodeUtf8 ucLast put (TaskStarred userId) = do put (5 :: Word8) put userId put (TaskUnstarred userId) = do put (6 :: Word8) put userId put (UserRegistered userId) = do put (7 :: Word8) put userId get = do i :: Word8 <- get case i of 0 -> do n <- liftM decodeUtf8 get sd <- liftM decodeUtf8 get return $ ProjectCreated n sd 1 -> do n <- liftM decodeUtf8 get return $ ProjectRenamed n 2 -> do pid <- get tsd <- liftM decodeUtf8 get return $ TaskAdded pid tsd 3 -> do wuId <- get wuDay <- get wuDuration <- get wuComment <- liftM decodeUtf8 get wuUserId <- get return $ RecordedWorkUnit wuId wuDay wuDuration wuComment wuUserId 4 -> do ucUserName <- liftM decodeUtf8 get ucPassword <- liftM decodeUtf8 get ucFirst <- liftM decodeUtf8 get ucLast <- liftM decodeUtf8 get return $ UserCreated ucUserName ucPassword ucFirst ucLast 5 -> do userId <- get return $ TaskStarred userId 6 -> do userId <- get return $ TaskUnstarred userId 7 -> do userId <- get return $ UserRegistered userId _ -> do fail $ "Unrecognized event type " ++ show i