nbt (empty) → 0.2
raw patch · 10 files changed
+362/−0 lines, 10 filesdep +basedep +binarydep +bytestringsetup-changedbinary-added
Dependencies added: base, binary, bytestring, data-binary-ieee754, utf8-string
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- nbt.cabal +36/−0
- src/Data/NBT.hs +193/−0
- test/Tests.hs +78/−0
- test/nbt-tests.cabal +23/−0
- test/testWorld/level.dat binary
- test/testWorld/region/r.-1.-1.mcr binary
- test/testWorld/region/r.0.-1.mcr binary
- test/testWorld/region/r.0.0.mcr too large to diff
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2010-2011, Adam C. Foltzer++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Adam C. Foltzer nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ nbt.cabal view
@@ -0,0 +1,36 @@+Name: nbt+Version: 0.2+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.+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+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++source-repository head+ type: git+ location: git://github.com/acfoltzer/bit-vector.git++Library+ Exposed-modules: Data.NBT+ hs-source-dirs: src+ Build-depends: base == 4.*, + binary == 0.5.*,+ bytestring == 0.9.*,+ data-binary-ieee754 == 0.4.*,+ utf8-string == 0.3.*+ ghc-options: -Wall -O2
+ src/Data/NBT.hs view
@@ -0,0 +1,193 @@+{-# OPTIONS_GHC -Wall #-}++{- |++Module : Data.NBT+Copyright : (c) Adam C. Foltzer 2010-2011+License : BSD3++Maintainer : acfoltzer@gmail.com+Stability : experimental+Portability : portable++Defines a Haskell representation of Minecraft's NBT binary data+format, along with instances of 'Data.Serialize.Serialize'. See the+NBT specification for details:+<https://raw.github.com/acfoltzer/nbt/master/NBT-spec.txt>.++-}++module Data.NBT where++import Data.Binary ( + Binary (..)+ , getWord8+ , putWord8 + )+import Data.Binary.Get ( + Get+ , getLazyByteString+ , lookAhead+ , skip+ )+import Data.Binary.Put ( putLazyByteString )+import Data.Binary.IEEE754++import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.UTF8 as UTF8 ( fromString, toString )+import Data.Int ( Int8, Int16, Int32, Int64 )++import Control.Applicative ( (<$>) )+import Control.Monad ( forM_, replicateM )++-- | 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)++instance Binary TagType where+ get = fmap (toEnum . fromIntegral) getWord8+ put = putWord8 . fromIntegral . 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)++instance Binary 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 <$> getLazyByteString (toEnum $ fromEnum len)+ getString n = do+ len <- get :: Get Int16+ StringTag n len <$> UTF8.toString + <$> getLazyByteString (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 n = putString n+ putByte = put+ putShort = put+ putInt = put+ putLong = put+ putFloat = putFloat32be+ putDouble = putFloat64be+ putByteArray len bs = put len >> putLazyByteString bs+ putString str = let bs = UTF8.fromString str + len = fromIntegral (B.length bs)+ in put (len :: Int16) >> putLazyByteString bs+ putList ty len ts = put ty >> put len >> forM_ ts put+ putCompound ts = forM_ ts put >> put EndTag++
+ test/Tests.hs view
@@ -0,0 +1,78 @@+{-# 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
+ test/nbt-tests.cabal view
@@ -0,0 +1,23 @@+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.*,+ binary == 0.5.*,+ 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
+ test/testWorld/level.dat view
binary file changed (absent → 652 bytes)
+ test/testWorld/region/r.-1.-1.mcr view
binary file changed (absent → 413696 bytes)
+ test/testWorld/region/r.0.-1.mcr view
binary file changed (absent → 1859584 bytes)
+ test/testWorld/region/r.0.0.mcr view
file too large to diff