msgpack 0.4.0 → 0.4.0.1

raw patch · 3 files changed

+41/−37 lines, 3 files

Files

• msgpack.cabal +1/−1
• src/Data/MessagePack/Derive.hs +17/−11
• test/UserData.hs +23/−25

@@ -1,5 +1,5 @@ Name:               msgpack-Version:            0.4.0+Version:            0.4.0.1 Synopsis:           A Haskell binding to MessagePack Description:   A Haskell binding to MessagePack <http://msgpack.org/>

@@ -7,6 +7,7 @@   ) where  import Control.Applicative+import Control.Monad import Language.Haskell.TH  import Data.MessagePack.Pack@@ -24,9 +25,9 @@            where     body (NormalC conName elms) =-      DoE-      [ BindS (tupOrListP $ map VarP names) (VarE 'get)-      , NoBindS $ AppE (VarE 'return) $ foldl AppE (ConE conName) $ map VarE names ]+      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 @@ -78,9 +79,9 @@       toObjectBody (NormalC conName $ map (\(_, b, c) -> (b, c)) elms)      tryFromObjectBody (NormalC conName elms) =-      DoE-      [ BindS (tupOrListP $ map VarP names) (AppE (VarE 'tryFromObject) (VarE oname))-      , NoBindS $ AppE (VarE 'return) $ foldl AppE (ConE conName) $ map VarE names ]+      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) =@@ -89,12 +90,17 @@     oname = mkName "o"     ch = foldl1 (\e f -> AppE (AppE (VarE '(<|>)) e) f) -tupOrListP :: [Pat] -> Pat-tupOrListP ls-  | length ls <= 1 = ListP ls-  | otherwise = TupP ls+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 ]  tupOrListE :: [Exp] -> Exp tupOrListE ls-  | length ls <= 1 = ListE ls+  | length ls == 0 = SigE (ListE []) (AppT ListT (ConT ''()))+  | length ls == 1 = ListE ls   | otherwise = TupE ls

@@ -6,40 +6,38 @@ data T   = A Int String   | B Double-  deriving (Show)+  deriving (Show, Eq)  $(deriveObject ''T)  data U   = C { c1 :: Int, c2 :: String }   | D { d1 :: Double }-  deriving (Show)+  deriving (Show, Eq)  $(deriveObject ''U) -main = do-  let bs = pack $ A 123 "hoge"+data V+  = E String | F+  deriving (Show, Eq)++$(deriveObject ''V)++test :: (OBJECT a, Show a, Eq a) => a -> IO ()+test v = do+  let bs = pack v   print bs-  print (unpack bs :: T)-  let cs = pack $ B 3.14-  print cs-  print (unpack cs :: T)-  let oa = toObject $ A 123 "hoge"+  print (unpack bs == v)++  let oa = toObject v   print oa-  print (fromObject oa :: T)-  let ob = toObject $ B 3.14-  print ob-  print (fromObject ob :: T)+  print (fromObject oa == v) -  let ds = pack $ C 123 "hoge"-  print ds-  print (unpack ds :: U)-  let es = pack $ D 3.14-  print es-  print (unpack es :: U)-  let oc = toObject $ C 123 "hoge"-  print oc-  print (fromObject oc :: U)-  let od = toObject $ D 3.14-  print od-  print (fromObject od :: U)+main = do+  test $ A 123 "hoge"+  test $ B 3.14+  test $ C 123 "hoge"+  test $ D 3.14+  test $ E "hello"+  test $ F+  return ()