diff --git a/eventful-core.cabal b/eventful-core.cabal
--- a/eventful-core.cabal
+++ b/eventful-core.cabal
@@ -3,7 +3,7 @@
 -- see: https://github.com/sol/hpack
 
 name:           eventful-core
-version:        0.1.1
+version:        0.1.2
 synopsis:       Core module for eventful
 description:    Core module for eventful
 category:       Database,Eventsourcing
@@ -27,7 +27,6 @@
 library
   hs-source-dirs:
       src
-  default-extensions: ConstraintKinds DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies
   ghc-options: -Wall
   build-depends:
       base >= 4.9 && < 5
@@ -35,6 +34,7 @@
     , containers
     , http-api-data
     , path-pieces
+    , sum-type-boilerplate
     , template-haskell
     , text
     , transformers
@@ -50,7 +50,6 @@
       Eventful.Store.Class
       Eventful.TH
       Eventful.TH.Projection
-      Eventful.TH.SumType
       Eventful.TH.SumTypeSerializer
       Eventful.UUID
   default-language: Haskell2010
@@ -61,7 +60,6 @@
   hs-source-dirs:
       tests
       src
-  default-extensions: ConstraintKinds DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies
   ghc-options: -Wall
   build-depends:
       base >= 4.9 && < 5
@@ -69,6 +67,7 @@
     , containers
     , http-api-data
     , path-pieces
+    , sum-type-boilerplate
     , template-haskell
     , text
     , transformers
@@ -77,7 +76,6 @@
     , HUnit
   other-modules:
       Eventful.SerializerSpec
-      Eventful.TH.SumTypeSpec
       HLint
       Eventful
       Eventful.Aggregate
@@ -89,7 +87,6 @@
       Eventful.Store.Class
       Eventful.TH
       Eventful.TH.Projection
-      Eventful.TH.SumType
       Eventful.TH.SumTypeSerializer
       Eventful.UUID
   default-language: Haskell2010
@@ -99,7 +96,6 @@
   main-is: HLint.hs
   hs-source-dirs:
       tests
-  default-extensions: ConstraintKinds DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies
   ghc-options: -Wall
   build-depends:
       base >= 4.9 && < 5
@@ -107,6 +103,7 @@
     , containers
     , http-api-data
     , path-pieces
+    , sum-type-boilerplate
     , template-haskell
     , text
     , transformers
@@ -114,6 +111,5 @@
     , hlint
   other-modules:
       Eventful.SerializerSpec
-      Eventful.TH.SumTypeSpec
       Spec
   default-language: Haskell2010
