diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,22 @@
+Copyright (c) 2014, Nikita Volkov
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
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/src/HTFTestSuite.hs b/src/HTFTestSuite.hs
new file mode 100644
--- /dev/null
+++ b/src/HTFTestSuite.hs
@@ -0,0 +1,9 @@
+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+
+import Test.Framework
+import TypeStructure.Prelude.Basic
+
+import {-@ HTF_TESTS @-} TypeStructureTest
+import {-@ HTF_TESTS @-} TypeStructure.THTest
+
+main = htfMain $ htf_thisModulesTests : htf_importedTests
diff --git a/src/TypeStructure.hs b/src/TypeStructure.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeStructure.hs
@@ -0,0 +1,121 @@
+module TypeStructure
+(
+  -- * Class
+  TypeStructure(..), 
+  derive,
+  -- * Model
+  module TypeStructure.Model, 
+)
+where
+
+import TypeStructure.Prelude.Basic
+import TypeStructure.Prelude.Data
+import TypeStructure.Prelude.Transformers
+import TypeStructure.Model
+import TypeStructure.Class
+import TypeStructure.TH
+import qualified TypeStructure.Prelude.TH as TH
+import qualified GHC.Exts
+
+
+-- base
+---------------------
+derive ''(->)
+derive ''()
+derive ''[]
+derive ''Int
+derive ''Int8
+derive ''Int16
+derive ''Int32
+derive ''Int64
+derive ''Integer
+derive ''Word
+derive ''Word8
+derive ''Word16
+derive ''Word32
+derive ''Word64
+derive ''Float
+derive ''Double
+derive ''Char
+derive ''Bool
+derive ''Ordering
+derive ''Fixed
+derive ''E0
+derive ''E1
+derive ''E2
+derive ''E3
+derive ''E6
+derive ''E9
+derive ''E12
+derive ''Ratio
+derive ''Last
+derive ''First
+derive ''Any
+derive ''All
+derive ''Sum
+derive ''Product
+derive ''Dual
+derive ''Seq
+derive ''Maybe
+derive ''Either
+derive ''GHC.Exts.Any
+derive ''ThreadId
+derive ''TypeRep
+derive ''StableName
+
+-- tuples
+fmap join $ mapM derive $ map TH.tupleTypeName [2..24]
+
+-- transformers
+---------------------
+derive ''Identity
+
+-- vector
+---------------------
+derive ''Vector
+
+-- array
+---------------------
+derive ''UArray
+derive ''Array
+
+-- containers
+---------------------
+derive ''IntSet
+derive ''IntMap
+derive ''Set
+derive ''Tree
+derive ''Map
+
+-- unordered-containers
+---------------------
+derive ''HashSet
+derive ''HashMap
+
+-- bytestring
+---------------------
+derive ''ByteString
+derive ''LazyByteString
+
+-- text
+---------------------
+derive ''Text
+derive ''LazyText
+
+-- time
+---------------------
+derive ''AbsoluteTime
+derive ''ZonedTime
+derive ''LocalTime
+derive ''TimeZone
+derive ''TimeOfDay
+derive ''NominalDiffTime
+derive ''UTCTime
+derive ''UniversalTime
+derive ''DiffTime
+derive ''Day
+
+-- type-structure
+---------------------
+derive ''Type
+derive ''Declaration
diff --git a/src/TypeStructure/Class.hs b/src/TypeStructure/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeStructure/Class.hs
@@ -0,0 +1,16 @@
+module TypeStructure.Class where
+
+import TypeStructure.Prelude.Basic
+import TypeStructure.Model
+
+
+-- |
+-- A type structure graph production.
+-- 
+-- Supposed to be used like this:
+-- 
+-- @
+-- graph (undefined :: Int)
+-- @
+class TypeStructure a where
+  graph :: a -> Graph
diff --git a/src/TypeStructure/Model.hs b/src/TypeStructure/Model.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeStructure/Model.hs
@@ -0,0 +1,50 @@
+module TypeStructure.Model where
+
+import TypeStructure.Prelude.Basic
+import TypeStructure.Prelude.Data
+
+
+-- |
+-- A representation of the type structure graph.
+-- 
+-- Consists of a type signature of the subject type and 
+-- a dictionary of all the types it refers to internally with
+-- primitive types as end-nodes.
+type Graph = (Type, Dictionary)
+
+-- | A type signature.
+data Type =
+  Type_App Type Type |
+  Type_Var TypeVar |
+  Type_Con TypeCon
+  deriving (Read, Show, Ord, Eq, Data, Typeable, Generic)
+
+instance Hashable Type
+
+-- | A type variable.
+type TypeVar = Name
+
+-- | A type constructor.
+type TypeCon = (Namespace, Name)
+
+-- | A name.
+type Name = Text
+
+-- | A namespace (module name).
+type Namespace = Text
+
+-- | A dictionary of type declarations indexed by type constructors.
+type Dictionary = [(TypeCon, Declaration)]
+
+-- | A type declaration.
+data Declaration = 
+  Declaration_ADT [TypeVar] [Constructor] | 
+  Declaration_Primitive |
+  Declaration_Synonym [TypeVar] Type
+  deriving (Read, Show, Ord, Eq, Data, Typeable, Generic)
+
+instance Hashable Declaration
+
+-- | A data constructor used in type declaration.
+type Constructor = (Name, [Type])
+
diff --git a/src/TypeStructure/Prelude/Basic.hs b/src/TypeStructure/Prelude/Basic.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeStructure/Prelude/Basic.hs
@@ -0,0 +1,88 @@
+module TypeStructure.Prelude.Basic
+( 
+  module Exports,
+
+  traceM,
+  bug,
+  bottom,
+
+  (?:),
+  (|>),
+  (<|),
+  (|$>),
+)
+where
+
+-- base
+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, FilePath, id, (.))
+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)
+import Control.Applicative as Exports
+import Control.Arrow as Exports hiding (left, right)
+import Control.Category as Exports
+import Data.Monoid as Exports
+import Data.Foldable as Exports
+import Data.Traversable as Exports hiding (for)
+import Data.Maybe as Exports
+import Data.Either as Exports
+import Data.List as Exports hiding (concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
+import Data.Tuple as Exports
+import Data.Ord as Exports (Down(..))
+import Data.String as Exports
+import Data.Int as Exports
+import Data.Word as Exports
+import Data.Ratio as Exports
+import Data.Fixed as Exports
+import Data.Ix as Exports
+import Data.Data as Exports
+import Text.Read as Exports (readMaybe, readEither)
+import Control.Exception as Exports hiding (tryJust, try, assert)
+import Control.Concurrent as Exports hiding (yield)
+import System.Mem.StableName as Exports
+import System.Timeout as Exports
+import System.Exit as Exports
+import System.IO.Unsafe as Exports
+import System.IO as Exports (Handle, hClose)
+import System.IO.Error as Exports
+import Unsafe.Coerce as Exports
+import GHC.Exts as Exports hiding (Any, traceEvent)
+import GHC.Generics as Exports (Generic)
+import GHC.IO.Exception as Exports
+import Data.IORef as Exports
+import Data.STRef as Exports
+import Control.Monad.ST as Exports
+import Debug.Trace as Exports
+
+-- placeholders
+import Development.Placeholders as Exports
+
+
+import qualified Debug.Trace.LocationTH
+
+traceM :: (Monad m) => String -> m ()
+traceM s = trace s $ return ()
+
+bug = [e| $(Debug.Trace.LocationTH.failure) . (msg <>) |]
+  where
+    msg = "A \"type-structure\" package bug: " :: String
+
+bottom = [e| $bug "Bottom evaluated" |]
+
+(?:) :: Maybe a -> a -> a
+maybeA ?: b = fromMaybe b maybeA
+{-# INLINE (?:) #-}
+
+(|>) :: a -> (a -> b) -> b
+a |> aToB = aToB a
+{-# INLINE (|>) #-}
+
+(<|) :: (a -> b) -> a -> b
+aToB <| a = aToB a
+{-# INLINE (<|) #-}
+
+-- | 
+-- The following are all the same:
+-- fmap f a == f <$> a == a |> fmap f == a |$> f
+-- 
+-- This operator accomodates the left-to-right operators: >>=, >>>, |>.
+(|$>) = flip fmap
+{-# INLINE (|$>) #-}
diff --git a/src/TypeStructure/Prelude/Data.hs b/src/TypeStructure/Prelude/Data.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeStructure/Prelude/Data.hs
@@ -0,0 +1,54 @@
+module TypeStructure.Prelude.Data
+(
+  module Exports,
+
+  LazyByteString,
+  LazyText,
+  packText,
+  unpackText,
+)
+where
+
+-- hashable
+import Data.Hashable as Exports (Hashable(..), hash)
+
+-- bytestring
+import Data.ByteString as Exports (ByteString)
+
+-- text
+import Data.Text as Exports (Text)
+
+-- containers
+import Data.Map as Exports (Map)
+import Data.IntMap as Exports (IntMap)
+import Data.Set as Exports (Set)
+import Data.IntSet as Exports (IntSet)
+import Data.Sequence as Exports (Seq)
+import Data.Tree as Exports (Tree)
+
+-- unordered-containers
+import Data.HashMap.Strict as Exports (HashMap)
+import Data.HashSet as Exports (HashSet)
+
+-- array
+import Data.Array as Exports (Array)
+import Data.Array.Unboxed as Exports (UArray)
+import Data.Array.IArray as Exports (IArray)
+
+-- vector
+import Data.Vector as Exports (Vector)
+
+-- time
+import Data.Time as Exports (Day, DiffTime, NominalDiffTime, UniversalTime, UTCTime, LocalTime, TimeOfDay, TimeZone, ZonedTime)
+import Data.Time.Clock.TAI as Exports (AbsoluteTime)
+
+
+import qualified Data.ByteString.Lazy
+import qualified Data.Text.Lazy
+import qualified Data.Text
+
+type LazyByteString = Data.ByteString.Lazy.ByteString
+type LazyText = Data.Text.Lazy.Text
+
+packText = Data.Text.pack
+unpackText = Data.Text.unpack
diff --git a/src/TypeStructure/Prelude/TH.hs b/src/TypeStructure/Prelude/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeStructure/Prelude/TH.hs
@@ -0,0 +1,24 @@
+module TypeStructure.Prelude.TH
+(
+  module Exports,
+
+  purify,
+  tryToReify,
+  isProperInstance',
+)
+where
+
+import TypeStructure.Prelude.Basic
+import Language.Haskell.TH as Exports
+import THInstanceReification as Exports
+
+
+purify :: Q a -> a
+purify = unsafePerformIO . runQ
+
+tryToReify :: Name -> Q (Maybe Info)
+tryToReify n = recover (return Nothing) (fmap Just $ reify n) 
+
+isProperInstance' :: Name -> [Type] -> Q Bool
+isProperInstance' name types = recover (return False) (isProperInstance name types)
+
diff --git a/src/TypeStructure/Prelude/Transformers.hs b/src/TypeStructure/Prelude/Transformers.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeStructure/Prelude/Transformers.hs
@@ -0,0 +1,9 @@
+module TypeStructure.Prelude.Transformers (module Exports) where
+
+import Control.Monad.Identity as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)
+import Control.Monad.State as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)
+import Control.Monad.Reader as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)
+import Control.Monad.Writer as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM, Any)
+import Control.Monad.RWS as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM, Any)
+import Control.Monad.Cont as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)
+import Control.Monad.Error as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)
diff --git a/src/TypeStructure/TH.hs b/src/TypeStructure/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeStructure/TH.hs
@@ -0,0 +1,117 @@
+module TypeStructure.TH where
+
+import TypeStructure.Prelude.Basic
+import TypeStructure.Prelude.Transformers
+import TypeStructure.Prelude.Data
+import TypeStructure.Prelude.TH
+import qualified TypeStructure.Class as Class
+import qualified TypeStructure.TH.Model as M
+import qualified TypeStructure.TH.Template as Template
+
+
+-- |
+-- Automatically derive the instance of 'Class.TypeStructure' using Template Haskell.
+derive :: Name -> Q [Dec]
+derive name = do
+  typeCon <- deriveTypeCon name
+  info <- reify name
+  let
+    declaration = infoToDeclaration info
+    vars = case declaration of
+      M.Primitive arity -> arity |> take |> ($ [0..]) |> map (show >>> ('_':))
+      M.ADT vars _ -> vars
+      M.Synonym vars _ -> vars
+  (typesWithoutDictionaries, typesWithDictionaries) <- 
+    partitionEithers <$> 
+    execStateT (analyzeReferredTypes name) []
+  inlinedRecords <- forM typesWithoutDictionaries $ \n -> do
+    typeCon <- deriveTypeCon n
+    declaration <- infoToDeclaration <$> reify n
+    return (typeCon, declaration)
+  return $ (:[]) $ Template.renderInstance 
+    name vars typeCon (nub $ (typeCon, declaration) : inlinedRecords) typesWithDictionaries
+  where
+    deriveTypeCon name = do
+      ns <- maybe (fail "Name without namespace") return $ nameModule name
+      return (ns, nameBase name)
+
+analyzeReferredTypes :: 
+  Name -> 
+  StateT [Either Name Type] Q ()
+analyzeReferredTypes name = do
+  info <- lift $ reify $ name
+  forM_ (referredTypes info) analyzeType
+  where
+    analyzeType t = do
+      (lift $ isProperInstance' ''Class.TypeStructure [t]) >>= \case
+        True -> void $ insert $ Right $ t
+        False -> case t of
+          AppT l r -> analyzeType l >> analyzeType r
+          ConT n -> do
+            inserted <- insert $ Left $ n
+            when inserted $ analyzeReferredTypes n
+          _ -> return ()
+    insert a = state $ \list ->
+      if elem a list
+        then (False, list)
+        else (True, a : list)
+
+referredTypes :: Info -> [Type]
+referredTypes = \case
+  TyConI d -> case d of
+    DataD _ _ _ cons _ -> conTypes =<< cons
+    NewtypeD _ _ _ con _ -> conTypes $ con
+    TySynD _ _ t -> [t]
+    d -> $bug $ "Unsupported dec: " <> show d
+  PrimTyConI n arity _ -> []
+  i -> $bug $ "Unsupported info: " <> show i
+
+conTypes :: Con -> [Type]
+conTypes = \case
+  NormalC n ts -> map snd ts
+  RecC n ts -> map (\(_, _, t) -> t) ts
+  InfixC (_, l) n (_, r) -> [l, r]
+  c -> $bug $ "Unexpected constructor: " <> show c
+
+adaptType :: Type -> M.Type
+adaptType = \case
+  AppT l r -> M.App (adaptType l) (adaptType r)
+  VarT n -> M.Var $ nameBase $ n
+  ConT n -> fromName n
+  TupleT a -> fromName $ tupleTypeName a
+  UnboxedTupleT a -> fromName $ unboxedTupleTypeName a
+  ArrowT -> fromName ''(->)
+  ListT -> fromName ''[]
+  t -> $bug $ "Unsupported type: " <> show t
+  where
+    fromName n = 
+      M.Con $ 
+        adaptTypeConName n ?: 
+        ($bug $ "Name has no namespace: " <> show n)
+
+adaptTypeConName :: Name -> Maybe M.TypeCon
+adaptTypeConName n = do
+  ns <- nameModule n
+  return (ns, nameBase n)
+
+infoToDeclaration :: Info -> M.Declaration
+infoToDeclaration = \case
+  TyConI d -> case d of
+    DataD _ _ vars cons _ -> M.ADT (map adaptVar vars) (map adaptCon cons)
+    NewtypeD _ _ vars con _ -> M.ADT (map adaptVar vars) [adaptCon con]
+    TySynD _ vars t -> M.Synonym (map adaptVar vars) (adaptType t)
+    d -> $bug $ "Unsupported dec: " <> show d
+  PrimTyConI _ arity _ -> M.Primitive arity
+  i -> $bug $ "Unsupported info: " <> show i
+
+adaptVar :: TyVarBndr -> M.TypeVar
+adaptVar = \case
+  PlainTV n -> nameBase n
+  KindedTV n k -> nameBase n
+
+adaptCon :: Con -> M.Constructor
+adaptCon = \case
+  NormalC n ts -> (nameBase n, map (\(_, t) -> adaptType t) ts)
+  RecC n ts -> (nameBase n, map (\(_, _, t) -> adaptType t) ts)
+  InfixC (_, a) n (_, b) -> (nameBase n, [adaptType a, adaptType b])
+  c -> $bug $ "Unexpected constructor: " <> show c
diff --git a/src/TypeStructure/TH/Model.hs b/src/TypeStructure/TH/Model.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeStructure/TH/Model.hs
@@ -0,0 +1,32 @@
+module TypeStructure.TH.Model where
+
+import TypeStructure.Prelude.Basic
+
+-- NOTE!
+-- Oddly enough, this model almost completely replicates the output Model itself, 
+-- so... Refactoring, baby!
+
+data Type =
+  App Type Type |
+  Var TypeVar |
+  Con TypeCon
+  deriving (Show, Eq, Ord)
+
+type TypeCon = (Namespace, Name)
+
+type Namespace = String
+
+type Name = String
+
+type TypeVar = Name
+
+data Declaration = 
+  Primitive Arity |
+  ADT [TypeVar] [Constructor] |
+  Synonym [TypeVar] Type
+  deriving (Show, Eq, Ord)
+
+type Arity = Int
+
+type Constructor = (Name, [Type])
+
diff --git a/src/TypeStructure/TH/Template.hs b/src/TypeStructure/TH/Template.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeStructure/TH/Template.hs
@@ -0,0 +1,141 @@
+
+module TypeStructure.TH.Template where
+
+import TypeStructure.Prelude.Basic
+import TypeStructure.Prelude.Transformers
+import TypeStructure.Prelude.Data
+import TypeStructure.TH.Model
+import qualified TypeStructure.Prelude.TH as T
+import qualified TypeStructure.Model as M
+import qualified TypeStructure.Class as C
+
+-- |
+-- 1.
+-- @
+-- Type_Var "a"
+-- @
+-- 
+-- 2.
+-- @
+-- Type_App (Type_Con ("GHC.Types", "[]")) (Type_Var "a")])
+-- @
+-- 
+renderType :: Type -> T.Exp
+renderType = \case
+  App l r -> T.purify [e| M.Type_App $(return $ renderType $ l) $(return $ renderType $ r) |]
+  Var n -> T.purify [e| M.Type_Var $(T.stringE $ n) |]
+  Con tcs -> T.purify [e| M.Type_Con $(return $ renderTypeCon tcs) |]
+
+-- |
+renderTypeCon :: TypeCon -> T.Exp
+renderTypeCon (ns, n) = T.purify [e| ($(T.stringE ns), $(T.stringE n)) |]
+
+-- |
+-- Either
+-- 
+-- @
+-- let
+--   vars = ["a"]
+--   cons =
+--     [("[]", []),
+--      (":", 
+--       [Type_Var "a",
+--        Type_App (Type_Con ("GHC.Types", "[]")) (Type_Var "a")])]
+--   in Dec_ADT vars cons
+-- @
+-- 
+-- or
+-- 
+-- @
+-- Dec_Primitive
+-- @
+-- 
+renderDeclaration :: Declaration -> T.Exp
+renderDeclaration = \case
+  Primitive _ -> T.purify [e| M.Declaration_Primitive |]
+  ADT vars constructors -> T.purify [e| M.Declaration_ADT $varsE $consE |] where
+    varsE = T.listE $ map T.stringE vars
+    consE = T.listE $ map renderCons constructors
+      where
+        renderCons (n, tss) = [e| ($nameE, $typesE) |] where
+          nameE = T.stringE $ n
+          typesE = T.listE $ map (return . renderType) tss
+  Synonym vars t -> T.purify [e| M.Declaration_Synonym $varsE $typeE |] where
+    varsE = T.listE $ map T.stringE vars
+    typeE = return $ renderType t
+
+-- |
+-- @
+-- instance TypeStructure a => TypeStructure (GHC.Types.[] a) where
+--   graph = const $ (finalType, dictionary)
+--     where
+--       finalType = Type_App (Type_Con ("GHC.Types", "[]")) ((fst . graph) (undefined :: a))
+--       dictionary = Data.HashMap.Strict.insert typeCon declaration inheritedDictionary
+--         where
+--           typeCon = ("GHC.Types", "[]")
+--           declaration = 
+--             let
+--               vars = ["a"]
+--               cons =
+--                 [("[]", []),
+--                  (":", 
+--                   [Type_Var "a",
+--                    Type_App (Type_Con ("GHC.Types", "[]")) (Type_Var "a")])]
+--               in Dec_ADT vars cons
+--           inheritedDictionary = mconcat [(snd . graph) (undefined :: a)]
+-- @
+-- 
+renderInstance
+  :: T.Name -- ^ Type con 
+  -> [TypeVar]
+  -> TypeCon
+  -> [(TypeCon, Declaration)] -- ^ Records
+  -> [T.Type] -- ^ TH Types to inherit dictionaries from
+  -> T.Dec
+renderInstance name vars tcs dictionaryRecords inheritedDictionaries =
+  T.InstanceD 
+    context 
+    (T.ConT ''C.TypeStructure `T.AppT` headType) 
+    [graphDec]
+  where
+    context = flip map varTypes $ (T.ClassP ''C.TypeStructure . pure)
+    varTypes = map (T.VarT . T.mkName) vars
+    headType = foldl T.AppT (T.ConT name) varTypes
+    graphDec = T.FunD 'C.graph [T.Clause [] (T.NormalB exp) [finalTypeDec, dictionaryDec, typeConDec]] 
+      where
+        exp = T.purify $ [e| const ($(T.varE $ T.mkName "finalType"), $(T.varE $ T.mkName "dictionary")) |]
+        finalTypeDec = T.FunD (T.mkName "finalType") [clause] where
+          clause = T.Clause [] (T.NormalB exp) [] where
+            exp = 
+              T.purify $
+              foldM 
+                (\l r -> [e| M.Type_App $(return l) $(return r) |]) 
+                (T.purify [e| M.Type_Con $(T.varE $ T.mkName "typeCon") |])
+                (map varExp varTypes)
+              where
+                varExp t = T.purify [e| ((fst . C.graph) (undefined :: $(return t))) |]
+        dictionaryDec = T.FunD (T.mkName "dictionary") [T.Clause [] (T.NormalB exp) []] where
+          exp = T.purify
+            [e|
+              let
+                newRecords = $(
+                    return $ T.ListE $ flip map dictionaryRecords $ \(tcs, ds) ->
+                      T.purify 
+                        [e|
+                          let 
+                            typeCon = $(return $ renderTypeCon tcs)
+                            declaration = $(return $ renderDeclaration ds)
+                            in (typeCon, declaration)
+                        |]
+                  )
+                inheritedDictionary = 
+                  mconcat $ dicsOfTypeVars ++ dicsOfReferredTypes
+                  where
+                    dicsOfTypeVars = $(return $ T.ListE $ map dictionaryExp varTypes)
+                    dicsOfReferredTypes = $(return $ T.ListE $ map dictionaryExp inheritedDictionaries)
+                in foldr (\p -> (p:) . delete p) inheritedDictionary newRecords
+            |]
+            where
+              dictionaryExp t = T.purify [e| ((snd . C.graph) (undefined :: $(return t))) |]
+        typeConDec = T.FunD (T.mkName "typeCon") [T.Clause [] (T.NormalB exp) []] where
+          exp = renderTypeCon tcs
diff --git a/type-structure.cabal b/type-structure.cabal
new file mode 100644
--- /dev/null
+++ b/type-structure.cabal
@@ -0,0 +1,183 @@
+name:
+  type-structure
+version:
+  0.1.0
+synopsis:
+  Type structure analysis
+description:
+  Provides facilities to match type structures.
+
+  Useful for checking protocol compliance in client-server applications.
+category:
+  Data
+homepage:
+  https://github.com/nikita-volkov/type-structure 
+bug-reports:
+  https://github.com/nikita-volkov/type-structure/issues 
+author:
+  Nikita Volkov <nikita.y.volkov@mail.ru>
+maintainer:
+  Nikita Volkov <nikita.y.volkov@mail.ru>
+copyright:
+  (c) 2014, Nikita Volkov
+license:
+  MIT
+license-file:
+  LICENSE
+build-type:
+  Simple
+cabal-version:
+  >=1.10
+
+
+source-repository head
+  type:
+    git
+  location:
+    git://github.com/nikita-volkov/type-structure.git
+
+
+library
+  hs-source-dirs:
+    src
+  other-modules:
+    TypeStructure.TH.Model
+    TypeStructure.TH.Template
+    TypeStructure.TH
+    TypeStructure.Model
+    TypeStructure.Class
+    TypeStructure.Prelude.Basic
+    TypeStructure.Prelude.Data
+    TypeStructure.Prelude.Transformers
+    TypeStructure.Prelude.TH
+  exposed-modules:
+    TypeStructure
+  build-depends:
+    -- data:
+    time,
+    vector,
+    array,
+    bytestring,
+    text,
+    hashable,
+    unordered-containers,
+    containers,
+    -- control:
+    transformers,
+    mtl,
+    -- debugging:
+    loch-th == 0.2.*,
+    placeholders == 0.1.*,
+    -- template-haskell:
+    th-instance-reification > 0.1.0 && < 0.2,
+    template-haskell,
+    -- general:
+    base >= 4.5 && < 5
+  default-extensions:
+    Arrows
+    BangPatterns
+    ConstraintKinds
+    DataKinds
+    DefaultSignatures
+    DeriveDataTypeable
+    DeriveGeneric
+    EmptyDataDecls
+    FlexibleContexts
+    FlexibleInstances
+    FunctionalDependencies
+    GADTs
+    GeneralizedNewtypeDeriving
+    ImpredicativeTypes
+    LambdaCase
+    LiberalTypeSynonyms
+    MultiParamTypeClasses
+    MultiWayIf
+    NoImplicitPrelude
+    NoMonomorphismRestriction
+    OverloadedStrings
+    PatternGuards
+    QuasiQuotes
+    RankNTypes
+    RecordWildCards
+    ScopedTypeVariables
+    StandaloneDeriving
+    TemplateHaskell
+    TupleSections
+    TypeFamilies
+    TypeOperators
+  default-language:
+    Haskell2010
+
+
+test-suite type-structure-htf-test-suite
+  type:             
+    exitcode-stdio-1.0
+  hs-source-dirs:   
+    src
+  main-is:          
+    HTFTestSuite.hs
+  ghc-options:
+    -threaded
+    "-with-rtsopts=-N"
+  build-depends:
+    -- testing:
+    quickcheck-instances,
+    QuickCheck-GenT == 0.1.*,
+    QuickCheck,
+    HUnit,
+    HTF == 0.11.*,
+    -- data:
+    time,
+    vector,
+    array,
+    bytestring,
+    text,
+    hashable,
+    unordered-containers,
+    containers,
+    -- control:
+    transformers,
+    mtl,
+    -- debugging:
+    loch-th == 0.2.*,
+    placeholders == 0.1.*,
+    -- template-haskell:
+    th-instance-reification > 0.1.0 && < 0.2,
+    template-haskell,
+    -- general:
+    base >= 4.5 && < 5
+  default-extensions:
+    Arrows
+    BangPatterns
+    ConstraintKinds
+    DataKinds
+    DefaultSignatures
+    DeriveDataTypeable
+    DeriveGeneric
+    EmptyDataDecls
+    FlexibleContexts
+    FlexibleInstances
+    FunctionalDependencies
+    GADTs
+    GeneralizedNewtypeDeriving
+    ImpredicativeTypes
+    LambdaCase
+    LiberalTypeSynonyms
+    MultiParamTypeClasses
+    MultiWayIf
+    NoImplicitPrelude
+    NoMonomorphismRestriction
+    OverloadedStrings
+    PatternGuards
+    QuasiQuotes
+    RankNTypes
+    RecordWildCards
+    ScopedTypeVariables
+    StandaloneDeriving
+    TemplateHaskell
+    TupleSections
+    TypeFamilies
+    TypeOperators
+  default-language:
+    Haskell2010
+