binary-file 0.15.9 → 0.15.10

raw patch · 6 files changed

+26/−31 lines, 6 files

Files

• binary-file.cabal +2/−2
• examples/readPNG.hs +3/−18
• src/File/Binary/Instances.hs +1/−1
• src/File/Binary/Instances/BigEndian.hs +7/−2
• src/File/Binary/Instances/LittleEndian.hs +8/−3
• src/File/Binary/Quote.hs +5/−5

@@ -2,7 +2,7 @@ cabal-version:	>= 1.8  name:		binary-file-version:	0.15.9+version:	0.15.10 stability:	experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -90,7 +90,7 @@ source-repository	this     type:	git     location:	git://github.com/YoshikuniJujo/binary-file.git-    tag:	0.15.9+    tag:	0.15.10  library     hs-source-dirs:	src

@@ -2,7 +2,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  import Prelude hiding (concat)-import File.Binary (binary, Field(..), Binary(..))+import File.Binary (binary, Field(..)) import File.Binary.Instances () import File.Binary.Instances.BigEndian () import CRC (crc)@@ -12,9 +12,8 @@ import qualified Data.ByteString as BS (ByteString, length, readFile, writeFile) import qualified Data.ByteString.Char8 as BSC (unpack) import Data.ByteString.Lazy-	(ByteString, pack, unpack, concat, toChunks, fromChunks)-import Data.Word (Word8, Word32)-import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR)+	(ByteString, concat, toChunks, fromChunks)+import Data.Word (Word32) import Data.Monoid (mconcat) import Control.Applicative ((<$>)) import Control.Arrow(first)@@ -94,20 +93,6 @@ 4{Word32}:chunkCRC  |]--instance Field Word32 where-	type FieldArgument Word32 = Int-	toBinary n = makeBinary . pack . intToWords n-	fromBinary n = return . first (wordsToInt . unpack) . getBytes n--intToWords :: (Bits i, Integral i) => Int -> i -> [Word8]-intToWords = itw []-	where-	itw r 0 _ = r-	itw r n i = itw (fromIntegral (i .&. 0xff) : r) (n - 1) (i `shiftR` 8)--wordsToInt :: Bits i => [Word8] -> i-wordsToInt = foldl (\r w -> r `shiftL` 8 .|. fromIntegral w) 0  data ChunkBody 	= ChunkIHDR IHDR

@@ -44,7 +44,7 @@ whole e f = runStateT $ do 	emp <- gets (== e) 	if emp then return [] else-		(:) <$> (StateT f) <*> (StateT $ whole e f)+		(:) <$> StateT f <*> (StateT $ whole e f)  -------------------------------------------------------------------------------- 