diff --git a/src/Eventful/Aggregate.hs b/src/Eventful/Aggregate.hs
--- a/src/Eventful/Aggregate.hs
+++ b/src/Eventful/Aggregate.hs
@@ -4,12 +4,14 @@
   ( Aggregate (..)
   , allAggregateStates
   , commandStoredAggregate
+  , serializedAggregate
   ) where
 
 import Data.Foldable (foldl')
 import Data.List (scanl')
 
 import Eventful.Projection
+import Eventful.Serializer
 import Eventful.Store.Class
 import Eventful.UUID
 
@@ -18,17 +20,17 @@
 -- service, it is common to simply load the latest projection state from the
 -- event store and handle the command. If the command is valid then the new
 -- events are applied to the projection in the event store.
-data Aggregate state event cmd =
+data Aggregate state event command =
   Aggregate
-  { aggregateCommandHandler :: state -> cmd -> [event]
+  { aggregateCommandHandler :: state -> command -> [event]
   , aggregateProjection :: Projection state event
   }
 
 -- | Given a list commands, produce all of the states the aggregate's
 -- projection sees. This is useful for unit testing aggregates.
 allAggregateStates
-  :: Aggregate state event cmd
-  -> [cmd]
+  :: Aggregate state event command
+  -> [command]
   -> [state]
 allAggregateStates (Aggregate commandHandler (Projection seed eventHandler)) events =
   scanl' go seed events
@@ -41,9 +43,9 @@
 commandStoredAggregate
   :: (Monad m)
   => EventStore serialized m
-  -> Aggregate state serialized cmd
+  -> Aggregate state serialized command
   -> UUID
-  -> cmd
+  -> command
   -> m [serialized]
 commandStoredAggregate store (Aggregate handler proj) uuid command = do
   (latest, vers) <- getLatestProjection store proj uuid
@@ -52,3 +54,20 @@
   case mError of
     (Just err) -> error $ "TODO: Create aggregate restart logic. " ++ show err
     Nothing -> return events
+
+-- | Use a pair of 'Serializer's to wrap a 'Aggregate' with event type @event@
+-- and command type @command@ so it uses the @serializedEvent@ and
+-- @serializedCommand@ types.
+serializedAggregate
+  :: Aggregate state event command
+  -> Serializer event serializedEvent
+  -> Serializer command serializedCommand
+  -> Aggregate state serializedEvent serializedCommand
+serializedAggregate (Aggregate commandHandler projection) eventSerializer commandSerializer =
+  Aggregate serializedHandler serializedProjection'
+  where
+    serializedProjection' = serializedProjection projection eventSerializer
+    -- Try to deserialize the command and apply the handler. If we can't
+    -- deserialize, then just return no events. We also need to serialize the
+    -- events after of course.
+    serializedHandler state = map (serialize eventSerializer) . maybe [] (commandHandler state) . deserialize commandSerializer
diff --git a/src/Eventful/ProcessManager.hs b/src/Eventful/ProcessManager.hs
--- a/src/Eventful/ProcessManager.hs
+++ b/src/Eventful/ProcessManager.hs
@@ -1,9 +1,10 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RecordWildCards #-}
+
 module Eventful.ProcessManager
   ( ProcessManager (..)
   , ProcessManagerCommand (..)
-  , ProcessManagerEvent (..)
-  , ProcessManagerRouter (..)
-  , processManagerHandler
+  , applyProcessManagerCommandsAndEvents
   ) where
 
 import Control.Monad (forM_, void)
@@ -14,15 +15,15 @@
 import Eventful.UUID
 
 -- | A 'ProcessManager' manages interaction between aggregates. It works by
--- listening to events on an event bus (see 'processManagerHandler') and
--- applying events to its internal 'Projection'. Then, pending commands and
--- events are plucked off of that Projection and applied to the appropriate
--- Aggregates or Projections in other streams.
+-- listening to events on an event bus and applying events to its internal
+-- 'Projection' (see 'applyProcessManagerCommandsAndEvents'). Then, pending
+-- commands and events are plucked off of that Projection and applied to the
+-- appropriate Aggregates or Projections in other streams.
 data ProcessManager state event command
   = ProcessManager
-  { processManagerProjection :: Projection state event
+  { processManagerProjection :: Projection state (ProjectionEvent event)
   , processManagerPendingCommands :: state -> [ProcessManagerCommand event command]
-  , processManagerPendingEvents :: state -> [ProcessManagerEvent event]
+  , processManagerPendingEvents :: state -> [ProjectionEvent event]
   }
 
 -- | This is a @command@ along with the UUID of the target 'Aggregate', and
@@ -37,56 +38,19 @@
 
 instance (Show command, Show event) => Show (ProcessManagerCommand event command) where
   show (ProcessManagerCommand uuid _ command) =
-    "ProcessManagerCommand{ processManagerCommandAggregateId = " ++ show uuid ++
-    ", processManagerCommandCommand = " ++ show command
-
--- | This is an @event@ paired with the UUID of the stream to which the event
--- will be applied.
-data ProcessManagerEvent event
-  = ProcessManagerEvent
-  { processManagerEventProjectionId :: UUID
-  , processManagerEventEvent :: event
-  } deriving (Show, Eq)
-
--- | A 'ProcessManagerRouter' decides which process manager projection ID to
--- use for a given event.
-data ProcessManagerRouter state event command
-  = ProcessManagerRouter
-  { processManagerRouterGetManagerId :: UUID -> event -> Maybe UUID
-    -- TODO: Should this really be just "Maybe UUID"? We should consider
-    -- allowing UUID creation as well when the first event for a process comes
-    -- in so we know every process manager has a unique UUID. We could make an
-    -- ADT for ProcessManagerRouteResult that returns either the UUID, a value
-    -- saying we need to make a UUID, or a value saying the manager ignores
-    -- that event.
-  , processManagerRouterManager :: ProcessManager state event command
-  }
-
--- | This is an event handler for a 'ProcessManager' that applies all events to
--- the 'ProcessManagerRouter', and then applied any pending commands or events
--- to the appropriate places.
-processManagerHandler
-  :: (Monad m)
-  => ProcessManagerRouter state event command
-  -> EventStore event m
-  -> UUID
-  -> event
-  -> m ()
-processManagerHandler (ProcessManagerRouter getManagerId manager) store eventAggregateId event =
-  maybe (return ()) (processManagerHandler' manager store event) (getManagerId eventAggregateId event)
+    "ProcessManagerCommand{processManagerCommandAggregateId = " ++ show uuid ++
+    ", processManagerCommandCommand = " ++ show command ++ "}"
 
-processManagerHandler'
+-- | Plucks the pending commands and events off of the process manager's state
+-- and applies them to the appropriate locations in the event store.
+applyProcessManagerCommandsAndEvents
   :: (Monad m)
   => ProcessManager state event command
   -> EventStore event m
-  -> event
-  -> UUID
+  -> state
   -> m ()
-processManagerHandler' ProcessManager{..} store startEvent managerId = do
-  -- TODO: Don't ignore storage errors
-  _ <- storeEvents store AnyVersion managerId [startEvent]
-  (managerState, _) <- getLatestProjection store processManagerProjection managerId
-  forM_ (processManagerPendingCommands managerState) $ \(ProcessManagerCommand aggregateId aggregate command) ->
+applyProcessManagerCommandsAndEvents ProcessManager{..} store state = do
+  forM_ (processManagerPendingCommands state) $ \(ProcessManagerCommand aggregateId aggregate command) ->
     void $ commandStoredAggregate store aggregate aggregateId command
-  forM_ (processManagerPendingEvents managerState) $ \(ProcessManagerEvent projectionId event) ->
+  forM_ (processManagerPendingEvents state) $ \(ProjectionEvent projectionId event) ->
     storeEvents store AnyVersion projectionId [event]
diff --git a/src/Eventful/Projection.hs b/src/Eventful/Projection.hs
--- a/src/Eventful/Projection.hs
+++ b/src/Eventful/Projection.hs
@@ -1,14 +1,20 @@
+{-# LANGUAGE RecordWildCards #-}
+
 module Eventful.Projection
   ( Projection (..)
   , latestProjection
   , allProjections
   , getLatestProjection
+  , getLatestGlobalProjection
+  , serializedProjection
   )
   where
 
 import Data.Foldable (foldl')
 import Data.List (scanl')
+import Data.Maybe (fromMaybe)
 
+import Eventful.Serializer
 import Eventful.Store.Class
 import Eventful.UUID
 
@@ -55,3 +61,39 @@
   where
     maxEventVersion [] = -1
     maxEventVersion es = maximum $ storedEventVersion <$> es
+
+-- | Gets globally ordered events from the event store and builds a
+-- 'Projection' based on 'ProjectionEvent'. Optionally accepts the current
+-- projection state as an argument.
+getLatestGlobalProjection
+  :: (Monad m)
+  => GloballyOrderedEventStore serialized m
+  -> Projection proj (ProjectionEvent serialized)
+  -> Maybe (proj, SequenceNumber)
+  -> m (proj, SequenceNumber)
+getLatestGlobalProjection store proj mCurrentState = do
+  let
+    currentState = fromMaybe (projectionSeed proj) $ fst <$> mCurrentState
+    startingSequenceNumber = maybe 0 (+1) $ snd <$> mCurrentState
+  events <- getSequencedEvents store startingSequenceNumber
+  let
+    projectionEvents = globallyOrderedEventToProjectionEvent <$> events
+    latestState = foldl' (projectionEventHandler proj) currentState projectionEvents
+    latestSeq =
+      case events of
+        [] -> startingSequenceNumber
+        _ -> globallyOrderedEventSequenceNumber $ last events
+  return (latestState, latestSeq)
+
+-- | Use a 'Serializer' to wrap a 'Projection' with event type @event@ so it
+-- uses the @serialized@ type.
+serializedProjection
+  :: Projection state event
+  -> Serializer event serialized
+  -> Projection state serialized
+serializedProjection (Projection seed eventHandler) Serializer{..} =
+  Projection seed serializedHandler
+  where
+    -- Try to deserialize the event and apply the handler. If we can't
+    -- deserialize, then just return the state.
+    serializedHandler state = maybe state (eventHandler state) . deserialize
diff --git a/src/Eventful/ReadModel/Class.hs b/src/Eventful/ReadModel/Class.hs
--- a/src/Eventful/ReadModel/Class.hs
+++ b/src/Eventful/ReadModel/Class.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+
 module Eventful.ReadModel.Class
   ( ReadModel (..)
   , runPollingReadModel
@@ -13,7 +16,7 @@
   ReadModel
   { readModelModel :: model
   , readModelLatestAppliedSequence :: model -> m SequenceNumber
-  , readModelHandleEvents :: model -> [GloballyOrderedEvent (StoredEvent serialized)] -> m ()
+  , readModelHandleEvents :: model -> [GloballyOrderedEvent serialized] -> m ()
   }
 
 type PollingPeriodSeconds = Double
diff --git a/src/Eventful/Serializer.hs b/src/Eventful/Serializer.hs
--- a/src/Eventful/Serializer.hs
+++ b/src/Eventful/Serializer.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeOperators #-}
 
 module Eventful.Serializer
@@ -137,7 +140,7 @@
   GloballyOrderedEventStore getSequencedEvents'
   where
     getSequencedEvents' sequenceNumber =
-      mapMaybe (traverse (traverse deserialize)) <$> getSequencedEvents store sequenceNumber
+      mapMaybe (traverse deserialize) <$> getSequencedEvents store sequenceNumber
 
 -- | This is a type class for serializing sum types of events to 'Dynamic'
 -- without the associated constructor. This is useful when transforming between
diff --git a/src/Eventful/Store/Class.hs b/src/Eventful/Store/Class.hs
--- a/src/Eventful/Store/Class.hs
+++ b/src/Eventful/Store/Class.hs
@@ -1,3 +1,9 @@
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+
 module Eventful.Store.Class
   ( -- * EventStore
     EventStore (..)
@@ -5,8 +11,13 @@
   , ExpectedVersion (..)
   , EventWriteError (..)
     -- * Utility types
+  , ProjectionEvent (..)
   , StoredEvent (..)
+  , storedEventToProjectionEvent
   , GloballyOrderedEvent (..)
+  , globallyOrderedEventToStoredEvent
+  , globallyOrderedEventToProjectionEvent
+  , storedEventToGloballyOrderedEvent
   , EventVersion (..)
   , SequenceNumber (..)
     -- * Utility functions
@@ -39,7 +50,7 @@
 -- store.
 newtype GloballyOrderedEventStore serialized m =
   GloballyOrderedEventStore
-  { getSequencedEvents :: SequenceNumber -> m [GloballyOrderedEvent (StoredEvent serialized)]
+  { getSequencedEvents :: SequenceNumber -> m [GloballyOrderedEvent serialized]
   }
 
 -- | ExpectedVersion is used to assert the event stream is at a certain version
@@ -90,27 +101,79 @@
   then storeEvents' uuid events >> return Nothing
   else return $ Just $ EventStreamNotAtExpectedVersion latestVersion
 
+-- | A 'ProjectionEvent' is an event that is associated with a 'Projection' via
+-- the projection's 'UUID'.
+data ProjectionEvent event
+  = ProjectionEvent
+  { projectionEventProjectionId :: !UUID
+    -- ^ The UUID of the 'Projection' that the event belongs to.
+  , projectionEventEvent :: !event
+    -- ^ The actual event type. Note that this can be a serialized event or the
+    -- actual Haskell event type.
+  } deriving (Show, Eq, Functor, Foldable, Traversable)
+
 -- | A 'StoredEvent' is an event with associated storage metadata.
 data StoredEvent event
   = StoredEvent
-  { storedEventProjectionId :: UUID
+  { storedEventProjectionId :: !UUID
     -- ^ The UUID of the 'Projection' that the event belongs to.
-  , storedEventVersion :: EventVersion
+  , storedEventVersion :: !EventVersion
     -- ^ The version of the Projection corresponding to this event.
-  , storedEventEvent :: event
+  , storedEventEvent :: !event
     -- ^ The actual event type. Note that this can be a serialized event or the
     -- actual Haskell event type.
   } deriving (Show, Eq, Functor, Foldable, Traversable)
 
--- | A 'GloballyOrderedEvent' is an event that has a global 'SequenceNumber'.
+storedEventToProjectionEvent :: StoredEvent event -> ProjectionEvent event
+storedEventToProjectionEvent StoredEvent{..} =
+  ProjectionEvent
+  { projectionEventProjectionId = storedEventProjectionId
+  , projectionEventEvent = storedEventEvent
+  }
+
+-- | A 'GloballyOrderedEvent' is like a 'StoredEvent' but has a global
+-- 'SequenceNumber'.
 data GloballyOrderedEvent event
   = GloballyOrderedEvent
-  { globallyOrderedEventSequenceNumber :: SequenceNumber
+  { globallyOrderedEventProjectionId :: !UUID
+    -- ^ The UUID of the 'Projection' that the event belongs to.
+  , globallyOrderedEventVersion :: !EventVersion
+    -- ^ The version of the Projection corresponding to this event.
+  , globallyOrderedEventSequenceNumber :: !SequenceNumber
     -- ^ The global sequence number of this event.
-  , globallyOrderedEventEvent :: event
+  , globallyOrderedEventEvent :: !event
     -- ^ The actual event type. Note that this can be a serialized event or the
     -- actual Haskell event type.
   } deriving (Show, Eq, Functor, Foldable, Traversable)
+
+-- | Extract the 'StoredEvent' from a 'GloballyOrderedEvent'
+globallyOrderedEventToStoredEvent :: GloballyOrderedEvent event -> StoredEvent event
+globallyOrderedEventToStoredEvent GloballyOrderedEvent{..} =
+  StoredEvent
+  { storedEventProjectionId = globallyOrderedEventProjectionId
+  , storedEventVersion = globallyOrderedEventVersion
+  , storedEventEvent = globallyOrderedEventEvent
+  }
+
+-- | Extract the 'ProjectionEvent' from a 'GloballyOrderedEvent'
+globallyOrderedEventToProjectionEvent :: GloballyOrderedEvent event -> ProjectionEvent event
+globallyOrderedEventToProjectionEvent GloballyOrderedEvent{..} =
+  ProjectionEvent
+  { projectionEventProjectionId = globallyOrderedEventProjectionId
+  , projectionEventEvent = globallyOrderedEventEvent
+  }
+
+-- | Convert a 'StoredEvent' to a 'GloballyOrderedEvent' by adding the
+-- 'SequenceNumber'. This is mainly used by event stores to create globally
+-- ordered events.
+storedEventToGloballyOrderedEvent :: SequenceNumber -> StoredEvent event -> GloballyOrderedEvent event
+storedEventToGloballyOrderedEvent sequenceNumber StoredEvent{..} =
+  GloballyOrderedEvent
+  { globallyOrderedEventProjectionId = storedEventProjectionId
+  , globallyOrderedEventVersion = storedEventVersion
+  , globallyOrderedEventSequenceNumber = sequenceNumber
+  , globallyOrderedEventEvent = storedEventEvent
+  }
 
 -- | Event versions are a strictly increasing series of integers for each
 -- projection. They allow us to order the events when they are replayed, and
diff --git a/src/Eventful/TH.hs b/src/Eventful/TH.hs
--- a/src/Eventful/TH.hs
+++ b/src/Eventful/TH.hs
@@ -3,5 +3,4 @@
   ) where
 
 import Eventful.TH.Projection as X
-import Eventful.TH.SumType as X
 import Eventful.TH.SumTypeSerializer as X
diff --git a/src/Eventful/TH/Projection.hs b/src/Eventful/TH/Projection.hs
--- a/src/Eventful/TH/Projection.hs
+++ b/src/Eventful/TH/Projection.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Eventful.TH.Projection
   ( mkProjection
@@ -6,9 +7,9 @@
 
 import Data.Char (toLower)
 import Language.Haskell.TH
+import SumTypes.TH
 
 import Eventful.Projection
-import Eventful.TH.SumType
 
 -- | Creates a 'Projection' for a given type and a list of events. The user of
 -- this function also needs to provide event handlers for each event. For
@@ -50,7 +51,7 @@
 mkProjection stateName stateDefault events = do
   -- Make event sum type
   let eventTypeName = nameBase stateName ++ "Event"
-  sumTypeDecls <- mkSumType eventTypeName (nameBase stateName ++) events
+  sumTypeDecls <- constructSumType eventTypeName defaultSumTypeOptions events
 
   -- Make function to handle events from sum type to handlers.
   let handleFuncName = mkName $ "handle" ++ eventTypeName
diff --git a/src/Eventful/TH/SumType.hs b/src/Eventful/TH/SumType.hs
deleted file mode 100644
--- a/src/Eventful/TH/SumType.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-module Eventful.TH.SumType
-  ( mkSumType
-  , mkSumType'
-  ) where
-
-import Language.Haskell.TH
-
--- | This is a template haskell function that creates a sum type from a list of
--- types. This is very useful when creating an event type for a 'Projection'
--- from a list of events in your system. Here is an example:
---
--- @
---    data EventA = EventA
---    data EventB = EventB
---    data EventC = EventC
---
---    mkSumType "MyEvent" ("MyEvent" ++) [''EventA, ''EventB, ''EventC]
--- @
---
--- This will produce the following sum type:
---
--- @
---    data MyEvent
---      = MyEventEventA EventA
---      | MyEventEventB EventB
---      | MyEventEventC EventC
--- @
---
--- Note that you can use standalone deriving to derive any instances you want:
---
--- @
---    deriving instance Show MyEvent
---    deriving instance Eq MyEvent
--- @
-mkSumType :: String -> (String -> String) -> [Name] -> Q [Dec]
-mkSumType typeName mkConstructorName eventTypes = do
-  let
-    mkConstructor eventName =
-      NormalC
-      (mkName . mkConstructorName . nameBase $ eventName)
-      [(Bang NoSourceUnpackedness SourceStrict, ConT eventName)]
-    constructors = map mkConstructor eventTypes
-  return [DataD [] (mkName typeName) [] Nothing constructors []]
-
--- | Variant of mkSumType that just appends a @'@ to each constructor.
---
--- @
---    mkSumType' name events = mkSumType name (++ "'") events
--- @
-mkSumType' :: String -> [Name] -> Q [Dec]
-mkSumType' name = mkSumType name (++ "'")
diff --git a/src/Eventful/TH/SumTypeSerializer.hs b/src/Eventful/TH/SumTypeSerializer.hs
--- a/src/Eventful/TH/SumTypeSerializer.hs
+++ b/src/Eventful/TH/SumTypeSerializer.hs
@@ -1,12 +1,14 @@
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Eventful.TH.SumTypeSerializer
   ( mkSumTypeSerializer
   ) where
 
 import Data.Char (toLower)
-import Data.List (lookup)
 import Language.Haskell.TH
+import SumTypes.TH
 
 -- | This is a template haskell function that creates a 'Serializer' between
 -- two sum types. The first sum type must be a subset of the second sum type.
@@ -59,93 +61,23 @@
 -- @
 mkSumTypeSerializer :: String -> Name -> Name -> Q [Dec]
 mkSumTypeSerializer serializerName sourceType targetType = do
-  -- Get the constructors for both types and match them up based on event type.
-  sourceConstructors <- typeConstructors sourceType
-  targetConstructors <- typeConstructors targetType
-  bothConstructors <- mapM (matchConstructor targetConstructors) sourceConstructors
-
   -- Construct the serialization function
   let
-    serializeFuncName = mkName $ firstCharToLower (nameBase sourceType) ++ "To" ++ nameBase targetType
-    serializeFuncClauses = map mkSerializeFunc bothConstructors
-  serializeTypeDecl <- [t| $(conT sourceType) -> $(conT targetType) |]
-
-  -- Construct the deserialization function
-  let
-    deserializeFuncName = mkName $ firstCharToLower (nameBase targetType) ++ "To" ++ nameBase sourceType
-    wildcardDeserializeClause = Clause [WildP] (NormalB (ConE 'Nothing)) []
-    deserializeFuncClauses = map mkDeserializeFunc bothConstructors ++ [wildcardDeserializeClause]
-  deserializeTypeDecl <- [t| $(conT targetType) -> Maybe $(conT sourceType) |]
+    serializeFuncName = firstCharToLower (nameBase sourceType) ++ "To" ++ nameBase targetType
+    deserializeFuncName = firstCharToLower (nameBase targetType) ++ "To" ++ nameBase sourceType
+  serializeDecls <- sumTypeConverter serializeFuncName sourceType targetType
+  deserializeDecls <- partialSumTypeConverter deserializeFuncName targetType sourceType
 
   -- Construct the serializer
   serializerTypeDecl <- [t| $(conT $ mkName "Serializer") $(conT sourceType) $(conT targetType) |]
-  serializerExp <- [e| $(varE $ mkName "simpleSerializer") $(varE serializeFuncName) $(varE deserializeFuncName) |]
+  serializerExp <- [e| $(varE $ mkName "simpleSerializer") $(varE $ mkName serializeFuncName) $(varE $ mkName deserializeFuncName) |]
   let
     serializerClause = Clause [] (NormalB serializerExp) []
 
-  return
-    [ -- Serialization
-      SigD serializeFuncName serializeTypeDecl
-    , FunD serializeFuncName serializeFuncClauses
-
-      -- Deserialization
-    , SigD deserializeFuncName deserializeTypeDecl
-    , FunD deserializeFuncName deserializeFuncClauses
-
-      -- Serializer
-    , SigD (mkName serializerName) serializerTypeDecl
+  return $
+    [ SigD (mkName serializerName) serializerTypeDecl
     , FunD (mkName serializerName) [serializerClause]
-    ]
-
--- | Extract the constructors and event types for the given type.
-typeConstructors :: Name -> Q [(Type, Name)]
-typeConstructors typeName = do
-  info <- reify typeName
-  case info of
-    (TyConI (DataD _ _ _ _ constructors _)) -> mapM go constructors
-      where
-        go (NormalC name []) = fail $ "Constructor " ++ nameBase name ++ " doesn't have any arguments"
-        go (NormalC name [(_, type')]) = return (type', name)
-        go (NormalC name _) = fail $ "Constructor " ++ nameBase name ++ " has more than one argument"
-        go _ = fail $ "Invalid constructor in " ++ nameBase typeName
-    _ -> fail $ nameBase typeName ++ " must be a sum type"
-
--- | Find the corresponding target constructor for a given source constructor.
-matchConstructor :: [(Type, Name)] -> (Type, Name) -> Q BothConstructors
-matchConstructor targetConstructors (type', sourceConstructor) = do
-  targetConstructor <-
-    maybe
-    (fail $ "Can't find constructor in target type corresponding to " ++ nameBase sourceConstructor)
-    return
-    (lookup type' targetConstructors)
-  return $ BothConstructors type' sourceConstructor targetConstructor
-
--- | Utility type to hold the source and target constructors for a given event
--- type.
-data BothConstructors =
-  BothConstructors
-  { eventType :: Type
-  , sourceConstructor :: Name
-  , targetConstructor :: Name
-  }
-
--- | Construct the TH function 'Clause' for the serialization function for a
--- given type.
-mkSerializeFunc :: BothConstructors -> Clause
-mkSerializeFunc BothConstructors{..} =
-  let
-    patternMatch = ConP sourceConstructor [VarP (mkName "e")]
-    constructor = AppE (ConE targetConstructor) (VarE (mkName "e"))
-  in Clause [patternMatch] (NormalB constructor) []
-
--- | Construct the TH function 'Clause' for the deserialization function for a
--- given type.
-mkDeserializeFunc :: BothConstructors -> Clause
-mkDeserializeFunc BothConstructors{..} =
-  let
-    patternMatch = ConP targetConstructor [VarP (mkName "e")]
-    constructor = AppE (ConE 'Just) (AppE (ConE sourceConstructor) (VarE (mkName "e")))
-  in Clause [patternMatch] (NormalB constructor) []
+    ] ++ serializeDecls ++ deserializeDecls
 
 firstCharToLower :: String -> String
 firstCharToLower [] = []
diff --git a/tests/Eventful/SerializerSpec.hs b/tests/Eventful/SerializerSpec.hs
--- a/tests/Eventful/SerializerSpec.hs
+++ b/tests/Eventful/SerializerSpec.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Eventful.SerializerSpec (spec) where
 
 import Data.Dynamic
diff --git a/tests/Eventful/TH/SumTypeSpec.hs b/tests/Eventful/TH/SumTypeSpec.hs
deleted file mode 100644
--- a/tests/Eventful/TH/SumTypeSpec.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module Eventful.TH.SumTypeSpec (spec) where
-
-import Test.Hspec
-
-import Eventful.TH.SumType
-
-data EventA = EventA deriving (Show, Eq)
-data EventB = EventB deriving (Show, Eq)
-data EventC = EventC deriving (Show, Eq)
-
-mkSumType' "MyEvent" [''EventA, ''EventB, ''EventC]
-
-deriving instance Show MyEvent
-deriving instance Eq MyEvent
-
-spec :: Spec
-spec = do
-  describe "mkSumType" $ do
-    it "can create events" $ do
-      -- The real utility in this test is the fact that it compiles
-      length [EventA' EventA, EventB' EventB, EventC' EventC] `shouldBe` 3