diff --git a/msgpack.cabal b/msgpack.cabal
--- a/msgpack.cabal
+++ b/msgpack.cabal
@@ -1,5 +1,5 @@
 Name:               msgpack
-Version:            0.6.1.3
+Version:            0.6.2
 Synopsis:           A Haskell implementation of MessagePack
 Description:
   A Haskell implementation of MessagePack <http://msgpack.org/>
diff --git a/src/Data/MessagePack/Derive.hs b/src/Data/MessagePack/Derive.hs
--- a/src/Data/MessagePack/Derive.hs
+++ b/src/Data/MessagePack/Derive.hs
@@ -1,4 +1,5 @@
 {-# Language TemplateHaskell #-}
+{-# Language FlexibleInstances #-}
 
 module Data.MessagePack.Derive (
   derivePack,
@@ -6,101 +7,89 @@
   deriveObject,
   ) where
 
-import Control.Applicative
 import Control.Monad
+import Control.Monad.Error () -- for MonadPlus instance of Either e
 import Language.Haskell.TH
 
+import Data.MessagePack.Assoc
 import Data.MessagePack.Pack
 import Data.MessagePack.Unpack
 import Data.MessagePack.Object
 
-deriveUnpack :: Name -> Q [Dec]
-deriveUnpack typName = do
-  TyConI (DataD _ name _ cons _) <- reify typName
-  
-  return
-    [ InstanceD [] (AppT (ConT ''Unpackable) (ConT name))
-      [ FunD 'get [Clause [] (NormalB $ ch $ map body cons) []]
-        ]]
-        
-  where
-    body (NormalC conName elms) =
-      DoE $
-      tupOrListP (map VarP names) (VarE 'get) ++
-      [ NoBindS $ AppE (VarE 'return) $ foldl AppE (ConE conName) $ map VarE names ]
-        where
-          names = zipWith (\ix _ -> mkName $ "a" ++ show (ix :: Int)) [1..] elms
-
-    body (RecC conName elms) =
-      body (NormalC conName $ map (\(_, b, c) -> (b, c)) elms)
+derivePack :: Name -> Q [Dec]
+derivePack tyName = do
+  info <- reify tyName
+  case info of
+    TyConI (DataD _ {- cxt -} name _ {- tyVarBndr -} cons _ {- derivings -}) -> do
+      [d|
+       instance Packable $(conT name) where
+         put v = $(caseE [| v |] (map alt cons))
+       |]
 
-    ch = foldl1 (\e f -> AppE (AppE (VarE '(<|>)) e) f)
+    _ -> error $ "cant derive Packable: " ++ show tyName
 
-derivePack :: Name -> Q [Dec]
-derivePack typName = do
-  TyConI (DataD _ name _ cons _) <- reify typName
-  
-  return
-    [ InstanceD [] (AppT (ConT ''Packable) (ConT name))
-      [ FunD 'put (map body cons)
-        ]]
-        
   where
-    body (NormalC conName elms) =
-      Clause
-        [ ConP conName $ map VarP names ]
-        (NormalB $ AppE (VarE 'put) $ tupOrListE $ map VarE names) []
-      where
-        names = zipWith (\ix _ -> mkName $ "a" ++ show (ix :: Int)) [1..] elms
+    alt (NormalC conName elms) = do
+      vars <- replicateM (length elms) (newName "v")
+      match (conP conName $ map varP vars)
+        (normalB [| put $(tupE $ map varE vars) |])
+        []
 
-    body (RecC conName elms) =
-      body (NormalC conName $ map (\(_, b, c) -> (b, c)) elms)
+    alt (RecC conName elms) = do
+      vars <- replicateM (length elms) (newName "v")
+      match (conP conName $ map varP vars)
+        (normalB
+         [| put $ Assoc
+              $(listE [ [| ( $(return $ LitE $ StringL $ show fname)
+                           , toObject $(varE v)) |]
+                      | (v, (fname, _, _)) <- zip vars elms])
+          |])
+        []
 
-deriveObject :: Name -> Q [Dec]
-deriveObject typName = do
-  g <- derivePack typName
-  p <- deriveUnpack typName
+    alt c = error $ "unsupported constructor: " ++ pprint c
 
-  TyConI (DataD _ name _ cons _) <- reify typName
-  let o = InstanceD [] (AppT (ConT ''OBJECT) (ConT name))
-          [ FunD 'toObject (map toObjectBody cons),
-            FunD 'tryFromObject [Clause [ VarP oname ]
-                                 (NormalB $ ch $ map tryFromObjectBody cons) []]]
+deriveUnpack :: Name -> Q [Dec]
+deriveUnpack tyName = do
+  info <- reify tyName
+  case info of
+    TyConI (DataD _ {- cxt -} name _ {- tyVarBndr -} cons _ {- derivings -}) -> do
+      [d|
+       instance Unpackable $(conT name) where
+         get = $(foldl1 (\x y -> [| $x `mplus` $y |]) $ map alt cons)
+       |]
 
-  return $ g ++ p ++ [o]
+    _ -> error $ "cant derive Packable: " ++ show tyName
+
   where
-    toObjectBody (NormalC conName elms) =
-      Clause
-        [ ConP conName $ map VarP names ]
-        (NormalB $ AppE (VarE 'toObject) $ tupOrListE $ map VarE names) []
-      where
-        names = zipWith (\ix _ -> mkName $ "a" ++ show (ix :: Int)) [1..] elms
-    toObjectBody (RecC conName elms) =
-      toObjectBody (NormalC conName $ map (\(_, b, c) -> (b, c)) elms)
+    alt (NormalC conName elms) = do
+      vars <- replicateM (length elms) (newName "v")
+      doE [ bindS (tupP $ map varP vars) [| get |]
+          , noBindS [| return $(foldl appE (conE conName) $ map varE vars) |]
+          ]
 
-    tryFromObjectBody (NormalC conName elms) =
-      DoE $
-      tupOrListP (map VarP names) (AppE (VarE 'tryFromObject) (VarE oname)) ++
-      [ NoBindS $ AppE (VarE 'return) $ foldl AppE (ConE conName) $ map VarE names ]
-        where
-          names = zipWith (\ix _ -> mkName $ "a" ++ show (ix :: Int)) [1..] elms
-    tryFromObjectBody (RecC conName elms) =
-      tryFromObjectBody (NormalC conName $ map (\(_, b, c) -> (b, c)) elms)
+    alt (RecC conName elms) = do
+      var <- newName "v"
+      vars <- replicateM (length elms) (newName "w")
+      doE $ [ bindS (conP 'Assoc [varP var]) [| get |] ]
+            ++ zipWith (binds var) vars elms ++
+            [ noBindS [| return $(foldl appE (conE conName) $ map varE vars) |] ]
 
-    oname = mkName "o"
-    ch = foldl1 (\e f -> AppE (AppE (VarE '(<|>)) e) f)
+    alt c = error $ "unsupported constructor: " ++ pprint c
 
-tupOrListP :: [Pat] -> Exp -> [Stmt]
-tupOrListP ls e
-  | length ls == 0 =
-    let lsname = mkName "ls" in
-    [ BindS (VarP lsname) e
-    , NoBindS $ AppE (VarE 'guard) $ AppE (VarE 'null) $ SigE (VarE lsname) (AppT ListT (ConT ''())) ]
-  | length ls == 1 = [ BindS (ListP ls) e ]
-  | otherwise = [ BindS (TupP ls) e ]
+    binds var res (fname, _, _) =
+      bindS (varP res)
+            [| failN $ lookup $(return $ LitE $ StringL $ show fname) $(varE var) |]
 
-tupOrListE :: [Exp] -> Exp
-tupOrListE ls
-  | length ls == 0 = SigE (ListE []) (AppT ListT (ConT ''()))
-  | length ls == 1 = ListE ls
-  | otherwise = TupE ls
+failN Nothing = mzero
+failN (Just a) =
+  case tryFromObject a of
+    Left _ -> mzero
+    Right v -> return v
+
+
+deriveObject :: Name -> Q [Dec]
+deriveObject typName = do
+  g <- derivePack typName
+  p <- deriveUnpack typName
+  o <- [d| instance OBJECT $(conT typName) where |]
+  return $ g ++ p ++ o
diff --git a/test/UserData.hs b/test/UserData.hs
--- a/test/UserData.hs
+++ b/test/UserData.hs
@@ -1,27 +1,26 @@
 {-# Language TemplateHaskell #-}
 
 import Data.MessagePack
-import Data.MessagePack.Derive
 
 data T
   = A Int String
   | B Double
   deriving (Show, Eq)
 
-$(deriveObject ''T)
+deriveObject ''T
 
 data U
   = C { c1 :: Int, c2 :: String }
   | D { d1 :: Double }
   deriving (Show, Eq)
 
-$(deriveObject ''U)
+deriveObject ''U
 
 data V
   = E String | F
   deriving (Show, Eq)
 
-$(deriveObject ''V)
+deriveObject ''V
 
 test :: (OBJECT a, Show a, Eq a) => a -> IO ()
 test v = do
@@ -33,6 +32,7 @@
   print oa
   print (fromObject oa == v)
 
+main :: IO ()
 main = do
   test $ A 123 "hoge"
   test $ B 3.14
