nbt 0.5.1 → 0.6
raw patch · 3 files changed
+119/−74 lines, 3 filesdep ~HUnitdep ~QuickCheckdep ~base
Dependency ranges changed: HUnit, QuickCheck, base, bytestring, cereal, zlib
Files
- nbt.cabal +8/−8
- src/Data/NBT.hs +100/−63
- test/RoundTrip.hs +11/−3
nbt.cabal view
@@ -1,5 +1,5 @@ Name: nbt-Version: 0.5.1+Version: 0.6 Synopsis: A parser/serializer for Minecraft's Named Binary Tag (NBT) data format. Description: This package includes a data type for the NBT file@@ -30,8 +30,8 @@ hs-source-dirs: src default-language: Haskell2010 Build-depends: base == 4.*,- bytestring >= 0.9 && < 0.11,- cereal >= 0.3.4 && < 0.5,+ bytestring >= 0.9,+ cereal >= 0.3.4, text, array >= 0.4 ghc-options: -Wall@@ -43,12 +43,12 @@ hs-source-dirs: test default-language: Haskell2010 Build-depends: base == 4.*,- bytestring >= 0.9 && < 0.11,- cereal >= 0.3.4 && < 0.5,- zlib == 0.5.*,+ bytestring >= 0.9,+ cereal >= 0.3.4,+ zlib >= 0.5, text,- HUnit == 1.2.*,- QuickCheck >= 2.4 && < 3.0,+ HUnit >= 1.2,+ QuickCheck >= 2.4, test-framework, test-framework-quickcheck2, test-framework-hunit,
src/Data/NBT.hs view
@@ -1,5 +1,10 @@+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} +#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif+ {- | Module : Data.NBT@@ -17,16 +22,16 @@ -} -module Data.NBT where+module Data.NBT (TagType(..), NBT(..), NbtContents(..), typeOf) where -import Control.Applicative ((<$>))-import Control.Monad (forM_, replicateM)+import Control.Monad (replicateM) import Data.Array.IArray (Array, IArray (bounds)) import Data.Array.Unboxed (UArray, listArray, elems)+import Data.Foldable (traverse_) 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.Get (Get, getByteString) import Data.Serialize.IEEE754 import Data.Serialize.Put (Put, putByteString) import Data.Text.Encoding (encodeUtf8, decodeUtf8)@@ -34,6 +39,10 @@ import qualified Data.ByteString as B import qualified Data.Text as T +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>),(<*>))+#endif+ -- | Tag types listed in order so that deriving 'Enum' will assign -- them the correct number for the binary type field. data TagType@@ -69,48 +78,80 @@ | DoubleTag Double | ByteArrayTag (UArray Int32 Int8) | StringTag T.Text- | ListTag TagType (Array Int32 NbtContents)+ | ListTag (Array Int32 NbtContents) | CompoundTag [NBT] | IntArrayTag (UArray Int32 Int32) deriving (Show, Eq) getByType :: TagType -> Get NbtContents-getByType EndType = fail "Can not get end-marker elements"-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- if ty == EndType- -- 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+getByType EndType = fail "Can not get end-marker elements"+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 = ByteArrayTag <$> getArrayElements get+getByType StringType = StringTag <$> getString+getByType ListType = ListTag <$> getList+getByType CompoundType = CompoundTag <$> getCompoundElements+getByType IntArrayType = IntArrayTag <$> getArrayElements get -getArrayElements :: (IArray arr a, Integral len, Ix len)- => len -> Get a -> Get (arr len a)-getArrayElements len getter = do+getList :: Get (Array Int32 NbtContents)+getList = do+ subType <- get+ getArrayElements (getByType subType)++putList :: Array Int32 NbtContents -> Put+putList ts = do+ ty <- case elems ts of+ [] -> return EndType+ x:xs | all (\e -> typeOf e == ty) xs -> return ty+ | otherwise -> fail "Attempted to write heterogeneous list"+ where ty = typeOf x+ put ty+ putArray putContents ts++getCompoundElements :: Get [NBT]+getCompoundElements = do+ ty <- get+ case ty of+ EndType -> return []+ _ -> do x <- getNBT ty+ xs <- getCompoundElements+ return (x:xs)++putCompoundElements :: [NBT] -> Put+putCompoundElements xs = traverse_ put xs >> put EndType++getArrayElements :: IArray a e => Get e -> Get (a Int32 e)+getArrayElements getter = do+ len <- get elts <- replicateM (fromIntegral len) getter- return $ listArray (0, len - 1) elts+ return (listArray (0, len - 1) elts) +getBytes16 :: Get B.ByteString+getBytes16 = do+ len <- get :: Get Int16+ getByteString (fromIntegral len)++putBytes16 :: B.ByteString -> Put+putBytes16 bs = do+ put (fromIntegral (B.length bs) :: Int16)+ putByteString bs++getString :: Get T.Text+getString = decodeUtf8 <$> getBytes16++putString :: T.Text -> Put+putString = putBytes16 . encodeUtf8++putArray :: (Ix i, IArray a e) => (e -> Put) -> a i e -> Put+putArray putter a = do+ let len = rangeSize (bounds a)+ put (fromIntegral len :: Int32)+ traverse_ putter (elems a)+ putContents :: NbtContents -> Put putContents tag = case tag of ByteTag b -> put b@@ -119,37 +160,33 @@ 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+ ByteArrayTag bs -> putArray put bs+ StringTag str -> putString str+ ListTag ts -> putList ts+ CompoundTag ts -> putCompoundElements ts+ IntArrayTag is -> putArray put is instance Serialize NBT where get = do ty <- get- StringTag nm <- getByType StringType- co <- getByType ty- return $ NBT nm co+ getNBT ty put (NBT name tag) = do put (typeOf tag)- putContents (StringTag name)+ putString name putContents tag +getNBT :: TagType -> Get NBT+getNBT ty = NBT <$> getString <*> getByType ty+ 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+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
@@ -1,9 +1,13 @@+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif+ 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)@@ -19,6 +23,10 @@ import Test.HUnit import Test.QuickCheck +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif+ instance Arbitrary TagType where arbitrary = toEnum <$> choose (1, 11) -- don't arbitrarily pick end type, it has special meaning@@ -52,10 +60,10 @@ return (StringTag str) ListType -> do len <- choose (0, 10) -- list types nest, don't get too big- subTy <- if len == 0 then return EndType else arbitrary+ subTy <- arbitrary ts <- replicateM len (mkArb subTy) let a = IA.listArray (0, fromIntegral len - 1) ts- return (ListTag subTy a)+ return (ListTag a) CompoundType -> do len <- choose (0, 10) -- compound types nest, don't get too big ts <- replicateM len arbitrary