pure haskell implementation.

haskell/test/Monad.hs

@@ -1,16 +1,21 @@
-import Control.Monad.Trans
+{-# Language OverloadedStrings #-}
+
+import Control.Monad.IO.Class
+import qualified Data.ByteString as B
 import Data.MessagePack
 
 main = do
-  sb <- packToString $ do
+  sb <- return $ packToString $ do
     put [1,2,3::Int]
     put (3.14 :: Double)
-    put "Hoge"
+    put ("Hoge" :: B.ByteString)
   
   print sb
   
-  unpackFromString sb $ do
+  r <- unpackFromString sb $ do
     arr <- get
     dbl <- get
     str <- get
-    liftIO $ print (arr :: [Int], dbl :: Double, str :: String)
+    return (arr :: [Int], dbl :: Double, str :: B.ByteString)
+  
+  print r

haskell/test/Stream.hs

@@ -1,14 +0,0 @@
-import Control.Applicative
-import qualified Data.ByteString as BS
-import Data.MessagePack
-
-main = do
-  sb <- newSimpleBuffer
-  pc <- newPacker sb
-  pack pc [1,2,3::Int]
-  pack pc True
-  pack pc "hoge"
-  bs <- simpleBufferData sb
-  
-  os <- unpackObjectsFromString bs
-  mapM_ print os

haskell/test/Test.hs

@@ -1,36 +1,45 @@
+import Test.Framework
+import Test.Framework.Providers.QuickCheck2
+import Test.QuickCheck
+
 import Control.Monad
+import qualified Data.ByteString.Char8 as B
 import Data.MessagePack
 
-{-
-main = do
-  sb <- newSimpleBuffer
-  pc <- newPacker sb
-  
-  pack pc [(1,2),(2,3),(3::Int,4::Int)]
-  pack pc [4,5,6::Int]
-  pack pc "hoge"
-  
-  bs <- simpleBufferData sb
-  print bs
-  
-  up <- newUnpacker defaultInitialBufferSize
-  
-  unpackerFeed up bs
+mid :: (ObjectGet a, ObjectPut a) => a -> a
+mid = unpack . pack
 
-  let f = do
-        res <- unpackerExecute up
-        when (res==1) $ do
-          obj <- unpackerData up
-          print obj
-          f
-  
-  f
+prop_mid_int a = a == mid a
+  where types = a :: Int
+prop_mid_nil a = a == mid a
+  where types = a :: ()
+prop_mid_bool a = a == mid a
+  where types = a :: Bool
+prop_mid_double a = a == mid a
+  where types = a :: Double
+prop_mid_string a = a == B.unpack (mid (B.pack a))
+  where types = a :: String
+prop_mid_array_int a = a == mid a
+  where types = a :: [Int]
+prop_mid_array_string a = a == map B.unpack (mid (map B.pack a))
+  where types = a :: [String]
+prop_mid_map_int_double a = a == mid a
+  where types = a :: [(Int, Double)]
+prop_mid_map_string_string a = a == map (\(x, y) -> (B.unpack x, B.unpack y)) (mid (map (\(x, y) -> (B.pack x, B.pack y)) a))
+  where types = a :: [(String, String)]
 
-  return ()
--}
+tests =
+  [ testGroup "simple"
+    [ testProperty "int" prop_mid_int
+    , testProperty "nil" prop_mid_nil
+    , testProperty "bool" prop_mid_bool
+    , testProperty "double" prop_mid_double
+    , testProperty "string" prop_mid_string
+    , testProperty "[int]" prop_mid_array_int
+    , testProperty "[string]" prop_mid_array_string
+    , testProperty "[(int, double)]" prop_mid_map_int_double
+    , testProperty "[(string, string)]" prop_mid_map_string_string
+    ]
+  ]
 
-main = do
-  bs <- packb [(1,2),(2,3),(3::Int,4::Int)]
-  print bs
-  dat <- unpackb bs
-  print (dat :: Result [(Int, Int)])
+main = defaultMain tests