nbt 0.3 → 0.4
raw patch · 5 files changed
+248/−284 lines, 5 filesdep +HUnitdep +QuickCheckdep +arraydep −utf8-string
Dependencies added: HUnit, QuickCheck, array, nbt, test-framework, test-framework-hunit, test-framework-quickcheck2, text, zlib
Dependencies removed: utf8-string
Files
- nbt.cabal +40/−19
- src/Data/NBT.hs +121/−161
- test/RoundTrip.hs +87/−0
- test/Tests.hs +0/−81
- test/nbt-tests.cabal +0/−23
nbt.cabal view
@@ -1,35 +1,56 @@ Name: nbt-Version: 0.3-Synopsis: A parser/serializer for Minecraft's Named Binary Tag (NBT) data format.-Description: This package includes a data type for the NBT file format, notably used to represent saved data in Minecraft.+Version: 0.4+Synopsis: A parser/serializer for Minecraft's Named Binary Tag (NBT)+ data format.+Description: This package includes a data type for the NBT file+ format, notably used to represent saved data in Minecraft and+ significant parts of the Minecraft network protocol. All twelve+ tags of verion 19133 (needed for Anvil maps) are implemented. Homepage: https://github.com/acfoltzer/nbt Bug-reports: https://github.com/acfoltzer/nbt/issues License: BSD3 License-file: LICENSE-Author: Adam C. Foltzer-Maintainer: acfoltzer@gmail.com-Tested-With: GHC==7.0.4+Author: Adam C. Foltzer <acfoltzer@gmail.com>, Stijn van Drongelen <rhymoid@gmail.com>+Maintainer: Adam C. Foltzer <acfoltzer@gmail.com>+Tested-With: GHC==7.0.4, GHC==7.4.1, GHC==7.6.2 Category: Data Build-type: Simple-Cabal-version: >=1.8--extra-source-files:- test/Tests.hs- test/nbt-tests.cabal- test/testWorld/level.dat- test/testWorld/region/r.-1.-1.mcr- test/testWorld/region/r.0.-1.mcr- test/testWorld/region/r.0.0.mcr+Cabal-version: >=1.14+data-files: test/testWorld/level.dat+ test/testWorld/region/r.-1.-1.mcr+ test/testWorld/region/r.0.-1.mcr+ test/testWorld/region/r.0.0.mcr source-repository head type: git- location: git://github.com/acfoltzer/bit-vector.git+ location: git://github.com/acfoltzer/nbt.git Library Exposed-modules: Data.NBT hs-source-dirs: src- Build-depends: base == 4.*, + default-language: Haskell2010+ Build-depends: base == 4.*, bytestring == 0.9.*, cereal >= 0.3.4 && < 0.4,- utf8-string == 0.3.*- ghc-options: -Wall + text,+ array >= 0.4+ ghc-options: -Wall++Test-Suite round-trip+ ghc-options: -Wall+ type: exitcode-stdio-1.0+ main-is: RoundTrip.hs+ hs-source-dirs: test+ default-language: Haskell2010+ Build-depends: base == 4.*,+ bytestring == 0.9.*,+ cereal >= 0.3.4 && < 0.4,+ zlib == 0.5.*,+ text,+ HUnit == 1.2.*,+ QuickCheck >= 2.4 && < 3.0,+ test-framework,+ test-framework-quickcheck2,+ test-framework-hunit,+ nbt == 0.4,+ array >= 0.4
src/Data/NBT.hs view
@@ -19,175 +19,135 @@ module Data.NBT where -import Data.Serialize ( - Serialize (..)- , getWord8- , putWord8 - )-import Data.Serialize.Get ( - Get- , getByteString- , lookAhead- , skip- )-import Data.Serialize.Put ( putByteString )+import Control.Applicative ((<$>))+import Control.Monad (forM_, replicateM)+import Data.Array.IArray (Array, IArray (bounds))+import Data.Array.Unboxed (UArray, listArray, elems)+import Data.Int (Int16, Int32, Int64, Int8)+import Data.Ix (Ix (rangeSize))+import Data.Serialize (Serialize (..), getWord8, putWord8)+import Data.Serialize.Get (Get, getByteString, lookAhead, skip) import Data.Serialize.IEEE754--import qualified Data.ByteString as B-import qualified Data.ByteString.UTF8 as UTF8 ( fromString, toString )-import Data.Int ( Int8, Int16, Int32, Int64 )+import Data.Serialize.Put (Put, putByteString)+import Data.Text.Encoding (encodeUtf8, decodeUtf8) -import Control.Applicative ( (<$>) )-import Control.Monad ( forM_, replicateM )+import qualified Data.ByteString as B+import qualified Data.Text as T -- | Tag types listed in order so that deriving 'Enum' will assign -- them the correct number for the binary type field.-data TagType = EndType- | ByteType- | ShortType- | IntType- | LongType- | FloatType- | DoubleType- | ByteArrayType- | StringType- | ListType- | CompoundType- deriving (Show, Eq, Enum)+data TagType+ = ByteType+ | ShortType+ | IntType+ | LongType+ | FloatType+ | DoubleType+ | ByteArrayType+ | StringType+ | ListType+ | CompoundType+ | IntArrayType+ deriving (Show, Eq, Enum) instance Serialize TagType where- get = fmap (toEnum . fromIntegral) getWord8- put = putWord8 . fromIntegral . fromEnum+ get = fmap (toEnum . pred . fromIntegral) getWord8+ put = putWord8 . fromIntegral . succ . fromEnum --- | Primitive representation of NBT data. This type contains both named--- and unnamed variants; a 'Nothing' name signifies an unnamed tag, so--- when serialized, neither the name nor the type tag will be put.-data NBT = EndTag- | ByteTag (Maybe String) Int8- | ShortTag (Maybe String) Int16- | IntTag (Maybe String) Int32- | LongTag (Maybe String) Int64- | FloatTag (Maybe String) Float- | DoubleTag (Maybe String) Double- | ByteArrayTag (Maybe String) Int32 B.ByteString- | StringTag (Maybe String) Int16 String- | ListTag (Maybe String) TagType Int32 [NBT]- | CompoundTag (Maybe String) [NBT]- deriving (Show, Eq)+-- | Primitive representation of NBT data. This type contains only the data+-- part, since named nodes can only exist inside compound nodes.+data NBT = NBT T.Text NbtContents+ deriving (Show, Eq) -instance Serialize NBT where- get = get >>= \ty ->- case ty of- EndType -> return EndTag- ByteType -> named getByte- ShortType -> named getShort- IntType -> named getInt- LongType -> named getLong- FloatType -> named getFloat- DoubleType -> named getDouble- ByteArrayType -> named getByteArray- StringType -> named getString- ListType -> named getList- CompoundType -> named getCompound- where- -- name combinators- named f = getName >>= f- unnamed f = f Nothing- -- name and payload readers- getName = do- strTag <- unnamed getString- case strTag of- StringTag Nothing _ str -> return $ Just str- _ -> error "found tag with unparseable name"- getByte n = ByteTag n <$> get- getShort n = ShortTag n <$> get- getInt n = IntTag n <$> get- getLong n = LongTag n <$> get- getFloat n = FloatTag n <$> getFloat32be- getDouble n = DoubleTag n <$> getFloat64be- getByteArray n = do- len <- get :: Get Int32- ByteArrayTag n len <$> getByteString (toEnum $ fromEnum len)- getString n = do- len <- get :: Get Int16- StringTag n len <$> UTF8.toString - <$> getByteString (toEnum $ fromEnum len)- getList n = do- ty <- get :: Get TagType- len <- get :: Get Int32- ListTag n ty len <$>- replicateM (toEnum $ fromEnum len) (getListElement ty)- getListElement ty = - case ty of- EndType -> error "TAG_End can't appear in a list"- ByteType -> unnamed getByte- ShortType -> unnamed getShort- IntType -> unnamed getInt- LongType -> unnamed getLong- FloatType -> unnamed getFloat- DoubleType -> unnamed getDouble- ByteArrayType -> unnamed getByteArray- StringType -> unnamed getString- ListType -> unnamed getList- CompoundType -> unnamed getCompound- getCompound n = CompoundTag n <$> getCompoundElements- getCompoundElements = do- ty <- lookAhead get- case ty of- -- if we see an end tag, drop it and end the list- EndType -> skip 1 >> return []- -- otherwise keep reading- _ -> get >>= \tag -> (tag :) <$> getCompoundElements- put tag = - case tag of - -- named cases - EndTag -> put EndType- ByteTag (Just n) b -> - put ByteType >> putName n >> putByte b- ShortTag (Just n) s -> - put ShortType >> putName n >> putShort s- IntTag (Just n) i -> - put IntType >> putName n >> putInt i- LongTag (Just n) l ->- put LongType >> putName n >> putLong l- FloatTag (Just n) f ->- put FloatType >> putName n >> putFloat f- DoubleTag (Just n) d ->- put DoubleType >> putName n >> putDouble d- ByteArrayTag (Just n) len bs ->- put ByteArrayType >> putName n >> putByteArray len bs- StringTag (Just n) _len str ->- put StringType >> putName n >> putString str- ListTag (Just n) ty len ts ->- put ListType >> putName n >> putList ty len ts- CompoundTag (Just n) ts ->- put CompoundType >> putName n >> putCompound ts- -- unnamed cases- -- EndTag can't be unnamed- ByteTag Nothing b -> putByte b- ShortTag Nothing s -> putShort s- IntTag Nothing i -> putInt i- LongTag Nothing l -> putLong l- FloatTag Nothing f -> putFloat f- DoubleTag Nothing d -> putDouble d- ByteArrayTag Nothing len bs -> putByteArray len bs- StringTag Nothing _len str -> putString str- ListTag Nothing ty len ts -> putList ty len ts- CompoundTag Nothing ts -> putCompound ts- where- -- name and payload helpers- putName = putString- putByte = put- putShort = put- putInt = put- putLong = put- putFloat = putFloat32be- putDouble = putFloat64be- putByteArray len bs = put len >> putByteString bs- putString str = let bs = UTF8.fromString str - len = fromIntegral (B.length bs)- in put (len :: Int16) >> putByteString bs- putList ty len ts = put ty >> put len >> forM_ ts put- putCompound ts = forM_ ts put >> put EndTag+data NbtContents+ = ByteTag Int8+ | ShortTag Int16+ | IntTag Int32+ | LongTag Int64+ | FloatTag Float+ | DoubleTag Double+ | ByteArrayTag (UArray Int32 Int8)+ | StringTag T.Text+ | ListTag TagType (Array Int32 NbtContents)+ | CompoundTag [NBT]+ | IntArrayTag (UArray Int32 Int32)+ deriving (Show, Eq) +getByType :: TagType -> Get NbtContents+getByType ByteType = ByteTag <$> get+getByType ShortType = ShortTag <$> get+getByType IntType = IntTag <$> get+getByType LongType = LongTag <$> get+getByType FloatType = FloatTag <$> getFloat32be+getByType DoubleType = DoubleTag <$> getFloat64be+getByType ByteArrayType = do+ len <- get :: Get Int32+ ByteArrayTag <$> getArrayElements len get+getByType StringType = do+ len <- get :: Get Int16+ StringTag . decodeUtf8 <$> getByteString (fromIntegral len)+getByType ListType = do+ subType <- get :: Get TagType+ len <- get :: Get Int32+ ListTag subType <$> getArrayElements len (getByType subType)+getByType CompoundType = CompoundTag <$> getCompoundElements+ where+ getCompoundElements = do+ ty <- lookAhead (get :: Get Int8)+ if ty == 0+ -- if we see an end tag, drop it and end the list+ then skip 1 >> return []+ -- otherwise keep reading+ else get >>= \tag -> (tag :) <$> getCompoundElements+getByType IntArrayType = do+ len <- get :: Get Int32+ IntArrayTag <$> getArrayElements len get +getArrayElements :: (IArray arr a, Integral len, Ix len)+ => len -> Get a -> Get (arr len a)+getArrayElements len getter = do+ elts <- replicateM (fromIntegral len) getter+ return $ listArray (0, len - 1) elts++putContents :: NbtContents -> Put+putContents tag = case tag of+ ByteTag b -> put b+ ShortTag s -> put s+ IntTag i -> put i+ LongTag l -> put l+ FloatTag f -> putFloat32be f+ DoubleTag d -> putFloat64be d+ ByteArrayTag bs -> put (int32ArraySize bs) >> mapM_ put (elems bs)+ StringTag str -> let bs = encodeUtf8 str + len = fromIntegral (B.length bs)+ in put (len :: Int16) >> putByteString bs+ ListTag ty ts -> put ty >> put (int32ArraySize ts) >> mapM_ putContents (elems ts)+ CompoundTag ts -> forM_ ts put >> put (0 :: Int8)+ IntArrayTag is -> put (int32ArraySize is) >> mapM_ put (elems is)+ where+ int32ArraySize :: (IArray a e) => a Int32 e -> Int32+ int32ArraySize = fromIntegral . rangeSize . bounds++instance Serialize NBT where+ get = do+ ty <- get+ StringTag nm <- getByType StringType+ co <- getByType ty+ return $ NBT nm co+ put (NBT name tag) = do+ put (typeOf tag)+ putContents (StringTag name)+ putContents tag++typeOf :: NbtContents -> TagType+typeOf (ByteTag _) = ByteType+typeOf (ShortTag _) = ShortType+typeOf (IntTag _) = IntType+typeOf (LongTag _) = LongType+typeOf (FloatTag _) = FloatType+typeOf (DoubleTag _) = DoubleType+typeOf (ByteArrayTag _) = ByteArrayType+typeOf (StringTag _) = StringType+typeOf (ListTag _ _) = ListType+typeOf (CompoundTag _) = CompoundType+typeOf (IntArrayTag _) = IntArrayType
+ test/RoundTrip.hs view
@@ -0,0 +1,87 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main where++import qualified Codec.Compression.GZip as GZip+import Control.Applicative+import Control.Monad+import qualified Data.Array.IArray as IA+import Data.Array.Unboxed (listArray)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import Data.Int (Int32)+import Data.NBT+import Data.Serialize (decode, encode)+import qualified Data.Text as T+import Paths_nbt (getDataFileName)+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2+import Test.HUnit+import Test.QuickCheck++instance Arbitrary TagType where+ arbitrary = toEnum <$> choose (0, 10)++eitherErr :: (Either String a -> a)+eitherErr = either error id++prop_TagType :: TagType -> Bool+prop_TagType ty = eitherErr (decode (encode ty)) == ty++instance Arbitrary NBT where+ arbitrary = arbitrary >>= \(ty, nm) -> NBT (T.pack nm) <$> mkArb ty+ where+ mkArb ty =+ case ty of+ ByteType -> ByteTag <$> arbitrary+ ShortType -> ShortTag <$> arbitrary+ IntType -> IntTag <$> arbitrary+ LongType -> LongTag <$> arbitrary+ FloatType -> FloatTag <$> arbitrary+ DoubleType -> DoubleTag <$> arbitrary+ ByteArrayType -> do+ len <- fromIntegral <$> choose (0, 100 :: Int) :: Gen Int32+ ws <- replicateM (fromIntegral len) arbitrary+ return $ ByteArrayTag . listArray (0, len - 1) $ ws+ StringType -> do+ n <- choose (0, 100) :: Gen Int+ str <- T.pack <$> replicateM (fromIntegral n) arbitrary+ return $ StringTag str+ ListType -> do+ subTy <- arbitrary+ len <- fromIntegral <$> choose (0, 11 :: Int) :: Gen Int32+ ts <- replicateM (fromIntegral len) (mkArb subTy)+ return $ ListTag subTy . IA.listArray (0, len - 1) $ ts+ CompoundType -> do+ n <- choose (0, 11)+ ts <- replicateM n arbitrary+ return $ CompoundTag ts+ IntArrayType -> do+ len <- fromIntegral <$> choose (0, 100 :: Int) :: Gen Int32+ IntArrayTag+ . listArray (0, len-1)+ <$> (vector $ fromIntegral len)++prop_NBTroundTrip :: NBT -> Bool+prop_NBTroundTrip nbt = eitherErr (decode (encode nbt)) == nbt++testWorld :: IO ()+testWorld = do+ fileName <- getDataFileName "test/testWorld/level.dat"+ fileL <- GZip.decompress <$> L.readFile fileName+ let file = B.pack (L.unpack fileL)+ dec = eitherErr (decode file) :: NBT+ enc = encode dec+ enc @?= file+ eitherErr (decode enc) @?= dec++tests :: [Test.Framework.Test]+tests = [+ testProperty "Tag roundtrip" prop_TagType+ , testProperty "NBT roundtrip" prop_NBTroundTrip+ , testCase "testWorld roundtrip" testWorld+ ]++main :: IO ()+main = defaultMain tests
− test/Tests.hs
@@ -1,81 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Main where--import Data.NBT--import qualified Codec.Compression.GZip as GZip-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import Data.Serialize ( Serialize (..), decode, encode )-import qualified Data.ByteString.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)--eitherErr = either error id--prop_TagType :: TagType -> Bool-prop_TagType ty = eitherErr (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 = eitherErr (decode (encode nbt)) == nbt--testWorld = do- fileL <- GZip.decompress <$> L.readFile "testWorld/level.dat"- let file = B.pack (L.unpack fileL)- dec = eitherErr (decode file) :: NBT- enc = encode dec- enc @?= file - eitherErr (decode enc) @?= dec--tests = [- testProperty "Tag roundtrip" prop_TagType- , testProperty "NBT roundtrip" prop_NBTroundTrip- , testCase "testWorld roundtrip" testWorld- ]--main = defaultMain tests
− test/nbt-tests.cabal
@@ -1,23 +0,0 @@-Name: nbt-tests-Version: 0.1-Homepage: http://github.com/acfoltzer/nbt-License: BSD3-Author: Adam C. Foltzer-Maintainer: acfoltzer@gmail.com-Category: Testing-Build-type: Simple-Cabal-version: >=1.8--Executable nbt-tests- Main-is: Tests.hs- Build-depends: base == 4.*,- bytestring == 0.9.*,- cereal >= 0.3.4 && < 0.4,- zlib == 0.5.*,- utf8-string == 0.3.*,- HUnit == 1.2.*,- QuickCheck == 2.4.*,- test-framework == 0.4.*,- test-framework-quickcheck2 == 0.2.*,- test-framework-hunit == 0.2.*,- nbt == 0.3