binary-file 0.12.8 → 0.13.1

raw patch · 8 files changed

+327/−229 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• binary-file.cabal +26/−35
• examples/readPNG.hs +160/−70
• src/Classes.hs +78/−78
• src/File/Binary.hs +4/−4
• src/File/Binary/Data/BigEndian.hs +9/−6
• src/File/Binary/Data/LittleEndian.hs +8/−5
• src/ParseBinaryStructure.hs +5/−4
• src/QuoteBinaryStructure.hs +37/−27

@@ -2,7 +2,7 @@ cabal-version:	>= 1.8  name:		binary-file-version:	0.12.8+version:	0.13.1 stability:	experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -14,65 +14,56 @@ synopsis:	read/write binary file description: -    > runghc -XQuasiQuotes exam.hs some.bmp out.bmp+    > runghc -XQuasiQuotes -XTypeFamilies -XFlexibleInstances exam.hs some.bmp     .     exam.hs:     .     > import File.Binary     > import File.Binary.Data.LittleEndian     > import System.Environment-    > import Data.ByteString as BS+    > import Data.ByteString.Lazy as BSL     >     > main = do-    >	[inf, outf] <- getArgs-    >+    >	[inf] <- getArgs     >   cnt <- BS.readFile inf-    >	let bmp = readBitmap $ cnt `BS.append` replicate 20 ' '+    >	let (bmp, rest) = fromBinary () cnt :: (Bitmap, String)     >	print bmp     >-    >	let out = writeBitmap bmp {-    >		authorFirst = "Yoshikuni ",-    >		authorSecond = "Jujo      "-    >	 }-    >   BS.writeFile outf out-    >-    > instance RetType (Int, Int, Int) where-    >    type Argument (Int, Int, Int) = ()-    >    fromType _ (b, g, r) = cc $ [-    >        fromType 1 b, fromType 1 g, fromType 1 r, zero]-    >    toType _ str = let-    >        (b, rest) = toType 1 str+    > instance Field (Int, Int, Int) where+    >    type FieldArgument (Int, Int, Int) = ()+    >    fromBinary _ s = let+    >        (b, rest) = toType 1 s     >        (g, rest') = toType 1 rest     >        (r, rest'') = toType 1 rest' in-    >        ((b, g, r), dp 1 rest'')+    >        ((b, g, r), snd $ getBytes 1 1 rest'')+    >    toBinary _ (b, g, r) = concatBinary [+    >        fromType 1 b, fromType 1 g, fromType 1 r,+    >        makeBinary $ BSL.singleton 0]     >     > [binary|     >     > Bitmap     >     > 2: "BM"-    > 4: fileSize+    > 4: file_size     > 2: 0     > 2: 0     > 4: offset     >     > 4: 40-    > 4: bitmapWidth-    > 4: bitmapHeight+    > 4: width+    > 4: height     > 2: 1-    > 2: bitsPerPixel-    > 4: compressionMethod-    > 4: imageSize-    > 4: horizontalResolution-    > 4: verticalResolution-    > 4: numberOfColors-    > 4: importantColors-    > ((), Just numberOfColors)<[(Int, Int, Int)]>: colors-    > imageSize<BS.ByteString>: image+    > 2: bits_per_pixel+    > 4: compression+    > 4: image_size+    > 4: resolutionH+    > 4: resolutionV+    > 4: color_num+    > 4: important_color_num+    > ((), Just color_num)<[(Int, Int, Int)]>: colors+    > ((), image_size)<String>: image     >-    > ((), Just 10)<String>: authorFirst-    > ((), Just 10)<String>: authorSecond-    >      > |]     . @@ -85,7 +76,7 @@ source-repository	this     type:	git     location:	git://github.com/YoshikuniJujo/binary-file.git-    tag:	0.12.7+    tag:	0.13.1  library     hs-source-dirs:	src

@@ -5,35 +5,104 @@ import System.Environment import Data.Word import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BSLC+import Codec.Compression.Zlib+import CRC (crc)+import Control.Applicative  main = do 	[fin, fout] <- getArgs-	cnt <- readBinaryFile fin-	let (png, rest) = readPNG () cnt-	print $ png-	writeBinaryFile fout $ writePNG () png+--	cnt <- readBinaryFile fin+	cnt <- BS.readFile fin+	let (png, rest) = fromBinary () cnt -test = readPNG () `fmap` readBinaryFile "tmp/out.png"+	putStrLn $ take 1000 (show png) ++ "..." -instance RetType Word32 where-	type Argument Word32 = Int-	fromType n = rev . fi n . fromIntegral-	toType n s = (fromIntegral $ ti $ rev $ tk n s, dp n s)+--	writeBinaryFile fout $ toBinary () png+--	BS.writeFile fout $ writePNG () png -instance RetType Chank where-	type Argument Chank = ()-	fromType = writeChank-	toType = readChank+	let	ChankIDAT idt = chankData $ chanks png !! 6+		dat = idat idt+{- ---+		dec = decompress dat+		recomp = compressWith defaultCompressParams {+			compressLevel = bestCompression,+--			compressLevel = bestSpeed,+			compressWindowBits = WindowBits 15+		 } dec+{-+	print $ length dat+	print $ length recomp+-} -instance RetType (Int, Int, Int) where-	type Argument (Int, Int, Int) = ()-	fromType _ (b, g, r) = cc [fromType 1 b, fromType 1 g, fromType 1 r]-	toType _ s = let-		(b, rest) = toType 1 s-		(g, rest') = toType 1 rest-		(r, rest'') = toType 1 rest' in-		((b, g, r), rest'')+	let	chank6 = chanks png !! 6+		newDat = chank6 {+			chankSize = fromIntegral $ BSL.length recomp,+			chankData = ChankIDAT $ IDAT recomp,+			chankCRC = crc $ "IDAT" ++ BSL.unpack recomp+		 }+		new = png {+			chanks = take 6 (chanks png) ++ [newDat] +++				drop 7 (chanks png)+		 }+{-+	print new+-} +	print $ dat == recomp+--- -}++--	BS.writeFile fout $ toBinary () new++	let	dat = makeData png+		decomp = decompress dat+		recomp = compressWith defaultCompressParams {+			compressLevel = bestCompression,+--			compressLevel = bestSpeed,+			compressWindowBits = WindowBits 10+		 } decomp+		newData = makeDataChank recomp+		newnew = png {+			chanks = headerChanks png ++ newData +++				footerChanks png+		 }+{-+		newnew = png {+			chanks = head (chanks png) : newData +++				[last $ chanks png]+		 }+-}+	BS.writeFile fout $ toBinary () newnew+	print $ dat == recomp++headerChanks :: PNG -> [Chank]+headerChanks PNG{ chanks = cs } =+	filter ((`notElem` ["IEND", "IDAT"]) . chankName) cs++footerChanks :: PNG -> [Chank]+footerChanks PNG{ chanks = cs } = filter ((== "IEND") . chankName) cs++makeData :: PNG -> BSL.ByteString+makeData PNG{ chanks = cs } =+	BSL.concat $ map (idat . cidat . chankData) $+		filter ((== "IDAT") . chankName) cs++makeDataChank :: BSL.ByteString -> [Chank]+makeDataChank = map makeOneDataChank . BSL.toChunks++makeOneDataChank :: BS.ByteString -> Chank+makeOneDataChank bs = Chank {+	chankSize = fromIntegral $ BS.length bs,+	chankName = "IDAT",+	chankData = ChankIDAT $ IDAT $ BSL.fromChunks [bs],+	chankCRC = crc $ "IDAT" ++ BSC.unpack bs+ }++test :: IO PNG+test = fst . fromBinary () <$> readBinaryFile "tmp/sample.png"+ [binary|  PNG@@ -47,6 +116,38 @@  |] +[binary|++Chank++4: chankSize+((), Just 4)<String>: chankName+(chankSize, chankName)<ChankBody>: chankData+4<Word32>:chankCRC++|]++instance Field Word32 where+	type FieldArgument Word32 = Int+	toBinary n = makeBinary . BSLC.pack . reverse . lintToBin n . fromIntegral+	fromBinary n s = (fromIntegral $ toIntgr $ BSL.reverse t, d)+		where+		(t, d) = getBytes n s++instance Field BSL.ByteString where+	type FieldArgument BSL.ByteString = Int+	toBinary _ = makeBinary -- . BS.concat . BSL.toChunks+	fromBinary n s = (t, d) -- (BSL.fromChunks [t], d)+		where+		(t, d) = getBytes n s++toIntgr :: BSL.ByteString -> Integer+toIntgr = mkNum . map fromIntegral . BSL.unpack++mkNum :: [Integer] -> Integer+mkNum [] = 0+mkNum (x : xs) = x + 2 ^ 8 * mkNum xs+ data ChankBody 	= ChankIHDR IHDR 	| ChankGAMA GAMA@@ -54,59 +155,47 @@ 	| ChankCHRM CHRM 	| ChankPLTE PLTE 	| ChankBKGD BKGD-	| ChankIDAT IDAT+	| ChankIDAT { cidat :: IDAT } 	| ChankTEXT TEXT 	| ChankIEND IEND 	| Others String 	deriving Show -instance RetType ChankBody where-	type Argument ChankBody = (Int, String)-	fromType _ (ChankIHDR ihdr) = writeIHDR () ihdr-	fromType _ (ChankGAMA gama) = writeGAMA () gama-	fromType _ (ChankSRGB srgb) = writeSRGB () srgb-	fromType _ (ChankCHRM chrm) = writeCHRM () chrm-	fromType (n, _) (ChankPLTE plte) = writePLTE n plte-	fromType _ (ChankBKGD bkgd) = writeBKGD () bkgd-	fromType (n, _) (ChankIDAT idat) = writeIDAT n idat-	fromType (n, _) (ChankTEXT text) = writeTEXT n text-	fromType _ (ChankIEND iend) = writeIEND () iend-	fromType (n, _) (Others str) = fromType ((), Just n) str-	toType (_, "IHDR") str = let (ihdr, rest) = readIHDR () str in+instance Field ChankBody where+	type FieldArgument ChankBody = (Int, String)+	toBinary _ (ChankIHDR ihdr) = toBinary () ihdr+	toBinary _ (ChankGAMA gama) = toBinary () gama+	toBinary _ (ChankSRGB srgb) = toBinary () srgb+	toBinary (n, _) (ChankCHRM chrm) = toBinary n chrm+	toBinary (n, _) (ChankPLTE plte) = toBinary n plte+	toBinary _ (ChankBKGD bkgd) = toBinary () bkgd+	toBinary (n, _) (ChankIDAT idat) = toBinary n idat+	toBinary (n, _) (ChankTEXT text) = toBinary n text+	toBinary _ (ChankIEND iend) = toBinary () iend+	toBinary (n, _) (Others str) = toBinary ((), Just n) str+	fromBinary (_, "IHDR") str = let (ihdr, rest) = fromBinary () str in 		(ChankIHDR ihdr, rest)-	toType (_, "gAMA") str = let (gama, rest) = readGAMA () str in+	fromBinary (_, "gAMA") str = let (gama, rest) = fromBinary () str in 		(ChankGAMA gama, rest)-	toType (_, "sRGB") str = let (srgb, rest) = readSRGB () str in+	fromBinary (_, "sRGB") str = let (srgb, rest) = fromBinary () str in 		(ChankSRGB srgb, rest)-	toType (_, "cHRM") str = let (chrm, rest) = readCHRM () str in+	fromBinary (n, "cHRM") str = let (chrm, rest) = fromBinary n str in 		(ChankCHRM chrm, rest)-	toType (n, "PLTE") str = let (plte, rest) = readPLTE n str in+	fromBinary (n, "PLTE") str = let (plte, rest) = fromBinary n str in 		(ChankPLTE plte, rest)-	toType (_, "bKGD") str = let (bkgd, rest) = readBKGD () str in+	fromBinary (_, "bKGD") str = let (bkgd, rest) = fromBinary () str in 		(ChankBKGD bkgd, rest)-	toType (n, "IDAT") str = let (idat, rest) = readIDAT n str in+	fromBinary (n, "IDAT") str = let (idat, rest) = fromBinary n str in 		(ChankIDAT idat, rest)-	toType (n, "tEXt") str = let (text, rest) = readTEXT n str in+	fromBinary (n, "tEXt") str = let (text, rest) = fromBinary n str in 		(ChankTEXT text, rest)-	toType (_, "IEND") str = let (iend, rest) = readIEND () str in+	fromBinary (_, "IEND") str = let (iend, rest) = fromBinary () str in 		(ChankIEND iend, rest)-	toType (n, _) str = let (others, rest) = toType ((), Just n) str in+	fromBinary (n, _) str = let (others, rest) = fromBinary ((), Just n) str in 		(Others others, rest)  [binary| -Chank--4: chankSize-((), Just 4)<String>: chankName-(chankSize, chankName)<ChankBody>: chankData--- ((), Just chankSize)<String>: chankData-4<Word32>:chankCRC--|]--[binary|- IHDR  4: width@@ -139,15 +228,10 @@  CHRM -4: chrm1-4: chrm2-4: chrm3-4: chrm4-4: chrm5-4: chrm6-4: chrm7-4: chrm8+<Int> +(4, Just (arg `div` 4))<[Int]>: chrms+ |]  [binary|@@ -160,6 +244,15 @@  |] +instance Field (Int, Int, Int) where+	type FieldArgument (Int, Int, Int) = ()+	toBinary _ (b, g, r) = concatBinary [toBinary 1 b, toBinary 1 g, toBinary 1 r]+	fromBinary _ s = let+		(b, rest) = fromBinary 1 s+		(g, rest') = fromBinary 1 rest+		(r, rest'') = fromBinary 1 rest' in+		((b, g, r), rest'')+ [binary|  BKGD@@ -174,7 +267,8 @@  <Int> -arg<BS.ByteString>: idat+arg<BSL.ByteString>: idat+--((), Just arg)<String>: idat  |] @@ -188,8 +282,4 @@  |] -[binary|--IEND--|]+[binary|IEND|]

@@ -1,20 +1,23 @@ {-# LANGUAGE-	TemplateHaskell, 	TypeSynonymInstances, 	FlexibleInstances, 	TypeFamilies, 	OverloadedStrings #-}  module Classes (-	RetType(..),-	Str(..),-	fii, fiiBE,-	tii, tiiBE,-	readInt+	Field(..),+	Binary(..),+	fii, tii,+	readInt,+	dp, fs, ti, cc,+	lintToBin ) where  import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BSLC import Data.Char+import Control.Arrow  data Endian = BigEndian | LittleEndian deriving Show @@ -23,85 +26,82 @@ readInt LittleEndian (c : cs) = fromIntegral (ord c) + 2 ^ (8 :: Integer) * readInt LittleEndian cs readInt BigEndian str = readInt LittleEndian $ reverse str -class RetType r where-	type Argument r-	fromType :: Str s => Argument r -> r -> s-	toType :: Str s => Argument r -> s -> (r, s)+class Field r where+	type FieldArgument r+	fromBinary :: Binary s => FieldArgument r -> s -> (r, s)+	toBinary :: Binary s => FieldArgument r -> r -> s -instance RetType r => RetType [r] where-	type Argument [r] = (Argument r, Maybe Int)-	fromType (a, _) rs = cc $ map (fromType a) rs-	toType (a, Just b) s = (b `times` toType a) s-	toType (a, Nothing) s = whole (toType a) s+instance Field r => Field [r] where+	type FieldArgument [r] = (FieldArgument r, Maybe Int)+	fromBinary (a, Just b) s = (b `times` fromBinary a) s+	fromBinary (a, Nothing) s = whole (fromBinary a) s+	toBinary (a, _) rs = cc $ map (toBinary a) rs -instance RetType Char where-	type Argument Char = ()-	fromType _ = fs . (: [])-	toType _ str = (head $ ts str, dp 1 str)+instance Field Char where+	type FieldArgument Char = ()+	fromBinary _ str = (head $ BSLC.unpack t, d)+		where+		(t, d) = getBytes 1 str+	toBinary _ = fs . (: []) -instance RetType BS.ByteString where-	type Argument BS.ByteString = Int-	fromType _ = fbs-	toType n str = (tbs $ tk n str, dp n str)+instance Field BS.ByteString where+	type FieldArgument BS.ByteString = Int+	fromBinary n str =+		first (BS.concat . BSL.toChunks) $ getBytes n str+	toBinary _ = makeBinary . BSL.fromChunks . (: []) -class Str a where-	tk :: Int -> a -> a-	dp :: Int -> a -> a-	ts :: a -> String-	fs :: String -> a-	fbs :: BS.ByteString -> a-	tbs :: a -> BS.ByteString-	ti :: a -> Integer-	fi :: Int -> Integer -> a-	tiBE :: a -> Integer-	fiBE :: Int -> Integer -> a-	cc :: [a] -> a-	zero :: a-	len :: a -> Int-	empty :: a -> Bool-	rev :: a -> a+class Binary a where+	getBytes :: Int -> a -> (BSL.ByteString, a)+	makeBinary :: BSL.ByteString -> a+	concatBinary :: [a] -> a+	emptyBinary :: a -> Bool -instance Str String where-	tk = take-	dp = drop-	ts = id-	fs = id-	fbs = ts-	tbs = fs-	ti = readInt LittleEndian-	fi = intToBin LittleEndian-	tiBE = readInt BigEndian-	fiBE = intToBin BigEndian-	cc = concat-	zero = "\0"-	len = length-	empty = null-	rev = reverse+empty :: Binary a => a -> Bool+empty = emptyBinary -fii, fiiBE :: Str a => Int -> Int -> a-fii n = fi n . fromIntegral-fiiBE n = fiBE n . fromIntegral-tii, tiiBE :: Str a => Int -> a -> (Int, a)-tii _ str = (fromIntegral $ ti $ tk 4 str, dp 4 str)-tiiBE _ str = (fromIntegral $ tiBE $ tk 4 str, dp 4 str)+cc :: Binary a => [a] -> a+cc = concatBinary -instance Str BS.ByteString where-	tk = BS.take-	dp = BS.drop-	ts = map (chr . fromIntegral) . BS.unpack-	fs = BS.pack . map (fromIntegral . ord)-	fbs = id-	tbs = id-	ti = readInt LittleEndian . map (chr . fromIntegral) . BS.unpack-	fi n = BS.pack . map (fromIntegral . ord) . intToBin LittleEndian n-	tiBE = readInt BigEndian . map (chr . fromIntegral) . BS.unpack-	fiBE n = BS.pack . map (fromIntegral . ord) . intToBin BigEndian n-	cc = BS.concat-	zero = BS.singleton 0-	len = BS.length-	empty = (== 0) . BS.length-	rev = BS.reverse+ti :: Binary a => a -> Integer+ti = readInt LittleEndian . BSLC.unpack . fst . getBytes 100 +fs :: Binary a => String -> a+fs = makeBinary . BSLC.pack++dp :: Binary a => Int -> a -> a+dp n = snd . getBytes n++instance Binary String where+	getBytes n = BSLC.pack . take n &&& drop n+	makeBinary = BSLC.unpack++	concatBinary = concat+	emptyBinary = null++fii :: Binary a => Int -> Int -> a+fii n = makeBinary . BSLC.pack . intToBin LittleEndian n . fromIntegral+tii :: Binary a => Int -> a -> (Int, a)+tii _ str = let+	(t, d) = getBytes 4 str in+	(fromIntegral $ ti t, d)++instance Binary BSL.ByteString where+	getBytes n = BSL.take (fromIntegral n) &&& BSL.drop (fromIntegral n)+	makeBinary = id++	concatBinary = BSL.concat+	emptyBinary = (== 0) . BSL.length++instance Binary BS.ByteString where+	getBytes n = BSL.fromChunks . (: []) . BS.take n &&& BS.drop n+	makeBinary = BS.concat . BSL.toChunks++	concatBinary = BS.concat+	emptyBinary = (== 0) . BS.length++lintToBin :: Int -> Integer -> String+lintToBin = intToBin LittleEndian+ intToBin :: Endian -> Int -> Integer -> String intToBin LittleEndian 0 _ = "" intToBin LittleEndian n x = chr (fromIntegral $ x `mod` 256) :@@ -115,7 +115,7 @@ 	(rets, rest') = times (n - 1) f rest in 	(ret : rets, rest') -whole :: Str s => (s -> (ret, s)) -> s -> ([ret], s)+whole :: Binary s => (s -> (ret, s)) -> s -> ([ret], s) whole f s 	| empty s = ([], s) 	| otherwise = let

@@ -2,10 +2,10 @@ 	readBinaryFile, 	writeBinaryFile, 	binary,-	RetType(..),-	Str(..),-	tii, tiiBE,-	fii, fiiBE+	Field(..),+	Binary(..),+	tii, -- tiiBE,+	fii, -- fiiBE --	times  ) where 

@@ -1,12 +1,15 @@-{-# LANGUAGE TemplateHaskell, TypeFamilies #-}+{-# LANGUAGE TypeFamilies #-} -module File.Binary.Data.BigEndian where+module File.Binary.Data.BigEndian (+	lintToBin+) where  import Classes+import qualified Data.ByteString.Lazy.Char8 as BSLC  -- retTypeInt BigEndian -instance RetType Int where-	type Argument Int = Int-	fromType n = rev . fi n . fromIntegral-	toType n s = (fromIntegral $ ti $ rev $ tk n s, dp n s)+instance Field Int where+	type FieldArgument Int = Int+	fromBinary n s = (fromIntegral $ ti $ BSLC.reverse $ fst $ getBytes n s, dp n s)+	toBinary n = makeBinary . BSLC.pack . reverse . lintToBin n . fromIntegral

@@ -1,12 +1,15 @@-{-# LANGUAGE TemplateHaskell, TypeFamilies #-}+{-# LANGUAGE TypeFamilies #-}  module File.Binary.Data.LittleEndian where  import Classes+import qualified Data.ByteString.Lazy.Char8 as BSLC  -- retTypeInt LittleEndian -instance RetType Int where-	type Argument Int = Int-	fromType n = fi n . fromIntegral-	toType n s = (fromIntegral $ ti $ tk n s, dp n s)+instance Field Int where+	type FieldArgument Int = Int+	fromBinary n s = (fromIntegral $ ti t, d)+		where+		(t, d) = getBytes n s+	toBinary n = makeBinary . BSLC.pack . reverse . lintToBin n . fromIntegral

@@ -20,10 +20,11 @@ 	valueOf,  	Expression,-	Str(..),-	RetType(..),-	fii, fiiBE,-	tii, tiiBE+	Binary(..),+	Field(..),+	fii, -- fiiBE,+	tii, -- tiiBE,+	dp, fs, cc ) where  import Text.Peggy

@@ -7,10 +7,10 @@  module QuoteBinaryStructure ( 	binary,-	RetType(..),-	Str(..),-	fii, fiiBE,-	tii, tiiBE,+	Field(..),+	Binary(..),+	fii, -- fiiBE,+	tii, -- tiiBE, 	times ) where @@ -21,6 +21,7 @@ import Data.Traversable hiding (mapM) import Data.Either import Data.Maybe+import qualified Data.ByteString.Lazy.Char8 as BSLC  import ParseBinaryStructure @@ -35,20 +36,28 @@ mkHaskellTree :: BinaryStructure -> DecsQ mkHaskellTree bs = do 		d <- mkData bsn body-		r <- mkReader bsn body-		w <- mkWriter bsn body-		return $ d ++ [r, w]+		i <- mkInst bsn typ body+		return $ d ++ [i] 	where 	bsn = binaryStructureName bs+	typ = binaryStructureArgType bs 	body = binaryStructureBody bs -mkWriter :: String -> [BinaryStructureItem] -> DecQ-mkWriter bsn body = do+mkInst :: String -> TypeQ -> [BinaryStructureItem] -> DecQ+mkInst bsn typ body =+	instanceD (cxt []) (appT (conT ''Field) (conT $ mkName bsn)) [+		tySynInstD ''FieldArgument [conT $ mkName bsn] typ,+		reading "fromBinary" bsn body,+		writing "toBinary" body+	 ]++writing :: String -> [BinaryStructureItem] -> DecQ+writing name body = do 	arg <- newName "arg" 	bs <- newName "bs" 	let run = appE (varE 'cc) $ listE $ map 		(\bsi -> writeField bs arg (bytesOf bsi) (valueOf bsi)) body-	funD (mkName $ "write" ++ bsn)+	funD (mkName name) 		[clause [varP arg, varP bs] (normalB run) []]  writeField :: Name -> Name -> Expression -> Either (Either Int String) String -> ExpQ@@ -56,7 +65,7 @@ 	appsE [fiend', expression bs arg size, sigE (litE $ integerL $ fromIntegral n) 		(conT ''Int)] 	where-	fiend' = varE 'fromType+	fiend' = varE 'toBinary writeField _ _ _ (Left (Right s)) = 	appsE [varE 'fs, litE $ stringL s] writeField bs arg bytes (Right v) =@@ -64,19 +73,18 @@  fieldValueToStr :: Name -> Name -> Expression -> Bool -> ExpQ -> ExpQ fieldValueToStr bs arg size False =-	appE $ appE (varE 'fromType) (expression bs arg size)+	appE $ appE (varE 'toBinary) (expression bs arg size) fieldValueToStr bs arg size True = \val -> 	appE (varE 'cc) $ appsE [-		varE 'map, appE (varE 'fromType) (expression bs arg size), val]+		varE 'map, appE (varE 'toBinary) (expression bs arg size), val] -mkReader :: String -> [BinaryStructureItem] -> DecQ-mkReader bsn body = do+reading :: String -> String -> [BinaryStructureItem] -> DecQ+reading name bsn body = do 	arg <- newName "arg" 	cs <- newName "cs" 	ret <- newName "ret"-	funD (mkName $ "read" ++ bsn)-		[clause [varP arg, varP cs] (normalB $ mkLetRec ret $-			mkBody bsn arg body cs) []]+	funD (mkName name) [clause [varP arg, varP cs]+		(normalB $ mkLetRec ret $ mkBody bsn arg body cs) []]  mkLetRec :: Name -> (Name -> ExpQ) -> ExpQ mkLetRec n f = do@@ -97,10 +105,11 @@ 	mkDef np item cs' 	    | Left (Left val) <- valueOf item = do 		cs'' <- newName "cs"-		let t = dropE' n $ varE cs'-		let p = val `equal` appE (varE 'fst)-			(appE (appE (varE 'toType) arg') $ takeE' n $ varE cs')-		let e = [e| error "bad value" |]+		let	t = dropE' n $ varE cs'+			p = val `equal` appE (varE 'fst)+				(appE (appE (varE 'fromBinary) arg') $+					takeE' n $ varE cs')+			e = [e| error "bad value" |] 		d <- valD (varP cs'') (normalB $ condE p t e) [] 		return ([d], cs'') 	    | Left (Right val) <- valueOf item = do@@ -113,7 +122,7 @@ 	    | Right var <- valueOf item = do 		cs'' <- newName "cs" 		def <- valD (tupP [varP $ fromJust $ lookup var np, varP cs''])-			(normalB $ appE (appE (varE 'toType) arg') $ varE cs') []+			(normalB $ appE (appE (varE 'fromBinary) arg') $ varE cs') [] 		return ([def], cs'') 	    | otherwise = error "bad" 	    where@@ -134,7 +143,8 @@ equal' x y = infixE (Just $ litE $ stringL x) (varE '(==)) (Just y)  takeE' :: ExpQ -> ExpQ -> ExpQ-takeE' n xs = appE (varE 'ts) $ appsE [varE 'tk, n, xs]+takeE' n xs = -- appE (varE 'ts) $ appsE [varE 'tk, n, xs]+	appE (varE 'BSLC.unpack) $ appE (varE 'fst) $ appsE [varE 'getBytes, n, xs]  dropE' :: ExpQ -> ExpQ -> ExpQ dropE' n xs = appsE [varE 'dp, n, xs]@@ -148,10 +158,10 @@  mkInstance :: String -> DecQ mkInstance name =-	instanceD (cxt []) (appT (conT ''RetType) (conT $ mkName name)) [-		valD (varP $ 'fromType)+	instanceD (cxt []) (appT (conT ''Field) (conT $ mkName name)) [+		valD (varP $ 'toBinary) 			(normalB $ varE $ mkName $ "write" ++ name) [],-		valD (varP $ 'toType)+		valD (varP $ 'fromBinary) 			(normalB $ varE $ mkName $ "read" ++ name) [] 	 ]