diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,5 @@
+* 0.2.0.0
+  - Add `motor-reflection` and `motor-diagrams` packages.
 * 0.1.1.0
   - Add `call` operation to `MonadFSM` class
 * 0.1.0.0
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,9 +1,6 @@
-# Motor: Type-safe effectful state machines in Haskell
+# `motor` (core library)
 
-*Motor* is an experimental Haskell library for building finite-state
-machines with type-safe transitions and effects. It draws inspiration
-from the Idris
-[ST](http://docs.idris-lang.org/en/latest/st/state.html) library.
+This library provides the core part of Motor.
 
 ## Usage
 
diff --git a/motor.cabal b/motor.cabal
--- a/motor.cabal
+++ b/motor.cabal
@@ -1,5 +1,5 @@
 name:                motor
-version:             0.1.1.0
+version:             0.2.0.0
 synopsis:
   Type-safe effectful state machines in Haskell
 description:
@@ -29,13 +29,15 @@
                      , Motor.FSM.Class
                      , Motor.FSM.Sugar
                      , Motor.FSM.Logging
+                     , Motor.FSM.TH
   -- other-modules:
   -- other-extensions:
-  build-depends:       base >=4.9 && <5
+  build-depends:       CTRex
+                     , base >=4.9 && <5
                      , indexed
                      , indexed-extras
-                     , CTRex
                      , reflection
+                     , template-haskell >= 2.11.1.0
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall
diff --git a/src/Motor/FSM/TH.hs b/src/Motor/FSM/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Motor/FSM/TH.hs
@@ -0,0 +1,142 @@
+{-# LANGUAGE DeriveLift        #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TupleSections     #-}
+-- |
+module Motor.FSM.TH where
+
+import           Control.Applicative
+import           Data.Foldable
+import           Data.Maybe
+import           Data.Semigroup
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax
+
+data TransitionSigs = TransitionSigs { stateTypeFamily :: Maybe TypeFamilyHead
+                                     , transitionSigs  :: [(Name, Type)]
+                                     } deriving (Eq, Show)
+
+instance Semigroup TransitionSigs where
+  TransitionSigs tf1 s1 <> TransitionSigs tf2 s2 =
+    TransitionSigs (tf1 <|> tf2) (s1 <> s2)
+
+instance Monoid TransitionSigs where
+  mempty = TransitionSigs Nothing []
+  mappend = (<>)
+
+data Transition
+  = Add String
+  | Transition String
+               String
+  | Delete String
+  deriving (Eq, Show, Lift)
+
+newtype Transitions = Transitions [(String, Transition)]
+  deriving (Eq, Show, Lift)
+
+asTransitions :: TransitionSigs -> Q Transitions
+asTransitions sigs = do
+  TypeFamilyHead tfName _ _ _ <-
+    fail "Missing associated type." `fromMaybe` (return <$> stateTypeFamily sigs)
+  Transitions . concat <$> mapM (sigToTransition tfName) (transitionSigs sigs)
+
+sigToTransition :: Name -> (Name, Type) -> Q [(String, Transition)]
+sigToTransition tfName (transitionName, type') =
+    case type' of
+    (ForallT
+            [ KindedTV _m1 (AppT
+                            (AppT
+                                ArrowT
+                                (AppT
+                                (ConT _rowKind1) StarT))
+                            (AppT
+                                (AppT ArrowT
+                                (AppT (ConT _rowKind2) StarT))
+                                (AppT (AppT ArrowT StarT) StarT)))
+            ]
+            [ AppT (ConT _className) (VarT _cm)
+            ]
+            (ForallT
+                [ KindedTV _n1 (ConT _symbolKind1)
+                , KindedTV _r1 (AppT (ConT _rowKind3) StarT)
+                ]
+                _constraints
+                (AppT _ actions))) ->
+        map (nameBase transitionName,) <$> actionsToTransitions tfName actions
+    _ -> do
+        reportWarning ("Unsupported type:" ++ show type')
+        return []
+
+actionsToTransitions :: Name -> Type -> Q [Transition]
+actionsToTransitions tfName =
+    \case
+    SigT (AppT (AppT (AppT (AppT (ConT _actions) (VarT _m)) as) (VarT _r)) _) _ ->
+        actionListToTransitions tfName as
+    _ -> return []
+
+actionListToTransitions :: Name -> Type -> Q [Transition]
+actionListToTransitions tfName =
+    \case
+    SigT
+        (AppT
+        (AppT
+            PromotedConsT
+            action)
+        actions)
+        (AppT ListT StarT) ->
+        mappend
+        <$> actionToTransitions tfName action
+        <*> actionListToTransitions tfName actions
+    SigT PromotedNilT (AppT ListT StarT) ->
+        return []
+    t -> do
+        reportWarning ("Unsupported action type: " ++ show t)
+        return []
+
+actionToTransitions :: Name -> Type -> Q [Transition]
+actionToTransitions tfName =
+    \case
+    AppT
+        (AppT (ConT _add) (VarT _n))
+        (AppT
+        (AppT
+        (ConT tf)
+        (VarT _m))
+        (ConT state))
+      | show tf == show tfName ->
+        return [Add (nameBase state)]
+
+    AppT
+        (AppT (ConT _assoc) (VarT _n))
+        (AppT
+        (AppT (ConT _to) (AppT (AppT (ConT tf1) (VarT _m1)) (ConT from)))
+        (AppT
+        (AppT (ConT tf2) (VarT _m2))
+        (ConT to)))
+      | show tf1 == show tfName && show tf2 == show tfName ->
+      return [Transition (nameBase from) (nameBase to)]
+    action -> fail ("Action not supported: " ++ show action)
+
+showClass :: Name -> Q [Dec]
+showClass name = do
+  info <- reify name
+  case info of
+    ClassI (ClassD _ctx _className _binders _deps decls) _ -> do
+      ts <- asTransitions =<< fold <$> mapM getTransitions decls
+      [d|
+        transitions :: Transitions
+        transitions = ts
+        |]
+    _ ->
+      fail "Not an FSM typeclass."
+
+  where
+    getTransitions :: Dec -> Q TransitionSigs
+    getTransitions dec =
+      case dec of
+        OpenTypeFamilyD tf@(TypeFamilyHead _n _ _ _) ->
+          return mempty { stateTypeFamily = Just tf }
+        SigD n t ->
+          return mempty { transitionSigs = [(n, t)]}
+        _ -> return mempty
diff --git a/test/Motor/FSMSpec/Game.hs b/test/Motor/FSMSpec/Game.hs
--- a/test/Motor/FSMSpec/Game.hs
+++ b/test/Motor/FSMSpec/Game.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE PolyKinds                  #-}
 {-# LANGUAGE RebindableSyntax           #-}
 {-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
 module Motor.FSMSpec.Game where
@@ -18,6 +19,7 @@
 
 import           Motor.FSM
 import           Motor.FSM.Logging
+import           Motor.FSM.TH
 
 -- * Game Protocol/Machine
 
@@ -26,10 +28,24 @@
 
 class MonadFSM m => Game (m :: Row * -> Row * -> * -> *) where
   type State m :: * -> *
-  spawn :: KnownSymbol n => Name n -> m r (n ::= State m Standing :| r) ()
-  jump :: KnownSymbol n => Name n -> m r (n ::= State m Jumping :| (r :- n)) ()
-  land :: KnownSymbol n => Name n -> m r (n ::= State m Standing :| (r :- n)) ()
-  perish :: KnownSymbol n => Name n -> m r (r :- n) ()
+  spawn
+    :: KnownSymbol n
+    => Name n
+    -> Actions m '[n !+ State m Standing] r ()
+  jump
+    :: KnownSymbol n
+    => Name n
+    -> Actions m '[n :-> State m Standing !--> State m Jumping] r ()
+  land
+    :: KnownSymbol n
+    => Name n
+    -> Actions m '[n :-> State m Jumping !--> State m Standing] r ()
+  perish
+    :: KnownSymbol n
+    => Name n
+    -> Actions m '[n !- State m Standing] r ()
+
+showClass ''Game
 
 -- * Game Implemention