Events.hs

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