diff --git a/Control/Monad/Operational/Class.hs b/Control/Monad/Operational/Class.hs
--- a/Control/Monad/Operational/Class.hs
+++ b/Control/Monad/Operational/Class.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 -----------------------------------------------------------------------------
 -- |
@@ -12,7 +12,7 @@
 --
 -- A class for operational monads
 ----------------------------------------------------------------------------
-module Control.Monad.Operational.Class (Operational(..)) where
+module Control.Monad.Operational.Class ((:!)(..)) where
 
 import Control.Monad.Trans.Reader
 import qualified Control.Monad.Trans.State.Strict as Strict
@@ -29,42 +29,42 @@
 import Control.Monad.Trans.Class
 import Data.Monoid
 
-class Monad m => Operational t m where -- need fundeps?
+class Monad m => t :! m | m -> t where
   -- | Construct an operational action from a single imperative.
   singleton :: t a -> m a
 
-instance (Operational f m) => Operational f (ReaderT e m) where
+instance (t :! m) => t :! ReaderT e m where
   singleton = lift . singleton
 
-instance (Operational f m) => Operational f (Lazy.StateT s m) where
+instance (t :! m) => t :! Lazy.StateT s m where
   singleton = lift . singleton
 
-instance (Operational f m) => Operational f (Strict.StateT s m) where
+instance (t :! m) => t :! Strict.StateT s m where
   singleton = lift . singleton
 
-instance (Operational f m) => Operational f (ContT r m) where
+instance (t :! m) => t :! ContT r m where
   singleton = lift . singleton
 
-instance (Operational f m, Monoid w) => Operational f (Lazy.WriterT w m) where
+instance (t :! m, Monoid w) => t :! Lazy.WriterT w m where
   singleton = lift . singleton
 
-instance (Operational f m, Monoid w) => Operational f (Strict.WriterT w m) where
+instance (t :! m, Monoid w) => t :! Strict.WriterT w m where
   singleton = lift . singleton
 
-instance (Operational f m, Monoid w) => Operational f (Strict.RWST r w s m) where
+instance (t :! m, Monoid w) => t :! Strict.RWST r w s m where
   singleton = lift . singleton
 
-instance (Operational f m, Monoid w) => Operational f (Lazy.RWST r w s m) where
+instance (t :! m, Monoid w) => t :! Lazy.RWST r w s m where
   singleton = lift . singleton
 
-instance (Operational f m) => Operational f (MaybeT m) where
+instance (t :! m) => t :! MaybeT m where
   singleton = lift . singleton
 
-instance (Operational f m) => Operational f (IdentityT m) where
+instance (t :! m) => t :! IdentityT m where
   singleton = lift . singleton
 
-instance (Operational f m) => Operational f (ListT m) where
+instance (t :! m) => t :! ListT m where
   singleton = lift . singleton
 
-instance (Operational f m, Error e) => Operational f (ErrorT e m) where
+instance (t :! m, Error e) => t :! ErrorT e m where
   singleton = lift . singleton
