nbt-0.2: test/Tests.hs

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Main where

import Data.NBT

import qualified Codec.Compression.GZip as GZip
import qualified Data.ByteString.Lazy as B
import Data.Binary ( Binary (..), decode, encode )
import qualified Data.ByteString.Lazy.UTF8 as UTF8 ( fromString, toString )

import Control.Applicative
import Control.Monad
import Data.Int ( Int32 )

import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck
import Test.HUnit

instance Arbitrary TagType where
    arbitrary = toEnum <$> choose (0, 10)

prop_TagType :: TagType -> Bool
prop_TagType ty = decode (encode ty) == ty

instance Arbitrary NBT where
  arbitrary = do
    ty <- arbitrary
    name <- arbitrary
    let mkArb ty name = 
          case ty of
            EndType -> return EndTag
            ByteType -> ByteTag name <$> arbitrary
            ShortType -> ShortTag name <$> arbitrary
            IntType -> IntTag name <$> arbitrary
            LongType -> LongTag name <$> arbitrary
            FloatType -> FloatTag name <$> arbitrary
            DoubleType -> DoubleTag name <$> arbitrary
            ByteArrayType -> do
              len <- (toEnum . fromEnum) <$> choose (0, 100 :: Int) :: Gen Int32
              ws <- replicateM (toEnum $ fromEnum len) arbitrary
              return $ ByteArrayTag name len $ B.pack ws
            StringType -> do
              n <- choose (0, 100) :: Gen Int
              str <- replicateM (toEnum $ fromEnum n) arbitrary
              let len' = (toEnum . fromEnum) (B.length (UTF8.fromString str))
              return $ StringTag name len' str
            ListType -> do
              ty <- arbitrary `suchThat` (EndType /=)
              len <- (toEnum . fromEnum) <$> choose (0, 10 :: Int) :: Gen Int32
              ts <- replicateM (toEnum $ fromEnum len) (mkArb ty Nothing)
              return $ ListTag name ty len ts
            CompoundType -> do
              n <- choose (0, 10)
              ts <- replicateM n (arbitrary `suchThat` (EndTag /=) :: Gen NBT)
              return $ CompoundTag name ts
    mkArb ty (Just name)

prop_NBTroundTrip :: NBT -> Bool
prop_NBTroundTrip nbt = decode (encode nbt) == nbt

testWorld = do
  fileL <- GZip.decompress <$> B.readFile "testWorld/level.dat"
  let file = B.pack (B.unpack fileL)
      dec = (decode file :: NBT)
      enc = encode dec
  enc @?= file 
  decode enc @?= dec

tests = [
    testProperty "Tag roundtrip" prop_TagType
  , testProperty "NBT roundtrip" prop_NBTroundTrip
  , testCase "testWorld roundtrip" testWorld
  ]

main = defaultMain tests