Z-MessagePack-0.1.0.0: test/Z/Data/MessagePack/BaseSpec.hs
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Z.Data.MessagePack.BaseSpec where
import qualified Data.List as L
import Data.Word
import Data.Int
import Data.Either
import GHC.Generics
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Tree as Tree
import qualified Z.Data.Text as T
import qualified Z.Data.Vector as V
import qualified Z.Data.Builder as B
import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
import Data.Time.Calendar (CalendarDiffDays (..), DayOfWeek (..))
import Data.Time.LocalTime (CalendarDiffTime (..))
import Data.Time.Clock.System (SystemTime (..), systemToUTCTime, utcToSystemTime)
import Test.QuickCheck
import Test.QuickCheck.Function
import Test.QuickCheck.Instances
import Test.QuickCheck.Property
import Test.Hspec
import Test.Hspec.QuickCheck
import qualified Z.Data.MessagePack as MessagePack
import Z.Data.MessagePack (MessagePack(..), Value(..))
data T a
= Nullary
| Unary Int
| Product T.Text (Maybe Char) a
| Record { testOne :: Double
, testTwo :: Maybe Bool
, testThree :: Maybe a
}
| RecordII { testFour :: Double }
| List [a]
deriving (Show, Eq, Generic, MessagePack)
mid :: MessagePack a => a -> a
mid = fromRight (error "decode failed") . MessagePack.decode' . MessagePack.encode
intMid :: Int64 -> Int64
intMid = mid
ns :: UTCTime -> UTCTime
ns = systemToUTCTime . utcToSystemTime
encode' :: MessagePack a => a -> V.Bytes
encode' = MessagePack.encode . toValue
spec :: Spec
spec = modifyMaxSuccess (*5) . modifyMaxSize (*5) $ do
describe "MessagePack Base instances" $ do
it "Nullary constructor are encoded as text" $
MessagePack.encode (Nullary :: T Integer) === B.build (do
B.word8 0xA7
"Nullary"
)
it "Unary constructor are encoded as single field object" $
MessagePack.encode (Unary 256 :: T ()) === B.build (do
B.word8 0x81
B.word8 0xA5
"Unary"
B.word8 0xCD
B.word8 0x01
B.word8 0x00
)
it "Product are encoded as array" $
MessagePack.encode (Product "ABC" (Just 'x') (256::Integer)) === B.build (do
B.word8 0x81
B.word8 0xA7
"Product"
B.word8 0x93
B.word8 0xA3
"ABC"
B.word8 0xA1
"x"
B.word8 0xC7
B.word8 0x03
B.word8 0x00
B.word8 0x00
B.word8 0x01
B.word8 0x00
)
it "Record are encoded as key values" $
MessagePack.encode (Record 0.123456 Nothing (Just (256::Integer))) === B.build (do
B.word8 0x81
B.word8 0xA6
"Record"
B.word8 0x83
B.word8 0xA7
"testOne"
B.word8 0xCB
B.encodePrimBE @Double 0.123456
B.word8 0xA7
"testTwo"
B.word8 0xC0
B.word8 0xA9
"testThree"
B.word8 0xC7
B.word8 0x03
B.word8 0x00
B.word8 0x00
B.word8 0x01
B.word8 0x00
)
it "Record are encoded as key values(single field)" $
MessagePack.encode (RecordII 0.123456 :: T ()) === B.build (do
B.word8 0x81
B.word8 0xA8
"RecordII"
B.word8 0x81
B.word8 0xA8
"testFour"
B.word8 0xCB
B.encodePrimBE @Double 0.123456
)
-- tests from MessagePack suit
it "int" $ property $ \(a :: Int ) -> a `shouldBe` mid a
it "int8" $ property $ \(a :: Int8 ) -> a `shouldBe` mid a
it "int16" $ property $ \(a :: Int16 ) -> a `shouldBe` mid a
it "int32" $ property $ \(a :: Int32 ) -> a `shouldBe` mid a
it "int64" $ property $ \(a :: Int64 ) -> a `shouldBe` mid a
it "word" $ property $ \(a :: Word ) -> a `shouldBe` mid a
it "word8" $ property $ \(a :: Word8 ) -> a `shouldBe` mid a
it "word16" $ property $ \(a :: Word16) -> a `shouldBe` mid a
it "word32" $ property $ \(a :: Word32) -> a `shouldBe` mid a
it "word64" $ property $ \(a :: Word64) -> a `shouldBe` mid a
it "()" $ property $ \(a :: ()) -> a `shouldBe` mid a
it "bool" $ property $ \(a :: Bool) -> a `shouldBe` mid a
it "float" $ property $ \(a :: Float) -> a `shouldBe` mid a
it "integer" $ property $ \(a :: Integer) -> a `shouldBe` mid a
it "double" $ property $ \(a :: Double) -> a `shouldBe` mid a
it "string" $ property $ \(a :: String) -> a `shouldBe` mid a
it "bytes" $ property $ \(a :: V.Bytes) -> a `shouldBe` mid a
it "primvector" $ property $ \(a :: V.PrimVector Int) -> a `shouldBe` mid a
it "vector" $ property $ \(a :: V.Vector [Integer]) -> a `shouldBe` mid a
it "maybe int" $ property $ \(a :: (Maybe Int)) -> a `shouldBe` mid a
it "[int]" $ property $ \(a :: [Int]) -> a `shouldBe` mid a
it "[string]" $ property $ \(a :: [String]) -> a `shouldBe` mid a
it "(int, int)" $ property $ \(a :: (Int, Int)) -> a `shouldBe` mid a
it "(int, int, int)" $ property $ \(a :: (Int, Int, Int)) -> a `shouldBe` mid a
it "(int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int)) -> a `shouldBe` mid a
it "(int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int)) -> a `shouldBe` mid a
it "(int, int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int, Int)) -> a `shouldBe` mid a
it "(int, int, int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int, Int, Int)) -> a `shouldBe` mid a
it "(int, double)" $ property $ \(a :: (Int, Double)) -> a `shouldBe` mid a
it "[(int, double)]" $ property $ \(a :: [(Int, Double)]) -> a `shouldBe` mid a
it "[(string, string)]" $ property $ \(a :: [(String, String)]) -> a `shouldBe` mid a
it "HashMap Text Int" $ property $ \(a :: HM.HashMap T.Text Int) -> a `shouldBe` mid a
it "HashSet Text" $ property $ \(a :: HS.HashSet T.Text) -> a `shouldBe` mid a
it "Map Text Int" $ property $ \(a :: M.Map T.Text Int) -> a `shouldBe` mid a
it "IntMap Int" $ property $ \(a :: IM.IntMap Int) -> a `shouldBe` mid a
it "Set Int" $ property $ \(a :: Set.Set Int) -> a `shouldBe` mid a
it "IntSet" $ property $ \(a :: IS.IntSet) -> a `shouldBe` mid a
it "Seq Int" $ property $ \(a :: Seq.Seq Int) -> a `shouldBe` mid a
it "Tree Int" $ property $ \(a :: Tree.Tree Int) -> a `shouldBe` mid a
it "maybe int" $ property $ \(a :: Maybe Int) -> a `shouldBe` mid a
it "maybe nil" $ property $ \(a :: Maybe ()) -> a `shouldBe` mid a
it "maybe bool" $ property $ \(a :: Maybe Bool) -> a `shouldBe` mid a
it "maybe double" $ property $ \(a :: Maybe Double) -> a `shouldBe` mid a
it "maybe string" $ property $ \(a :: Maybe String) -> a `shouldBe` mid a
it "maybe bytes" $ property $ \ (a :: Maybe V.Bytes) -> a `shouldBe` mid a
it "maybe [int]" $ property $ \(a :: Maybe [Int]) -> a `shouldBe` mid a
it "maybe [string]" $ property $ \(a :: Maybe [String]) -> a `shouldBe` mid a
it "maybe (int, int)" $ property $ \(a :: Maybe (Int, Int)) -> a `shouldBe` mid a
it "maybe (int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int)) -> a `shouldBe` mid a
it "maybe (int, int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int, Int)) -> a `shouldBe` mid a
it "maybe (int, int, int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int, Int, Int)) -> a `shouldBe` mid a
it "maybe [(int, double)]" $ property $ \(a :: Maybe [(Int, Double)]) -> a `shouldBe` mid a
it "maybe [(string, string)]" $ property $ \(a :: Maybe [(String, String)]) -> a `shouldBe` mid a
it "either int float" $ property $ \(a :: Either Int Float) -> a `shouldBe` mid a
it "Day" $ property $ \(a :: Day) -> a `shouldBe` mid a
it "DiffTime" $ property $ \(a :: DiffTime) -> a `shouldBe` mid a
it "LocalTime" $ property $ \(a :: LocalTime) -> a `shouldBe` mid a
it "NominalDiffTime" $ property $ \(a :: NominalDiffTime) -> a `shouldBe` mid a
it "TimeOfDay" $ property $ \(a :: TimeOfDay) -> a `shouldBe` mid a
it "UTCTime" $ property $ \(a :: UTCTime) -> ns a `shouldBe` mid (ns a)
it "SystemTime" $ property $ \(a :: SystemTime) -> a `shouldBe` mid a
it "CalendarDiffDays" $ property $ \(a :: CalendarDiffDays) -> a `shouldBe` mid a
it "DayOfWeek" $ property $ \(a :: DayOfWeek) -> a `shouldBe` mid a
it "CalendarDiffTime" $ property $ \(a :: CalendarDiffTime) -> a `shouldBe` mid a
it "arbitrary message" $ property $ \(a :: Value) -> a `shouldBe` mid a
describe "MessagePack Base instances encodeMessagePack == encodeMessagePack . toValue" $ do
it "Nullary constructor are encoded as text" $
MessagePack.encode (Nullary :: T Integer) ===
encode' (Nullary :: T Integer)
it "Unary constructor are encoded as single field object" $
MessagePack.encode (Unary 123456 :: T Integer) ===
encode' (Unary 123456 :: T Integer)
it "Product are encoded as array" $
MessagePack.encode (Product "ABC" (Just 'x') (123456::Integer)) ===
encode' (Product "ABC" (Just 'x') (123456::Integer))
it "Record are encoded as key values" $
MessagePack.encode (Record 0.123456 Nothing (Just (123456::Integer))) ===
encode' (Record 0.123456 Nothing (Just (123456::Integer)))
it "Record are encoded as key values(single field)" $
MessagePack.encode (RecordII 0.123456 :: T Integer) ===
encode' (RecordII 0.123456 :: T Integer)
it "List are encode as array" $
MessagePack.encode (List [Nullary
, Unary 123456
, (Product "ABC" (Just 'x') (123456::Integer))
, (Record 0.123456 Nothing (Just (123456::Integer)))]) ===
encode' (List [Nullary
, Unary 123456
, (Product "ABC" (Just 'x') (123456::Integer))
, (Record 0.123456 Nothing (Just (123456::Integer)))])
it "control characters are escaped" $
MessagePack.encode (T.pack $ map toEnum [0..0x1F]) ===
encode' (T.pack $ map toEnum [0..0x1F])
-- tests from MessagePack suit
it "int" $ property $ \(a :: Int ) -> encode' a === MessagePack.encode a
it "int8" $ property $ \(a :: Int8 ) -> encode' a === MessagePack.encode a
it "int16" $ property $ \(a :: Int16 ) -> encode' a === MessagePack.encode a
it "int32" $ property $ \(a :: Int32 ) -> encode' a === MessagePack.encode a
it "int64" $ property $ \(a :: Int64 ) -> encode' a === MessagePack.encode a
it "word" $ property $ \(a :: Word ) -> encode' a === MessagePack.encode a
it "word8" $ property $ \(a :: Word8 ) -> encode' a === MessagePack.encode a
it "word16" $ property $ \(a :: Word16) -> encode' a === MessagePack.encode a
it "word32" $ property $ \(a :: Word32) -> encode' a === MessagePack.encode a
it "word64" $ property $ \(a :: Word64) -> encode' a === MessagePack.encode a
it "()" $ property $ \(a :: ()) -> encode' a === MessagePack.encode a
it "bool" $ property $ \(a :: Bool) -> encode' a === MessagePack.encode a
it "float" $ property $ \(a :: Float) -> encode' a === MessagePack.encode a
it "double" $ property $ \(a :: Double) -> encode' a === MessagePack.encode a
it "integer" $ property $ \(a :: Integer) -> encode' a === MessagePack.encode a
it "string" $ property $ \(a :: String) -> encode' a === MessagePack.encode a
it "bytes" $ property $ \(a :: V.Bytes) -> encode' a === MessagePack.encode a
it "primvector" $ property $ \(a :: V.PrimVector Int) -> encode' a === MessagePack.encode a
it "vector" $ property $ \(a :: V.Vector [Integer]) -> encode' a === MessagePack.encode a
it "maybe int" $ property $ \(a :: (Maybe Int)) -> encode' a === MessagePack.encode a
it "[int]" $ property $ \(a :: [Int]) -> encode' a === MessagePack.encode a
it "[string]" $ property $ \(a :: [String]) -> encode' a === MessagePack.encode a
it "(int, int)" $ property $ \(a :: (Int, Int)) -> encode' a === MessagePack.encode a
it "(int, int, int)" $ property $ \(a :: (Int, Int, Int)) -> encode' a === MessagePack.encode a
it "(int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int)) -> encode' a === MessagePack.encode a
it "(int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int)) -> encode' a === MessagePack.encode a
it "(int, int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int, Int)) -> encode' a === MessagePack.encode a
it "(int, int, int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int, Int, Int)) -> encode' a === MessagePack.encode a
it "(int, double)" $ property $ \(a :: (Int, Double)) -> encode' a === MessagePack.encode a
it "[(int, double)]" $ property $ \(a :: [(Int, Double)]) -> encode' a === MessagePack.encode a
it "[(string, string)]" $ property $ \(a :: [(String, String)]) -> encode' a === MessagePack.encode a
it "HashMap Text Int" $ property $ \(a :: HM.HashMap T.Text Int) -> encode' a === MessagePack.encode a
it "HashSet Text" $ property $ \(a :: HS.HashSet T.Text) -> encode' a === MessagePack.encode a
it "Map Text Int" $ property $ \(a :: M.Map T.Text Int) -> encode' a === MessagePack.encode a
it "IntMap Int" $ property $ \(a :: IM.IntMap Int) -> encode' a === MessagePack.encode a
it "Set Int" $ property $ \(a :: Set.Set Int) -> encode' a === MessagePack.encode a
it "IntSet" $ property $ \(a :: IS.IntSet) -> encode' a === MessagePack.encode a
it "Seq Int" $ property $ \(a :: Seq.Seq Int) -> encode' a === MessagePack.encode a
it "Tree Int" $ property $ \(a :: Tree.Tree Int) -> encode' a === MessagePack.encode a
it "maybe int" $ property $ \(a :: Maybe Int) -> encode' a === MessagePack.encode a
it "maybe nil" $ property $ \(a :: Maybe ()) -> encode' a === MessagePack.encode a
it "maybe bool" $ property $ \(a :: Maybe Bool) -> encode' a === MessagePack.encode a
it "maybe double" $ property $ \(a :: Maybe Double) -> encode' a === MessagePack.encode a
it "maybe string" $ property $ \(a :: Maybe String) -> encode' a === MessagePack.encode a
it "maybe bytes" $ property $ \ (a :: Maybe V.Bytes) -> encode' a === MessagePack.encode a
it "maybe [int]" $ property $ \(a :: Maybe [Int]) -> encode' a === MessagePack.encode a
it "maybe [string]" $ property $ \(a :: Maybe [String]) -> encode' a === MessagePack.encode a
it "maybe (int, int)" $ property $ \(a :: Maybe (Int, Int)) -> encode' a === MessagePack.encode a
it "maybe (int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int)) -> encode' a === MessagePack.encode a
it "maybe (int, int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int, Int)) -> encode' a === MessagePack.encode a
it "maybe (int, int, int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int, Int, Int)) -> encode' a === MessagePack.encode a
it "maybe [(int, double)]" $ property $ \(a :: Maybe [(Int, Double)]) -> encode' a === MessagePack.encode a
it "maybe [(string, string)]" $ property $ \(a :: Maybe [(String, String)]) -> encode' a === MessagePack.encode a
it "either int float" $ property $ \(a :: Either Int Float) -> encode' a === MessagePack.encode a
it "Day" $ property $ \(a :: Day) -> encode' a === MessagePack.encode a
it "DiffTime" $ property $ \(a :: DiffTime) -> encode' a === MessagePack.encode a
it "LocalTime" $ property $ \(a :: LocalTime) -> encode' a === MessagePack.encode a
it "NominalDiffTime" $ property $ \(a :: NominalDiffTime) -> encode' a === MessagePack.encode a
it "TimeOfDay" $ property $ \(a :: TimeOfDay) -> encode' a === MessagePack.encode a
it "UTCTime" $ property $ \(a :: UTCTime) -> encode' a === MessagePack.encode a
it "SystemTime" $ property $ \(a :: SystemTime) -> encode' a === MessagePack.encode a
it "CalendarDiffDays" $ property $ \(a :: CalendarDiffDays) -> encode' a === MessagePack.encode a
it "DayOfWeek" $ property $ \(a :: DayOfWeek) -> encode' a === MessagePack.encode a
it "CalendarDiffTime" $ property $ \(a :: CalendarDiffTime) -> encode' a === MessagePack.encode a
it "arbitrary message" $ property $ \(a :: Value) -> encode' a === MessagePack.encode a