diff --git a/Control/Monad/Operational/Mini.hs b/Control/Monad/Operational/Mini.hs
--- a/Control/Monad/Operational/Mini.hs
+++ b/Control/Monad/Operational/Mini.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RankNTypes, FlexibleInstances, MultiParamTypeClasses, GADTs #-}
+{-# LANGUAGE RankNTypes, FlexibleInstances, MultiParamTypeClasses, GADTs, TypeOperators #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Monad.Operational.Mini
@@ -42,10 +42,10 @@
 interpret :: Monad m => (forall x. t x -> m x) -> Program t a -> m a
 interpret e (Program m) = m return (\t f -> e t >>= f)
 
-cloneProgram :: Operational t m => Program t a -> m a
+cloneProgram :: (t :! m) => Program t a -> m a
 cloneProgram (Program m) = m return (\t c -> singleton t >>= c)
 
-instance Operational t (Program t) where
+instance t :! Program t where
     singleton t = Program $ \p i -> i t p
 
 -- | Reified version of 'Program'. It is useful for testing.
@@ -76,5 +76,5 @@
     Return a >>= f = f a
     (t :>>= m) >>= k = t :>>= (>>= k) . m
 
-instance Operational t (ReifiedProgram t) where
+instance t :! ReifiedProgram t where
     singleton t = t :>>= Return
diff --git a/Control/Monad/Operational/TH.hs b/Control/Monad/Operational/TH.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monad/Operational/TH.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Control.Monad.Operational.TH (makeSingletons) where
+
+import Language.Haskell.TH
+import Control.Monad.Operational.Class
+import Data.Char
+
+import Control.Monad.Trans.State
+import Control.Applicative
+import Data.List (union)
+import Data.Maybe (fromJust)
+
+renameType :: [(Name, Name)] -> Type -> State Int Type
+renameType m (VarT n) = case n `lookup` m of
+    Just n' -> return $ VarT n'
+    Nothing -> do
+        i <- get
+        modify (+1)
+        return $ VarT $ mkName $ "a" ++ show i
+renameType m (SigT t k)          = SigT <$> renameType m t <*> pure k
+renameType m (AppT l r)          = AppT <$> renameType m l <*> renameType m r
+renameType _ t                   = pure t
+
+tyVars :: Type -> [Name]
+tyVars (VarT n) = [n]
+tyVars (AppT l r) = tyVars l ++ tyVars r
+tyVars _ = []
+
+makeSingletons :: Name -> Q [Dec]
+makeSingletons name = do
+    TyConI dec <- reify name
+    case dec of
+        DataD _ _ vs cs _ -> fmap concat $ mapM (fromCon (map fromTyVarBndr vs)) cs
+        _ -> fail "Expecting a type construcor"
+    where
+        gen vs conName argTypes resultType = do
+            let bodyName = let (b:bs) = nameBase name in mkName (toLower b : bs)
+                ref = [(n, mkName ("p" ++ show i)) | (i, n) <- zip [(0::Int)..] (init vs)]
+                instr = foldl AppT (ConT name) $ map VarT $ map (fromJust . (`lookup`ref)) (init vs)
+                
+                m = mkName "m"
+                
+                ts = evalState (mapM (renameType ref) argTypes) 0
+                result = evalState (renameType ref resultType) 0
+                
+                vars = PlainTV m : map PlainTV (map snd ref `union` tyVars result)
+                
+                sig = SigD bodyName $ ForallT vars [ClassP ''(:!) [instr, VarT m]]
+                    $ foldr (\x y -> AppT ArrowT x `AppT` y) (AppT (VarT m) result) ts
+            
+            ps <- mapM (newName . ("p"++) . show) [0..length argTypes - 1]
+
+            let body = AppE (VarE 'singleton) $ foldl AppE (ConE conName) (map VarE ps)
+
+            return [sig, FunD bodyName [Clause (map VarP ps) (NormalB body) []]]  
+
+        fromCon vs (ForallC _ [EqualP _ t] (NormalC conName ts)) = gen vs conName (map snd ts) t
+        fromCon vs (NormalC conName ts) = gen vs conName (map snd ts) (VarT $ last vs)
+        fromCon _ _ = fail "Unsupported data constructor"
+
+        fromTyVarBndr :: TyVarBndr -> Name
+        fromTyVarBndr (PlainTV n) = n
+        fromTyVarBndr (KindedTV n _) = n
diff --git a/Control/Monad/Trans/Operational/Mini.hs b/Control/Monad/Trans/Operational/Mini.hs
--- a/Control/Monad/Trans/Operational/Mini.hs
+++ b/Control/Monad/Trans/Operational/Mini.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE RankNTypes, GADTs #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses,KindSignatures #-}
 -----------------------------------------------------------------------------
 -- |
@@ -39,7 +40,7 @@
 interpret :: Monad m => (forall x. t x -> m x) -> ProgramT t m a -> m a
 interpret e (ProgramT m) = m return (\t c -> e t >>= c)
 
-instance Operational t (ProgramT t m) where
+instance t :! ProgramT t m where
     singleton t = ProgramT $ \p i -> i t p
 
 instance MonadTrans (ProgramT t) where
@@ -81,7 +82,7 @@
     (t :>>= m) >>= k = t :>>= (>>= k) . m
     Lift a c >>= f = Lift a (c >=> f)
 
-instance Monad m => Operational t (ReifiedProgramT t m) where
+instance Monad m => t :! ReifiedProgramT t m where
     singleton t = t :>>= Return
 
 instance MonadTrans (ReifiedProgramT t) where lift = flip Lift Return
diff --git a/minioperational.cabal b/minioperational.cabal
--- a/minioperational.cabal
+++ b/minioperational.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                minioperational
-version:             0.3
+version:             0.4
 synopsis:            fast and simple operational monad
 description:         This package provides tiny implementation of operational monad.
 homepage:            https://github.com/fumieval/minioperational
@@ -22,6 +22,9 @@
 library
   default-language:   Haskell2010
   ghc-options: -Wall -O2
-  exposed-modules:     Control.Monad.Operational.Mini, Control.Monad.Trans.Operational.Mini, Control.Monad.Operational.Class
+  exposed-modules:     Control.Monad.Operational.Mini
+    , Control.Monad.Trans.Operational.Mini
+    , Control.Monad.Operational.Class
+    , Control.Monad.Operational.TH
   -- other-modules:       
-  build-depends:       base ==4.*, transformers >= 0.2.0 && <0.4
+  build-depends:       base ==4.*, transformers >= 0.2.0 && <0.4, template-haskell