packages feed

binary-file 0.14.1 → 0.14.3

raw patch · 9 files changed

+285/−251 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

binary-file.cabal view
@@ -2,7 +2,7 @@ cabal-version:	>= 1.8  name:		binary-file-version:	0.14.1+version:	0.14.3 stability:	experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -47,6 +47,8 @@     >     > Bitmap     >+    > deriving Show+    >     > 2: "BM"     > 4: file_size     > 2: 0@@ -70,7 +72,11 @@     > |]     . -extra-source-files:	examples/readPNG.hs+extra-source-files:+    examples/readPNG.hs,+    examples/readBitmap.hs,+    examples/readHex.hs,+    examples/tiny.hs  source-repository	head     type:	git@@ -79,7 +85,7 @@ source-repository	this     type:	git     location:	git://github.com/YoshikuniJujo/binary-file.git-    tag:	0.14.1+    tag:	0.14.3  library     hs-source-dirs:	src
+ examples/readBitmap.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++import File.Binary+import File.Binary.Instances.LittleEndian()+import File.Binary.Instances()+import System.Environment+import qualified Data.ByteString.Lazy as BSL+import Data.Monoid++main :: IO ()+main = do+	[inf] <- getArgs+	cnt <- readBinaryFile inf+	let (bmp, rest) = fromBinary () cnt :: (Bitmap, String)+	print bmp+	print $ colors bmp+	print rest++instance Field (Int, Int, Int) where+	type FieldArgument (Int, Int, Int) = ()+	fromBinary _ s = let+		(b, rest) = fromBinary 1 s+		(g, rest') = fromBinary 1 rest+		(r, rest'') = fromBinary 1 rest' in+		((b, g, r), snd $ getBytes 1 rest'')+	toBinary _ (b, g, r) = mconcat [+		toBinary 1 b,+		toBinary 1 g,+		toBinary 1 r,+		makeBinary $ BSL.singleton 0+	 ]++[binary|++Bitmap++deriving Show++2: "BM"+4: fileSize+2: 0+2: 0+4: offset++4: 40+4: width+4: height+2: 1+2: bits_per_pixel+4: compression+4: image_size+4: resolutionH+4: resolutionV+4: color_num+4: important_colors_num+((), Just color_num){[(Int, Int, Int)]}: colors+((), Just image_size){String}: image++|]
+ examples/readHex.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies #-}++import File.Binary+import File.Binary.Instances+import File.Binary.Instances.LittleEndian+import System.Environment+import Control.Applicative+import Numeric++main = do+	cnt <- readBinaryFile . head =<< getArgs+	putStrLn $ unlines $ map unwords $ groupN 16 $ map (two . flip showHex "") $+		hex $ fst (fromBinary () cnt :: (Hex, String))++two s = replicate (2 - l) '0' ++ s+	where+	l = length s++groupN :: Int -> [a] -> [[a]]+groupN _ [] = []+groupN n xs = take n xs : groupN n (drop n xs)+	+[binary|++Hex deriving Show++(1, Nothing){[Int]}: hex++|]
examples/readPNG.hs view
@@ -64,7 +64,7 @@  [binary| -PNG+PNG deriving Show  1: 0x89 3: "PNG"@@ -77,7 +77,7 @@  [binary| -Chank+Chank deriving Show  4: chankSize ((), Just 4){String}: chankName@@ -93,13 +93,6 @@ 		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 @@ -155,7 +148,7 @@  [binary| -IHDR+IHDR deriving Show  4: width 4: height@@ -169,7 +162,7 @@  [binary| -GAMA+GAMA deriving Show  4: gamma @@ -177,7 +170,7 @@  [binary| -SRGB+SRGB deriving Show  1: srgb @@ -187,6 +180,8 @@  CHRM +deriving Show+ arg :: Int  (4, Just (arg `div` 4)){[Int]}: chrms@@ -195,8 +190,7 @@  [binary| -PLTE-+PLTE deriving Show arg :: Int  ((), Just (arg `div` 3)){[(Int, Int, Int)]}: colors@@ -215,7 +209,7 @@  [binary| -BKGD+BKGD deriving Show  1: bkgd @@ -223,7 +217,7 @@  [binary| -IDAT+IDAT deriving Show  arg :: Int @@ -234,10 +228,7 @@  [binary| -TEXT-{--test {- hoge -}--}+TEXT deriving Show  arg :: Int @@ -245,4 +236,4 @@  |] -[binary|IEND|]+[binary|IEND deriving Show|]
+ examples/tiny.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, ScopedTypeVariables #-}++import File.Binary+import File.Binary.Instances+import File.Binary.Instances.LittleEndian+import System.Directory+import System.IO+import Control.Applicative+import Numeric+import System.Environment++size = 4++main = do+	n <- read . head <$> getArgs+	writeBinaryFile "tmp/out/tiny.dat" $ toBinary n $ Tiny 0x0123456789abcdef+	(t ::Tiny, rest) <- fromBinary n <$> readBinaryFile "tmp/out/tiny.dat"+	print t+	putStrLn $ flip showHex "" $ value t+	print rest++[binary|++Tiny deriving Show++arg :: Int++4: "tiny"+Main.size * arg{Integer}: value++|]
src/File/Binary.hs view
@@ -1,22 +1,16 @@ module File.Binary (-	readBinaryFile,-	writeBinaryFile,-	binary, 	Field(..), 	Binary(..),---	tii, -- tiiBE,---	fii, -- fiiBE---	times+	binary,+	readBinaryFile,+	writeBinaryFile  ) where -import File.Binary.Quote-import System.IO+import File.Binary.Quote (Field(..), Binary(..), binary)+import System.IO (IOMode(..), withBinaryFile, openBinaryFile, hGetContents, hPutStr)  readBinaryFile :: FilePath -> IO String readBinaryFile path = openBinaryFile path ReadMode >>= hGetContents  writeBinaryFile :: FilePath -> String -> IO ()-writeBinaryFile path str = do-	h <- openBinaryFile path WriteMode-	hPutStr h str-	hClose h+writeBinaryFile f txt = withBinaryFile f WriteMode $ \hdl -> hPutStr hdl txt
src/File/Binary/Instances.hs view
@@ -15,6 +15,11 @@ import Control.Arrow (first, (&&&)) import Data.Monoid +instance Field BSL.ByteString where+	type FieldArgument BSL.ByteString = Int+	fromBinary n str = getBytes n str+	toBinary _ = makeBinary+ instance Field BS.ByteString where 	type FieldArgument BS.ByteString = Int 	fromBinary n str =
src/File/Binary/Parse.hs view
@@ -7,16 +7,13 @@ 	-fno-warn-unused-do-bind #-}  module File.Binary.Parse (-	parse,-	BinaryStructure, bsName, bsArgName, bsArgType, bsBody,-	BinaryStructureItem, bytesOf, typeOf, valueOf,-	Value(..), variables,-	Expression, expression,+	parse, BinaryStructure, bsName, bsDerive, bsArgName, bsArgType, bsItem,+	BSItem, argOf, valueOf, Value(..), variables, Expression, expression, ) where -import Prelude hiding (exp) import Control.Applicative ((<$>), (<*>)) import "monads-tf" Control.Monad.Reader (Reader, runReader, ask)+import Data.Maybe (catMaybes) import Numeric (readHex)  import Text.Peggy (peggy, parseString, space, defaultDelimiter)@@ -31,73 +28,76 @@  data BinaryStructure = BinaryStructure { 	bsName :: Name,-	bsArgName :: Name,+	bsDerive :: [Name],+	bsArgName :: String, 	bsArgType :: TypeQ,-	bsBody :: [BinaryStructureItem]- }--data BinaryStructureItem = BinaryStructureItem {-	bytesOf :: Expression,-	typeOf :: TypeQ,-	valueOf :: Value- }+	bsItem :: [BSItem] } -type Expression	= Reader (ExpQ, ExpQ, Name) ExpQ+data BSItem = BSItem { argOf :: Expression, typeOf :: TypeQ, valueOf :: Value }+type Expression	= Reader (ExpQ, ExpQ, String) ExpQ -expression :: ExpQ -> ExpQ -> Name -> Expression -> ExpQ+expression :: ExpQ -> ExpQ -> String -> Expression -> ExpQ expression ret arg argn e = runReader e (ret, arg, argn) -data Value-	= Constant { constant :: Either Integer String }-	| Variable { variable :: Name }+data Value = Constant (Either Integer String) | Variable Name -variables :: [Value] -> [Name]-variables =-	map variable . filter (\v -> case v of Variable _ -> True; _ -> False)+variables :: [BSItem] -> [(Name, TypeQ)]+variables = catMaybes . map (\bsi -> case valueOf bsi of+		Variable var -> Just (var, typeOf bsi); _ -> Nothing) +varToExp :: String -> (ExpQ, ExpQ, String) -> ExpQ+varToExp var (ret, arg, argn)+	| var == argn = arg+	| '.' `elem` var = varE $ mkName var+	| otherwise = appE (varE $ mkName var) ret+ [peggy|  top :: BinaryStructure-	= emp lname arg dat*		{ BinaryStructure $2 (fst $3) (snd $3) $4 }+	= emp lname der arg dat*+				{ BinaryStructure $2 $3 (fst $4) (snd $4) $5 } -arg :: (Name, TypeQ)+der :: [Name]+	= emp 'deriving' sp ln (sp ',' sp ln)*+				{ mkName $3 : map (\(_, _, n) -> mkName n) $4 }+	/ ''			{ [] }++arg :: (String, TypeQ) 	= emp var sp '::' sp typ	{ ($2, $5) }-	/ ''				{ (mkName "_", conT $ mkName "()") }+	/ ''				{ ("_", conT $ mkName "()") } -dat :: BinaryStructureItem-	= emp exp sp typS sp ':' sp val	{ BinaryStructureItem $2 $4 $7 }+dat :: BSItem+	= emp ex sp typS sp ':' sp val	{ BSItem $2 $4 $7 }  typS :: TypeQ 	= '{' typ '}'			{ $1 } 	/ ''				{ conT $ mkName "Int" }  val :: Value-	= var				{ Variable $1 }+	= var				{ Variable $ mkName $1 } 	/ num				{ Constant $ Left $1 } 	/ string			{ Constant $ Right $1 } -exp :: Expression-	= exp sp op sp expOp1		{ uInfixE <$> $1 <*> $3 <*> $5 }-	/ expOp1+ex :: Expression+	= ex sp op sp exOp1		{ uInfixE <$> $1 <*> $3 <*> $5 }+	/ exOp1 -expOp1 :: Expression-	= expOp1 sp exp1		{ appE <$> $1 <*> $3 }-	/ exp1+exOp1 :: Expression+	= exOp1 sp ex1			{ appE <$> $1 <*> $3 }+	/ ex1 -exp1 :: Expression+ex1 :: Expression 	= '(' tupExp ')'-	/ '(' exp ')'			{ parensE <$> $1 }+	/ '(' ex ')'			{ parensE <$> $1 } 	/ '()'				{ return $ conE $ mkName "()" } 	/ num				{ return $ litE $ integerL $1 } 	/ lname				{ return $ conE $1 }-	/ var				{ flip fmap ask $ \(ret, arg, argn) ->-						if $1 == argn-							then arg-							else appE (varE $1) ret }+	/ var				{ flip fmap ask $ varToExp $1 }+ op :: Expression 	= [!\\#$%&*+./<=>?@^|~-:]+	{ return $ varE $ mkName $1 }-	/ '`' var '`'			{ return $ varE $1 }-tupExp :: Expression = exp (sp ',' sp exp)++	/ '`' var '`'			{ return $ varE $ mkName $1 }+tupExp :: Expression = ex (sp ',' sp ex)+ 	{ (.) tupE . (:) <$> $1 <*> mapM (\(_, _, e) -> e) $2 }  typ :: TypeQ@@ -116,8 +116,8 @@ lname :: Name 	= (ln '.')* ln			{ mkName $ concatMap (++ ".") $1 ++ $2 } -var :: Name-	= (ln '.')* sn			{ mkName $ concatMap (++ ".") $1 ++ $2 }+var :: String+	= (ln '.')* sn			{ concatMap (++ ".") $1 ++ $2 }  num :: Integer 	= '0x' [0-9a-fA-F]+		{ fst $ head $ readHex $1 }
src/File/Binary/Quote.hs view
@@ -1,190 +1,108 @@-{-# LANGUAGE-	TemplateHaskell,-	TupleSections,-	PatternGuards,-	TypeSynonymInstances,-	FlexibleInstances #-}--module File.Binary.Quote (-	binary,-	Field(..),-	Binary(..),---	fii, -- fiiBE,---	tii, -- tiiBE,-	times-) where+{-# LANGUAGE TemplateHaskell, TupleSections, PackageImports #-} -import Prelude hiding (sequence)+module File.Binary.Quote (Field(..), Binary(..), binary) where -import Language.Haskell.TH hiding (Type)-import Language.Haskell.TH.Quote-import Data.Traversable hiding (mapM)-import Data.Maybe-import qualified Data.ByteString.Lazy.Char8 as BSLC+import Language.Haskell.TH (+	Q, DecsQ, ClauseQ, ExpQ, Dec, Exp(..), Name, FieldExp,+	dataD, recC, varStrictType, strictType, notStrict,+	instanceD, funD, clause, normalB, valD, tySynInstD, cxt,+	conT, appT, sigE, varP, tupP, letE, condE, recConE, tupE, listE,+	appE, appsE, infixApp, varE, litE, newName, integerL, stringL)+import Language.Haskell.TH.Quote (QuasiQuoter(..))+import Data.Monoid (mconcat)+import Control.Monad (zipWithM)+import "monads-tf" Control.Monad.State (StateT, runStateT, get, put, lift)+import "monads-tf" Control.Monad.Writer (WriterT, runWriterT, tell)+import Control.Applicative ((<$>), (<*>))+import qualified Data.ByteString.Lazy.Char8 as BSLC (ByteString, pack) -import File.Binary.Parse-import File.Binary.Classes+import File.Binary.Parse (+	parse, BinaryStructure, bsName, bsDerive, bsArgName, bsArgType, bsItem,+	BSItem, argOf, valueOf, Value(..), variables, expression)+import File.Binary.Classes (Field(..), Binary(..)) -import Data.Monoid+--------------------------------------------------------------------------------  binary :: QuasiQuoter binary = QuasiQuoter {-	quoteExp = undefined,-	quotePat = undefined,-	quoteType = undefined,-	quoteDec = mkHaskellTree . parse+	quoteExp = undefined, quotePat = undefined, quoteType = undefined,+	quoteDec = top . parse  } -mkHaskellTree :: BinaryStructure -> DecsQ-mkHaskellTree bs = do-		d <- mkData bsn body-		i <- mkInst bsn argn typ body-		return $ d ++ [i]-	where-	bsn = bsName bs-	argn = bsArgName bs-	typ = bsArgType bs-	body = bsBody bs--mkInst :: Name -> Name -> TypeQ -> [BinaryStructureItem] -> DecQ-mkInst bsn argn typ body =-	instanceD (cxt []) (appT (conT ''Field) (conT bsn)) [-		tySynInstD ''FieldArgument [conT bsn] typ,-		reading "fromBinary" bsn argn body,-		writing "toBinary" argn body+top :: BinaryStructure -> DecsQ+top bs = let c = bsName bs in (\d i -> [d, i])+	<$> dataD (cxt []) c [] [recC c $+		map (varStrictType <$> fst <*> strictType notStrict . snd) $+			variables $ bsItem bs] (bsDerive bs)+	<*> instanceD (cxt []) (appT (conT ''Field) (conT c)) [+		tySynInstD ''FieldArgument [conT c] $ bsArgType bs,+		funD 'fromBinary $ (: []) $ reading c (bsArgName bs) (bsItem bs),+		funD 'toBinary $ (: []) $ writing (bsArgName bs) (bsItem bs) 	 ] -writing :: String -> Name -> [BinaryStructureItem] -> DecQ-writing name argn body = do-	arg <- newName "_arg"-	bs <- newName "_bs"-	let run = appE (varE 'mconcat) $ listE $ map-		(\bsi -> writeField bs arg argn (bytesOf bsi) (valueOf bsi)) body-	funD (mkName name)-		[clause [varP arg, varP bs] (normalB run) []]--writeField :: Name -> Name -> Name -> Expression -> Value -> ExpQ-writeField bs arg argn size (Constant (Left n)) =-	appsE [fiend', expression (varE bs) (varE arg) argn size,-		sigE (litE $ integerL $ fromIntegral n)-		(conT ''Int)]-	where-	fiend' = varE 'toBinary-writeField _ _ _ _ (Constant (Right s)) =-	appsE [varE 'fs, litE $ stringL s]-writeField bs arg argn bytes (Variable v) =-	fieldValueToStr bs arg argn bytes False $ getField bs v--fs :: Binary a => String -> a-fs = makeBinary . BSLC.pack--fieldValueToStr :: Name -> Name -> Name -> Expression -> Bool -> ExpQ -> ExpQ-fieldValueToStr bs arg argn size False =-	appE $ appE (varE 'toBinary) (expression (varE bs) (varE arg) argn size)-fieldValueToStr bs arg argn size True = \val ->-	appE (varE 'mconcat) $ appsE [-		varE 'map, appE (varE 'toBinary) (expression (varE bs) (varE arg) argn size), val]--reading :: String -> Name -> Name -> [BinaryStructureItem] -> DecQ-reading name bsn argn body = do+reading :: Name -> String -> [BSItem] -> ClauseQ+reading con argn items = do 	arg <- newName "_arg"-	cs <- newName "cs1"-	ret <- newName "ret"-	funD (mkName name) [clause [varP arg, varP cs]-		(normalB $ mkLetRec ret $ mkBody bsn arg argn body cs) []]--mkLetRec :: Name -> (Name -> ExpQ) -> ExpQ-mkLetRec n f = do-	rest <- newName "rest"-	letE [valD (tupP [varP n, varP rest]) (normalB $ f n) []] $-		tupE [varE n, varE rest]--mkBody :: Name -> Name -> Name -> [BinaryStructureItem] -> Name -> Name -> ExpQ-mkBody bsn arg argn body cs ret = do-	namePairs <- for names $ \n -> return . (n ,) =<< newName "tmp"-	(defs, rest) <- gather cs body $ mkDef namePairs-	letE (map return defs) $ tupE-		[recConE bsn (map toPair2 namePairs), varE rest]-	where-	names = variables $ map valueOf body-	toPair2 (n, nn) = return (n, VarE nn)-	mkDef :: [(Name, Name)] -> BinaryStructureItem -> Name -> Q ([Dec], Name)-	mkDef np item cs'-	    | Constant (Left val) <- valueOf item = do-		cs'' <- newName "cs"-		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'')-	    | Constant (Right val) <- valueOf item = do-		cs'' <- newName "cs"-		let t = dropE' n $ varE cs'-		let p = val `equal'` takeE' n (varE cs')-		let e = [e| error "bad value" |]-		d <- valD (varP cs'') (normalB $ condE p t e) []-		return ([d], cs'')-	    | Variable var <- valueOf item = do-		cs'' <- newName "cs"-		def <- valD (tupP [varP $ fromJust $ lookup var np, varP cs''])-			(normalB $ appE (appE (varE 'fromBinary) arg') $ varE cs') []-		return ([def], cs'')-	    | otherwise = error "bad"-	    where-	    n = expression (varE ret) (varE arg) argn $ bytesOf item-	    arg' = expression (varE ret) (varE arg) argn $ bytesOf item--getField :: Name -> Name -> ExpQ-getField bs v = appE (varE v) (varE bs)--equal :: Integer -> ExpQ -> ExpQ-equal x y = infixE (Just $ sigE (litE $ integerL x) (conT ''Integer))-	(varE '(==)) (Just y)--equal' :: String -> ExpQ -> ExpQ-equal' x y = infixE (Just $ litE $ stringL x) (varE '(==)) (Just y)+	bin <- newName "bin"+	flip (clause [varP arg, varP bin]) [] $+		normalB $ letRec $ binToDat con items (varE bin) $ \ret ->+			expression ret (varE arg) argn . argOf -takeE' :: ExpQ -> ExpQ -> ExpQ-takeE' n xs = -- appE (varE 'ts) $ appsE [varE 'tk, n, xs]-	appE (varE 'BSLC.unpack) $ appE (varE 'fst) $ appsE [varE 'getBytes, n, xs]+letRec :: (ExpQ -> ExpQ) -> ExpQ+letRec e = do+	(ret, rest) <- (,) <$> newName "ret" <*> newName "rest"+	letE [valD (tupP [varP ret, varP rest]) (normalB $ e $ varE ret) []] $+		tupE [varE ret, varE rest] -dropE' :: ExpQ -> ExpQ -> ExpQ-dropE' n xs = appsE [varE 'dp, n, xs]+binToDat :: Name -> [BSItem] -> ExpQ -> (ExpQ -> BSItem -> ExpQ) -> ExpQ -> ExpQ+binToDat con items bin size ret = do+	((binds, rest), rts) <- runWriterT $ (`runStateT` bin) $+		(zipWithM binToField <$> map (size ret) <*> map valueOf) items+	letE (return <$> binds) $ tupE $ (: [rest]) $ recConE con $ return <$> rts -dp :: Binary a => Int -> a -> a-dp n = snd . getBytes n+type FieldMonad = StateT ExpQ (WriterT [FieldExp] Q) -gather :: Monad m => s -> [a] -> (a -> s -> m ([b], s)) -> m ([b], s)-gather s [] _ = return ([], s)-gather s (x : xs) f = do-	(ys, s') <- f x s-	(zs, s'') <- gather s' xs f-	return (ys ++ zs, s'')+liftQ :: Q a -> FieldMonad a+liftQ = lift . lift -mkData :: Name -> [BinaryStructureItem] -> DecsQ-mkData bsn body = do-	d <- dataD (cxt []) name [] [con] [''Show]-	return [d]-	where-	name = bsn-	con = recC bsn vsts+liftW :: WriterT [FieldExp] Q a -> FieldMonad a+liftW = lift -	vsts = flip map (filter isRight body) $ \item ->-		varStrictType (variable $ valueOf item) $-			strictType notStrict $ mkType False $ typeOf item-	isRight item-		| Variable _ <- valueOf item = True-		| otherwise = False+binToField :: ExpQ -> Value -> FieldMonad Dec+binToField size (Constant val) = do+	bin <- get+	[rv, rest, bin'] <- liftQ $ mapM newName ["rv", "rst", "bin'"]+	put $ varE bin'+	let lit = either+		((`sigE` conT ''Integer) . litE . integerL)+		((`sigE` conT ''BSLC.ByteString) .+			appE (varE 'BSLC.pack) . litE . stringL) val+	liftQ $ flip (valD $ varP bin') [] $ normalB $+		letE [flip (valD $ tupP [varP rv, varP rest]) [] $ normalB $+			appsE [varE 'fromBinary, size, bin]] $+		condE (infixApp (varE rv) (varE '(==)) lit) (varE rest)+			[e| error "bad value" |]+binToField size (Variable var) = do+	bin <- get+	[bin', tmp] <- liftQ $ mapM newName ["bin'", "tmp"]+	put $ varE bin'+	liftW $ tell [(var, VarE tmp)]+	liftQ $ valD (tupP [varP tmp, varP bin'])+		(normalB $ appsE [varE 'fromBinary, size, bin]) [] -mkType :: Bool -> TypeQ -> TypeQ-mkType True t = appT listT $ mkType False t-mkType False typ = typ+writing :: String -> [BSItem] -> ClauseQ+writing argn items = do+	arg <- newName "_arg"+	dat <- newName "_dat"+	flip (clause [varP arg, varP dat]) [] $ normalB $+		appE (varE 'mconcat) $ listE $ (<$> items) $ fieldToBin dat+			<$> expression (varE dat) (varE arg) argn . argOf+			<*> valueOf -times :: Int -> (s -> (ret, s)) -> s -> ([ret], s)-times 0 _ s = ([], s)-times n f s = let-	(ret, rest) = f s-	(rets, rest') = times (n - 1) f rest in-	(ret : rets, rest')+fieldToBin :: Name -> ExpQ -> Value -> ExpQ+fieldToBin _ size (Constant val) =  varE 'toBinary `appE` size `appE` either+	((`sigE` conT ''Integer) . litE . integerL)+	((`sigE` conT ''BSLC.ByteString) . appE (varE 'BSLC.pack) . litE . stringL)+	val+fieldToBin dat size (Variable val) =+	varE 'toBinary `appE` size `appE` (varE val `appE` varE dat)