diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,3 @@
+# 0.1.0.0
+
+- Initial release.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Koji Miyazato (c) 2019
+
+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 Koji Miyazato 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,46 @@
+## matchable-th
+
+This package provides TemplateHaskell functions to
+generate instances of `Matchable` and `Bimatchable` type classes,
+which are from `matchable` package.
+
+### Example
+
+``` haskell
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+import Data.Functor.Classes (Eq1(..))
+import Data.Matchable
+import Data.Matchable.TH
+
+newtype G a = G [(a, Int, a)]
+  deriving (Show, Eq, Functor)
+
+$(deriveMatchable ''G)
+
+-- @deriveMatchable@ generates a @Matchable@ instance only,
+-- so you also have to declare @Functor G@ and @Eq1 G@.
+-- There is a handy @DeriveFunctor@ extension.
+-- Also, you can use @liftEqDefault@ to easily implement @liftEq@.
+instance Eq1 G where
+  liftEq = liftEqDefault
+```
+
+``` haskell
+{-# LANGUAGE TemplateHaskell #-}
+
+import Data.Functor.Classes (Eq2(..))
+import Data.Bimatchable
+import Data.Matchable.TH
+
+data BiG a b = BiG0 | BiG1 [a] [b] | BiG2 (Int, BiF a b)
+
+instance Eq2 BiG where
+  liftEq2 = liftEq2Default
+
+instance Bifunctor BiG where
+  bimap = bimapRecovered
+
+$(deriveBimatchable ''BiG)
+```
diff --git a/matchable-th.cabal b/matchable-th.cabal
new file mode 100644
--- /dev/null
+++ b/matchable-th.cabal
@@ -0,0 +1,36 @@
+name:                matchable-th
+version:             0.1.0.0
+synopsis:            Generates Matchable instances using TemplateHaskell
+description:         This package provides TemplateHaskell function to generate
+                     instances of @Matchable@ and @Bimatchable@ type classes,
+                     which are from "matchable" package.
+license:             BSD3
+license-file:        LICENSE
+author:              Koji Miyazato
+maintainer:          viercc@gmail.com
+category:            Functors
+build-type:          Simple
+extra-source-files:  README.md, CHANGELOG.md
+cabal-version:       >=1.10
+
+source-repository head
+  type:     git
+  location: https://github.com/viercc/matchable
+  branch:   master
+
+library
+  hs-source-dirs:       src
+  exposed-modules:      Data.Matchable.TH
+  build-depends:        base                 >=4.9       && <5,
+                        matchable            >=0.1.2,
+                        template-haskell >= 2.4 && < 2.15,
+                        th-abstraction
+  ghc-options:          -Wall
+  default-language:     Haskell2010
+
+test-suite th-examples
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             th.hs
+  build-depends:       base, containers, matchable, matchable-th
+  default-language:    Haskell2010
diff --git a/src/Data/Matchable/TH.hs b/src/Data/Matchable/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Matchable/TH.hs
@@ -0,0 +1,413 @@
+{-# LANGUAGE CPP             #-}
+{-# LANGUAGE MultiWayIf      #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Data.Matchable.TH (
+  deriveMatchable, makeZipMatchWith,
+  deriveBimatchable, makeBizipMatchWith
+) where
+
+import           Data.Bimatchable             (Bimatchable (..))
+import           Data.Matchable               (Matchable (..))
+
+import           Data.Monoid                  (Monoid (..))
+import           Data.Semigroup               (Semigroup (..))
+
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Datatype (ConstructorInfo (..),
+                                               DatatypeInfo (..), reifyDatatype)
+
+-- | Build an instance of 'Matchable' for a data type.
+--
+-- /e.g./
+--
+-- @
+-- data Exp a = Plus a a | Times a a
+-- 'deriveMatchable' ''Exp
+-- @
+--
+-- will create
+--
+-- @
+-- instance Matchable Exp where
+--   zipMatchWith f (Plus  l1 l2) (Plus  r1 r2) = pure Plus  <*> f l1 r1 <*> f l2 r2
+--   zipMatchWith f (Times l1 l2) (Times r1 r2) = pure Times <*> f l1 r1 <*> f l2 r2
+--   zipMatchWith _ _ _ = Nothing
+-- @
+deriveMatchable :: Name -> Q [Dec]
+deriveMatchable name = do
+  ((ctx, f), zipMatchWithE) <- makeZipMatchWith' name
+
+  dec <- instanceD ctx (appT (conT ''Matchable) (pure f))
+           [ funD 'zipMatchWith [clause [] (normalB zipMatchWithE) []] ]
+
+  pure [dec]
+
+makeZipMatchWith :: Name -> ExpQ
+makeZipMatchWith name = makeZipMatchWith' name >>= snd
+
+makeZipMatchWith' :: Name -> Q ((Q Cxt, Type), ExpQ)
+makeZipMatchWith' name = do
+  info <- reifyDatatype name
+  let DatatypeInfo { datatypeVars = dtVars , datatypeCons = cons } = info
+      tyA : rest' = reverse (removeSig <$> dtVars)
+      dtFunctor = foldr (flip AppT) (ConT name) rest'
+
+      removeSig (SigT a _) = a
+      removeSig a          = a
+
+  f <- newName "f"
+
+  let mkMatchClause (ConstructorInfo ctrName _ _ fields _ _) =
+        do matchers <- mapM (dMatchField tyA f) fields
+           let lFieldsP = leftPat <$> matchers
+               rFieldsP = rightPat <$> matchers
+               bodyUsesF = any additionalInfo matchers
+               body = foldl (\x y -> [| $x <*> $y |])
+                            [| pure $(conE ctrName) |]
+                            (bodyExp <$> matchers)
+               ctx = concatMap requiredCtx matchers
+               fPat = if bodyUsesF then varP f else wildP
+               lPat = conP ctrName lFieldsP
+               rPat = conP ctrName rFieldsP
+           return (clause [fPat, lPat, rPat] (normalB body) [], ctx)
+
+  matchClausesAndCtxs <- mapM mkMatchClause cons
+
+  let matchClauses = map fst matchClausesAndCtxs
+      ctx = concatMap snd matchClausesAndCtxs
+      mismatchClause = clause [ wildP, wildP, wildP ] (normalB [| Nothing |]) []
+      finalClauses = case cons of
+        []  -> []
+        [_] -> matchClauses
+        _   -> matchClauses ++ [mismatchClause]
+
+  zmw <- newName "zmw"
+  return ((sequenceA ctx, dtFunctor), letE [ funD zmw finalClauses ] (varE zmw))
+
+data Matcher u = Matcher
+  { leftPat        :: PatQ
+  , rightPat       :: PatQ
+  , bodyExp        :: ExpQ
+  , requiredCtx    :: [TypeQ]
+  , additionalInfo :: u }
+
+dMatchField :: Type -> Name -> Type -> Q (Matcher Bool)
+dMatchField tyA fName ty = case spine ty of
+  _ | ty == tyA -> do
+        l <- newName "l"
+        r <- newName "r"
+        return $ Matcher
+          { leftPat = varP l
+          , rightPat = varP r
+          , additionalInfo = True
+          , bodyExp = [| $(varE fName) $(varE l) $(varE r) |]
+          , requiredCtx = [] }
+    | not (occurs tyA ty) -> do
+        l <- newName "l"
+        r <- newName "r"
+        let ctx = [ pure (AppT (ConT ''Eq) ty) | hasTyVar ty ]
+        return $ Matcher
+          { leftPat = varP l
+          , rightPat = varP r
+          , additionalInfo = False
+          , bodyExp = [| if $(varE l) == $(varE r)
+                           then Just $(varE l)
+                           else Nothing |]
+          , requiredCtx = ctx }
+  (ListT, ty':_) -> dWrapped ty'
+  (TupleT n, subtys) -> do
+     matchers <- mapM (dMatchField tyA fName) (reverse subtys)
+     let lP = tupP (leftPat <$> matchers)
+         rP = tupP (rightPat <$> matchers)
+         tupcon = [| pure $(conE (tupleDataName n)) |]
+         anyUsesF = any additionalInfo matchers
+         body = foldl (\x y -> [| $x <*> $y |]) tupcon (bodyExp <$> matchers)
+         ctx = concatMap requiredCtx matchers
+     return $ Matcher
+       { leftPat = lP
+       , rightPat = rP
+       , additionalInfo = anyUsesF
+       , bodyExp = body
+       , requiredCtx = ctx }
+  (ConT tcon, ty' : rest) | all (not . occurs tyA) rest -> do
+     let g = foldr (flip AppT) (ConT tcon) rest
+         ctxG = [ pure (AppT (ConT ''Matchable) g) | hasTyVar g ]
+     matcher <- dWrapped ty'
+     return $ matcher{ requiredCtx = ctxG ++ requiredCtx matcher }
+  (ConT tcon, ty1' : ty2' : rest) | all (not . occurs tyA) rest -> do
+     let g = foldr (flip AppT) (ConT tcon) rest
+         ctxG = [ pure (AppT (ConT ''Bimatchable) g) | hasTyVar g ]
+     -- Note that since @spine@ reverses argument order,
+     -- it must be dWrappedBi ty2 ty1.
+     matcher <- dWrappedBi ty2' ty1'
+     return $ matcher{ requiredCtx = ctxG ++ requiredCtx matcher }
+  (VarT t, ty' : rest) | all (not . occurs tyA) rest -> do
+     let g = foldr (flip AppT) (VarT t) rest
+         ctxG = [ pure (AppT (ConT ''Matchable) g) ]
+     matcher <- dWrapped ty'
+     return $ matcher{ requiredCtx = ctxG ++ requiredCtx matcher }
+  (VarT t, ty1' : ty2' : rest) | all (not . occurs tyA) rest -> do
+     let g = foldr (flip AppT) (VarT t) rest
+         ctxG = [ pure (AppT (ConT ''Bimatchable) g) | hasTyVar g ]
+     matcher <- dWrappedBi ty2' ty1'
+     return $ matcher{ requiredCtx = ctxG ++ requiredCtx matcher }
+  (ForallT _ _ _, _) -> unexpectedType ty "Matchable"
+  (ParensT _, _) -> error "Never reach here"
+  (AppT _ _, _) -> error "Never reach here"
+  (SigT _ _, _) -> error "Never reach here"
+  _ -> unexpectedType ty "Matchable"
+
+  where
+    dWrapped :: Type -> Q (Matcher Bool)
+    dWrapped ty' =do
+      l <- newName "l"
+      r <- newName "r"
+      (usesF', ctx, fun) <- do
+         matcher <- dMatchField tyA fName ty'
+         let fun = lamE [leftPat matcher, rightPat matcher] (bodyExp matcher)
+         return (additionalInfo matcher, requiredCtx matcher, fun)
+      return $ Matcher
+        { leftPat = varP l
+        , rightPat = varP r
+        , additionalInfo = usesF'
+        , bodyExp = [| zipMatchWith $fun $(varE l) $(varE r) |]
+        , requiredCtx = ctx }
+
+    dWrappedBi :: Type -> Type -> Q (Matcher Bool)
+    dWrappedBi ty1 ty2 = do
+      l <- newName "l"
+      r <- newName "r"
+      (usesF', ctx, fun1, fun2) <- do
+         matcher1 <- dMatchField tyA fName ty1
+         matcher2 <- dMatchField tyA fName ty2
+         let fun1 = lamE [leftPat matcher1, rightPat matcher1] (bodyExp matcher1)
+             fun2 = lamE [leftPat matcher2, rightPat matcher2] (bodyExp matcher2)
+             usesF' = additionalInfo matcher1 || additionalInfo matcher2
+             ctx = requiredCtx matcher1 ++ requiredCtx matcher2
+         return (usesF', ctx, fun1, fun2)
+      return $ Matcher
+        { leftPat = varP l
+        , rightPat = varP r
+        , additionalInfo = usesF'
+        , bodyExp = [| bizipMatchWith $fun1 $fun2 $(varE l) $(varE r) |]
+        , requiredCtx = ctx }
+
+-- | Build an instance of 'Bimatchable' for a data type.
+--
+-- /e.g./
+--
+-- @
+-- data Sum a b = InL a | InR b
+-- 'deriveMatchable' ''Sum
+-- @
+--
+-- will create
+--
+-- @
+-- instance Matchable Sum where
+--   bizipMatchWith f _ (InL l1) (InL r1) = pure InL <$> f l1 r1
+--   bizipMatchWith _ g (InR l1) (InR r1) = pure InR <$> g l1 r1
+-- @
+deriveBimatchable :: Name -> Q [Dec]
+deriveBimatchable name = do
+  ((ctx, f), zipMatchWithE) <- makeBizipMatchWith' name
+
+  dec <- instanceD ctx (appT (conT ''Bimatchable) (pure f))
+           [ funD 'bizipMatchWith [clause [] (normalB zipMatchWithE) []] ]
+
+  pure [dec]
+
+makeBizipMatchWith :: Name -> ExpQ
+makeBizipMatchWith name = makeBizipMatchWith' name >>= snd
+
+makeBizipMatchWith' :: Name -> Q ((Q Cxt, Type), ExpQ)
+makeBizipMatchWith' name = do
+  info <- reifyDatatype name
+  let DatatypeInfo { datatypeVars = dtVars , datatypeCons = cons } = info
+      tyB : tyA : rest' = reverse (removeSig <$> dtVars)
+      dtFunctor = foldr (flip AppT) (ConT name) rest'
+
+      removeSig (SigT a _) = a
+      removeSig a          = a
+
+  f <- newName "f"
+  g <- newName "g"
+
+  let mkMatchClause (ConstructorInfo ctrName _ _ fields _ _) =
+        do matchers <- mapM (dBimatchField tyA f tyB g) fields
+           let lFieldsP = leftPat <$> matchers
+               rFieldsP = rightPat <$> matchers
+               Usage2 usesF usesG = foldMap additionalInfo matchers
+               body = foldl (\x y -> [| $x <*> $y |])
+                            [| pure $(conE ctrName) |]
+                            (bodyExp <$> matchers)
+               ctx = concatMap requiredCtx matchers
+               fPat = if usesF then varP f else wildP
+               gPat = if usesG then varP g else wildP
+               lPat = conP ctrName lFieldsP
+               rPat = conP ctrName rFieldsP
+           return (clause [fPat, gPat, lPat, rPat] (normalB body) [], ctx)
+
+  matchClausesAndCtxs <- mapM mkMatchClause cons
+
+  let matchClauses = map fst matchClausesAndCtxs
+      ctx = concatMap snd matchClausesAndCtxs
+      mismatchClause = clause [ wildP, wildP, wildP, wildP ] (normalB [| Nothing |]) []
+      finalClauses = case cons of
+        []  -> []
+        [_] -> matchClauses
+        _   -> matchClauses ++ [mismatchClause]
+
+  bzmw <- newName "bzmw"
+  return ((sequenceA ctx, dtFunctor), letE [ funD bzmw finalClauses ] (varE bzmw))
+
+data FunUsage2 = Usage2 Bool Bool
+
+instance Semigroup FunUsage2 where
+  Usage2 f1 g1 <> Usage2 f2 g2 = Usage2 (f1 || f2) (g1 || g2)
+
+instance Monoid FunUsage2 where
+  mempty = Usage2 False False
+  mappend = (<>)
+
+dBimatchField :: Type -> Name -> Type -> Name -> Type -> Q (Matcher FunUsage2)
+dBimatchField tyA fName tyB gName ty = case spine ty of
+  _ | ty == tyA -> do
+        l <- newName "l"
+        r <- newName "r"
+        return $ Matcher
+          { leftPat = varP l
+          , rightPat = varP r
+          , additionalInfo = Usage2 True False
+          , bodyExp = [| $(varE fName) $(varE l) $(varE r) |]
+          , requiredCtx = [] }
+    | ty == tyB -> do
+        l <- newName "l"
+        r <- newName "r"
+        return $ Matcher
+          { leftPat = varP l
+          , rightPat = varP r
+          , additionalInfo = Usage2 False True
+          , bodyExp = [| $(varE gName) $(varE l) $(varE r) |]
+          , requiredCtx = [] }
+    | isConst ty -> do
+        l <- newName "l"
+        r <- newName "r"
+        let ctx = [ pure (AppT (ConT ''Eq) ty) | hasTyVar ty ]
+        return $ Matcher
+          { leftPat = varP l
+          , rightPat = varP r
+          , additionalInfo = Usage2 False False
+          , bodyExp = [| if $(varE l) == $(varE r)
+                           then Just $(varE l)
+                           else Nothing |]
+          , requiredCtx = ctx }
+  (ListT, ty':_) -> dWrapped ty'
+  (TupleT n, subtys) -> do
+     matchers <- mapM (dBimatchField tyA fName tyB gName) (reverse subtys)
+     let lP = tupP (leftPat <$> matchers)
+         rP = tupP (rightPat <$> matchers)
+         tupcon = [| pure $(conE (tupleDataName n)) |]
+         anyUsesF = foldMap additionalInfo matchers
+         body = foldl (\x y -> [| $x <*> $y |]) tupcon (bodyExp <$> matchers)
+         ctx = concatMap requiredCtx matchers
+     return $ Matcher
+       { leftPat = lP
+       , rightPat = rP
+       , additionalInfo = anyUsesF
+       , bodyExp = body
+       , requiredCtx = ctx }
+  (ConT tcon, ty' : rest) | all isConst rest -> do
+     let g = foldr (flip AppT) (ConT tcon) rest
+         ctxG = [ pure (AppT (ConT ''Matchable) g) | hasTyVar g ]
+     matcher <- dWrapped ty'
+     return $ matcher{ requiredCtx = ctxG ++ requiredCtx matcher }
+  (ConT tcon, ty1' : ty2' : rest) | all isConst rest -> do
+     let g = foldr (flip AppT) (ConT tcon) rest
+         ctxG = [ pure (AppT (ConT ''Bimatchable) g) | hasTyVar g ]
+     -- Note that since @spine@ reverses argument order,
+     -- it must be dWrappedBi ty2 ty1.
+     matcher <- dWrappedBi ty2' ty1'
+     return $ matcher{ requiredCtx = ctxG ++ requiredCtx matcher }
+  (VarT t, ty' : rest) | all isConst rest -> do
+     let g = foldr (flip AppT) (VarT t) rest
+         ctxG = [ pure (AppT (ConT ''Matchable) g) ]
+     matcher <- dWrapped ty'
+     return $ matcher{ requiredCtx = ctxG ++ requiredCtx matcher }
+  (VarT t, ty1' : ty2' : rest) | all isConst rest -> do
+     let g = foldr (flip AppT) (VarT t) rest
+         ctxG = [ pure (AppT (ConT ''Bimatchable) g) | hasTyVar g ]
+     matcher <- dWrappedBi ty2' ty1'
+     return $ matcher{ requiredCtx = ctxG ++ requiredCtx matcher }
+  (ForallT _ _ _, _) -> unexpectedType ty "Bimatchable"
+  (ParensT _, _) -> error "Never reach here"
+  (AppT _ _, _) -> error "Never reach here"
+  (SigT _ _, _) -> error "Never reach here"
+  _ -> unexpectedType ty "Bimatchable"
+
+  where
+    isConst :: Type -> Bool
+    isConst t = not (occurs tyA t || occurs tyB t)
+
+    dWrapped :: Type -> Q (Matcher FunUsage2)
+    dWrapped ty' = do
+      l <- newName "l"
+      r <- newName "r"
+      (usesF', ctx, fun) <- do
+         matcher <- dBimatchField tyA fName tyB gName ty'
+         let fun = lamE [leftPat matcher, rightPat matcher] (bodyExp matcher)
+         return (additionalInfo matcher, requiredCtx matcher, fun)
+      return $ Matcher
+        { leftPat = varP l
+        , rightPat = varP r
+        , additionalInfo = usesF'
+        , bodyExp = [| zipMatchWith $fun $(varE l) $(varE r) |]
+        , requiredCtx = ctx }
+
+    dWrappedBi :: Type -> Type -> Q (Matcher FunUsage2)
+    dWrappedBi ty1 ty2 = do
+      l <- newName "l"
+      r <- newName "r"
+      (usesF', ctx, fun1, fun2) <- do
+         matcher1 <- dBimatchField tyA fName tyB gName ty1
+         matcher2 <- dBimatchField tyA fName tyB gName ty2
+         let fun1 = lamE [leftPat matcher1, rightPat matcher1] (bodyExp matcher1)
+             fun2 = lamE [leftPat matcher2, rightPat matcher2] (bodyExp matcher2)
+             usesF' = additionalInfo matcher1 <> additionalInfo matcher2
+             ctx = requiredCtx matcher1 ++ requiredCtx matcher2
+         return (usesF', ctx, fun1, fun2)
+      return $ Matcher
+        { leftPat = varP l
+        , rightPat = varP r
+        , additionalInfo = usesF'
+        , bodyExp = [| bizipMatchWith $fun1 $fun2 $(varE l) $(varE r) |]
+        , requiredCtx = ctx }
+
+-----------------------------
+
+unexpectedType :: Type -> String -> Q a
+unexpectedType ty cls = fail $
+  "unexpected type " ++ show ty ++ " in derivation of " ++ cls ++
+  " (it's only possible to implement " ++ cls ++
+  " genericaly when all subterms are traversable)"
+
+spine :: Type -> (Type, [Type])
+spine (ParensT t)  = spine t
+spine (AppT t1 t2) = let (h, r) = spine t1 in (h, t2:r)
+spine (SigT t _)   = spine t
+spine t            = (t, [])
+
+occurs :: Type -> Type -> Bool
+occurs t u | t == u = True
+occurs t u = case u of
+  AppT u1 u2 -> occurs t u1 || occurs t u2
+  ParensT u' -> occurs t u'
+  SigT u' _  -> occurs t u'
+  _          -> False
+
+hasTyVar :: Type -> Bool
+hasTyVar (VarT _)     = True
+hasTyVar (ParensT t)  = hasTyVar t
+hasTyVar (AppT t1 t2) = hasTyVar t1 || hasTyVar t2
+hasTyVar (SigT t _)   = hasTyVar t
+hasTyVar _            = False
diff --git a/test/th.hs b/test/th.hs
new file mode 100644
--- /dev/null
+++ b/test/th.hs
@@ -0,0 +1,110 @@
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Main(main) where
+
+import           Data.Functor.Classes
+import           Data.Bifunctor
+import           Data.Bimatchable
+import           Data.Matchable
+import           Data.Matchable.TH
+
+main :: IO ()
+main = putStrLn "compiles"
+
+-- Most simple case
+data F a = F0 | F1 a | F2 a a
+  deriving (Show, Eq, Functor)
+
+instance Eq1 F where
+  liftEq = liftEqDefault
+
+$(deriveMatchable ''F)
+
+-- Test case for using [] and tuples
+newtype G a = G [(a, Int, a)]
+  deriving (Show, Eq, Functor)
+
+instance Eq1 G where
+  liftEq = liftEqDefault
+
+$(deriveMatchable ''G)
+
+-- Test case for extra type variable
+data H a b = H0 a | H1 a b | H2 [Either a b]
+  deriving (Show, Eq, Functor)
+
+instance (Eq a) => Eq1 (H a) where
+  liftEq = liftEqDefault
+
+$(deriveMatchable ''H)
+
+{-
+
+@$(deriveMatchable ''H)@ expands like below:
+
+  instance (Eq a, Matchable (Either a)) => Matchable (H a) where ...
+
+This requires UndecidableInstances extension, and warned by GHC
+as it exibits worse type inference.
+
+Mitigating this problem might need manually implement constraint
+solver in TH side, so it's not an easy target.
+
+-}
+
+-- Test case for using Matchable and Bimatchable
+data I a b = I a (F b) (Either [b] (a,b))
+  deriving (Show, Eq)
+
+instance (Eq a) => Eq1 (I a) where
+  liftEq = liftEqDefault
+
+instance (Eq a) => Functor (I a) where
+  fmap = fmapRecovered
+
+$(deriveMatchable ''I)
+
+-- Test case for recursive type
+data J a = J0 | J1 (J a, Int) a (Int, J a)
+  deriving (Show, Eq, Functor)
+
+instance Eq1 J where
+  liftEq = liftEqDefault
+
+$(deriveMatchable ''J)
+
+-------------------------------
+
+-- Most simple case
+data BiF a b = BiF0 | BiF1 a b
+
+instance Eq2 BiF where
+  liftEq2 = liftEq2Default
+
+instance Bifunctor BiF where
+  bimap = bimapRecovered
+
+$(deriveBimatchable ''BiF)
+
+-- Test case for using [], tuple, and another Bimatchable instance
+data BiG a b = BiG0 | BiG1 [a] [b] | BiG2 (Int, BiF a b)
+
+instance Eq2 BiG where
+  liftEq2 = liftEq2Default
+
+instance Bifunctor BiG where
+  bimap = bimapRecovered
+
+$(deriveBimatchable ''BiG)
+
+-- Test case for recursive type
+data BiH a b = BiH1 a b | BiH2 (BiH b a) (BiH a String)
+
+instance Eq2 BiH where
+  liftEq2 = liftEq2Default
+
+instance Bifunctor BiH where
+  bimap = bimapRecovered
+
+$(deriveBimatchable ''BiH)