diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2011, Yoshikuni Jujo
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+  * Redistributions of source code must retain the above copyright notice,
+    this list of conditions and the following disclaimer.
+
+  * Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in the
+    documentation and/or other materials provided with the distribution.
+
+  * Neither the name of the Yoshikuni Jujo nor the names of its
+    contributors may be used to endorse or promote products derived from
+    this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVEN SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain
diff --git a/binary-file.cabal b/binary-file.cabal
new file mode 100644
--- /dev/null
+++ b/binary-file.cabal
@@ -0,0 +1,70 @@
+build-type:	Simple
+cabal-version:	>= 1.8
+
+name:		binary-file
+version:	0.2
+stability:	experimental
+author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp>
+maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>
+
+license:	BSD3
+license-file:	LICENSE
+
+category:	File
+synopsis:	read/write binary file
+description:
+
+    > runghc -XQuasiQuotes exam.hs some.bmp out.bmp
+    .
+    exam.hs:
+    .
+    > import Binary
+    > import System.Environment
+    >
+    > main = do
+    >	[inf, outf] <- getArgs
+    >
+    >	cnt <- readBinaryFile inf
+    >	let bmp = readBitmap cnt
+    >	print $ readBitmap cnt
+    >
+    >	let out = writeBitmap bmp {
+    >		authorFirst = "Yoshikuni ",
+    >		authorSecond = "Jujo      "
+    >	 }
+    >	writeBinaryFile outf out
+    >
+    > [binary|
+    >
+    > Bitmap
+    >
+    > 2: "BM"
+    > 4: fileSize
+    > 2: 0
+    > 2: 0
+    > 4: offset
+    > 4: 40
+    > 4: bitmapWidth
+    > 4: bitmapHeight
+    > 2: 1
+    > 2: bitsPerPixel
+    > 4: compressionMethod
+    > 4: imageSize
+    > 4: horizontalResolution
+    > 4: verticalResolution
+    > 4: numberOfColors
+    > 4: importantColors
+    > 4[numberOfColors]: colors
+    > bitsPerPixel/8[imageSize*8/bitsPerPixel]: image
+    > 10<String>: authorFirst
+    > 10<String>: authorSecond
+    > 
+    > |]
+    .
+
+library
+    hs-source-dirs:	src
+    exposed-modules:	Binary
+    other-modules:	QuoteBinaryStructure, ParseBinaryStructure, Here
+    build-depends:	base > 3 && < 5, template-haskell, peggy
+    ghc-options:	-Wall
diff --git a/src/Binary.hs b/src/Binary.hs
new file mode 100644
--- /dev/null
+++ b/src/Binary.hs
@@ -0,0 +1,17 @@
+module Binary (
+	readBinaryFile,
+	writeBinaryFile,
+	binary
+ ) where
+
+import QuoteBinaryStructure
+import System.IO
+
+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
diff --git a/src/Here.hs b/src/Here.hs
new file mode 100644
--- /dev/null
+++ b/src/Here.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
+
+module Here (printf, here) where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+
+printf :: QuasiQuoter
+printf = QuasiQuoter {
+	quoteExp = buildFun . parsePrintf,
+	quotePat = undefined,
+	quoteType = undefined,
+	quoteDec = undefined
+ }
+
+data Printf
+	= Lit Char
+	| String
+	| Dec
+	| Float
+	| Show
+	| Char
+	deriving (Show, Eq)
+
+parsePrintf :: String -> [Printf]
+parsePrintf (c : _) = [Lit c]
+
+buildFun :: [Printf] -> ExpQ
+buildFun [Lit c] = [| putChar c |]
+
+here :: QuasiQuoter
+here = QuasiQuoter {
+	quoteExp = litE . stringL . tail,
+	quotePat = undefined,
+	quoteType = undefined,
+	quoteDec = undefined
+ }
diff --git a/src/ParseBinaryStructure.hs b/src/ParseBinaryStructure.hs
new file mode 100644
--- /dev/null
+++ b/src/ParseBinaryStructure.hs
@@ -0,0 +1,168 @@
+{-# LANGUAGE TemplateHaskell, QuasiQuotes, FlexibleContexts #-}
+
+module ParseBinaryStructure (
+	BinaryStructure(..),
+	BinaryStructureItem,
+	Expression(..),
+	Type(..),
+	bytesOf,
+	typeOf,
+	sizeOf,
+	valueOf,
+	parseBinaryStructure,
+	readInt
+) where
+
+import Text.Peggy
+import Here
+import Control.Arrow
+import Data.Char
+
+main :: IO ()
+main = do
+	putStrLn "ParseBinaryStructure"
+	print $ parseBinaryStructure [here|
+
+BitmapFileHeader
+
+2: 19778
+4: fileSize
+2: 0
+2: 0
+4: offset
+
+4: 40
+4: bitmapWidth
+4: bitmapHeight
+2: 1
+2: bitPerPic
+4: compress
+4: imageDataSize
+4: horizontalDensity
+4: verticalDensity
+4: colorIndexNumber
+4: neededIndexNumber
+
+4[colorIndexNumber]: colors
+1[3]: image
+10<String>: author
+
+|]
+
+data Expression
+	= Multiple Expression Expression
+	| Division Expression Expression
+	| Variable String
+	| Number Int
+	deriving Show
+
+data ConstantValue
+	= ConstantInt Int
+	| ConstantString String
+	deriving Show
+
+constantInt (ConstantInt v) = v
+constantInt (ConstantString v) = readInt v
+
+data Type = String | Int deriving Show
+
+data VariableValue
+	= VariableValue { variableValue :: String }
+	deriving Show
+
+data BinaryStructureItem = BinaryStructureItem {
+	binaryStructureItemBytes :: Expression,
+	binaryStructureItemType :: Type,
+	binaryStructureItemListSize :: Maybe Expression, -- (Either Int String),
+	binaryStructureItemValue :: Either ConstantValue VariableValue -- Int String
+ } deriving Show
+
+bytesOf :: BinaryStructureItem -> Expression
+bytesOf = binaryStructureItemBytes
+
+typeOf :: BinaryStructureItem -> Type
+typeOf = binaryStructureItemType
+
+sizeOf :: BinaryStructureItem -> Maybe Expression
+sizeOf = binaryStructureItemListSize
+
+valueOf :: BinaryStructureItem -> Either Int String
+valueOf = (constantInt +++ variableValue) . binaryStructureItemValue
+
+binaryStructureItem :: Expression -> Type -> Maybe Expression ->
+	Either ConstantValue VariableValue -> BinaryStructureItem
+binaryStructureItem = BinaryStructureItem
+
+{-
+type BinaryStructureItem = (Int, Either Int String)
+
+bytesOf :: (Int, Either Int String) -> Int
+bytesOf = fst
+
+valueOf :: (Int, Either Int String) -> Either Int String
+valueOf = snd
+
+binaryStructureItem :: Int -> Either Int String -> BinaryStructureItem
+binaryStructureItem = (,)
+-}
+
+data BinaryStructure = BinaryStructure {
+	binaryStructureName :: String,
+	binaryStructureBody :: [BinaryStructureItem]
+ } deriving Show
+
+parseBinaryStructure :: String -> BinaryStructure
+parseBinaryStructure src = case parseString top "<code>" src of
+	Right bs -> bs
+	Left ps -> error $ show ps
+
+readInt :: String -> Int
+readInt "" = 0
+readInt (c : cs) = ord c + 2 ^ 8 * readInt cs
+
+[peggy|
+
+top :: BinaryStructure
+	= emptyLines name emptyLines dat*
+				{ BinaryStructure $2 $4 }
+
+emptyLines :: ()
+	= [ \n]*		{ () }
+
+spaces :: ()
+	= [ ]*			{ () }
+
+name :: String
+	= [A-Z][a-zA-Z0-9]*	{ $1 : $2 }
+
+dat :: BinaryStructureItem
+	= expr type size? ':' spaces val emptyLines
+				{ binaryStructureItem $1 $2 $3 $5 }
+type :: Type
+	= "<String>"		{ String }
+	/ "<Int>"?		{ Int }
+
+expr :: Expression
+	= expr '*' expr		{ Multiple $1 $2 }
+	/ expr '/' expr		{ Division $1 $2 }
+	/ num			{ Number $1 }
+	/ var			{ Variable $1 }
+
+size :: Expression
+	= '[' expr ']'
+
+val :: Either ConstantValue VariableValue
+	= num			{ Left $ ConstantInt $1 }
+	/ var			{ Right $ VariableValue $1 }
+	/ stringL		{ Left $ ConstantString $1 }
+
+stringL :: String
+	= '\"' [^\"]* '\"'
+
+var :: String
+	= [a-z][a-zA-Z0-9]*	{ $1 : $2 }
+
+num :: Int
+	= [0-9]+		{ read $1 }
+
+|]
diff --git a/src/QuoteBinaryStructure.hs b/src/QuoteBinaryStructure.hs
new file mode 100644
--- /dev/null
+++ b/src/QuoteBinaryStructure.hs
@@ -0,0 +1,188 @@
+{-# LANGUAGE TemplateHaskell, TupleSections, PatternGuards #-}
+
+module QuoteBinaryStructure (
+	binary
+) where
+
+import Prelude hiding (sequence)
+
+import Language.Haskell.TH hiding (Type)
+import Language.Haskell.TH.Quote
+import Data.Traversable hiding (mapM)
+import Data.Either
+import Control.Applicative
+import Control.Arrow
+import Data.Maybe
+import Data.Char
+import Data.Bits
+
+import ParseBinaryStructure
+
+main = do
+	runQ (mkHaskellTree $ parseBinaryStructure "BinaryFileHeader") >>= print
+
+binary :: QuasiQuoter
+binary = QuasiQuoter {
+	quoteExp = undefined,
+	quotePat = undefined,
+	quoteType = undefined,
+	quoteDec = mkHaskellTree . parseBinaryStructure
+ }
+
+mkHaskellTree :: BinaryStructure -> DecsQ
+mkHaskellTree BinaryStructure{
+	binaryStructureName = bsn,
+	binaryStructureBody = body } = do
+		d <- mkData bsn body
+		r <- mkReader bsn body
+		w <- mkWriter bsn body
+		return [d, r, w]
+
+mkWriter :: String -> [BinaryStructureItem] -> DecQ
+mkWriter bsn body = do
+	bs <- newName "bs"
+	let run = appE (varE 'concat) $ listE $ map
+		(\bsi -> writeField bs (bytesOf bsi) (typeOf bsi) (sizeOf bsi) (valueOf bsi))
+		body
+	funD (mkName $ "write" ++ bsn)
+		[clause [varP bs] (normalB run) []]
+
+writeField :: Name -> Expression -> Type -> Maybe Expression -> Either Int String -> ExpQ
+writeField bs size Int Nothing (Left n) =
+	appsE [varE 'intToBin, expression bs size, litE $ integerL $ fromIntegral n]
+writeField bs size Int Nothing (Right v) =
+	appsE [varE 'intToBin, expression bs size, getField bs v]
+writeField bs size Int (Just n) (Right v) = appsE [varE 'concatMap,
+	appE (varE 'intToBin) (expression bs size), getField bs v]
+writeField bs size String Nothing (Right v) = getField bs v
+
+intToBin :: Int -> Int -> String
+intToBin n x = intToBinGen (fromIntegral n) (fromIntegral x)
+
+intToBinGen :: Integer -> Integer -> String
+intToBinGen 0 _ = ""
+intToBinGen n x = chr (fromIntegral $ x `mod` 256) :
+	intToBinGen (n - 1) (x `div` 256)
+
+mkReader :: String -> [BinaryStructureItem] -> DecQ
+mkReader bsn body = do
+	cs <- newName "cs"
+	ret <- newName "ret"
+	funD (mkName $ "read" ++ bsn)
+		[clause [varP cs] (normalB $ mkLetRec ret $ mkBody bsn body cs) []]
+
+mkLetRec :: Name -> (Name -> ExpQ) -> ExpQ
+mkLetRec n f = letE [valD (varP n) (normalB $ f n) []] $ varE n
+
+mkBody :: String -> [BinaryStructureItem] -> Name -> Name -> ExpQ
+mkBody bsn body cs ret = do
+	namePairs <- for names $ \n -> return . (n ,) =<< newName "tmp"
+	defs <- gather cs body $ mkDef namePairs
+	letE (map return defs) $ recConE (mkName bsn) (map toPair2 namePairs)
+	where
+	names = rights $ map valueOf body
+	toPair2 (n, nn) = return $ (mkName n, VarE nn)
+	mkValD v = valD (varP v) (normalB $ litE $ integerL 45) []
+	mkDef :: [(String, Name)] -> BinaryStructureItem -> Name -> Q ([Dec], Name)
+	mkDef np item cs'
+	    | Left val <- valueOf item = do
+		cs'' <- newName "cs"
+		let t = dropE' n $ varE cs'
+		let p = val `equal` appE (varE 'readInt) (takeE' n $ varE cs')
+		let e = [e| error "bad value" |]
+		d <- valD (varP cs'') (normalB $ condE p t e) []
+		return ([d], cs'')
+	    | Right var <- valueOf item, Nothing <- sizeOf item, Int <- typeOf item = do
+		cs'' <- newName "cs"
+		def <- valD (varP $ fromJust $ lookup var np)
+			(normalB $ appE (varE 'readInt) $ takeE' n $ varE cs') []
+		next <- valD (varP cs'') (normalB $ dropE' n $ varE cs') []
+		return ([def, next], cs'')
+	    | Right var <- valueOf item, Nothing <- sizeOf item = do
+		cs'' <- newName "cs"
+		def <- valD (varP $ fromJust $ lookup var np)
+			(normalB $ takeE' n $ varE cs') []
+		next <- valD (varP cs'') (normalB $ dropE' n $ varE cs') []
+		return ([def, next], cs'')
+	    | Right var <- valueOf item, Just expr <- sizeOf item = do
+		cs'' <- newName "cs"
+		def <- valD (varP $ fromJust $ lookup var np)
+			(normalB $
+				appsE [varE 'map, varE 'readInt,
+				appsE [varE 'devideN, n,
+			takeE' (multiE' n $ expression ret expr) $ varE cs']]) []
+		next <- valD (varP cs'') (normalB $
+			dropE' (multiE' n $ expression ret expr) $ varE cs') []
+		return ([def, next], cs'')
+	    where
+	    n = expression ret $ bytesOf item
+
+expression :: Name -> Expression -> ExpQ
+expression ret (Variable v) = appE (varE $ mkName v) (varE ret)
+expression _ (Number n) = litE $ integerL $ fromIntegral n
+expression ret (Division x y) = divE (expression ret x) (expression ret y)
+expression ret (Multiple x y) = multiE' (expression ret x) (expression ret y)
+
+getField :: Name -> String -> ExpQ
+getField bs v = appE (varE $ mkName v) (varE bs)
+
+multiE :: Int -> ExpQ -> ExpQ
+multiE x y = infixE (Just $ litE $ integerL $ fromIntegral x) (varE '(*)) (Just y)
+
+multiE' :: ExpQ -> ExpQ -> ExpQ
+multiE' x y = infixE (Just x) (varE '(*)) (Just y)
+
+divE :: ExpQ -> ExpQ -> ExpQ
+divE x y = infixE (Just x) (varE 'div) (Just y)
+
+equal :: Int -> ExpQ -> ExpQ
+equal x y = infixE (Just $ litE $ integerL $ fromIntegral x) (varE '(==)) (Just y)
+
+takeE :: Int -> ExpQ -> ExpQ
+takeE n xs = appsE [varE 'take, litE $ integerL $ fromIntegral n, xs]
+
+takeE' :: ExpQ -> ExpQ -> ExpQ
+takeE' n xs = appsE [varE 'take, n, xs]
+
+dropE :: Int -> ExpQ -> ExpQ
+dropE n xs = appsE [varE 'drop, litE $ integerL $ fromIntegral n, xs]
+
+dropE' :: ExpQ -> ExpQ -> ExpQ
+dropE' n xs = appsE [varE 'drop, n, xs]
+
+gather :: Monad m => s -> [a] -> (a -> s -> m ([b], s)) -> m [b]
+gather s [] f = return []
+gather s (x : xs) f = do
+	(ys, s') <- f x s
+	zs <- gather s' xs f
+	return $ ys ++ zs
+
+mkData :: String -> [BinaryStructureItem] -> DecQ
+mkData bsn body =
+	dataD (cxt []) name [] [con] [''Show]
+	where
+	name = mkName bsn
+	con = recC (mkName bsn) vsts
+
+	vsts = flip map (filter isRight body) $ \item ->
+		case (sizeOf item, typeOf item) of
+			(Nothing, Int) -> varStrictType
+				(mkName $ fromRight $ valueOf item) $
+					strictType notStrict $ conT ''Int
+			(_, Int) -> varStrictType
+				(mkName $ fromRight $ valueOf item) $
+					strictType notStrict $
+						appT listT $ conT ''Int
+			(Nothing, _) -> varStrictType
+				(mkName $ fromRight $ valueOf item) $
+					strictType notStrict $ conT ''String
+
+	isRight item
+		| Right _ <- valueOf item = True
+		| otherwise = False
+
+fromRight = either (error "not Right") id
+
+devideN :: Int -> [a] -> [[a]]
+devideN _ [] = []
+devideN n xs = take n xs : devideN n (drop n xs)