diff --git a/Data/Yoko.hs b/Data/Yoko.hs
--- a/Data/Yoko.hs
+++ b/Data/Yoko.hs
@@ -3,11 +3,15 @@
   ScopedTypeVariables, UndecidableInstances #-}
 
 module Data.Yoko
-  (derive, Equal, module Data.Yoko.Representation,
-   module Data.Yoko.TypeSums, module Data.Yoko, encode) where
+  (Equal,
+   module Data.Yoko.Representation,
+   module Data.Yoko.TypeSums,
+   module Data.Yoko.View,
+   module Data.Yoko) where
 
 import Data.Yoko.TypeBasics
 import Data.Yoko.Representation
+import Data.Yoko.View
 import Data.Yoko.TypeSums (Embed, Partition, (:-:))
 import qualified Data.Yoko.TypeSums as TypeSums
 import Data.Yoko.Each
@@ -26,19 +30,6 @@
 
 
 
-type family Tag dc
-
-type family Range dc
-class (Generic dc, DT (Range dc)) => DC dc where rejoin :: dc -> Range dc
-
-type family DCs t
-type Disbanded t = DCsOf t (DCs t)
-class Each IsDCOf (DCs t) => DT t where disband :: t -> Disbanded t
-
-class (Partition (DCs (Range dc)) (N dc) (DCs (Range dc) :-: N dc),
-       Embed (N dc) (DCs (Range dc))) => IsDCOf dc
-instance (Partition (DCs (Range dc)) (N dc) (DCs (Range dc) :-: N dc),
-          Embed (N dc) (DCs (Range dc))) => IsDCOf dc
 
 
 
diff --git a/Data/Yoko/Representation.hs b/Data/Yoko/Representation.hs
--- a/Data/Yoko/Representation.hs
+++ b/Data/Yoko/Representation.hs
@@ -8,7 +8,6 @@
 
 
 data U = U
-newtype F a = F a
 infixr 6 :*:
 data a :*: b = a :*: b
 
@@ -20,6 +19,7 @@
 
 
 newtype Par1 f a = Par1 (f a)
+newtype Par2 f a b = Par2 (f a b)
 
 
 
@@ -41,6 +41,7 @@
 mapRec f (Rec x) = Rec (f x)
 
 unPar1 (Par1 x) = x
+unPar2 (Par2 x) = x
 
 unN (N x) = x
 foldN f = f . unN
