diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for c-struct
+
+## Unreleased changes
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Yoshikuni Jujo (c) 2021
+
+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 Yoshikuni Jujo nor the names of other
+      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 EVENT SHALL THE COPYRIGHT
+OWNER 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/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,208 @@
+# c-struct
+
+## C definition
+
+foo.h
+
+```
+#ifndef _FOO_H
+#define _FOO_H
+
+typedef struct { int x; int y; } Foo;
+
+#endif
+```
+
+foo.c
+
+```
+#include <stdlib.h>
+#include <stdio.h>
+#include "foo.h"
+
+Foo *
+foo_copy(Foo *src)
+{
+	Foo *p = malloc(sizeof(Foo));
+	p -> x = src -> x;
+	p -> y = src -> y;
+	return p;
+}
+
+void
+foo_free(Foo *p)
+{
+	free(p);
+}
+
+void
+foo_print(Foo *f)
+{
+	printf("Foo: x = %d, y = %d\n", f -> x, f -> y);
+}
+
+void
+foo_scale(Foo *f, int s)
+{
+	f -> x = f -> x * s;
+	f -> y = f -> y * s;
+}
+```
+
+## Immutable
+
+### Foo
+
+Foo.hsc
+
+```
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
+
+module Foo where
+
+import Foreign.Ptr (Ptr)
+import Foreign.ForeignPtr (withForeignPtr)
+import Foreign.Storable (peekByteOff, pokeByteOff)
+import Foreign.C.Types (CInt(..))
+import Foreign.C.Struct (struct)
+
+#include "foo.h"
+
+struct "Foo" #{size Foo}
+	[	("x", ''CInt, [| #{peek Foo, x} |], [| #{poke Foo, x} |]),
+		("y", ''CInt, [| #{peek Foo, y} |], [| #{poke Foo, y} |]) ]
+	[''Show, ''Read, ''Eq, ''Ord, ''Bounded]
+
+fooPrint :: Foo -> IO ()
+fooPrint (Foo_ f) = withForeignPtr f c_foo_print
+
+foreign import ccall "foo_print" c_foo_print :: Ptr Foo -> IO ()
+```
+
+You get newtype Foo.
+
+```
+> Foo 123 456
+Foo {fooX = 123, fooY = 456}
+> it { fooY = 654}
+Foo {fooX = 123, fooY = 654}
+> f = it
+> fooPrint f
+Foo: x = 123, y = 654
+> g = read "Foo {fooX = 456, fooY = 123}" :: Foo
+> g
+Foo {fooX = 456, fooY = 123}
+> f < g
+True
+> minBound :: Foo
+Foo {fooX = -2147483648, fooY = -2147483648}
+```
+
+### FooIx
+
+FooIx.hsc
+
+```
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
+
+module FooIx where
+
+import Foreign.Storable (Storable, peekByteOff, pokeByteOff)
+import Foreign.C.Types (CInt(..))
+import Foreign.C.Struct (struct)
+import Data.Array (Ix(..))
+
+#include "foo.h"
+
+newtype CIntIx = CIntIx CInt
+	deriving (Show, Eq, Ord, Enum, Num, Real, Integral, Storable)
+
+struct "FooIx" #{size Foo}
+	[	("x", ''CIntIx, [| #{peek Foo, x} |], [| #{poke Foo, x} |]),
+		("y", ''CIntIx, [| #{peek Foo, y} |], [| #{poke Foo, y} |]) ]
+	[''Show, ''Eq, ''Ord, ''Ix]
+
+instance Ix CIntIx where
+	range (l, u) = [l .. u]
+	index (l, _) i = fromIntegral $ i - l
+	inRange (l, u) i = l <= i && i <= u
+```
+
+You get newtype FooIx.
+
+```
+> :module + Data.Array
+> listArray (FooIx 3 5, FooIx 4 7) [5 ..]
+array (FooIx {fooIxX = CIntIx 3, fooIxY = CIntIx 5},FooIx {fooIxX = CIntIx 4, fooIxY = CIntIx 7}) [(FooIx {...
+> a = it
+> a ! FooIx 4 6
+9
+```
+
+## Mutable
+
+If you want to change values of a struct, you should use `structPrim`.
+
+FooPrim.hsc
+
+```
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
+
+module FooPrim where
+
+import Foreign.Ptr (Ptr)
+import Foreign.ForeignPtr (withForeignPtr)
+import Foreign.Storable (peekByteOff, pokeByteOff)
+import Foreign.C.Types (CInt(..))
+import Foreign.C.Struct (struct, structPrim)
+import Control.Monad.Primitive (PrimMonad(..), unsafeIOToPrim)
+
+#include "foo.h"
+
+struct "Foo" #{size Foo}
+	[	("x", ''CInt, [| #{peek Foo, x} |], [| #{poke Foo, x} |]),
+		("y", ''CInt, [| #{peek Foo, y} |], [| #{poke Foo, y} |]) ]
+	[''Show, ''Read, ''Eq, ''Ord, ''Bounded]
+
+foreign import ccall "foo_copy" c_foo_copy :: Ptr Foo -> IO (Ptr Foo)
+foreign import ccall "foo_free" c_foo_free :: Ptr Foo -> IO ()
+
+structPrim "Foo" 'c_foo_copy 'c_foo_free [''Show]
+
+fooScale :: PtimMonad m => FooPrim (PrimState m) -> CInt -> m ()
+fooScale (FooPrim f) s = unsafeIOToPrim $ withForeignPtr f (`c_foo_scale` s)
+
+foreign import ccall "foo_scale" c_foo_scale :: Ptr Foo -> CInt -> IO ()
+```
+
+You get `FooPrim`, `FooST`, `FooIO`, `fooFreeze`, `fooThaw` and `fooCopy`.
+
+```
+> :modu	+ Control.Monad.Primitive
+> :type fooFreeze
+fooFreeze :: PrimMonad m => FooPrim (PrimState m) -> m Foo
+> :type fooThaw
+fooThaw :: PrimMonad m => Foo -> m (FooPrim (PrimState m))
+> :type FooCopy
+fooCopy
+  :: PrimMonad m =>
+     FooPrim (PrimState m) -> m (FooPrim (PrimState m))
+> Foo 123 456
+Foo {fooX = 123, fooY = 456}
+> fooThaw it
+FooPrim 0x00000000002354a60
+> fp = it
+> fooScale fp 3
+> fooFreeze fp
+Foo {fooX = 369, fooY = 1368}
+```
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/c-struct.cabal b/c-struct.cabal
new file mode 100644
--- /dev/null
+++ b/c-struct.cabal
@@ -0,0 +1,57 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.4.
+--
+-- see: https://github.com/sol/hpack
+
+name:           c-struct
+version:        0.1.0.0
+synopsis:       To make a wrapper for struct of C language
+description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/c-struct#readme>
+category:       Foreign
+homepage:       https://github.com/YoshikuniJujo/c-struct#readme
+bug-reports:    https://github.com/YoshikuniJujo/c-struct/issues
+author:         Yoshikuni Jujo
+maintainer:     yoshikuni.jujo.pc@gmail.com
+copyright:      2021 Yoshikuni Jujo
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/YoshikuniJujo/c-struct
+
+library
+  exposed-modules:
+      Foreign.C.Struct
+  other-modules:
+      Foreign.C.Struct.Parts
+      Paths_c_struct
+  hs-source-dirs:
+      src
+  build-depends:
+      array
+    , base >=4.7 && <5
+    , primitive
+    , template-haskell
+  default-language: Haskell2010
+
+test-suite c-struct-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_c_struct
+  hs-source-dirs:
+      test
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      array
+    , base >=4.7 && <5
+    , c-struct
+    , primitive
+    , template-haskell
+  default-language: Haskell2010
diff --git a/src/Foreign/C/Struct.hs b/src/Foreign/C/Struct.hs
new file mode 100644
--- /dev/null
+++ b/src/Foreign/C/Struct.hs
@@ -0,0 +1,412 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE BlockArguments, LambdaCase #-}
+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
+
+module Foreign.C.Struct (
+	-- * STRUCT
+	struct, StrName, StrSize,
+	MemName, MemType, MemPeek, MemPoke, DerivClass,
+	-- * STRUCT WITH PRIMITIVE MONAD
+	structPrim, FunCopy, FunFree ) where
+
+import Language.Haskell.TH (
+	DecsQ, DecQ, Dec(PragmaD), Pragma(CompleteP), sigD, valD, funD, tySynD,
+	newtypeD, plainTV, normalC, derivClause,
+		bangType, bang, noSourceUnpackedness, noSourceStrictness,
+	instanceD, cxt,
+	patSynSigD, patSynD, recordPatSyn, explBidir,
+	ExpQ, varE, conE, appE, lamE, tupE, listE,
+	forallT, varT, conT, appT, varP, wildP, conP, tupP, viewP,
+	Name, mkName, newName,
+	ClauseQ, clause, normalB, StmtQ, doE, compE, bindS, noBindS )
+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
+import Foreign.Concurrent (newForeignPtr)
+import Foreign.Marshal (mallocBytes, free)
+import Control.Arrow ((&&&))
+import Control.Monad (replicateM)
+import Control.Monad.Primitive (PrimMonad(..), RealWorld, unsafeIOToPrim)
+import Data.Bool (bool)
+import Data.Maybe (mapMaybe)
+import Data.List (unzip4, intersperse, intercalate)
+import Data.Array (Ix(..))
+import System.IO.Unsafe (unsafePerformIO)
+import Text.Read (Lexeme(..), readPrec, step, lexP, parens, prec)
+
+import Foreign.C.Struct.Parts (
+	(.->), (.$), (...), (.<$>), (.<*>), (.>>=),
+	(.&&), (.||), (.==), (.<), (.+), (.*),
+	tupleE, tupT, tupP', intE, strP, pt, zp, ss, (..+), toLabel, lcfirst )
+
+---------------------------------------------------------------------------
+
+-- * STRUCT
+--	+ FUNCTION STRUCT
+--	+ NEWTYPE
+--	+ PATTERN
+--		- Function Mk Pattern
+--		- Function Mk Pattern Fun
+--	+ DERIVING
+--		- Function Mk Deriving
+--		- Show
+--		- Read
+--		- Eq
+--		- Ord
+--		- Bounded
+--		- Ix
+-- * STRUCT WITH PRIMITIVE MONAD
+-- 	+ FUNCTION STRUCT PRIM
+-- 	+ NEWTYPE
+-- 	+ FREEZE
+-- 	+ THAW
+-- 	+ COPY
+
+---------------------------------------------------------------------------
+-- STRUCT
+---------------------------------------------------------------------------
+
+-- FUNCTION STRUCT
+
+struct :: StrName -> StrSize ->
+	[(MemName, MemType, MemPeek, MemPoke)] -> [DerivClass] -> DecsQ
+struct sn sz (unzip4 -> (mns, mts, mpes, mpos)) dcs_ = (++)
+	<$> sequence [
+		mkNewtype sn,
+		pure . PragmaD $ CompleteP [mkName sn] Nothing,
+		mkPatternSig sn mts, mkPatternBody sn sz mns mpos,
+		mkPatternFunSig sn mts, mkPatternFunBody sn mpes ]
+	<*> mkInstances sn mns dcs
+	where dcs = case toDerivCollection dcs_ of
+		(d, []) -> d; (_, os) -> error $ "Can't derive: " ++ show os
+
+-- ^
+-- Example
+--
+-- @
+-- struct "Foo" ${size Foo}
+--	[	("x", ''CInt, [| #{peek Foo, x} |], [| #{poke Foo, x} |]),
+--		("y", ''CInt, [| #{peek Foo, y} |], [| #{poke Foo, y} |]) ]
+--	[''Show, ''Read, ''Eq, ''Ord, ''Bounded]
+-- @
+
+type StrName = String; type StrSize = Integer
+type MemName = String; type MemType = Name
+type MemPeek = ExpQ; type MemPoke = ExpQ
+type DerivClass = Name
+
+-- NEWTYPE
+
+mkNewtype :: StrName -> DecQ
+mkNewtype sn =
+	newtypeD (cxt []) (mkName sn) [] Nothing (normalC (mkName $ sn ++ "_") [
+		bangType
+			(bang noSourceUnpackedness noSourceStrictness)
+			(conT ''ForeignPtr `appT` conT (mkName sn)) ]) []
+
+-- PATTERN
+
+-- Function Mk Pattern
+
+mkPatternSig :: StrName -> [MemType] -> DecQ
+mkPatternSig (mkName -> sn) = patSynSigD sn . foldr (.->) (conT sn) . (conT <$>)
+
+mkPatternBody :: StrName -> StrSize -> [MemName] -> [MemPoke] -> DecQ
+mkPatternBody sn sz ms_ pos = patSynD (mkName sn) (recordPatSyn ms)
+	(explBidir [mkPatternBodyClause sn sz pos])
+	(viewP (varE . mkName $ lcfirst sn) (tupP' $ varP <$> ms))
+	where ms = mkName . toLabel sn <$> ms_
+
+mkPatternBodyClause :: StrName -> StrSize -> [MemPoke] -> ClauseQ
+mkPatternBodyClause (mkName . (++ "_") -> sn) sz pos = do
+	(vs, p) <- (,) <$> length pos `replicateM` newName "v" <*> newName "p"
+	let	vps = varP <$> vs; pe = varE p; fr = varE 'free `appE` pe
+	clause vps (normalB $ varE 'unsafePerformIO .$ conE sn .<$> doE (
+		(varP p `bindS` (varE 'mallocBytes `appE` intE sz)) :
+		((<$> zip pos vs) \(po, v) ->
+			noBindS $ po `appE` pe `appE` varE v) ++
+		[noBindS $ varE 'newForeignPtr `appE` pe `appE` fr] )) []
+
+-- Function Mk Pattern Fun
+
+mkPatternFunSig :: StrName -> [MemType] -> DecQ
+mkPatternFunSig (mkName . lcfirst &&& conT . mkName -> (fn, st)) =
+	sigD fn . (st .->) . tupT . (conT <$>)
+
+mkPatternFunBody :: StrName -> [MemPeek] -> DecQ
+mkPatternFunBody (mkName . lcfirst &&& mkName . (++ "_") -> (fn, cn)) pes =
+	funD fn . (: []) $ (,) <$> newName "f" <*> newName "p" >>= \(f, p) ->
+		clause [conP cn [varP f]] (normalB $ varE 'unsafePerformIO
+			.$ varE 'withForeignPtr `appE` varE f
+				`appE` lamE [bool (varP p) wildP $ null pes]
+					(mkPatternFunPeeks p pes)) []
+
+mkPatternFunPeeks :: Name -> [MemPeek] -> ExpQ
+mkPatternFunPeeks (varE -> p) (length &&& id -> (n, pes)) =
+	foldl (.<*>) (varE 'pure .$ tupleE n) $ (`appE` p) <$> pes
+
+-- DERIVING
+
+-- Function Mk Deriving
+
+mkInstances :: StrName -> [MemName] -> DerivCollection -> DecsQ
+mkInstances sn ms dc =
+	sequence $ (\(t, b) -> bool Nothing (Just t) b) `mapMaybe` zip [
+		mkInstanceShow sn ms, mkInstanceRead sn ms, mkInstanceEq sn ms,
+		mkInstanceOrd sn ms, mkInstanceBounded sn ms, mkInstanceIx sn ms
+		] [	derivingShow dc, derivingRead dc, derivingEq dc,
+			derivingOrd dc, derivingBounded dc, derivingIx dc ]
+
+data DerivCollection = DerivCollection {
+	derivingShow :: Bool, derivingRead :: Bool,
+	derivingEq :: Bool, derivingOrd :: Bool,
+	derivingBounded :: Bool, derivingIx :: Bool } deriving Show
+
+toDerivCollection :: [DerivClass] -> (DerivCollection, [DerivClass])
+toDerivCollection [] = (DerivCollection False False False False False False, [])
+toDerivCollection (d : ds) = case d of
+	NameShow -> (dc { derivingShow = True }, ds')
+	NameRead -> (dc { derivingRead = True }, ds')
+	NameEq -> (dc { derivingEq = True }, ds')
+	NameOrd -> (dc { derivingOrd = True }, ds')
+	NameBounded -> (dc { derivingBounded = True }, ds')
+	NameIx -> (dc {derivingIx = True }, ds')
+	_ -> (dc, d : ds')
+	where (dc, ds') = toDerivCollection ds
+
+pattern NameShow, NameRead, NameEq, NameOrd, NameBounded, NameIx :: Name
+pattern NameShow <- ((== ''Show) -> True)
+pattern NameRead <- ((== ''Read) -> True)
+pattern NameEq <- ((== ''Eq) -> True)
+pattern NameOrd <- ((== ''Ord) -> True)
+pattern NameBounded <- ((== ''Bounded) -> True)
+pattern NameIx <- ((== ''Ix) -> True)
+
+-- Show
+
+mkInstanceShow :: StrName -> [MemName] -> DecQ
+mkInstanceShow (mkName &&& id -> (sn, ssn)) ms = do
+	(s, vs) <- (,) <$> newName "s" <*> length ms `replicateM` newName "v"
+	instanceD (cxt []) (conT ''Show `appT` conT sn) . (: [])
+		$ funD 'showsPrec [clause [wildP, varP s]
+			(normalB $ ss (ssn ++ " {") ...
+				mkShowMems ssn ms vs ... ss "}")
+			[valD (conP sn $ varP <$> vs) (normalB $ varE s) []]]
+
+mkShowMems :: StrName -> [MemName] -> [Name] -> ExpQ
+mkShowMems (toLabel -> l) ms vs = foldr (...) (varE 'id) . intersperse (ss ", ")
+	$ (<$> zip ms vs) \(m, v) ->
+		l m ..+ " = " ... varE 'showsPrec `appE` intE 0 `appE` varE v
+
+-- Read
+
+mkInstanceRead :: StrName -> [MemName] -> DecQ
+mkInstanceRead sn ms = length ms `replicateM` newName "v" >>= \vs ->
+	instanceD (cxt []) (conT ''Read `appT` t) . (: [])
+		$ valD (varP 'readPrec) (normalB $ varE 'parens
+			.$ varE 'prec `appE` intE 10 `appE` doE ([
+				conP 'Ident [strP sn] `bindS` varE 'lexP,
+				conP 'Punc [strP "{"] `bindS` varE 'lexP ] ++
+				mkReadMems sn ms vs ++ [
+				conP 'Punc [strP "}"] `bindS` varE 'lexP,
+				noBindS $ varE 'pure
+					.$ foldl appE c (varE <$> vs) ])) []
+	where t = conT $ mkName sn; c = conE $ mkName sn
+
+mkReadMems :: StrName -> [MemName] -> [Name] -> [StmtQ]
+mkReadMems sn ms vs =
+	intercalate [conP 'Punc [strP ","] `bindS` varE 'lexP]
+		$ (<$> zip ms vs) \(m, v) -> [
+			conP 'Ident [strP $ toLabel sn m] `bindS` varE 'lexP,
+			conP 'Punc [strP "="] `bindS` varE 'lexP,
+			varP v `bindS` (varE 'step `appE` varE 'readPrec) ]
+
+-- Eq
+
+mkInstanceEq :: StrName -> [MemName] -> DecQ
+mkInstanceEq sn ms = (,) <$> newName "s" <*> newName "t" >>= \(s, t) ->
+	instanceD (cxt []) (conT ''Eq `appT` conT (mkName sn)) . (: [])
+		. funD '(==) . (: []) $ clause [varP s, varP t] (normalB
+			$ foldl (.&&) (conE 'True) $ mkMemEq sn s t <$> ms) []
+
+mkMemEq :: StrName -> Name -> Name -> MemName -> ExpQ
+mkMemEq sn (varE -> s) (varE -> t) m = let l = varE . mkName $ toLabel sn m in
+	l `appE` s .== l `appE` t
+
+-- Ord
+
+mkInstanceOrd :: StrName -> [MemName] -> DecQ
+mkInstanceOrd sn ms = (,) <$> newName "s" <*> newName "t" >>= \(s, t) ->
+	instanceD (cxt []) (conT ''Ord `appT` conT (mkName sn)) . (: [])
+		. funD '(<=) . (: []) $ clause [varP s, varP t] (
+			normalB $ varE 'foldr `appE` lamOrd s t `appE`
+				conE 'True `appE` listE ln ) []
+	where ln = varE . mkName . toLabel sn <$> ms
+
+lamOrd :: Name -> Name -> ExpQ
+lamOrd (varE -> s) (varE -> t) =
+	(,) <$> newName "x" <*> newName "v" >>= \(x, v) -> let xe = varE x in
+		lamE [varP x, varP v] $ xe `appE` s .< xe `appE` t .||
+			xe `appE` s .== xe `appE` t .&& varE v
+
+-- Bounded
+
+mkInstanceBounded :: StrName -> [MemName] -> DecQ
+mkInstanceBounded (mkName -> sn) (length -> n) =
+	instanceD (cxt []) (conT ''Bounded `appT` conT sn) [
+		valD (varP 'minBound) (normalB $ foldl appE (conE sn)
+			(replicate n $ varE 'minBound)) [],
+		valD (varP 'maxBound) (normalB $ foldl appE (conE sn)
+			(replicate n $ varE 'maxBound)) [] ]
+
+-- Ix
+
+mkInstanceIx :: StrName -> [MemName] -> DecQ
+mkInstanceIx (mkName -> sn) ms = instanceD (cxt []) (conT ''Ix `appT` conT sn) [
+	mkRange 'range sn ms, mkIndex 'index sn ms, mkInRange 'inRange sn ms ]
+
+mkRange :: Name -> Name -> [MemName] -> DecQ
+mkRange fn sn (length -> n) = do
+	(vs, ws, is) <- unzip3 <$> n `replicateM`
+		((,,) <$> newName "v" <*> newName "w" <*> newName "i")
+	funD fn . (: []) $ clause
+		[tupP [conP sn $ varP <$> vs, conP sn $ varP <$> ws]]
+		(normalB . compE . (++ [noBindS . foldl appE sne $ varE <$> is])
+			$ (<$> is `zip` (vs `zip` ws)) \(i, (v, w)) ->
+				bindS (varP i) $ rg `appE` tupE [varE v, varE w]
+			) []
+	where rg = varE 'range; sne = conE sn
+
+mkIndex :: Name -> Name -> [MemName] -> DecQ
+mkIndex fn (conP -> sn) (length -> n) = do
+	(vs, ws, is) <- unzip3 <$> n `replicateM`
+		((,,) <$> newName "v" <*> newName "w" <*> newName "i")
+	funD fn . (: []) $ clause
+		[tupP [sn $ varP <$> vs, sn $ varP <$> ws], sn $ varP <$> is]
+		(normalB $ varE 'foldl `appE` mkIndexLam `appE` intE 0
+			.$ listE (varE <$> vs) `zp` listE (varE <$> ws) `zp`
+				listE (varE <$> is)) []
+
+mkIndexLam :: ExpQ
+mkIndexLam =
+	(,,) <$> newName "v" <*> newName "z" <*> newName "k" >>= \(v, z, k) ->
+		lamE [varP v, tupP [varP z, varP k]]
+			$ (varE 'index `appE` varE z `appE` varE k) .+
+				(varE 'rangeSize `appE` varE z .* varE v)
+
+mkInRange :: Name -> Name -> [MemName] -> DecQ
+mkInRange fn (conP -> sn) (length -> n) = do
+	(vs, ws, is) <- unzip3 <$> n `replicateM`
+		((,,) <$> newName "v" <*> newName "w" <*> newName "i")
+	funD fn . (: []) $ clause
+		[tupP [sn $ varP <$> vs, sn $ varP <$> ws], sn $ varP <$> is]
+		(normalB . foldr (.&&) (conE 'True) $
+			(<$> vs `zip` ws `zip` is) \((v, w), i) ->
+				ir `appE` tupE [varE v, varE w] `appE` varE i
+			) []
+	where ir = varE 'inRange
+
+---------------------------------------------------------------------------
+-- STRUCT WITH PRIMITIVE MONAD
+---------------------------------------------------------------------------
+
+-- FUNCTION STRUCT PRIM
+
+structPrim :: StrName -> FunCopy -> FunFree -> [DerivClass] -> DecsQ
+structPrim nt cp fr ds = sequence [
+	mkNewtypePrim nt ds, mkTypeST nt, mkTypeIO nt,
+	mkFreezeSig nt, mkFreezeFun nt cp fr, mkThawSig nt, mkThawFun nt cp fr,
+	mkCopySig nt, mkCopyFun nt cp fr ]
+
+-- ^
+-- Example
+--
+-- @
+-- foreign import ccall "foo_copy" c_foo_copy :: Ptr Foo -> IO (Ptr Foo)
+-- foreign import ccall "foo_free" c_foo_free :: Ptr Foo -> IO ()
+--
+-- structPrim "Foo" 'c_foo_copy 'c_foo_free [''Show]
+-- @
+
+type FunCopy = Name; type FunFree = Name
+
+-- NEWTYPE AND TYPE SYNONYM
+
+mkNewtypePrim :: StrName -> [DerivClass] -> DecQ
+mkNewtypePrim sn ds = newName "s" >>= \s ->
+	newtypeD (cxt []) snp [plainTV s] Nothing
+		(normalC snp . (: []) $ bangType
+			(bang noSourceUnpackedness noSourceStrictness)
+			(conT ''ForeignPtr `appT` conT (mkName sn)))
+		[derivClause Nothing $ conT <$> ds]
+	where snp = mkName $ sn ++ "Prim"
+
+mkTypeIO :: StrName -> DecQ
+mkTypeIO sn = tySynD (mkName $ sn ++ "IO") []
+	$ conT (mkName $ sn ++ "Prim") `appT` conT ''RealWorld
+
+mkTypeST :: StrName -> DecQ
+mkTypeST sn = tySynD (mkName $ sn ++ "ST") [] . conT . mkName $ sn ++ "Prim"
+
+-- FREEZE
+
+mkFreezeSig :: StrName -> DecQ
+mkFreezeSig sn = newName "m" >>= \m ->
+	sigD fn . forallT [] (cxt [conT ''PrimMonad `appT` varT m])
+		$ conT snp `appT` (conT ''PrimState `appT` varT m) .->
+			varT m `appT` conT (mkName sn)
+	where fn = mkName $ lcfirst sn ++ "Freeze"; snp = mkName $ sn ++ "Prim"
+
+mkFreezeFun :: StrName -> FunCopy -> FunFree -> DecQ
+mkFreezeFun sn cp fr = newName "fp" >>= \fp ->
+	funD (mkName $ lcfirst sn ++ "Freeze") . (: []) $
+		clause [conP (mkName $ sn ++ "Prim") [varP fp]] (normalB
+			$ mkFreezeBody sn cp fr fp) []
+
+mkFreezeBody :: StrName -> FunCopy -> FunFree -> Name -> ExpQ
+mkFreezeBody sn cp fr fp =
+	varE 'unsafeIOToPrim ... conE (mkName $ sn ++ "_") `pt` varE '(<$>)
+		.$ varE 'withForeignPtr `appE` varE fp `appE` varE cp
+			.>>= varE 'newForeignPtr .<$> varE 'id .<*> varE fr
+
+-- THAW
+
+mkThawSig :: StrName -> DecQ
+mkThawSig sn = newName "m" >>= \m ->
+	sigD fn . forallT [] (cxt [conT ''PrimMonad `appT` varT m])
+		$ conT (mkName sn) .-> varT m `appT`
+			(conT snp `appT` (conT ''PrimState `appT` varT m))
+	where fn = mkName $ lcfirst sn ++ "Thaw"; snp = mkName $ sn ++ "Prim"
+
+mkThawFun :: StrName -> FunCopy -> FunFree -> DecQ
+mkThawFun sn cp fr = newName "fp" >>= \fp ->
+	funD (mkName $ lcfirst sn ++ "Thaw") . (: [])
+		$ clause [conP (mkName $ sn ++ "_") [varP fp]] (
+			normalB $ mkThawBody sn cp fr fp) []
+
+mkThawBody :: StrName -> FunCopy -> FunFree -> Name -> ExpQ
+mkThawBody sn cp fr fp =
+	varE 'unsafeIOToPrim ... conE (mkName $ sn ++ "Prim") `pt` varE '(<$>)
+		.$ varE 'withForeignPtr `appE` varE fp `appE` varE cp
+			.>>= varE 'newForeignPtr .<$> varE 'id .<*> varE fr
+
+-- COPY
+
+mkCopySig :: StrName -> DecQ
+mkCopySig sn = newName "m" >>= \m ->
+	sigD fn . forallT [] (cxt [conT ''PrimMonad `appT` varT m])
+		$ conT snp `appT` (conT ''PrimState `appT` varT m) .->
+			varT m `appT` (conT snp `appT`
+				(conT ''PrimState `appT` varT m))
+	where fn = mkName $ lcfirst sn ++ "Copy"; snp = mkName $ sn ++ "Prim"
+
+mkCopyFun :: StrName -> FunCopy -> FunFree -> DecQ
+mkCopyFun sn cp fr = newName "fp" >>= \fp ->
+	funD (mkName $ lcfirst sn ++ "Copy") . (: [])
+		$ clause [conP (mkName $ sn ++ "Prim") [varP fp]] (normalB
+			$ mkCopyBody sn cp fr fp) []
+
+mkCopyBody :: StrName -> FunCopy -> FunFree -> Name -> ExpQ
+mkCopyBody sn cp fr fp =
+	varE 'unsafeIOToPrim ... conE (mkName $ sn ++ "Prim") `pt` varE '(<$>)
+		.$ varE 'withForeignPtr `appE` varE fp `appE` varE cp
+			.>>= varE 'newForeignPtr .<$> varE 'id .<*> varE fr
diff --git a/src/Foreign/C/Struct/Parts.hs b/src/Foreign/C/Struct/Parts.hs
new file mode 100644
--- /dev/null
+++ b/src/Foreign/C/Struct/Parts.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
+
+module Foreign.C.Struct.Parts (
+	tupleE, tupT, tupP', intE, strP,
+	(.->), pt, (.$), (...), (.<$>), (.<*>), (.>>=),
+	(.&&), (.||), (.==), (.<), (.+), (.*), zp, ss, (..+),
+	toLabel, lcfirst ) where
+
+import Language.Haskell.TH (
+	ExpQ, Exp(TupE), varE, litE, infixE, TypeQ, appT, arrowT, tupleT,
+	PatQ, litP, tupP, Name, integerL, stringL )
+import Data.Char (toLower, toUpper)
+
+---------------------------------------------------------------------------
+
+-- * TEMPLATE
+--	+ TUPLE AND LITERAL
+--	+ OPERATOR
+--		- Make Operator
+--		- TYPE ARROW
+--		- FUNCTION APPLICATION
+--		- NORMAL OPERATOR
+--		- PARTIAL AND ZIP
+--	+ SHOW S
+-- * CHARACTER
+
+---------------------------------------------------------------------------
+-- TEMPLATE
+---------------------------------------------------------------------------
+
+-- TUPLE AND LITERAL
+
+tupleE :: Int -> ExpQ
+tupleE = \case 1 -> varE 'id; n -> pure . TupE $ n `replicate` Nothing
+
+tupT :: [TypeQ] -> TypeQ
+tupT = \case [t] -> t; ts -> foldl appT (tupleT $ length ts) ts
+
+tupP' :: [PatQ] -> PatQ
+tupP' = \case [p] -> p; ps -> tupP ps
+
+intE :: Integer -> ExpQ
+intE = litE . integerL
+
+strP :: String -> PatQ
+strP = litP . stringL
+
+-- OPERATOR
+
+-- Make Operator
+
+mkop :: Name -> ExpQ -> ExpQ -> ExpQ
+mkop op e f = infixE (Just e) (varE op) (Just f)
+
+-- Type Arrow And Partial
+
+infixr 0 .->
+
+(.->) :: TypeQ -> TypeQ -> TypeQ
+t .-> u = arrowT `appT` t `appT` u
+
+pt :: ExpQ -> ExpQ -> ExpQ
+e `pt` op = infixE (Just e) op Nothing
+
+-- Function Application
+
+infixr 0 .$
+infixl 1 .>>=
+infixl 4 .<$>, .<*>
+infixr 8 ...
+
+(.$), (...), (.<$>), (.<*>), (.>>=) :: ExpQ -> ExpQ -> ExpQ
+[(.$), (...), (.<$>), (.<*>), (.>>=)] =
+	mkop <$> ['($), '(.), '(<$>), '(<*>), '(>>=)]
+
+-- Normal Operator
+
+infixr 2 .||
+infixr 3 .&&
+infix 4 .==, .<
+
+(.&&), (.||), (.==), (.<), (.+), (.*), zp :: ExpQ -> ExpQ -> ExpQ
+[(.&&), (.||), (.==), (.<), (.+), (.*), zp] =
+	mkop <$> ['(&&), '(||), '(==), '(<), '(+), '(*), 'zip]
+
+-- SHOW S
+
+ss :: String -> ExpQ
+ss s = litE (stringL s) `pt` varE '(++)
+
+(..+) :: String -> String -> ExpQ
+s1 ..+ s2 = ss $ s1 ++ s2
+
+---------------------------------------------------------------------------
+-- CHARACTER
+---------------------------------------------------------------------------
+
+toLabel :: String -> String -> String
+toLabel sn = (lcfirst sn ++) . ucfirst
+
+lcfirst, ucfirst :: String -> String
+lcfirst = \case "" -> ""; c : cs -> toLower c : cs
+ucfirst = \case "" -> ""; c : cs -> toUpper c : cs
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"