@@ -5,7 +5,7 @@  import File.Binary.Classes (Field(..), Binary(..), pop, push) import Data.ByteString.Lazy (pack, unpack)-import Data.Word (Word8)+import Data.Word (Word8, Word32) import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR) import Control.Arrow (first) @@ -21,6 +21,11 @@ 	fromBinary n = return . first (wordsToInt . unpack) . getBytes n 	toBinary n = makeBinary . pack . intToWords n +instance Field Word32 where+	type FieldArgument Word32 = Int+	fromBinary n = return . first (wordsToInt . unpack) . getBytes n+	toBinary n = makeBinary . pack . intToWords n+ wordsToInt :: Bits i => [Word8] -> i wordsToInt = foldl (\i w -> i `shiftL` 8 .|. fromIntegral w) 0 @@ -54,7 +59,7 @@ fb :: (Bits f, Binary b) => Int -> f -> ([Bool], b) -> (f, ([Bool], b)) fb 0 r bb = (r, bb) fb n r ([], b) = fb n r $ pop b-fb n r (bs, b) = fb (n - 1) (r `shiftL` 1 .|. (fromEnum' $ last bs)) (init bs, b)+fb n r (bs, b) = fb (n - 1) (r `shiftL` 1 .|. fromEnum' (last bs)) (init bs, b)  ctb :: (Bits f, Integral f, Binary b) => Int -> f -> ([Bool], b) -> ([Bool], b) ctb 0 _ r = r

@@ -5,7 +5,7 @@  import File.Binary.Classes (Field(..), Binary(..), pop, push) import Data.ByteString.Lazy (pack, unpack)-import Data.Word (Word8)+import Data.Word (Word8, Word32) import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR) import Control.Arrow (first) import Control.Applicative@@ -15,6 +15,11 @@ 	fromBinary n = return . first (wordsToInt . unpack) . getBytes n 	toBinary n = makeBinary . pack . intToWords n +instance Field Word32 where+	type FieldArgument Word32 = Int+	fromBinary n = return . first (wordsToInt . unpack) . getBytes n+	toBinary n = makeBinary . pack . intToWords n+ instance Field Integer where 	type FieldArgument Integer = Int 	fromBinary n = return . first (wordsToInt . unpack) . getBytes n@@ -32,7 +37,7 @@ 	fromBits () ([], bin) = fromBits () $ pop bin 	fromBits () (b : bs, bin) = return (b, (bs, bin)) 	consToBits () b (bs, bin)-		| length bs == 7 = ([], push ((b : bs), bin))+		| length bs == 7 = ([], push (b : bs, bin)) 		| otherwise = (b : bs, bin)  data BitsInt = BitsInt { bitsInt :: Int } deriving Show@@ -43,7 +48,7 @@ 	fromBits n ([], bin) = fromBits n $ pop bin 	fromBits n (b : bs, bin) = first 		(BitsInt . (fromEnum b .|.) . (`shiftL` 1) . bitsInt) <$>-		(fromBits (n - 1) (bs, bin))+		fromBits (n - 1) (bs, bin) 	consToBits 0 _ bb = bb 	consToBits n (BitsInt f) bb = let 		(bs, bin) = consToBits (n - 1) (BitsInt $ f `shiftR` 1) bb in

@@ -72,11 +72,11 @@ readf' size (Left val) = do 	(bin, rts2) <- get 	[rv, rest, bin'] <- liftQ $ mapM newName ["_rv", "_rst", "_bin'"]-	put $ (varE bin', rts2)+	put (varE bin', rts2) 	let lit = constant 		((`sigE` conT ''Integer) . litE . integerL) 		(appE (varE 'pack) . litE . stringL)-		(\b -> if b then conE 'True else conE 'False)+		(\b -> conE (if b then 'True else 'False)) 		val 	return [bindS (tupP [varP rv, varP rest]) 				(appsE [varE 'fromBits, size rts2, bin]),@@ -88,7 +88,7 @@ readf' size (Right (var, _)) = do 	(bin, rts2) <- get 	[bin', tmp] <- liftQ $ mapM newName ["_bin'", "_tmp"]-	put $ (varE bin', (var, VarE tmp) : rts2)+	put (varE bin', (var, VarE tmp) : rts2) 	liftW $ tell [(var, VarE tmp)] 	return [bindS (tildeP $ tupP [varP tmp, varP bin']) $ 		appsE [varE 'fromBits, size rts2, bin]]@@ -96,7 +96,7 @@ writing :: [FieldExp] -> String -> [SItem] -> ClauseQ writing fe argn items = do 	[arg, dat, bin0] <- mapM newName ["_arg", "_dat", "bin0"]-	let fe' = map (\n -> (n, VarE n `AppE` VarE dat)) $ map fst fe+	let fe' = map ((\n -> (n, VarE n `AppE` VarE dat)) . fst) fe 	flip (clause [varP arg, varP dat, varP bin0]) [] $ normalB $ 		appE (appsE [varE 'foldr, varE '($), varE bin0]) $ listE $ 			(<$> items) $ writef dat@@ -107,7 +107,7 @@ writef _ size (Left val) = varE 'consToBits `appE` size `appE` constant 	((`sigE` conT ''Integer) . litE . integerL) 	(appE (varE 'pack) . litE . stringL)-	(\b -> if b then conE 'True else conE 'False)+	(\b -> conE (if b then 'True else 'False)) 	val writef dat size (Right (rec, _)) = 	varE 'consToBits `appE` size `appE` (varE rec `appE` varE dat)