diff --git a/Data/Generics/Genifunctors.hs b/Data/Generics/Genifunctors.hs
new file mode 100644
--- /dev/null
+++ b/Data/Generics/Genifunctors.hs
@@ -0,0 +1,266 @@
+{-# LANGUAGE TemplateHaskell,PatternGuards,RecordWildCards #-}
+-- | Generate (derive) generalized 'fmap', 'foldMap' and 'traverse' for Bifunctors, Trifunctors, or a functor with any arity
+--
+-- Example:
+--
+-- @
+--data U a b c d
+--    = L [U a b c d]               -- polymorphic recursion
+--    | M (V (a,b) (Either c d))    -- mutually recursive
+--    | a :+: Int                   -- infix syntax, record syntax, type synonyms
+--    | R { c :: c, d :: String }   -- and primitive data types supported
+--
+--data V u v = X (U v v u u) | Z u
+--
+--fmapU :: (a -> a') -> (b -> b') -> (c -> c') -> (d -> d') -> U a b c d -> U a' b' c' d'
+--fmapU = $(genFmap ''U)
+--
+--foldU :: Monoid m => (a -> m) -> (b -> m) -> (c -> m) -> (d -> m) -> U a b c d -> m
+--foldU = $(genFoldMap ''U)
+--
+--travU :: Applicative f => (a -> f a') -> (b -> f b') -> (c -> f c') -> (d -> f d') -> U a b c d -> f (U a' b' c' d')
+--travU = $(genTraverse ''U)
+-- @
+module Data.Generics.Genifunctors (genFmap, genFoldMap, genTraverse) where
+
+import Language.Haskell.TH
+import Control.Applicative
+import Control.Monad
+import Control.Monad.RWS
+import Data.Map (Map)
+import qualified Data.Map as M
+
+import Control.Exception(assert)
+import Data.Maybe
+
+type GenM = RWST Generator [Dec] (Map Name Name) Q
+
+data Generator = Generator
+    { gen_combine   :: Name -> [Exp] -> Exp
+    , gen_primitive :: Exp -> Exp
+    , gen_type      :: Name -> [Name] -> Q Type
+    }
+
+gen :: Generator -> Name -> Q Exp
+gen generator tc = do
+    (fn,decls) <- evalRWST (generate tc) generator M.empty
+    return $ LetE decls (VarE fn)
+
+
+-- | Generate generalized 'fmap' for a type
+--
+-- @
+--bimapTuple :: (a -> a') -> (b -> b') -> (a,b) -> (a',b')
+--bimapTuple = $(genFmap ''(,))
+-- @
+genFmap :: Name -> Q Exp
+genFmap = gen Generator
+    { gen_combine   = fmapCombine
+    , gen_primitive = fmapPrimitive
+    , gen_type      = fmapType
+    }
+
+-- | Generate generalized 'foldMap' for a type
+--
+-- @
+--foldMapEither :: Monoid m => (a -> m) -> (b -> m) -> Either a b -> m
+--foldMapEither = $(genFoldMap ''Either)
+-- @
+genFoldMap :: Name -> Q Exp
+genFoldMap = gen Generator
+    { gen_combine   = foldMapCombine
+    , gen_primitive = foldMapPrimitive
+    , gen_type      = foldMapType
+    }
+
+-- | Generate generalized 'traversable' for a type
+--
+-- @
+--travTriple :: Applicative f => (a -> f a') -> (b -> f b') -> (c -> f c') -> (a,b,c) -> f (a',b',c')
+--travTriple = $(genTraverse ''(,,))
+-- @
+genTraverse :: Name -> Q Exp
+genTraverse = gen Generator
+    { gen_combine   = traverseCombine
+    , gen_primitive = traversePrimitive
+    , gen_type      = traverseType ''Applicative
+    }
+
+fmapCombine :: Name -> [Exp] -> Exp
+fmapCombine con_name args = foldl AppE (ConE con_name) args
+
+foldMapCombine :: Name -> [Exp] -> Exp
+foldMapCombine _con_name []     = VarE 'mempty
+foldMapCombine _con_name (a:as) = foldr (<<>>) a as
+
+traverseCombine :: Name -> [Exp] -> Exp
+traverseCombine con_name []     = VarE 'pure `AppE` ConE con_name
+traverseCombine con_name (a:as) = foldl (<***>) (ConE con_name <$$> a) as
+
+mkInfix :: Name -> Exp -> Exp -> Exp
+mkInfix n e1 e2 = InfixE (Just e1) (VarE n) (Just e2)
+
+(<***>) :: Exp -> Exp -> Exp
+(<***>) = mkInfix '(<*>)
+
+(<$$>) :: Exp -> Exp -> Exp
+(<$$>) = mkInfix '(<$>)
+
+(<<>>) :: Exp -> Exp -> Exp
+(<<>>) = mkInfix 'mappend
+
+fmapPrimitive :: Exp -> Exp
+fmapPrimitive = id
+
+foldMapPrimitive :: Exp -> Exp
+foldMapPrimitive = const (VarE 'mempty)
+
+traversePrimitive :: Exp -> Exp
+traversePrimitive e = VarE 'pure `AppE` e
+
+fmapType :: Name -> [Name] -> Q Type
+fmapType tc tvs = do
+    from <- mapM (newName . nameBase) tvs
+    to   <- mapM (newName . nameBase) tvs
+    return $ ForallT (map PlainTV (from ++ to)) []
+           $ foldr arr
+                (applyTyVars tc from `arr` applyTyVars tc to)
+                (zipWith arr (map VarT from) (map VarT to))
+
+foldMapType :: Name -> [Name] -> Q Type
+foldMapType tc tvs = do
+    m <- newName "m"
+    from <- mapM (newName . nameBase) tvs
+    return $ ForallT (map PlainTV (m : from)) [ClassP ''Monoid [VarT m]]
+           $ foldr arr
+                (applyTyVars tc from `arr` VarT m)
+                (zipWith arr (map VarT from) (repeat (VarT m)))
+
+traverseType :: Name -> Name -> [Name] -> Q Type
+traverseType constraint_class tc tvs = do
+    f <- newName "f"
+    from <- mapM (newName . nameBase) tvs
+    to   <- mapM (newName . nameBase) tvs
+    return $ ForallT (map PlainTV (f : from ++ to)) [ClassP constraint_class [VarT f]]
+           $ foldr arr
+                (applyTyVars tc from `arr` (VarT f `AppT` applyTyVars tc to))
+                (zipWith arr (map VarT from) (map (\ t -> VarT f `AppT` VarT t) to))
+
+genMatch :: Type -> [(Name,Name)] -> GenM Exp
+genMatch t tvfs = case t of
+    VarT a     | Just f <- lookup a tvfs -> return (VarE f)
+    AppT t1 t2 -> AppE <$> genMatch t1 tvfs <*> genMatch t2 tvfs
+    ConT tc    -> VarE <$> generate tc
+    TupleT i   -> VarE <$> generate (tupleTypeName i)
+    ListT      -> VarE <$> generate ''[]
+    _          -> error $ "genMatch:" ++ show t
+
+simpCon :: Con -> (Name,[Type])
+simpCon con = case con of
+    NormalC n ts   -> (n,map snd ts)
+    RecC n vts     -> (n,map (\ (_,_,t) -> t) vts)
+    InfixC t1 n t2 -> (n,[snd t1,snd t2])
+    ForallC{}      -> error "simpCon: ForallC"
+
+
+generate :: Name -> GenM Name
+generate tc = do
+    m_fn <- gets (M.lookup tc)
+    case m_fn of
+        Just fn -> return fn
+        Nothing -> do
+
+            Generator{..} <- ask
+
+            fn <- q $ newName ("_" ++ nameBase tc)
+            modify (M.insert tc fn)
+            (tvs,cons) <- getTyConInfo tc
+            fs <- zipWithM (const . q . newName) (repeat "_f") tvs
+            x <- q $ newName "_x"
+
+            body <- if null cons || null tvs
+                then return $ gen_primitive (VarE x)  -- primitive data types/non polymorphic
+                else do
+                    matches <- forM (map simpCon cons) $ \ (con_name,ts) -> do
+
+                        ys <- zipWithM (const . q . newName) (repeat "_y") ts
+
+                        lhs <- gen_combine con_name <$> sequence
+                                [ do t' <- q (expandSyn t)
+                                     le <- genMatch t' (zip tvs fs)
+                                     return (le `AppE` VarE y)
+                                | (y,t) <- zip ys ts ]
+
+                        return $ Match (ConP con_name (map VarP ys)) (NormalB lhs) []
+
+                    return (CaseE (VarE x) matches)
+
+            ty <- q $ gen_type tc tvs
+
+            tell
+                [ SigD fn ty
+                , FunD fn [ Clause (map VarP (fs ++ [x])) (NormalB $ body) [] ]
+                ]
+            return fn
+
+arr :: Type -> Type -> Type
+arr t1 t2 = (ArrowT `AppT` t1) `AppT` t2
+
+applyTyVars :: Name -> [Name] -> Type
+applyTyVars tc ns = foldl AppT (ConT tc) (map VarT ns)
+
+q :: Q a -> GenM a
+q = lift
+
+-- All the following functions are by Lennart in Geniplate
+
+getTyConInfo :: Name -> GenM ([Name], [Con])
+getTyConInfo con = do
+    info <- q (reify con)
+    case info of
+        TyConI (DataD _ _ tvs cs _) -> return (map unPlainTv tvs, cs)
+        TyConI (NewtypeD _ _ tvs c _) -> return (map unPlainTv tvs, [c])
+        PrimTyConI{} -> return ([], [])
+        i -> error $ "unexpected TyCon: " ++ show i
+  where
+    unPlainTv (PlainTV tv) = tv
+    unPlainTv i            = error $ "unexpected non-plain TV" ++ show i
+
+expandSyn ::  Type -> Q Type
+expandSyn (ForallT tvs ctx t) = liftM (ForallT tvs ctx) $ expandSyn t
+expandSyn t@AppT{} = expandSynApp t []
+expandSyn t@ConT{} = expandSynApp t []
+expandSyn (SigT t _) = expandSyn t   -- Ignore kind synonyms
+expandSyn t = return t
+
+expandSynApp :: Type -> [Type] -> Q Type
+expandSynApp (AppT t1 t2) ts = do t2' <- expandSyn t2; expandSynApp t1 (t2':ts)
+expandSynApp (ConT n) ts | nameBase n == "[]" = return $ foldl AppT ListT ts
+expandSynApp t@(ConT n) ts = do
+    info <- reify n
+    case info of
+        TyConI (TySynD _ tvs rhs) ->
+            let (ts', ts'') = splitAt (length tvs) ts
+                s = mkSubst tvs ts'
+                rhs' = subst s rhs
+            in  expandSynApp rhs' ts''
+        _ -> return $ foldl AppT t ts
+expandSynApp t ts = do t' <- expandSyn t; return $ foldl AppT t' ts
+
+
+type Subst = [(Name, Type)]
+
+mkSubst :: [TyVarBndr] -> [Type] -> Subst
+mkSubst vs ts =
+   let vs' = map un vs
+       un (PlainTV v) = v
+       un (KindedTV v _) = v
+   in  assert (length vs' == length ts) $ zip vs' ts
+
+subst :: Subst -> Type -> Type
+subst s (ForallT v c t) = ForallT v c $ subst s t
+subst s t@(VarT n) = fromMaybe t $ lookup n s
+subst s (AppT t1 t2) = AppT (subst s t1) (subst s t2)
+subst s (SigT t k) = SigT (subst s t) k
+subst _ t = t
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2013, Dan Rosén
+
+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 Dan Rosén 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/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/genifunctors.cabal b/genifunctors.cabal
new file mode 100644
--- /dev/null
+++ b/genifunctors.cabal
@@ -0,0 +1,20 @@
+name:                genifunctors
+version:             0.1.0.0
+synopsis:            Generate generalized fmap, foldMap and traverse
+description:         Generate (derive) fmap, foldMap and traverse for Bifunctors, Trifunctors, or a functor with any arity
+license:             BSD3
+license-file:        LICENSE
+author:              Dan Rosén
+maintainer:          danr@chalmers.se
+category:            Generics
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+    exposed-modules:     Data.Generics.Genifunctors
+    other-extensions:    TemplateHaskell, PatternGuards, RecordWildCards
+    build-depends:       base >= 4 && < 5,
+                         template-haskell <2.9,
+                         mtl,
+                         containers
+    default-language:    Haskell2010