diff --git a/Database/Groundhog.hs b/Database/Groundhog.hs
new file mode 100644
--- /dev/null
+++ b/Database/Groundhog.hs
@@ -0,0 +1,63 @@
+-- | This module exports the most commonly used functions and datatypes.
+--
+-- An example which shows the main features:
+--
+-- @
+-- {-\# LANGUAGE GADTs, TypeFamilies, TemplateHaskell \#-}
+-- import Control.Monad.IO.Class(liftIO)
+-- import Database.Groundhog.Sqlite
+-- import Database.Groundhog.TH
+-- 
+-- data Customer a = Customer {customerName :: String, details :: a} deriving Show
+-- data Item = ProductItem {productName :: String, quantity :: Int, customer :: Customer String}
+--           | ServiceItem {serviceName :: String, deliveryAddress :: String, servicePrice :: Int}
+--      deriving Show
+-- 
+-- 'deriveEntity' ''Customer $ Just $ do
+--   setConstructor 'Customer $ do
+--     setConstraints [(\"NameConstraint\", [\"customerName\"])]
+-- deriveEntity ''Item Nothing
+-- 
+-- main = withSqliteConn \":memory:\" $ runSqliteConn $ do
+--   -- Customer is also migrated because Item contains it
+--   'runMigration' 'silentMigrationLogger' $ 'migrate' (undefined :: Item)
+--   let john = Customer \"John Doe\" \"Phone: 01234567\"
+--   johnKey <- 'insert' john
+--   -- John is inserted only once because of the name constraint
+--   insert $ ProductItem \"Apples\" 5 john
+--   insert $ ProductItem \"Melon\" 2 john
+--   insert $ ServiceItem \"Taxi\" \"Elm Street\" 50
+--   insert $ ProductItem \"Melon\" 6 (Customer \"Jack Smith\" \"Don't let him pay by check\")
+--   -- bonus melon for all large melon orders
+--   'update' [QuantityField '=.' toArith QuantityField + 1] (ProductNameField '==.' \"Melon\" '&&.' QuantityField '>.' (5 :: Int))
+--   productsForJohn <- 'select' (CustomerField ==. johnKey) [] 0 0
+--   liftIO $ putStrLn $ \"Products for John: \" ++ show productsForJohn
+--   -- let's check bonus
+--   melon <- select (ProductNameField ==. \"Melon\") ['Desc' QuantityField] 0 0
+--   liftIO $ putStrLn $ \"Melon orders: \" ++ show melon
+-- @
+module Database.Groundhog
+  ( module Database.Groundhog.Core
+  , module Database.Groundhog.Generic
+  ) where
+
+import Database.Groundhog.Core
+  ( PersistBackend(..)
+  , DbPersist(..)
+  , Key(..)
+  , Cond(..)
+  , Order(..)
+  , (=.), (&&.), (||.), (==.), (/=.), (<.), (<=.), (>.), (>=.)
+  , wrapPrim
+  , toArith)
+import Database.Groundhog.Generic
+  ( createMigration
+  , executeMigration
+  , executeMigrationUnsafe
+  , runMigration
+  , runMigrationUnsafe
+  , printMigration
+  , silentMigrationLogger
+  , defaultMigrationLogger)
+
+import Database.Groundhog.TH
diff --git a/Database/Groundhog/Core.hs b/Database/Groundhog/Core.hs
new file mode 100644
--- /dev/null
+++ b/Database/Groundhog/Core.hs
@@ -0,0 +1,841 @@
+{-# LANGUAGE GADTs, TypeFamilies, ExistentialQuantification, StandaloneDeriving, TypeSynonymInstances, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, OverlappingInstances, ScopedTypeVariables, GeneralizedNewtypeDeriving, UndecidableInstances, EmptyDataDecls #-}
+
+-- | This module defines the functions and datatypes used throughout the framework.
+-- Most of them are for internal use
+module Database.Groundhog.Core
+  ( 
+  -- * Main types
+    PersistEntity(..)
+  , PersistValue(..)
+  , PersistField(..)
+  , Key(..)
+  -- * Constructing expressions
+  -- $exprDoc
+  , Cond(..)
+  , Update(..)
+  , (=.), (&&.), (||.), (==.), (/=.), (<.), (<=.), (>.), (>=.)
+  , wrapPrim
+  , toArith
+  , Expression(..)
+  , Primitive(..)
+  , HasOrder
+  , Numeric
+  , NeverNull
+  , Arith(..)
+  , Expr(..)
+  , Order(..)
+  -- * Type description
+  , DbType(..)
+  , NamedType
+  , namedType
+  , getName
+  , getType
+  , EntityDef(..)
+  , ConstructorDef(..)
+  , Constructor(..)
+  , Constraint
+  -- * Migration
+  , SingleMigration
+  , NamedMigrations
+  , Migration
+  -- * Database
+  , PersistBackend(..)
+  , RowPopper
+  , DbPersist(..)
+  , runDbPersist
+  ) where
+
+import Control.Applicative(Applicative)
+import Control.Monad(liftM, liftM2, liftM3, liftM4, liftM5)
+import Control.Monad.Trans.Class(MonadTrans(..))
+import Control.Monad.IO.Class(MonadIO(..))
+import Control.Monad.IO.Control (MonadControlIO)
+import Control.Monad.Trans.Reader(ReaderT, runReaderT)
+import Control.Monad.Trans.State(StateT)
+import Data.Bits(bitSize)
+import Data.ByteString.Char8 (ByteString, unpack)
+import Data.Enumerator(Enumerator)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Encoding.Error as T
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Word (Word8, Word16, Word32, Word64)
+import Data.Map(Map)
+import Data.Time(Day, TimeOfDay, UTCTime)
+import Unsafe.Coerce(unsafeCoerce)
+
+-- | Only instances of this class can be persisted in a database
+class PersistField v => PersistEntity v where
+  -- | This type is used for typesafe manipulation of separate fields of datatype v.
+  -- Each constructor in 'Fields' corresponds to its field in a datatype v.
+  -- It is parametrised by constructor phantom type and field value type.
+  data Fields v :: * -> * -> *
+  -- | Returns a complete description of the type
+  entityDef :: v -> EntityDef
+  -- | Marshalls value to a list of 'PersistValue' ready for insert to a database
+  toPersistValues   :: PersistBackend m => v -> m [PersistValue]
+  -- | Constructs the value from the list of 'PersistValue'
+  fromPersistValues :: PersistBackend m => [PersistValue] -> m v
+  -- | Returns constructor number and a list of constraint names and corresponding field names with their values
+  getConstraints    :: v -> (Int, [(String, [(String, PersistValue)])])
+  -- Show (Fields v c a) constraint would be nicer, but free c & a params don't allow this
+  showField :: Fields v c a -> String
+  eqField :: Fields v c a -> Fields v c a -> Bool
+
+instance PersistEntity v => Show (Fields v c a) where show = showField
+instance PersistEntity v => Eq (Fields v c a) where (==) = eqField
+
+-- | A unique identifier of a value stored in a database
+data PersistEntity v => Key v = Key Int64 deriving Show
+
+data Any
+
+type family MoreSpecific a b
+type instance MoreSpecific Any a = a
+type instance MoreSpecific a Any = a
+type instance MoreSpecific a a = a
+type instance MoreSpecific Any Any = Any
+
+class TypesCastV x y z | x y -> z
+-- instance TypesCastV x x x would not work. For example, it does not match TypesCastV (Type a1) (Type a2) z
+instance (x ~ y, MoreSpecific x y ~ z) => TypesCastV x y z
+instance TypesCastV Any x x
+instance TypesCastV x Any x
+instance TypesCastV Any Any Any
+
+class TypesEqualC x y
+instance TypesEqualC x x
+instance TypesEqualC Any x
+instance TypesEqualC x Any
+instance TypesEqualC Any Any
+
+class TypesCastC x y z | x y -> z
+instance (TypesEqualC x y, MoreSpecific x y ~ z) => TypesCastC x y z
+
+class (Expression a, Expression b) => TypeCast a b v c | a b -> v, a b -> c
+instance (Expression a, Expression b, TypesCastV (FuncV a) (FuncV b) v, TypesCastC (FuncC a) (FuncC b) c) => TypeCast a b v c
+--instance (Expression a, Expression b, FuncV a ~ Any, FuncC a ~ Any, FuncV b ~ v, FuncC b ~ c) => TypeCast a b v c
+--instance (FuncV a ~ v, FuncC a ~ c) => TypeCast a Any v c
+--instance TypeCast Any Any Any Any
+
+-- $exprDoc
+-- The expressions are used in conditions and right part of Update statement.
+-- Despite the wordy types of the comparison functions, they are simple to use.
+-- Type of the compared polymorphic values like numbers or Nothing must be supplied manually. Example:
+--
+-- @
+-- StringField ==. \"abc\" &&. NumberField >. (0 :: Int) ||. MaybeField ==. (Nothing :: Maybe String) ||. MaybeField ==. Just \"def\"
+-- @
+--
+
+-- | Represents condition for a query.
+data Cond v c =
+    And (Cond v c) (Cond v c)
+  | Or  (Cond v c) (Cond v c)
+  | Not (Cond v c)
+  | forall a.(HasOrder a, PersistField a) => Lesser  (Expr v c a) (Expr v c a)
+  | forall a.(HasOrder a, PersistField a) => Greater (Expr v c a) (Expr v c a)
+  | forall a.(PersistField a) => Equals    (Expr v c a) (Expr v c a)
+  | forall a.(PersistField a) => NotEquals (Expr v c a) (Expr v c a)
+  -- | Lookup will be performed only in table for the specified constructor c. To fetch value by key without constructor limitation use 'get'
+  | KeyIs (Key v)
+
+data Update v c = forall a.Update (Fields v c a) (Expr v c a)
+--deriving instance (Show (Fields c a)) => Show (Update c)
+
+-- | Defines sort order of a result-set
+data Order v c = forall a.HasOrder a => Asc  (Fields v c a)
+               | forall a.HasOrder a => Desc (Fields v c a)
+
+-- TODO: UGLY: we use unsafeCoerce to cast phantom types Any and Any to more specific type if possible. The safety is assured by TypeEqual and TypeEqualC classes. I hope it will work w/o woes of segfaults
+
+-- | Update field
+infixr 3 =.
+(=.) ::
+  ( Expression a
+  , TypesCastV v (FuncV a) v
+  , TypesCastC c (FuncC a) c)
+  => Fields v c (FuncA a) -> a -> Update v c
+f =. a = Update f (unsafeCoerceExpr $ wrap a)
+
+-- | Boolean \"and\" operator.
+(&&.) :: (TypesCastV v1 v2 v3, TypesCastC c1 c2 c3) =>
+  Cond v1 c1 -> Cond v2 c2 -> Cond v3 c3
+  
+-- | Boolean \"or\" operator.  
+(||.) :: (TypesCastV v1 v2 v3, TypesCastC c1 c2 c3) =>
+  Cond v1 c1 -> Cond v2 c2 -> Cond v3 c3
+  
+infixr 3 &&.
+a &&. b = And (unsafeCoerce a) (unsafeCoerce b)
+
+infixr 2 ||.
+a ||. b = Or (unsafeCoerce a) (unsafeCoerce b)
+
+unsafeCoerceExpr :: Expr v1 c1 a -> Expr v2 c2 a
+unsafeCoerceExpr = unsafeCoerce
+
+(==.), (/=.) ::
+  ( TypeCast a b v c
+  , FuncA a ~ FuncA b
+  , PersistField (FuncA a))
+  => a -> b -> Cond v c
+
+(<.), (<=.), (>.), (>=.) ::
+  ( TypeCast a b v c
+  , FuncA a ~ FuncA b
+  , PersistField (FuncA a)
+  , HasOrder (FuncA a))
+  => a -> b -> Cond v c
+
+infix 4 ==., <., <=., >., >=.
+a ==. b = Equals (unsafeCoerceExpr $ wrap a) (unsafeCoerceExpr $ wrap b)
+a /=. b = NotEquals (unsafeCoerceExpr $ wrap a) (unsafeCoerceExpr $ wrap b)
+a <.  b = Lesser (unsafeCoerceExpr $ wrap a) (unsafeCoerceExpr $ wrap b)
+a <=. b = Not $ a >. b
+a >.  b = Greater (unsafeCoerceExpr $ wrap a) (unsafeCoerceExpr $ wrap b)
+a >=. b = Not $ a <. b
+
+newtype Monad m => DbPersist conn m a = DbPersist { unDbPersist :: ReaderT conn m a }
+  deriving (Monad, MonadIO, Functor, Applicative, MonadControlIO, MonadTrans)
+
+runDbPersist :: Monad m => DbPersist conn m a -> conn -> m a
+runDbPersist = runReaderT.unDbPersist
+
+class Monad m => PersistBackend m where
+  -- | Insert a new record to a database and return its 'Key'
+  insert        :: PersistEntity v => v -> m (Key v)
+  -- | Try to insert a record and return Right newkey. If there is a constraint violation, Left oldkey is returned
+  -- , where oldkey is an identifier of the record with the same constraint values. Note that if several constraints are violated, a key of an arbitrary matching record is returned.
+  insertBy      :: PersistEntity v => v -> m (Either (Key v) (Key v))
+  -- | Replace a record with the given key. Result is undefined if the record does not exist.
+  replace       :: PersistEntity v => Key v -> v -> m ()
+  -- | Return a list of all records
+  selectEnum    :: (PersistEntity v, Constructor c)
+                => Cond v c
+                -> [Order v c]
+                -> Int -- ^ limit
+                -> Int -- ^ offset
+                -> Enumerator (Key v, v) m a
+  -- | Get all records. Order is undefined
+  selectAllEnum :: PersistEntity v => Enumerator (Key v, v) m a
+  -- | Return a list of the records satisfying the condition
+  select        :: (PersistEntity v, Constructor c)
+                => Cond v c
+                -> [Order v c]
+                -> Int -- ^ limit
+                -> Int -- ^ offset
+                -> m [(Key v, v)]
+  -- | Return a list of all records. Order is undefined
+  selectAll     :: PersistEntity v => m [(Key v, v)]
+  -- | Fetch an entity from a database
+  get           :: PersistEntity v => Key v -> m (Maybe v)
+  -- | Update the records satisfying the condition
+  update        :: (PersistEntity v, Constructor c) => [Update v c] -> Cond v c -> m ()
+  -- | Remove the records satisfying the condition
+  delete        :: (PersistEntity v, Constructor c) => Cond v c -> m ()
+  -- | Remove the record with given key. No-op if the record does not exist
+  deleteByKey   :: PersistEntity v => Key v -> m ()
+  -- | Count total number of records satisfying the condition
+  count         :: (PersistEntity v, Constructor c) => Cond v c -> m Int
+  -- | Count total number of records with all constructors
+  countAll      :: PersistEntity v => v -> m Int
+  -- | Check database schema and create migrations for the entity and the entities it contains
+  migrate       :: PersistEntity v => v -> Migration m
+  -- | Execute raw query
+  executeRaw    :: Bool           -- ^ keep in cache
+                -> String         -- ^ query
+                -> [PersistValue] -- ^ positional parameters
+                -> m ()
+  -- | Execute raw query with results
+  queryRaw      :: Bool           -- ^ keep in cache
+                -> String         -- ^ query
+                -> [PersistValue] -- ^ positional parameters
+                -> (RowPopper m -> m a) -- ^ results processing function
+                -> m a
+  -- TODO: we need to supply names of the tables or other info
+  insertTuple   :: NamedType -> [PersistValue] -> m Int64
+  getTuple      :: NamedType -> Int64 -> m [PersistValue]
+  insertList    :: PersistField a => [a] -> m Int64
+  getList       :: PersistField a => Int64 -> m [a]
+  
+type RowPopper m = m (Maybe [PersistValue])
+
+type Migration m = StateT NamedMigrations m ()
+
+-- | Datatype names and corresponding migrations
+type NamedMigrations = Map String SingleMigration
+
+-- | Either error messages or migration queries with safety flags
+type SingleMigration = Either [String] [(Bool, String)]
+
+-- | Describes an ADT.
+data EntityDef = EntityDef {
+  -- | Emtity name
+    entityName   :: String
+  -- | Named types of the instantiated polymorphic type parameters
+  , typeParams   :: [NamedType]
+  -- | List of entity constructors definitions
+  , constructors :: [ConstructorDef]
+} deriving (Show, Eq)
+
+-- | Describes an entity constructor
+data ConstructorDef = ConstructorDef {
+  -- | Number of the constructor in the ADT
+    constrNum     :: Int
+  -- | Constructor name
+  , constrName    :: String
+  -- | Parameter names with their named type
+  , constrParams  :: [(String, NamedType)]
+  -- | Uniqueness constraints on the constructor fiels
+  , constrConstrs :: [Constraint]
+} deriving (Show, Eq)
+
+-- | Phantom constructors are made instances of this class. This class should be used only by Template Haskell codegen
+class Constructor a where
+  -- returning ConstructorDef seems more logical, but it would require the value datatype
+  -- it can be supplied either as a part of constructor type, eg instance Constructor (MyDataConstructor (MyData a)) which requires -XFlexibleInstances
+  -- or as a separate type, eg instance Constructor MyDataConstructor (MyData a) which requires -XMultiParamTypeClasses
+  -- the phantoms are primarily used to get the constructor name. So to keep user code cleaner we return only the name and number, which can be later used to get ConstructorDef from the EntityDef
+  phantomConstrName :: a -> String
+  phantomConstrNum :: a -> Int
+
+-- | Constraint name and list of the field names that form a unique combination.
+-- Only fields of 'Primitive' types can be used in a constraint
+type Constraint = (String, [String])
+
+-- | A DB data type. Naming attempts to reflect the underlying Haskell
+-- datatypes, eg DbString instead of DbVarchar. Different databases may
+-- have different translations for these types.
+data DbType = DbString
+            | DbInt32
+            | DbInt64
+            | DbReal
+            | DbBool
+            | DbDay
+            | DbTime
+            | DbDayTime
+            | DbBlob    -- ByteString
+-- More complex types
+            | DbMaybe NamedType
+            | DbList NamedType
+            | DbTuple Int [NamedType]
+            | DbEntity EntityDef
+  deriving Show
+
+-- TODO: this type can be changed to avoid storing the value itself. For example, ([String, DbType). Restriction: can be used to get DbType and name
+-- | It is used to store type 'DbType' and persist name of a value
+data NamedType = forall v.PersistField v => NamedType v
+
+namedType :: PersistField v => v -> NamedType
+namedType = NamedType
+
+getName :: NamedType -> String
+getName (NamedType v) = persistName v
+
+getType :: NamedType -> DbType
+getType (NamedType v) = dbType v
+
+instance Show NamedType where
+  show (NamedType v) = show (dbType v)
+
+-- rely on the invariant that no two types have the same name
+instance Eq NamedType where
+  (NamedType v1) == (NamedType v2) = persistName v1 == persistName v2
+
+-- | A raw value which can be stored in any backend and can be marshalled to
+-- and from a 'PersistField'.
+data PersistValue = PersistString String
+                  | PersistByteString ByteString
+                  | PersistInt64 Int64
+                  | PersistDouble Double
+                  | PersistBool Bool
+                  | PersistDay Day
+                  | PersistTimeOfDay TimeOfDay
+                  | PersistUTCTime UTCTime
+                  | PersistNull
+  deriving (Show, Eq)
+
+-- | Arithmetic expressions which can include fields and literals
+data Arith v c a =
+    Plus  (Arith v c a) (Arith v c a)
+  | Minus (Arith v c a) (Arith v c a)
+  | Mult  (Arith v c a) (Arith v c a)
+  | Abs   (Arith v c a)
+  | ArithField (Fields v c a)
+  | Lit   Int64
+deriving instance Eq (Fields v c a) => Eq (Arith v c a)
+deriving instance Show (Fields v c a) => Show (Arith v c a)
+
+instance (Eq (Fields v c a), Show (Fields v c a), Numeric a) => Num (Arith v c a) where
+  a + b = Plus  a b
+  a - b = Minus a b
+  a * b = Mult  a b
+  abs   = Abs
+  signum = error "no signum"
+  fromInteger = Lit . fromInteger
+  
+-- | Convert field to an arithmetic value
+toArith :: Fields v c a -> Arith v c a
+toArith = ArithField
+
+-- | Constraint for use in arithmetic expressions. 'Num' is not used to explicitly include only types supported by the library .
+-- TODO: consider replacement with 'Num'
+class Numeric a
+-- | The same goals as for 'Numeric'. Certain types like String which have order in Haskell may not have it in DB
+class HasOrder a
+
+-- | Types which when converted to 'PersistValue' are never NULL.
+-- Consider the type @Maybe (Maybe a)@. Now Nothing is stored as NULL, so we cannot distinguish between Just Nothing and Nothing which is a problem.
+-- The purpose of this class is to ban the inner Maybe's.
+-- Maybe this class can be removed when support for inner Maybe's appears.
+class NeverNull a
+
+-- | Datatypes which can be converted directly to 'PersistValue'
+class Primitive a where
+  toPrim :: a -> PersistValue
+  fromPrim :: PersistValue -> a
+
+-- | Used to uniformly represent fields, literals and arithmetic expressions.
+-- A value should be convertec to 'Expr' for usage in expressions
+data Expr v c a where
+  ExprPrim  :: Primitive a => a -> Expr v c a
+  ExprField :: PersistEntity v => Fields v c a -> Expr v c a
+  ExprArith :: PersistEntity v => Arith v c a -> Expr v c a
+  -- we need this field for Key and Maybe mostly
+  ExprPlain :: Primitive a => a -> Expr v c (FuncA a)
+
+-- I wish wrap could return Expr with both fixed and polymorphic v&c. Any is used to emulate polymorphic types.
+-- | Instances of this type can be converted to 'Expr'
+class Expression a where
+  type FuncV a; type FuncC a; type FuncA a
+  wrap :: a -> Expr (FuncV a) (FuncC a) (FuncA a)
+
+-- | By default during converting values of certain types to 'Expr', the types can be changed. For example, @'Key' a@ is transformed into @a@.
+-- It is convenient because the fields usually contain reference to a certain datatype, not its 'Key'.
+-- But sometimes when automatic transformation gets in the way function 'wrapPrim' will help. Use it when a field in a datatype has type @(Key a)@ or @Maybe (Key a)@. Example:
+--
+-- @
+--data Example = Example {entity1 :: Maybe Smth, entity2 :: Key Smth}
+--Entity1Field ==. Just k &&. Entity2Field ==. wrapPrim k
+-- @
+wrapPrim :: Primitive a => a -> Expr Any Any a
+-- We cannot create different Expression instances for (Fields v c a) and (Fields v c (Key a))
+-- so that Func (Fields v c a) = a and Func (Fields v c (Key a)) = a
+-- because of the type families overlap restrictions. Neither we can create different instances for Key a
+wrapPrim = ExprPrim
+
+class PersistField a where
+  -- | Return name of the type. If it is polymorhic, the names of parameter types are separated with \"$\" symbol
+  persistName :: a -> String
+  -- | Convert a value into something which can be stored in a database column.
+  -- Note that for complex datatypes it may insert them to return identifier
+  toPersistValue :: PersistBackend m => a -> m PersistValue
+  -- | Constructs a value from a 'PersistValue'. For complex datatypes it may query the database
+  fromPersistValue :: PersistBackend m => PersistValue -> m a
+  -- | Description of value type
+  dbType :: a -> DbType
+
+---- INSTANCES
+
+instance Numeric Int
+instance Numeric Int8
+instance Numeric Int16
+instance Numeric Int32
+instance Numeric Int64
+instance Numeric Word8
+instance Numeric Word16
+instance Numeric Word32
+instance Numeric Word64
+instance Numeric Double
+
+instance HasOrder Int
+instance HasOrder Int8
+instance HasOrder Int16
+instance HasOrder Int32
+instance HasOrder Int64
+instance HasOrder Word8
+instance HasOrder Word16
+instance HasOrder Word32
+instance HasOrder Word64
+instance HasOrder Double
+instance HasOrder Bool
+instance HasOrder Day
+instance HasOrder TimeOfDay
+instance HasOrder UTCTime
+
+instance Primitive String where
+  toPrim = PersistString
+  fromPrim (PersistString s) = s
+  fromPrim (PersistByteString bs) = T.unpack $ T.decodeUtf8With T.lenientDecode bs
+  fromPrim (PersistInt64 i) = show i
+  fromPrim (PersistDouble d) = show d
+  fromPrim (PersistDay d) = show d
+  fromPrim (PersistTimeOfDay d) = show d
+  fromPrim (PersistUTCTime d) = show d
+  fromPrim (PersistBool b) = show b
+  fromPrim PersistNull = error "Unexpected null"
+
+instance Primitive T.Text where
+  toPrim = PersistString . T.unpack
+  fromPrim (PersistByteString bs) = T.decodeUtf8With T.lenientDecode bs
+  fromPrim x = T.pack $ fromPrim x
+
+instance Primitive ByteString where
+  toPrim = PersistByteString
+  fromPrim (PersistByteString a) = a
+  fromPrim x = T.encodeUtf8 . T.pack $ fromPrim x
+
+instance Primitive Int where
+  toPrim = PersistInt64 . fromIntegral
+  fromPrim (PersistInt64 a) = fromIntegral a
+  fromPrim x = error $ "Expected Integer, received: " ++ show x
+
+instance Primitive Int8 where
+  toPrim = PersistInt64 . fromIntegral
+  fromPrim (PersistInt64 a) = fromIntegral a
+  fromPrim x = error $ "Expected Integer, received: " ++ show x
+
+instance Primitive Int16 where
+  toPrim = PersistInt64 . fromIntegral
+  fromPrim (PersistInt64 a) = fromIntegral a
+  fromPrim x = error $ "Expected Integer, received: " ++ show x
+
+instance Primitive Int32 where
+  toPrim = PersistInt64 . fromIntegral
+  fromPrim (PersistInt64 a) = fromIntegral a
+  fromPrim x = error $ "Expected Integer, received: " ++ show x
+
+instance Primitive Int64 where
+  toPrim = PersistInt64
+  fromPrim (PersistInt64 a) = a
+  fromPrim x = error $ "Expected Integer, received: " ++ show x
+
+instance Primitive Word8 where
+  toPrim = PersistInt64 . fromIntegral
+  fromPrim (PersistInt64 a) = fromIntegral a
+  fromPrim x = error $ "Expected Integer, received: " ++ show x
+
+instance Primitive Word16 where
+  toPrim = PersistInt64 . fromIntegral
+  fromPrim (PersistInt64 a) = fromIntegral a
+  fromPrim x = error $ "Expected Integer, received: " ++ show x
+
+instance Primitive Word32 where
+  toPrim = PersistInt64 . fromIntegral
+  fromPrim (PersistInt64 a) = fromIntegral a
+  fromPrim x = error $ "Expected Integer, received: " ++ show x
+
+instance Primitive Word64 where
+  toPrim = PersistInt64 . fromIntegral
+  fromPrim (PersistInt64 a) = fromIntegral a
+  fromPrim x = error $ "Expected Integer, received: " ++ show x
+
+instance Primitive Double where
+  toPrim = PersistDouble
+  fromPrim (PersistDouble a) = a
+  fromPrim x = error $ "Expected Double, received: " ++ show x
+
+instance Primitive Bool where
+  toPrim = PersistBool
+  fromPrim (PersistBool a) = a
+  fromPrim (PersistInt64 i) = i /= 0
+  fromPrim x = error $ "Expected Bool, received: " ++ show x
+
+instance Primitive Day where
+  toPrim = PersistDay
+  fromPrim (PersistDay a) = a
+  fromPrim x = readHelper x ("Expected Day, received: " ++ show x)
+
+instance Primitive TimeOfDay where
+  toPrim = PersistTimeOfDay
+  fromPrim (PersistTimeOfDay a) = a
+  fromPrim x = readHelper x ("Expected TimeOfDay, received: " ++ show x)
+
+instance Primitive UTCTime where
+  toPrim = PersistUTCTime
+  fromPrim (PersistUTCTime a) = a
+  fromPrim x = readHelper x ("Expected UTCTime, received: " ++ show x)
+
+instance Primitive (Key a) where
+  toPrim (Key a) = PersistInt64 a
+  fromPrim (PersistInt64 a) = Key a
+  fromPrim x = error $ "Expected Integer(entity key), received: " ++ show x
+
+instance (Primitive a, NeverNull a) => Primitive (Maybe a) where
+  toPrim = maybe PersistNull toPrim
+  fromPrim PersistNull = Nothing
+  fromPrim x = Just $ fromPrim x
+
+instance NeverNull String
+instance NeverNull T.Text
+instance NeverNull ByteString
+instance NeverNull Int
+instance NeverNull Int64
+instance NeverNull Double
+instance NeverNull Bool
+instance NeverNull Day
+instance NeverNull TimeOfDay
+instance NeverNull UTCTime
+instance NeverNull (Key a)
+instance NeverNull [a]
+instance NeverNull (a, b)
+instance NeverNull (a, b, c)
+instance NeverNull (a, b, c, d)
+instance NeverNull (a, b, c, d, e)
+instance PersistEntity a => NeverNull a
+
+instance Expression (Expr v c a) where
+  type FuncV (Expr v c a) = v
+  type FuncC (Expr v c a) = c
+  type FuncA (Expr v c a) = a
+  wrap = id
+
+instance PersistEntity v => Expression (Fields v c a) where
+  type FuncV (Fields v c a) = v
+  type FuncC (Fields v c a) = c
+  type FuncA (Fields v c a) = a
+  wrap = ExprField
+
+instance PersistEntity v => Expression (Arith v c a) where
+  type FuncV (Arith v c a) = v
+  type FuncC (Arith v c a) = c
+  type FuncA (Arith v c a) = a
+  wrap = ExprArith
+
+instance (Expression a, Primitive a, NeverNull a) => Expression (Maybe a) where
+  type FuncV (Maybe a) = Any
+  type FuncC (Maybe a) = Any
+  type FuncA (Maybe a) = (Maybe (FuncA a))
+  wrap = ExprPlain
+
+instance Expression (Key a) where
+  type FuncV (Key a) = Any; type FuncC (Key a) = Any; type FuncA (Key a) = a
+  wrap = ExprPlain
+
+instance Expression Int where
+  type FuncV Int = Any; type FuncC Int = Any; type FuncA Int = Int
+  wrap = ExprPrim
+
+instance Expression Int8 where
+  type FuncV Int8 = Any; type FuncC Int8 = Any; type FuncA Int8 = Int8
+  wrap = ExprPrim
+
+instance Expression Int16 where
+  type FuncV Int16 = Any; type FuncC Int16 = Any; type FuncA Int16 = Int16
+  wrap = ExprPrim
+
+instance Expression Int32 where
+  type FuncV Int32 = Any; type FuncC Int32 = Any; type FuncA Int32 = Int32
+  wrap = ExprPrim
+
+instance Expression Int64 where
+  type FuncV Int64 = Any; type FuncC Int64 = Any; type FuncA Int64 = Int64
+  wrap = ExprPrim
+
+instance Expression Word8 where
+  type FuncV Word8 = Any; type FuncC Word8 = Any; type FuncA Word8 = Word8
+  wrap = ExprPrim
+
+instance Expression Word16 where
+  type FuncV Word16 = Any; type FuncC Word16 = Any; type FuncA Word16 = Word16
+  wrap = ExprPrim
+
+instance Expression Word32 where
+  type FuncV Word32 = Any; type FuncC Word32 = Any; type FuncA Word32 = Word32
+  wrap = ExprPrim
+
+instance Expression Word64 where
+  type FuncV Word64 = Any; type FuncC Word64 = Any; type FuncA Word64 = Word64
+  wrap = ExprPrim
+
+instance Expression String where
+  type FuncV String = Any; type FuncC String = Any; type FuncA String = String
+  wrap = ExprPrim
+
+instance Expression ByteString where
+  type FuncV ByteString = Any; type FuncC ByteString = Any; type FuncA ByteString = ByteString
+  wrap = ExprPrim
+
+instance Expression T.Text where
+  type FuncV T.Text = Any; type FuncC T.Text = Any; type FuncA T.Text = T.Text
+  wrap = ExprPrim
+
+instance Expression Bool where
+  type FuncV Bool = Any; type FuncC Bool = Any; type FuncA Bool = Bool
+  wrap = ExprPrim
+
+readHelper :: Read a => PersistValue -> String -> a
+readHelper s errMessage = case s of
+  PersistString str -> readHelper' str
+  PersistByteString str -> readHelper' (unpack str)
+  _ -> error errMessage
+  where
+    readHelper' str = case reads str of
+      (a, _):_ -> a
+      _        -> error errMessage
+
+instance PersistField ByteString where
+  persistName _ = "ByteString"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType _ = DbBlob
+
+instance PersistField String where
+  persistName _ = "String"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType _ = DbString
+
+instance PersistField T.Text where
+  persistName _ = "Text"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType _ = DbString
+
+instance PersistField Int where
+  persistName _ = "Int"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType a = if bitSize a == 32 then DbInt32 else DbInt64
+
+instance PersistField Int8 where
+  persistName _ = "Int8"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType _ = DbInt64
+
+instance PersistField Int16 where
+  persistName _ = "Int16"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType _ = DbInt64
+
+instance PersistField Int32 where
+  persistName _ = "Int32"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType _ = DbInt64
+
+instance PersistField Int64 where
+  persistName _ = "Int64"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType _ = DbInt64
+
+instance PersistField Word8 where
+  persistName _ = "Word8"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType _ = DbInt64
+
+instance PersistField Word16 where
+  persistName _ = "Word16"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType _ = DbInt64
+
+instance PersistField Word32 where
+  persistName _ = "Word32"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType _ = DbInt64
+
+instance PersistField Word64 where
+  persistName _ = "Word64"
+  toPersistValue = return . toPrim
+  fromPersistValue = return . fromPrim
+  dbType _ = DbInt64
+
+instance PersistField Double where
+  persistName _ = "Double"
+  toPersistValue = return . PersistDouble
+  fromPersistValue = return . fromPrim
+  dbType _ = DbReal
+
+instance PersistField Bool where
+  persistName _ = "Bool"
+  toPersistValue = return . PersistBool
+  fromPersistValue = return . fromPrim
+  dbType _ = DbBool
+
+instance PersistField Day where
+  persistName _ = "Day"
+  toPersistValue = return . PersistDay
+  fromPersistValue = return . fromPrim
+  dbType _ = DbDay
+
+instance PersistField TimeOfDay where
+  persistName _ = "TimeOfDay"
+  toPersistValue = return . PersistTimeOfDay
+  fromPersistValue = return . fromPrim
+  dbType _ = DbTime
+
+instance PersistField UTCTime where
+  persistName _ = "UTCTime"
+  toPersistValue = return . PersistUTCTime
+  fromPersistValue = return . fromPrim
+  dbType _ = DbDayTime
+
+instance (PersistField a, NeverNull a) => PersistField (Maybe a) where
+  persistName (_ :: Maybe a) = "Maybe$" ++ persistName (undefined :: a)
+  toPersistValue = maybe (return PersistNull) toPersistValue
+  fromPersistValue PersistNull = return Nothing
+  fromPersistValue x = liftM Just $ fromPersistValue x
+  dbType (_ :: Maybe a) = DbMaybe $ namedType (undefined :: a)
+  
+instance (PersistEntity a) => PersistField (Key a) where
+  persistName (_ :: Key a) = "Key$" ++ persistName (undefined :: a)
+  toPersistValue (Key a) = return $ PersistInt64 a
+  fromPersistValue = return . fromPrim
+  dbType (_ :: Key a) = DbEntity $ entityDef (undefined :: a)
+
+instance (PersistField a) => PersistField [a] where
+  persistName (_ :: [a]) = "List$$" ++ persistName (undefined :: a)
+  toPersistValue l = insertList l >>= toPersistValue
+  fromPersistValue k = getList (fromPrim k)
+  dbType (_ :: [a]) = DbList $ namedType (undefined :: a)
+
+instance (PersistField a, PersistField b) => PersistField (a, b) where
+  persistName (_ :: (a, b)) = "Tuple2$$" ++ persistName (undefined :: a) ++ "$" ++ persistName (undefined :: b)
+  toPersistValue x@(a, b) = do
+    vals <- sequence [toPersistValue a, toPersistValue b]
+    liftM PersistInt64 $ insertTuple (namedType x) vals 
+  fromPersistValue (PersistInt64 key) = do
+    [a, b] <- getTuple (namedType (undefined :: (a, b))) key
+    liftM2 (,) (fromPersistValue a) (fromPersistValue b)
+  fromPersistValue x = fail $ "Expected Integer(tuple key), received: " ++ show x
+  dbType (_ :: (a, b)) = DbTuple 2 [namedType (undefined :: a), namedType (undefined :: b)]
+  
+instance (PersistField a, PersistField b, PersistField c) => PersistField (a, b, c) where
+  persistName (_ :: (a, b, c)) = "Tuple3$$" ++ persistName (undefined :: a) ++ "$" ++ persistName (undefined :: b) ++ "$" ++ persistName (undefined :: c)
+  toPersistValue x@(a, b, c) = do
+    vals <- sequence [toPersistValue a, toPersistValue b, toPersistValue c]
+    liftM PersistInt64 $ insertTuple (namedType x) vals 
+  fromPersistValue (PersistInt64 key) = do
+    [a, b, c] <- getTuple (namedType (undefined :: (a, b, c))) key
+    liftM3 (,,) (fromPersistValue a) (fromPersistValue b) (fromPersistValue c)
+  fromPersistValue x = fail $ "Expected Integer(tuple key), received: " ++ show x
+  dbType (_ :: (a, b, c)) = DbTuple 3 [namedType (undefined :: a), namedType (undefined :: b), namedType (undefined :: c)]
+  
+instance (PersistField a, PersistField b, PersistField c, PersistField d) => PersistField (a, b, c, d) where
+  persistName (_ :: (a, b, c, d)) = "Tuple4$$" ++ persistName (undefined :: a) ++ "$" ++ persistName (undefined :: b) ++ "$" ++ persistName (undefined :: c) ++ "$" ++ persistName (undefined :: d)
+  toPersistValue x@(a, b, c, d) = do
+    vals <- sequence [toPersistValue a, toPersistValue b, toPersistValue c, toPersistValue d]
+    liftM PersistInt64 $ insertTuple (namedType x) vals 
+  fromPersistValue (PersistInt64 key) = do
+    [a, b, c, d] <- getTuple (namedType (undefined :: (a, b, c, d))) key
+    liftM4 (,,,) (fromPersistValue a) (fromPersistValue b) (fromPersistValue c) (fromPersistValue d)
+  fromPersistValue x = fail $ "Expected Integer(tuple key), received: " ++ show x
+  dbType (_ :: (a, b, c, d)) = DbTuple 4 [namedType (undefined :: a), namedType (undefined :: b), namedType (undefined :: c), namedType (undefined :: d)]
+  
+instance (PersistField a, PersistField b, PersistField c, PersistField d, PersistField e) => PersistField (a, b, c, d, e) where
+  persistName (_ :: (a, b, c, d, e)) = "Tuple5$$" ++ persistName (undefined :: a) ++ "$" ++ persistName (undefined :: b) ++ "$" ++ persistName (undefined :: c) ++ "$" ++ persistName (undefined :: d) ++ "$" ++ persistName (undefined :: e)
+  toPersistValue x@(a, b, c, d, e) = do
+    vals <- sequence [toPersistValue a, toPersistValue b, toPersistValue c, toPersistValue d, toPersistValue e]
+    liftM PersistInt64 $ insertTuple (namedType x) vals 
+  fromPersistValue (PersistInt64 key) = do
+    [a, b, c, d, e] <- getTuple (namedType (undefined :: (a, b, c, d, e))) key
+    liftM5 (,,,,) (fromPersistValue a) (fromPersistValue b) (fromPersistValue c) (fromPersistValue d) (fromPersistValue e)
+  fromPersistValue x = fail $ "Expected Integer(tuple key), received: " ++ show x
+  dbType (_ :: (a, b, c, d, e)) = DbTuple 5 [namedType (undefined :: a), namedType (undefined :: b), namedType (undefined :: c), namedType (undefined :: d), namedType (undefined :: e)]
diff --git a/Database/Groundhog/Generic.hs b/Database/Groundhog/Generic.hs
new file mode 100644
--- /dev/null
+++ b/Database/Groundhog/Generic.hs
@@ -0,0 +1,139 @@
+-- | This helper module is intended for use by the backend creators
+module Database.Groundhog.Generic
+  ( migrateRecursively
+  , createMigration
+  , executeMigration
+  , executeMigrationUnsafe
+  , runMigration
+  , runMigrationUnsafe
+  , printMigration
+  , getEntityName
+  , mergeMigrations
+  , silentMigrationLogger
+  , defaultMigrationLogger
+  , defaultSelect
+  , defaultSelectAll
+  ) where
+
+import Database.Groundhog.Core
+
+import Control.Monad(liftM, forM_)
+import Control.Monad.Trans.State
+import Control.Monad.Trans.Class(lift)
+import Control.Monad.IO.Class (MonadIO (..))
+import Data.Enumerator(Iteratee(..), run, (==<<))
+import Data.Enumerator.List(consume)
+import Data.Either(partitionEithers)
+import Data.List(intercalate)
+import qualified Data.Map as Map
+
+-- | Create migration for a given entity and all entities it depends on.
+-- The stateful Map is used to avoid duplicate migrations when an entity type
+-- occurs several times in a datatype
+migrateRecursively :: (Monad m, PersistEntity e) => 
+     (EntityDef -> m SingleMigration)          -- ^ migrate entity
+  -> (Int -> [NamedType] -> m SingleMigration) -- ^ migrate tuple
+  -> (NamedType -> m SingleMigration)          -- ^ migrate list
+  -> e                                         -- ^ initial entity
+  -> StateT NamedMigrations m ()
+migrateRecursively migE migT migL = go . namedType where
+  go w = case getType w of
+    (DbList t)     -> f (getName w) (migL t) (go t)
+    (DbTuple n ts) -> f (getName w) (migT n ts) (mapM_ go ts)
+    (DbEntity e) -> f (getName w) (migE e) (mapM_ go (allSubtypes e))
+    (DbMaybe t)    -> go t
+    _              -> return ()    -- ordinary types need not migration
+  f name mig cont = do
+    v <- gets (Map.lookup name)
+    case v of
+      Nothing -> lift mig >>= modify.Map.insert name >> cont
+      _ -> return ()
+  allSubtypes = map snd . concatMap constrParams . constructors
+
+getCorrectMigrations :: NamedMigrations -> [(Bool, String)]
+getCorrectMigrations = either (error.unlines) id . mergeMigrations . Map.elems
+
+-- | Produce the migrations but not execute them. Fails when an unsafe migration occurs.
+createMigration :: PersistBackend m => Migration m -> m NamedMigrations
+createMigration m = liftM snd $ runStateT m Map.empty
+
+-- | Execute the migrations and log them. 
+executeMigration :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> NamedMigrations -> m ()
+executeMigration logger m = do
+  let migs = getCorrectMigrations m
+  let unsafe = map snd $ filter fst migs
+  if null unsafe
+    then mapM_ (executeMigrate logger.snd) migs
+    else error $ concat
+            [ "\n\nDatabase migration: manual intervention required.\n"
+            , "The following actions are considered unsafe:\n\n"
+            , unlines $ map (\s -> "    " ++ s ++ ";") unsafe
+            ]
+
+-- | Execute migrations and log them. Executes the unsafe migrations without warnings
+executeMigrationUnsafe :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> NamedMigrations -> m ()
+executeMigrationUnsafe logger = mapM_ (executeMigrate logger.snd) . getCorrectMigrations
+
+-- | Pretty print the migrations
+printMigration :: MonadIO m => NamedMigrations -> m ()
+printMigration migs = liftIO $ do
+  let kv = Map.assocs migs
+  forM_ kv $ \(k, v) -> do
+    putStrLn $ "Datatype " ++ k ++ ":"
+    case v of
+      Left errors -> mapM_ (putStrLn . ("\tError:\t" ++)) errors
+      Right sqls  -> do
+        let showSql (isUnsafe, sql) = (if isUnsafe then "Unsafe:\t" else "Safe:\t") ++ sql
+        mapM_ (putStrLn . ("\t" ++).showSql) sqls
+
+-- | Run migrations and log them. Fails when an unsafe migration occurs.
+runMigration :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> Migration m -> m ()
+runMigration logger m = createMigration m >>= executeMigration logger
+
+-- | Run migrations and log them. Executes the unsafe migrations without warnings
+runMigrationUnsafe :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> Migration m -> m ()
+runMigrationUnsafe logger m = createMigration m >>= executeMigrationUnsafe logger
+
+executeMigrate :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> String -> m ()
+executeMigrate logger query = do
+  liftIO $ logger query
+  executeRaw False query []
+  return ()
+
+-- | No-op
+silentMigrationLogger :: String -> IO ()
+silentMigrationLogger _ = return ()
+
+-- | Prints the queries to stdout
+defaultMigrationLogger :: String -> IO ()
+defaultMigrationLogger query = putStrLn $ "Migrating: " ++ query
+
+-- | Joins the migrations. The result is either all error messages or all queries
+mergeMigrations :: [SingleMigration] -> SingleMigration
+mergeMigrations ms =
+  let (errors, statements) = partitionEithers ms
+  in if null errors
+       then Right (concat statements)
+       else Left  (concat errors)
+
+-- | Get full entity name with the names of its parameters.
+--
+-- @ getEntityName (entityDef v) == persistName v @
+getEntityName :: EntityDef -> String
+getEntityName e = intercalate "$" $ entityName e:map getName (typeParams e)
+
+-- | Call 'selectEnum' but return the result as a list
+defaultSelect :: (PersistBackend m, PersistEntity v, Constructor c) => Cond v c -> [Order v c] -> Int -> Int -> m [(Key v, v)]
+defaultSelect cond ord off lim = do
+    res <- run $ selectEnum cond ord off lim ==<< consume
+    case res of
+        Left e -> error $ show e
+        Right x -> return x
+
+-- | Call 'selectAllEnum' but return the result as a list
+defaultSelectAll :: (PersistBackend m, PersistEntity v) => m [(Key v, v)]
+defaultSelectAll = do
+    res <- run $ Iteratee (runIteratee consume >>= runIteratee . selectAllEnum)
+    case res of
+        Left e -> error $ show e
+        Right x -> return x
diff --git a/Database/Groundhog/Generic/Sql.hs b/Database/Groundhog/Generic/Sql.hs
new file mode 100644
--- /dev/null
+++ b/Database/Groundhog/Generic/Sql.hs
@@ -0,0 +1,137 @@
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, Rank2Types, GADTs #-}
+
+-- | This module defines the functions which are used only for backends creation.
+module Database.Groundhog.Generic.Sql
+    ( renderCond
+    , defaultShowPrim
+    , renderArith
+    , renderOrders
+    , renderUpdates
+    , defId
+    , defDelim
+    , defRenderEquals
+    , defRenderNotEquals
+    , renderExpr
+    , RenderS
+    , (<>)
+    ) where
+
+import Database.Groundhog.Core
+
+parens :: Int -> Int -> RenderS -> RenderS
+parens p1 p2 expr = if p1 < p2 then char '(' <> expr <> char ')' else expr
+
+(<>) :: RenderS -> RenderS -> RenderS
+(f1, g1) <> (f2, g2) = (f1.f2, g1.g2)
+
+string :: String -> RenderS
+string s = ((s++), id)
+
+char :: Char -> RenderS
+char c = ((c:), id)
+  
+type RenderS = (ShowS, [PersistValue] -> [PersistValue])
+
+renderArith :: PersistEntity v => (String -> String) -> Arith v c a -> RenderS
+renderArith escape arith = go arith 0 where
+  go :: PersistEntity v => Arith v c a -> Int -> RenderS
+  go (Plus a b)     p = parens 6 p $ go a 6 <> char '+' <> go b 6
+  go (Minus a b)    p = parens 6 p $ go a 6 <> char '-' <> go b 6
+  go (Mult a b)     p = parens 7 p $ go a 7 <> char '*' <> go b 7
+  go (Abs a)        p = parens 9 p $ string "ABS(" <> go a 0 <> char ')'
+  go (ArithField f) _ = string (escape (show f))
+  go (Lit a)        _ = (('?':), (toPrim a:))
+
+renderCond :: PersistEntity v
+  => (String -> String) -- escape
+  -> String -- name of id in constructor table
+  -> (forall a.PersistField a => (String -> String) -> Expr v c a -> Expr v c a -> RenderS) -- render equals
+  -> (forall a.PersistField a => (String -> String) -> Expr v c a -> Expr v c a -> RenderS) -- render not equals
+  -> Cond v c -> RenderS
+renderCond esc idName rendEq rendNotEq (cond :: Cond v c) = go cond 0 where
+  go :: Cond v c -> Int -> RenderS
+  go (And a b)       p = parens 3 p $ go a 3 <> string " AND " <> go b 3
+  go (Or a b)        p = parens 2 p $ go a 2 <> string " OR " <> go b 2
+  go (Not a)         p = parens 1 p $ string "NOT " <> go a 1
+  -- the comparisons have the highest priority, so they never need parentheses
+  go (Lesser a b)    _ = renderExpr esc a <> char '<' <> renderExpr esc b
+  go (Greater a b)   _ = renderExpr esc a <> char '>' <> renderExpr esc b
+  go (Equals a b)    _ = rendEq esc a b
+  go (NotEquals a b) _ = rendNotEq esc a b
+  go (KeyIs k) _ = ((idName ++) . ("=?" ++), (toPrim k:))
+
+-- TODO: they don't support all cases
+defRenderEquals :: PersistField a => (String -> String) -> Expr v c a -> Expr v c a -> RenderS
+defRenderEquals esc a b | not (isNullable a) = renderExpr esc a <> char '=' <> renderExpr esc b
+-- only ExprPrim and ExprField can come here here
+-- if one of arguments is Nothing, compare the other with NULL
+defRenderEquals _ (ExprPlain a) (ExprPlain b) | isNull a && isNull b = string "NULL IS NULL"
+defRenderEquals esc (ExprPlain a) b | isNull a = renderExpr esc b <> string " IS NULL"
+                                    | otherwise = renderPrim a <> char '=' <> renderExpr esc b
+defRenderEquals esc a (ExprPlain b) | isNull b = renderExpr esc a <> string " IS NULL"
+                                    | otherwise = renderExpr esc a <> char '=' <> renderPrim b
+--  if both are fields we compare them to each other and to null
+defRenderEquals esc (ExprField a) (ExprField b) = char '(' <> a' <> char '=' <> b' <> string " OR " <> a' <> string " IS NULL AND " <> b' <> string " IS NULL)" where
+  a' = string $ esc (show a)
+  b' = string $ esc (show b)
+defRenderEquals _ _ _ = error "for nullable values there must be no other expressions than ExprField and ExprPlain"
+
+defRenderNotEquals :: PersistField a => (String -> String) -> Expr v c a -> Expr v c a -> RenderS
+defRenderNotEquals esc a b | not (isNullable a) = renderExpr esc a <> string "<>" <> renderExpr esc b
+-- if one of arguments is Nothing, compare the other with NULL
+defRenderNotEquals _ (ExprPlain a) (ExprPlain b) | isNull a && isNull b = string "NULL IS NOT NULL"
+defRenderNotEquals esc (ExprPlain a) b | isNull a  = renderExpr esc b <> string " IS NOT NULL"
+                                       | otherwise = char '(' <> renderPrim a <> string "<>" <> renderExpr esc b <> string " OR " <> renderExpr esc b <> string " IS NULL)"
+defRenderNotEquals esc a (ExprPlain b) | isNull b = renderExpr esc a <> string " IS NOT NULL"
+                                       | otherwise = char '(' <> renderExpr esc a <> string "<>" <> renderPrim b <> string " OR " <> renderExpr esc a <> string " IS NULL)"
+defRenderNotEquals esc (ExprField a) (ExprField b) = a' <> string "<>" <> b' <> string " OR (" <> a' <> string " IS NULL AND " <> b' <> string " IS NOT NULL) OR (" <> a' <> string " IS NOT NULL AND " <> b' <> string " IS NULL)" where
+  a' = string $ esc (show a)
+  b' = string $ esc (show b)
+defRenderNotEquals _ _ _ = error "for nullable values there must be no other expressions than ExprField and ExprPlain"
+
+isNull :: Primitive a => a -> Bool
+isNull a = toPrim a == PersistNull
+
+renderExpr :: (String -> String) -> Expr v c a -> RenderS
+renderExpr esc (ExprField a) = string $ esc (show a)
+renderExpr _   (ExprPrim a)  = (('?':), (toPrim a:))
+renderExpr _   (ExprPlain a)  = (('?':), (toPrim a:))
+renderExpr esc (ExprArith a) = renderArith esc a
+
+renderPrim :: Primitive a => a -> RenderS
+renderPrim a = (('?':), (toPrim a:))
+
+isNullable :: PersistField a => Expr v c a -> Bool
+isNullable (_ :: Expr v c a) = case dbType (undefined :: a) of
+  DbMaybe _ -> True
+  _         -> False
+
+defaultShowPrim :: PersistValue -> String
+defaultShowPrim (PersistString x) = "'" ++ x ++ "'"
+defaultShowPrim (PersistByteString x) = "'" ++ show x ++ "'"
+defaultShowPrim (PersistInt64 x) = show x
+defaultShowPrim (PersistDouble x) = show x
+defaultShowPrim (PersistBool x) = if x then "1" else "0"
+defaultShowPrim (PersistDay x) = show x
+defaultShowPrim (PersistTimeOfDay x) = show x
+defaultShowPrim (PersistUTCTime x) = show x
+defaultShowPrim (PersistNull) = "NULL"
+
+renderOrders :: PersistEntity v => (String -> String) -> [Order v c] -> ShowS
+renderOrders _ [] = id
+renderOrders esc (x:xs) = (" ORDER BY " ++) . f x . rest where
+  rest = foldr (\ord r -> (',':) . f ord . r) id xs
+  f (Asc a)  = (esc (show a) ++)
+  f (Desc a) = (esc (show a) ++) . (" DESC" ++)
+
+renderUpdates :: PersistEntity v => (String -> String) -> [Update v c] -> RenderS
+renderUpdates _ [] = (id, id)
+renderUpdates esc (x:xs) = f x <> rest where
+  rest = foldr (\ord r -> char ',' <> f ord <> r) (id, id) xs
+  f (Update field a) = string (esc (show field)) <> char '=' <> renderExpr esc a
+
+defId :: String
+defId = "id$"
+
+defDelim :: Char
+defDelim = '$'
diff --git a/Database/Groundhog/TH.hs b/Database/Groundhog/TH.hs
new file mode 100644
--- /dev/null
+++ b/Database/Groundhog/TH.hs
@@ -0,0 +1,330 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | This module provides functions to generate the auxiliary structures for the user data type
+module Database.Groundhog.TH
+  ( deriveEntity
+  , setDbEntityName
+  , setConstructor
+  , setPhantomName
+  , setDbConstrName
+  , setConstraints
+  , setField
+  , setDbFieldName
+  , setExprFieldName
+  ) where
+
+import Database.Groundhog.Core(PersistEntity(..), PersistField(..), NeverNull, Primitive(toPrim), PersistBackend(..), DbType(DbEntity), Constraint, Constructor(..), namedType, EntityDef(..), ConstructorDef(..), PersistValue(..))
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax(StrictType, VarStrictType)
+import Control.Monad(liftM, forM, forM_)
+import Control.Monad.Trans.State(State, runState, modify)
+import Data.Char(toUpper, toLower, isSpace)
+import Data.List(nub, (\\))
+
+-- data SomeData a = U1 { foo :: Int} | U2 { bar :: Maybe String, asc :: Int64, add :: a} | U3 deriving (Show, Eq)
+
+data THEntityDef = THEntityDef {
+    dataName :: Name -- SomeData
+  , dbEntityName :: String  -- SQLSomeData
+  , thTypeParams :: [TyVarBndr]
+  , thConstructors :: [THConstructorDef]
+} deriving Show
+
+data THConstructorDef = THConstructorDef {
+    thConstrName    :: Name -- U2
+  , thPhantomConstrName :: String -- U2Constructor
+  , dbConstrName    :: String -- SQLU2
+  , thConstrParams  :: [FieldDef]
+  , thConstrConstrs :: [Constraint]
+} deriving Show
+
+data FieldDef = FieldDef {
+    fieldName :: String -- bar
+  , dbFieldName :: String -- SQLbar
+  , exprName :: String -- BarField
+  , fieldType :: Type
+} deriving Show
+
+-- | Set name of the table in the datatype
+setDbEntityName :: String -> State THEntityDef ()
+setDbEntityName name = modify $ \d -> d {dbEntityName = name}
+
+-- | Modify constructor
+setConstructor :: Name -> State THConstructorDef () -> State THEntityDef ()
+setConstructor name f = modify $ \d ->
+  d {thConstructors = replaceOne thConstrName name f $ thConstructors d}
+
+-- | Set name used to parametrise fields
+setPhantomName :: String -> State THConstructorDef ()
+setPhantomName name = modify $ \c -> c {thPhantomConstrName = name}
+
+-- | Set name of the constructor specific table
+setDbConstrName :: String -> State THConstructorDef ()
+setDbConstrName name = modify $ \c -> c {dbConstrName = name}
+
+-- | Set constraints of the constructor. The names should be database names of the fields
+setConstraints :: [Constraint] -> State THConstructorDef ()
+setConstraints cs = modify $ \c -> c {thConstrConstrs = cs}
+
+-- | Modify field. Field name is a regular field name in record constructor. Otherwise, it is lower-case constructor name with field number.
+setField :: String -> State FieldDef () -> State THConstructorDef ()
+setField name f = modify $ \c ->
+  c {thConstrParams = replaceOne fieldName name f $ thConstrParams c}
+
+-- | Set name of the field column in a database
+setDbFieldName :: String -> State FieldDef ()
+setDbFieldName name = modify $ \f -> f {dbFieldName = name}
+
+-- | Set name of field constructor used in expressions
+setExprFieldName :: String -> State FieldDef ()
+setExprFieldName name = modify $ \f -> f {exprName = name}
+
+replaceOne :: (Eq b, Show b) => (a -> b) -> b -> State a () -> [a] -> [a]
+replaceOne p a f xs = case length (filter ((==a).p) xs) of
+  1 -> map (\x -> if p x == a then runModify f x else x) xs
+  0 -> error $ "Element with name " ++ show a ++ " not found"
+  _ -> error $ "Found more than one element with name " ++ show a
+
+runModify :: State a () -> a -> a
+runModify m a = snd $ runState m a
+
+-- | Creates the auxiliary structures for a user datatype, which are required by Groundhog to manipulate it.
+-- 
+-- It creates GADT 'Fields' data instance for referring to the fields in
+-- expressions and phantom types for data constructors. For record constructors the Field name is the regular field name with 
+-- first letter capitalized and postpended \"Field\". If the field is an ordinary constructor, its name is constructor name
+-- and postponed field name. The constructor phantom datatypes have the same name as constructors with \"Constructor\" postpended.
+--
+-- The generation can be adjusted using the optional modifier function. Example:
+--
+-- > data SomeData a = Normal Int | Record { bar :: Maybe String, asc :: a}
+-- > deriveEntity ''SomeData $ Just $ do
+-- >   setDbEntityName "SomeTableName"
+-- >   setConstructor 'Normal $ do
+-- >     setPhantomName "NormalConstructor" -- the same as default
+--
+-- It will generate these new datatypes and required instances.
+--
+-- > data NormalConstructor
+-- > data RecordConstructor
+-- > instance PersistEntity where
+-- >   data Fields (SomeData a) where
+-- >     Normal0Field :: Fields NormalConstructor Int
+-- >     BarField :: Fields RecordConstructor (Maybe String)
+-- >     AscField :: Fields RecordConstructor a
+-- > ...
+
+deriveEntity :: Name -> Maybe (State THEntityDef ()) -> Q [Dec]
+deriveEntity name f = do
+  info <- reify name
+  let f' = maybe id runModify f
+  case info of
+    TyConI x -> do
+      case x of
+        def@(DataD _ _ _ _ _)  -> mkDecs $ either error id $ validate $ f' $ mkTHEntityDef def
+        NewtypeD _ _ _ _ _ -> error "Newtypes are not supported"
+        _ -> error $ "Unknown declaration type"
+    _        -> error "Only datatypes can be processed"
+
+validate :: THEntityDef -> Either String THEntityDef
+validate def = do
+  let notUniqueBy f xs = let xs' = map f xs in nub $ xs' \\ nub xs'
+  let assertUnique f xs what = case notUniqueBy f xs of
+        [] -> return ()
+        ys -> fail $ "All " ++ what ++ " must be unique: " ++ show ys
+  -- we need to validate datatype names because TH just creates unusable fields with spaces
+  let isSpaceFree = not . any isSpace
+  let assertSpaceFree s what = if isSpaceFree s then return () else fail $ "Spaces in " ++ what ++ " are not allowed: " ++ show s
+  let constrs = thConstructors def
+  assertUnique thPhantomConstrName constrs "constructor phantom name"
+  assertUnique dbConstrName constrs "constructor db name"
+  forM_ constrs $ \cdef -> do
+    let fields = thConstrParams cdef
+    assertSpaceFree (thPhantomConstrName cdef) "constructor phantom name"
+    assertUnique exprName fields "expr field name in a constructor"
+    assertUnique dbFieldName fields "db field name in a constructor"
+    forM_ fields $ \fdef -> assertSpaceFree (exprName fdef) "field expr name"
+  return def
+
+mkTHEntityDef :: Dec -> THEntityDef
+mkTHEntityDef (DataD _ dname typeVars cons _) =
+  THEntityDef dname (nameBase dname) typeVars constrs where
+  constrs = map mkConstr cons
+
+  mkConstr (NormalC name params) = mkConstr' name $ zipWith (\p i -> mkField (firstLetter toLower (nameBase name) ++ show i) p) params [0::Int ..]
+  mkConstr (RecC name params) = mkConstr' name (map mkVarField params)
+  mkConstr (InfixC _ _ _) = error "Types with infix constructors are not supported"
+  mkConstr (ForallC _ _ _) = error "Types with existential quantification are not supported"
+  mkConstr' name params = THConstructorDef name (nameBase name ++ "Constructor") (nameBase name) params []
+  
+  mkField :: String -> StrictType -> FieldDef
+  mkField name (_, t) = mkField' name t
+  mkVarField :: VarStrictType -> FieldDef
+  mkVarField (name, _, t) = mkField' (nameBase name) t
+  mkField' name t = FieldDef name name (firstLetter toUpper name ++ "Field") t
+mkTHEntityDef _ = error "Only datatypes can be processed"
+
+firstLetter :: (Char -> Char) -> String -> String
+firstLetter f s = f (head s):tail s
+
+mkDecs :: THEntityDef -> Q [Dec]
+mkDecs def = do
+--  runIO (print def)
+  decs <- fmap concat $ sequence
+    [ mkPhantomConstructors def
+    , mkPhantomConstructorInstances def
+    , mkPersistFieldInstance def
+    , mkPersistEntityInstance def
+    ]
+--  runIO $ putStrLn $ pprint decs
+  return decs
+-- $(reify ''SomeData >>= stringE.show)
+
+mkPhantomConstructors :: THEntityDef -> Q [Dec]
+mkPhantomConstructors def = mapM f $ thConstructors def where
+  f c = dataD (cxt []) (mkName $ thPhantomConstrName c) [] [] []
+  
+mkPhantomConstructorInstances :: THEntityDef -> Q [Dec]
+mkPhantomConstructorInstances def = sequence $ zipWith f [0..] $ thConstructors def where
+  f :: Int -> THConstructorDef -> Q Dec
+  f cNum c = instanceD (cxt []) (appT (conT ''Constructor) (conT $ mkName $ thPhantomConstrName c)) [phantomConstrName', phantomConstrNum'] where
+    phantomConstrName' = funD 'phantomConstrName [clause [wildP] (normalB $ stringE $ dbConstrName c) []]
+    phantomConstrNum' = funD 'phantomConstrNum [clause [wildP] (normalB $ [|cNum  |]) []]
+
+mkPersistEntityInstance :: THEntityDef -> Q [Dec]
+mkPersistEntityInstance def = do
+  let entity = foldl AppT (ConT (dataName def)) $ map getType $ thTypeParams def
+  
+  fields' <- do
+    cParam <- newName "c"
+    fParam <- newName "f"
+    let mkField name field = ForallC [] ([EqualP (VarT cParam) (ConT name), EqualP (VarT fParam) (fieldType field)]) $ NormalC (mkName $ exprName field) []
+    let f cdef = map (mkField $ mkName $ thPhantomConstrName cdef) $ thConstrParams cdef
+    let constrs = concatMap f $ thConstructors def
+    return $ DataInstD [] ''Fields [entity, VarT cParam, VarT fParam] constrs []
+    
+  entityDef' <- do
+    v <- newName "v"
+    let mkLambda t = [|undefined :: $(forallT (thTypeParams def) (cxt []) [t| $(return entity) -> $(return t) |]) |]
+    let typeParams' = listE $ map (\t -> [| namedType ($(mkLambda $ getType t) $(varE v)) |]) $ thTypeParams def
+    let mkField c fNum f = do
+        a <- newName "a"
+        let fname = dbFieldName f
+        let pats = replicate fNum wildP ++ [varP a] ++ replicate (length (thConstrParams c) - fNum - 1) wildP
+        let nvar = case hasFreeVars (fieldType f) of
+             True ->  appE (lamE [conP (thConstrName c) pats] (varE a)) (varE v)
+             False -> [| undefined :: $(return $ fieldType f) |]
+        [| (fname, namedType $nvar) |]
+         
+    let constrs = listE $ zipWith (\cNum c@(THConstructorDef _ _ name params conss) -> [| ConstructorDef cNum name $(listE $ zipWith (mkField c) [0..] params) conss |]) [0..] $ thConstructors def
+    let body = normalB [| EntityDef $(stringE $ dbEntityName def) $typeParams' $constrs |]
+    funD 'entityDef $ [ clause [varP v] body [] ]
+
+  toPersistValues' <- liftM (FunD 'toPersistValues) $ forM (zip [0..] $ thConstructors def) $ \(cNum, c) -> do
+    names <- mapM (const $ newName "f") $ thConstrParams c
+    let pat = conP (thConstrName c) (map varP names)
+    let body = normalB $ [| sequence $(listE $ map (appE (varE 'toPersistValue)) ([|cNum::Int|]:map varE names) ) |]
+    clause [pat] body []
+  
+--  fromPersistValues' <- funD 'fromPersistValues $ [ clause [wildP] (normalB [| error "fromPersistValues" |])[] ]
+  fromPersistValues' <- do
+    clauses <- forM (zip [0..] (thConstructors def)) $ \(cNum, c) -> do
+      names <- mapM (const $ newName "x") $ thConstrParams c
+      names' <- mapM (const $ newName "x'") $ thConstrParams c
+      let pat = conP '(:) [conP 'PersistInt64 [litP $ integerL cNum], listP $ map varP names]
+      let result = noBindS (appE (varE 'return) ( foldl (\a -> appE a . varE) (conE (thConstrName c)) names'))
+      let getField name name' f = bindS (varP name') [| fromPersistValue $(varE name) |]
+      let body = normalB $ doE $ (zipWith3 getField names names' (thConstrParams c)) ++ [result]
+--      let body = normalB [|undefined|]
+      clause [pat] body []
+    unexpected <- newName "xs" >>= \xs -> clause [varP xs] (normalB [| fail $ "Invalid values: " ++ show $(varE xs) |]) []
+    return $ FunD 'fromPersistValues $ clauses ++ [unexpected]
+  
+  getConstraints' <- let
+    hasConstraints = not . null . thConstrConstrs
+    clauses = zipWith mkClause [0::Int ..] (thConstructors def)
+    mkClause cNum cdef | not (hasConstraints cdef) = clause [conP (thConstrName cdef) pats] (normalB [| (cNum, []) |]) [] where
+      pats = map (const wildP) $ thConstrParams cdef
+    mkClause cNum cdef = clause [conP (thConstrName cdef) (map varP names)] body [] where
+      getFieldName n = case filter ((==n).dbFieldName) $ thConstrParams cdef of
+        [f] -> varE $ mkName $ fieldName f
+        []  -> error $ "Database field name " ++ show n ++ " declared in constraint not found"
+        _   -> error $ "It can never happen. Found several fields with one database name " ++ show n
+      body = normalB $ [| (cNum, $(listE $ map (\(cname, fnames) -> [|(cname, $(listE $ map (\fname -> [| (fname, toPrim $(getFieldName fname)) |] ) fnames )) |] ) $ thConstrConstrs cdef)) |]
+      names = map (mkName . fieldName) $ thConstrParams cdef
+    in funD 'getConstraints clauses
+  
+  showField' <- do
+    let fields = concatMap thConstrParams $ thConstructors def
+    funD 'showField $ map (\f -> clause [conP (mkName $ exprName f) []] (normalB $ stringE $ dbFieldName f)[] ) fields
+
+  eqField' <- let
+    fieldNames = thConstructors def >>= thConstrParams >>= return.mkName.exprName
+    clauses = map (\n -> clause [conP n [], conP n []] (normalB [| True |]) []) fieldNames
+    in funD 'eqField $ if length clauses > 1
+     then clauses ++ [clause [wildP, wildP] (normalB [| False |]) []]
+     else clauses
+
+  let context = paramsContext def
+  let decs = [fields', entityDef', toPersistValues', fromPersistValues', getConstraints', showField', eqField']
+  return $ [InstanceD context (AppT (ConT ''PersistEntity) entity) decs]
+  
+mkPersistFieldInstance :: THEntityDef -> Q [Dec]
+mkPersistFieldInstance def = do
+  let types = map getType $ thTypeParams def
+  let entity = foldl AppT (ConT (dataName def)) types
+  
+  persistName' <- do
+    v <- newName "v"
+    let mkLambda t = [|undefined :: $(forallT (thTypeParams def) (cxt []) [t| $(return entity) -> $(return t) |]) |]
+    
+    let paramNames = foldr1 (\p xs -> [| $p ++ "$" ++ $xs |] ) $ map (\t -> [| persistName ($(mkLambda t) $(varE v)) |]) types
+    let namesList = case null types of
+         True  -> [| $(stringE $ dbEntityName def) |]
+         False -> [| $(stringE $ dbEntityName def) ++ "$" ++ $(paramNames) |]
+    let body = normalB $ namesList
+    funD 'persistName $ [ clause [varP v] body [] ]
+  
+  toPersistValue' <- do
+    let body = normalB [| liftM (either toPrim toPrim) . insertBy |]
+    funD 'toPersistValue $ [ clause [] body [] ]
+  fromPersistValue' <- do
+    x <- newName "x"
+    let body = normalB [| fromPersistValue $(varE x) >>= get >>= maybe (fail $ "No data with id " ++ show $(varE x)) return |]
+    funD 'fromPersistValue $ [ clause [varP x] body [] ]
+  dbType' <- funD 'dbType $ [ clause [] (normalB [| DbEntity . entityDef |]) [] ]
+
+  let context = paramsContext def
+  let decs = [persistName', toPersistValue', fromPersistValue', dbType']
+  return $ [InstanceD context (AppT (ConT ''PersistField) entity) decs]
+
+paramsContext :: THEntityDef -> Cxt
+paramsContext def = classPred ''PersistField params ++ classPred ''NeverNull maybys where
+  classPred clazz = map (\t -> ClassP clazz [t])
+  -- every type must be an instance of PersistField
+  params = map getType $ thTypeParams def
+  -- all datatype fields also must be instances of PersistField
+  -- if Maybe is applied to a type param, the param must be also an instance of NeverNull
+  -- so that (Maybe param) is an instance of PersistField
+  maybys = nub $ thConstructors def >>= thConstrParams >>= insideMaybe . fieldType
+
+getType :: TyVarBndr -> Type
+getType (PlainTV name) = VarT name
+getType (KindedTV name _) = VarT name
+
+foldType :: (Type -> a) -> (a -> a -> a) -> Type -> a
+foldType f (<>) = go where
+  go (ForallT _ _ _) = error "forall'ed fields are not allowed"
+  go z@(AppT a b)    = f z <> go a <> go b
+  go z@(SigT t _)    = f z <> go t
+  go z               = f z
+
+hasFreeVars :: Type -> Bool
+hasFreeVars = foldType f (||) where
+  f (VarT _) = True
+  f _ = False
+
+insideMaybe :: Type -> [Type]
+insideMaybe = foldType f (++) where
+  f (AppT (ConT c) t@(VarT _)) | c == ''Maybe = [t]
+  f _ = []
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,10 @@
+Copyright (c) 2011, Boris Lykah
+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 copyright holders 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 EVENT 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.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,7 @@
+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain
diff --git a/groundhog.cabal b/groundhog.cabal
new file mode 100644
--- /dev/null
+++ b/groundhog.cabal
@@ -0,0 +1,30 @@
+name:            groundhog
+version:         0.0.1
+license:         BSD3
+license-file:    LICENSE
+author:          Boris Lykah <lykahb@gmail.com>
+maintainer:      Boris Lykah <lykahb@gmail.com>
+synopsis:        Type-safe, relational, multi-backend persistence.
+description:     This library provides just the general interface and helper functions. You must use a specific backend in order to make this useful.
+category:        Database
+stability:       Non-stable
+cabal-version:   >= 1.6
+build-type:      Simple
+
+library
+    build-depends:   base                     >= 4         && < 5
+                   , template-haskell
+                   , bytestring               >= 0.9       && < 0.10
+                   , transformers             >= 0.2.1     && < 0.3
+                   , time                     >= 1.1.4     && < 1.3
+                   , text                     >= 0.8       && < 0.12
+                   , containers               >= 0.2       && < 0.5
+                   , enumerator               >= 0.4.9     && < 0.5
+                   , monad-control            >= 0.2       && < 0.3
+                   , pool                     >= 0.1       && < 0.2
+    exposed-modules: Database.Groundhog
+                     Database.Groundhog.Core
+                     Database.Groundhog.Generic
+                     Database.Groundhog.Generic.Sql
+                     Database.Groundhog.TH
+    ghc-options:     -Wall