diff --git a/binary-file.cabal b/binary-file.cabal
--- a/binary-file.cabal
+++ b/binary-file.cabal
@@ -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
diff --git a/examples/readBitmap.hs b/examples/readBitmap.hs
new file mode 100644
--- /dev/null
+++ b/examples/readBitmap.hs
@@ -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
+
+|]
diff --git a/examples/readHex.hs b/examples/readHex.hs
new file mode 100644
--- /dev/null
+++ b/examples/readHex.hs
@@ -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
+
+|]
diff --git a/examples/readPNG.hs b/examples/readPNG.hs
--- a/examples/readPNG.hs
+++ b/examples/readPNG.hs
@@ -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|]
diff --git a/examples/tiny.hs b/examples/tiny.hs
new file mode 100644
--- /dev/null
+++ b/examples/tiny.hs
@@ -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
+
+|]
diff --git a/src/File/Binary.hs b/src/File/Binary.hs
--- a/src/File/Binary.hs
+++ b/src/File/Binary.hs
@@ -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
diff --git a/src/File/Binary/Instances.hs b/src/File/Binary/Instances.hs
--- a/src/File/Binary/Instances.hs
+++ b/src/File/Binary/Instances.hs
@@ -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 =
diff --git a/src/File/Binary/Parse.hs b/src/File/Binary/Parse.hs
--- a/src/File/Binary/Parse.hs
+++ b/src/File/Binary/Parse.hs
@@ -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 }
diff --git a/src/File/Binary/Quote.hs b/src/File/Binary/Quote.hs
--- a/src/File/Binary/Quote.hs
+++ b/src/File/Binary/Quote.hs
@@ -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)