diff --git a/Data/Yoko/TH.hs b/Data/Yoko/TH.hs
new file mode 100644
--- /dev/null
+++ b/Data/Yoko/TH.hs
@@ -0,0 +1,310 @@
+{-# LANGUAGE TypeOperators, ViewPatterns, TemplateHaskell, PatternGuards #-}
+
+module Data.Yoko.TH
+  (yokoTH, yokoTH_with, yokoDefaults, YokoOptions(..), Mapping(..)) where
+
+import Type.Spine.Stage0 (Spine, spineType_, kTypeG)
+import Type.Serialize (serializeTypeAsHash_)
+import qualified Type.Ord as Ord
+
+import Data.Yoko.TypeBasics (encode)
+import Data.Yoko.Representation
+import Data.Yoko.View
+
+import Language.Haskell.TH as TH hiding (Range)
+import Language.Haskell.TH.Syntax as TH hiding (Range)
+import qualified Language.Haskell.TH.SCCs as SCCs
+
+import qualified Data.Yoko.TH.Internal as Int
+
+import qualified Control.Monad.Writer as Writer
+import qualified Control.Monad.Trans as Trans
+
+import qualified Control.Arrow as Arrow
+
+import Data.Set (Set)
+import qualified Data.Set as Set
+import qualified Data.List as List
+
+import Data.Kind (KindStar(..))
+import Data.TypeFun
+import Data.Record hiding (convert, Name)
+import qualified Data.Record as R
+import qualified Data.Record.Combinators as R
+import Data.Record.Combinators ((!!!))
+
+
+
+
+
+convert r = R.convert $ R.withStyle r (Id KindStar)
+
+data Target = Target deriving Show
+data Renamer = Renamer deriving Show
+data Mappings = Mappings deriving Show
+data BindingGroup = BindingGroup deriving Show
+data TargetData = TargetData deriving Show
+data TargetType = TargetType deriving Show
+data TargetKind = TargetKind deriving Show
+instance R.Name Target where name = Target
+instance R.Name Renamer where name = Renamer
+instance R.Name Mappings where name = Mappings
+instance R.Name BindingGroup where name = BindingGroup
+instance R.Name TargetData where name = TargetData
+instance R.Name TargetType where name = TargetType
+instance R.Name TargetKind where name = TargetKind
+
+
+
+data Mapping = Mapping
+  {containerTypeName :: Name, containerCtor :: Name,
+   methodName :: Name}
+
+data YokoOptions = YokoOptions
+  {renamer :: (String -> String) -> (String -> String),
+   mappings :: [(Int, Mapping)] -> [(Int, Mapping)]}
+
+yokoDefaults :: YokoOptions
+yokoDefaults = YokoOptions id id
+
+type M r = Writer.WriterT [Dec] Q
+
+liftQ :: Q a -> M r a
+liftQ = Trans.lift
+
+runM :: M r () -> Q [Dec]
+runM = fmap snd . Writer.runWriterT
+
+generate :: [Dec] -> M r ()
+generate = Writer.tell
+
+
+
+yokoTH :: Name -> Q [Dec]
+yokoTH n = yokoTH_with yokoDefaults n
+
+yokoTH_with :: YokoOptions -> Name -> Q [Dec]
+yokoTH_with options n = runM $ yoko0 $ X :&
+  Target := n :& Renamer := (mkName . renamer options (++ "_") . TH.nameBase)
+         :& Mappings := mappings options [(1, Mapping ''Par1 'Par1 'fmap)]
+
+
+
+
+-- gather reflective information about the target type
+yoko0 r@(convert -> X :& Target := n) = do
+  names <- liftQ $ SCCs.binding_group n
+  datatype@(Int.DataType tvbs _) <- liftQ $ Int.dataType n
+
+  let ty = applyConT2TVBs n tvbs
+
+  -- get the kind of the target type; each fields type has the same kind
+  cxt <- flip mapM tvbs $ \tvb -> liftQ $
+    EqualP (ConT ''Ord.EQ) `fmap` do
+      let tv = [t| Spine ($(kTypeG (tvbKind tvb)) $(return $ tvbType tvb)) |]
+      [t| Ord.Compare $tv $tv |]
+
+  yoko1 $ r :&
+    BindingGroup := names :&
+    TargetData := datatype :&
+    TargetType := ty :&
+    TargetKind := (map tvbKind tvbs, cxt)
+
+-- generate fields types
+conName :: Con -> Name
+conName (NormalC n _) = n
+conName (RecC n _) = n
+conName (InfixC _ n _) = n
+conName (ForallC _ _ c) = conName c
+
+renameCon :: (Name -> Name) -> Con -> Con
+renameCon f (NormalC n fields) = NormalC (f n) fields
+renameCon f (RecC n fields) = RecC (f n) fields
+renameCon f (InfixC fieldL n fieldR) = InfixC fieldL (f n) fieldR
+renameCon f (ForallC tvbs cxt c) = ForallC tvbs cxt $ renameCon f c
+
+tvbName :: TyVarBndr -> Name
+tvbName (PlainTV n) = n
+tvbName (KindedTV n _) = n
+
+tvbKind :: TyVarBndr -> Kind
+tvbKind (PlainTV _) = StarK
+tvbKind (KindedTV _ k) = k
+
+tvbType :: TyVarBndr -> Type
+tvbType = VarT . tvbName
+
+applyConT2TVBs :: Name -> [TyVarBndr] -> Type
+applyConT2TVBs n tvbs = foldl ((. tvbType) . AppT) (ConT n) tvbs
+
+conFields :: Con -> Q [StrictType]
+conFields (NormalC _ fds)    = return fds
+conFields (RecC _ fds)       = return $ map (\(_, x, y) -> (x, y)) fds
+conFields (InfixC fdl _ fdr) = return [fdl, fdr]
+conFields ForallC{}          = Int.thFail "no support for existential types."
+
+pat_exp :: Name -> Name -> Int -> (Pat, Exp)
+pat_exp np ne k = (ConP np $ map VarP ns,
+                   foldl ((. VarE) . AppE) (ConE ne) ns) where
+  ns = [ mkName $ "x" ++ show i | i <- [0..k - 1] ]
+
+simpleClause pats exp = Clause pats (NormalB exp) []
+
+halves :: [a] -> b -> (b -> b -> b) -> (a -> b) -> b
+halves as nil app each = w (length as) as where
+  w _ []  = nil
+  w _ [a] = each a
+  w k as  = w lk l `app` w rk r
+    where lk = k `div` 2   ;   rk = k - lk
+          (l, r) = List.splitAt lk as
+
+peelApp :: Type -> (Type, [Type])
+peelApp = peelAppAcc []
+
+peelAppAcc acc (AppT ty0 ty1) = peelAppAcc (ty1 : acc) ty0
+peelAppAcc acc ty             = (ty, acc)
+
+data FieldRO = FieldRO {repF :: Exp, objF :: Exp}
+
+fieldRO :: [(Int, Mapping)] -> Set Name -> Type -> Q (Type, FieldRO)
+fieldRO maps bg = w' where
+  w' = uncurry w . peelApp
+
+  isRec n = Set.member n bg
+
+  simple b ty tys = return $ (ConT tyn `AppT` foldl AppT ty tys,
+    if b then FieldRO (ConE 'Rec) (VarE 'unRec)
+         else FieldRO (ConE 'Dep) (VarE 'unDep))
+    where tyn = if b then ''Rec else ''Dep
+
+  w ty tys = case ty of
+    AppT{}              -> Int.thFail $ "impossible: AppT is guarded by peelApp."
+    SigT ty _           -> uncurry w $ peelAppAcc tys ty
+    ForallT{}           -> Int.thFail $ "no support for ForallT."
+    ConT n
+      | isRec n -> if not (null recs) then Int.thFail "does not support nested recursion."
+                   else simple True ty tys
+    _ 
+      | not (null recs) -> case lookup (length recs) maps of
+        Nothing -> Int.thFail $ "no case in the given YokoOptions for type constructors with " ++ show (length recs) ++ " arguments."
+        Just (Mapping {containerTypeName = tyn, containerCtor = ctor,
+                       methodName = mn}) -> do
+          recs <- mapM w' recs
+          let snoc (tyL, fROL) (tyR, fROR) =
+                (tyL `AppT` tyR, fROL `appRO` fROR)
+              appRO l r = FieldRO {repF = repF l `AppE` repF r,
+                                   objF = objF l `AppE` objF r}
+              post fRO = FieldRO {repF = ConE ctor `compose` repF fRO,
+                                  objF = objF fRO `compose` dtor}
+          return $ Arrow.second post $ foldl snoc
+            (ConT tyn `AppT` container,
+             FieldRO {repF = VarE mn, objF = VarE mn}) recs
+          where dtor = LamE [ConP ctor [VarP x]] (VarE x)
+                  where x = mkName "x"
+      | otherwise -> simple False ty tys
+    where (foldl AppT ty -> container, recs) =
+            List.break (any isRec . Set.toList . SCCs.type_dependencies) tys
+
+data ConRO = ConRO {repP :: [Pat], repE :: Exp, objP :: Pat, objE :: [Exp]}
+
+yoko1 r@(convert -> X :&
+  Renamer := rn :&
+  Mappings := maps :&
+  BindingGroup := bg :&
+  TargetData := Int.DataType tvbs cons :&
+  TargetType := ty :&
+  TargetKind := (ks, cxt)
+        ) = do
+  loc <- liftQ TH.location
+
+  -- make a name into a NameG for a type in the current module; NB the fields
+  -- types need not be declared in the same module as the target type
+  let mkG n = Name (mkOccName $ nameBase n) $
+              NameG TcClsName (mkPkgName $ loc_package loc)
+                      (mkModName $ loc_module loc)
+
+  liftQ (sequence [do
+    let n = conName con
+        n' = rn n
+        fd = applyConT2TVBs n' tvbs
+
+    fields <- conFields con
+
+    -- declare the fields type and its Range/Tag/DC instances
+    let yokoD = 
+          [Int.dataType2Dec n' (Int.DataType tvbs (Right [renameCon rn con])),
+           TySynInstD ''Range [fd] ty,
+           TySynInstD ''Tag   [fd] $ encode $ TH.nameBase n,
+           InstanceD cxt (ConT ''DC `AppT` fd)
+             [let (pat, exp) = pat_exp n' n $ length fields
+              in FunD 'rejoin [simpleClause [pat] exp]]
+          ]
+
+    -- declare the Rep and Generic instances
+    (repTy, (conRO, _)) <- Arrow.second ($ 0) `fmap` halves fields
+          (return (ConT ''U, \s ->
+                   (ConRO {repP = [], repE = ConE 'U,
+                           objP = WildP, objE = []}, s)))
+          (\l r -> l >>= \(tyL, roL) -> r >>= \(tyR, roR) -> return $
+            (ConT ''(:*:) `AppT` tyL `AppT` tyR,
+             \s -> case roL s of
+               (roL, s) -> case roR s of
+                 (roR, s) ->
+                   (ConRO {repP = repP roL ++ repP roR,
+                           repE = ConE '(:*:) `AppE` repE roL `AppE` repE roR,
+                           objP = ConP '(:*:) [objP roL, objP roR],
+                           objE = objE roL ++ objE roR}, s)))
+          (\(_, ty) ->
+             let post fRO s =
+                   (ConRO {repP = [VarP n], repE = repF fRO `AppE` VarE n,
+                           objP = VarP n, objE = [objF fRO `AppE` VarE n]},
+                    s + 1)
+                   where n = mkName $ "x" ++ show s
+             in Arrow.second post `fmap` fieldRO maps bg ty)
+
+    let genD = [TySynInstD ''Rep [fd] repTy,
+                InstanceD cxt (ConT ''Generic `AppT` fd)
+                 [FunD 'rep [simpleClause [ConP n' (repP conRO)] $ repE conRO],
+                  FunD 'obj [simpleClause [objP conRO] $
+                               foldl AppE (ConE n') $ objE conRO]]]
+
+    -- integrate with type-spine and type-cereal
+    spineD <- spineType_ (mkG n') ks StarK
+    cerealD <- serializeTypeAsHash_ (mkG n') ks StarK
+
+    return $ yokoD ++ spineD ++ cerealD ++ genD
+       | con <- either (:[]) id cons ]) >>= generate . concat
+
+  yoko2 r
+
+-- generate DCs/DT instances
+compose l r = VarE '(.) `AppE` l `AppE` r
+
+postConE :: Name -> Exp -> Exp
+postConE n inj = compose (ConE n) inj
+
+yoko2 r@(convert -> X :&
+  Renamer := rn :&
+  TargetData := Int.DataType tvbs cons :&
+  TargetType := ty :&
+  TargetKind := (_, cxt)
+        ) = do
+  (dcs, cases) <- liftQ $ halves (either (:[]) id cons)
+    (Int.thFail $ "`" ++ show (r !!! Target :: Name) ++ "' must have constructors.")
+    (\l r -> do
+      (l, ls) <- l; (r, rs) <- r
+      return $
+        (ConT ''(:+:) `AppT` l `AppT` r,
+         map (Arrow.first (postConE 'L)) ls ++
+         map (Arrow.first (postConE 'R)) rs))
+    (\con -> do
+       fields <- length `fmap` conFields con
+       return $ let n = conName con
+                in (ConT ''N `AppT` applyConT2TVBs (rn n) tvbs,
+                    [(ConE 'N, (n, fields))]))
+
+  cases <- return $ flip map cases $ \(inj, (n, fds)) ->
+    let (pat, exp) = pat_exp n (rn n) fds
+    in simpleClause [pat] $ postConE 'DCsOf inj `AppE` exp
+  generate $ [TySynInstD ''DCs [ty] dcs,
+              InstanceD cxt (ConT ''DT `AppT` ty) [FunD 'disband cases]]
diff --git a/Data/Yoko/TH/Internal.hs b/Data/Yoko/TH/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Data/Yoko/TH/Internal.hs
@@ -0,0 +1,29 @@
+module Data.Yoko.TH.Internal where
+
+import Language.Haskell.TH
+
+
+
+thFail :: String -> Q a
+thFail s = fail $ "yokoTH: " ++ s
+
+
+
+data DataType = DataType [TyVarBndr] (Either Con [Con])
+
+
+
+dataType :: Name -> Q DataType
+dataType n = do
+  i <- reify n
+  case i of
+    TyConI d -> case d of
+      DataD _ _ tvbs cons _   -> return $ DataType tvbs $ Right cons
+      NewtypeD _ _ tvbs con _ -> return $ DataType tvbs $ Left con
+      _ -> thFail $ "expecting name of newtype or data type, not: " ++ show d
+    _ -> thFail $ "expecting name of newtype or data type, not: " ++ show i
+
+dataType2Dec :: Name -> DataType -> Dec
+dataType2Dec n (DataType tvbs cons) = case cons of
+  Left  con  -> NewtypeD [] n tvbs con  []
+  Right cons -> DataD    [] n tvbs cons []
diff --git a/Data/Yoko/View.hs b/Data/Yoko/View.hs
new file mode 100644
--- /dev/null
+++ b/Data/Yoko/View.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE TypeFamilies, TypeOperators, FlexibleContexts,
+  MultiParamTypeClasses, FlexibleInstances, ConstraintKinds,
+  UndecidableInstances #-}
+
+module Data.Yoko.View where
+
+import Data.Yoko.Representation
+import Data.Yoko.TypeSums (Embed, Partition, (:-:))
+import Data.Yoko.Each
+
+
+
+
+
+type family Tag dc
+
+type family Range dc
+class (Generic dc, DT (Range dc)) => DC dc where rejoin :: dc -> Range dc
+
+type family DCs t
+type Disbanded t = DCsOf t (DCs t)
+class Each IsDCOf (DCs t) => DT t where disband :: t -> Disbanded t
+
+class (Partition (DCs (Range dc)) (N dc) (DCs (Range dc) :-: N dc),
+       Embed (N dc) (DCs (Range dc))) => IsDCOf dc
+instance (Partition (DCs (Range dc)) (N dc) (DCs (Range dc) :-: N dc),
+          Embed (N dc) (DCs (Range dc))) => IsDCOf dc
diff --git a/yoko.cabal b/yoko.cabal
--- a/yoko.cabal
+++ b/yoko.cabal
@@ -1,5 +1,5 @@
 name: yoko
-version: 0.3.0.1
+version: 0.3.1
 synopsis: Generic Programming with Disbanded Data Types
 
 description:
@@ -81,28 +81,39 @@
 
 
 library
-  build-depends: base >= 4 && < 5, template-haskell
+  build-depends: base >= 4 && < 5,
+                 template-haskell > 2.7 && < 2.8,
+                 containers >= 0.4 && < 0.5,
+                 mtl >= 2.0 && < 2.1
   build-depends: type-equality < 0.2
 
   build-depends:
+    kinds >= 0.0.1.5 && < 0.1,
+    type-functions >= 0.2.0.3 && < 0.3,
+    records >= 0.1.1.6 && < 0.2
+
+  build-depends:
+    th-sccs < 0.1,
     type-booleans < 0.2,
-    type-spine < 0.2,
+    type-spine >= 0.1.1 && < 0.2,
     tagged-th < 0.2,
     type-digits < 0.2,
-    type-cereal < 0.2,
+    type-cereal >= 0.1.1 && < 0.2,
     type-ord < 0.2,
     type-ord-spine-cereal < 0.2
 
   exposed-modules:
-    Data.Yoko, Data.Yoko.HCompos,
+    Data.Yoko, Data.Yoko.HCompos, Data.Yoko.TH
 
     Data.Yoko.TypeBasics, Data.Yoko.Each
 
   other-modules:
+    Data.Yoko.View,
     Data.Yoko.MaybeKind,
     Data.Yoko.Representation,
     Data.Yoko.TypeSums,
-    Data.Yoko.TypeSumsAux
+    Data.Yoko.TypeSumsAux,
+    Data.Yoko.TH.Internal
 
     -- under development
 --    Data.Yoko.Fold,