diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2015, 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,1 @@
+import Distribution.Simple; main = defaultMain
diff --git a/exception-hierarchy.cabal b/exception-hierarchy.cabal
new file mode 100644
--- /dev/null
+++ b/exception-hierarchy.cabal
@@ -0,0 +1,35 @@
+build-type: Simple
+cabal-version: >= 1.8
+
+name: exception-hierarchy
+version: 0.0.0.1
+stability: Experimental
+author: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
+maintainer: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
+homepage: yet
+
+license: BSD3
+license-file: LICENSE
+
+category: Language
+synopsis: Exception type hierarchy with TemplateHaskell
+description:
+    see sample code in samples/
+
+extra-source-files:
+    samples/humanError.hs
+
+source-repository head
+    type: git
+    location: git://github.com/YoshikuniJujo/test-haskell.git
+
+source-repository this
+    type: git
+    location: git://github.com/YoshikuniJujo/test-haskell.git
+    tag: exception-hierarchy-0.0.0.1
+
+library
+    hs-source-dirs: src
+    exposed-modules: Control.Exception.Hierarchy
+    build-depends: base == 4.*, template-haskell == 2.9.*
+    ghc-options: -Wall
diff --git a/samples/humanError.hs b/samples/humanError.hs
new file mode 100644
--- /dev/null
+++ b/samples/humanError.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, ExistentialQuantification #-}
+
+import Control.Exception
+import Data.Typeable
+
+import Control.Exception.Hierarchy
+
+newtype GhostError = GhostError String deriving (Typeable, Show)
+newtype MyException = MyException String deriving (Typeable, Show)
+newtype ManError = ManError String deriving (Typeable, Show)
+newtype WomanError = WomanError String deriving (Typeable, Show)
+newtype WolfmanError = WolfmanError String deriving (Typeable, Show)
+newtype MermaidError = MermaidError String deriving (Typeable, Show)
+
+exceptionHierarchy Nothing (ExType ''MyException)
+exceptionHierarchy Nothing (
+	ExNode "HumanError" [
+		ExType ''ManError, 
+		ExNode "DemihumanError" [],
+		ExNode "NomanError" [
+			ExType ''GhostError ] ] )
+
+exceptionHierarchy (Just ''HumanError) (ExType ''WomanError)
+exceptionHierarchy (Just ''DemihumanError) (ExType ''WolfmanError)
+
+instance Exception MermaidError where
+	toException = demihumanErrorToException
+	fromException = demihumanErrorFromException
diff --git a/src/Control/Exception/Hierarchy.hs b/src/Control/Exception/Hierarchy.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Exception/Hierarchy.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Control.Exception.Hierarchy (
+	ExceptionHierarchy(..), exceptionHierarchy ) where
+
+import Control.Applicative
+import Control.Exception
+import Data.Typeable
+import Data.Char
+import Language.Haskell.TH
+
+data ExceptionHierarchy
+	= ExNode String [ExceptionHierarchy]
+	| ExType Name
+	deriving Show
+
+exceptionHierarchy :: Maybe Name -> ExceptionHierarchy -> DecsQ
+exceptionHierarchy mc (ExNode e es) = (concat .) . (:)
+	<$> exception1 mc (mkName e) True
+	<*> mapM (exceptionHierarchy . Just $ mkName e) es
+exceptionHierarchy mc (ExType e) = exception1 mc e False
+
+exception1 :: Maybe Name -> Name -> Bool -> DecsQ
+exception1 mc e c = (:)
+	<$> maybe (defInstException e) (`instException` e) mc
+	<*> if c then exceptionContainer e else return []
+
+exceptionContainer :: Name -> DecsQ
+exceptionContainer ec = sequence [
+	dataD (cxt []) he []
+		[forallC [PlainTV e] (cxt [classP ''Exception [varT e]]) $
+			normalC he [strictType notStrict (varT e)]]
+		[''Typeable],
+	instanceD (cxt []) (conT ''Show `appT` conT he)
+		[funD 'showsPrec
+			[clause [varP d, conP he [varP e]]
+				(normalB $ varE 'showsPrec `appE` varE d `appE` varE e) []]],
+	sigD toEx . forallT [PlainTV e] (cxt [classP ''Exception [varT e]]) $
+		varT e `arrT` conT ''SomeException,
+	valD (varP toEx)
+		(normalB $ infixE
+			(Just $ varE 'toException) (varE '(.)) (Just $ conE he))
+		[],
+	sigD fromEx . forallT [PlainTV e] (cxt [classP ''Exception [varT e]]) $
+		conT ''SomeException `arrT` (conT ''Maybe `appT` varT e),
+	funD fromEx [clause
+		[varP se]
+		(normalB $ doE [
+			bindS (conP he [varP e])
+				(varE 'fromException `appE` varE se),
+			noBindS $ varE 'cast `appE` varE e])
+		[]]
+	]
+	where
+	he = ec
+	ec' = toLowerH $ nameBase ec
+	toEx = mkName $ ec' ++ "ToException"
+	fromEx = mkName $ ec' ++ "FromException"
+	e = mkName "e"
+	se = mkName "se"
+	d = mkName "d"
+
+defInstException :: Name -> DecQ
+defInstException e = instanceD (cxt []) (conT ''Exception `appT` conT e) []
+
+infixr `arrT`
+arrT :: TypeQ -> TypeQ -> TypeQ
+arrT t1 t2 = arrowT `appT` t1 `appT` t2
+
+instException :: Name -> Name -> DecQ
+instException ec e = instanceD (cxt [])
+	(conT ''Exception `appT` conT e) [
+		valD (varP $ mkName "toException") (normalB $ varE te) [],
+		valD (varP $ mkName "fromException") (normalB $ varE fe) [] ]
+	where
+	ec' = toLowerH $ nameBase ec
+	te = mkName $ ec' ++ "ToException"
+	fe = mkName $ ec' ++ "FromException"
+
+toLowerH :: String -> String
+toLowerH (c : cs) = toLower c : cs
+toLowerH _ = ""