diff --git a/Database/Persist.hs b/Database/Persist.hs
--- a/Database/Persist.hs
+++ b/Database/Persist.hs
@@ -2,13 +2,10 @@
     ( PersistField (..)
     , PersistEntity (..)
     , PersistBackend (..)
-    , mkPersist
-    , persist
     , selectList
     , insertBy
+    , getByValue
     , checkUnique
     ) where
 
 import Database.Persist.Base
-import Database.Persist.TH
-import Database.Persist.Quasi
diff --git a/Database/Persist/Base.hs b/Database/Persist/Base.hs
--- a/Database/Persist/Base.hs
+++ b/Database/Persist/Base.hs
@@ -1,11 +1,11 @@
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 -- | This defines the API for performing database actions. There are two levels
 -- to this API: dealing with fields, and dealing with entities. In SQL, a field
@@ -25,13 +25,13 @@
     , SomePersistField (..)
     , selectList
     , insertBy
+    , getByValue
     , checkUnique
     , DeleteCascade (..)
     , deleteCascadeWhere
     , PersistException (..)
     ) where
 
-import Language.Haskell.TH.Syntax
 import Data.Time (Day, TimeOfDay, UTCTime)
 import Data.ByteString.Char8 (ByteString, unpack)
 import Control.Applicative
@@ -43,7 +43,8 @@
 import qualified Data.Text as T
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
-import Data.Enumerator
+import Data.Enumerator hiding (consume)
+import Data.Enumerator.List (consume)
 import qualified Control.Exception as E
 import Data.Bits (bitSize)
 import Control.Monad (liftM)
@@ -53,7 +54,7 @@
 
 -- | A raw value which can be stored in any backend and can be marshalled to
 -- and from a 'PersistField'.
-data PersistValue = PersistString String
+data PersistValue = PersistText T.Text
                   | PersistByteString ByteString
                   | PersistInt64 Int64
                   | PersistDouble Double
@@ -62,14 +63,17 @@
                   | PersistTimeOfDay TimeOfDay
                   | PersistUTCTime UTCTime
                   | PersistNull
-    deriving (Show, Read, Eq, Typeable)
+                  | PersistList [PersistValue]
+                  | PersistMap [(T.Text, PersistValue)]
+                  | PersistForeignKey ByteString -- ^ intended especially for MongoDB backend
+    deriving (Show, Read, Eq, Typeable, Ord)
 
 -- | A SQL data type. Naming attempts to reflect the underlying Haskell
 -- datatypes, eg SqlString instead of SqlVarchar. Different SQL databases may
 -- have different translations for these types.
 data SqlType = SqlString
              | SqlInt32
-             | SqlInteger -- ^ 8-byte integer; should be renamed SqlInt64
+             | SqlInteger -- ^ FIXME 8-byte integer; should be renamed SqlInt64
              | SqlReal
              | SqlBool
              | SqlDay
@@ -87,8 +91,8 @@
     isNullable _ = False
 
 instance PersistField String where
-    toPersistValue = PersistString
-    fromPersistValue (PersistString s) = Right s
+    toPersistValue = PersistText . T.pack
+    fromPersistValue (PersistText s) = Right $ T.unpack s
     fromPersistValue (PersistByteString bs) =
         Right $ T.unpack $ T.decodeUtf8With T.lenientDecode bs
     fromPersistValue (PersistInt64 i) = Right $ show i
@@ -98,19 +102,32 @@
     fromPersistValue (PersistUTCTime d) = Right $ show d
     fromPersistValue PersistNull = Left "Unexpected null"
     fromPersistValue (PersistBool b) = Right $ show b
+    fromPersistValue (PersistList _) = Left "Cannot convert PersistList to String"
+    fromPersistValue (PersistMap _) = Left "Cannot convert PersistMap to String"
+    fromPersistValue (PersistForeignKey _) = Left "Cannot convert PersistForeignKey to String"
     sqlType _ = SqlString
 
 instance PersistField ByteString where
     toPersistValue = PersistByteString
     fromPersistValue (PersistByteString bs) = Right bs
-    fromPersistValue x = T.encodeUtf8 . T.pack <$> fromPersistValue x
+    fromPersistValue x = T.encodeUtf8 <$> fromPersistValue x
     sqlType _ = SqlBlob
 
 instance PersistField T.Text where
-    toPersistValue = PersistString . T.unpack
+    toPersistValue = PersistText
+    fromPersistValue (PersistText s) = Right s
     fromPersistValue (PersistByteString bs) =
         Right $ T.decodeUtf8With T.lenientDecode bs
-    fromPersistValue v = fmap T.pack $ fromPersistValue v
+    fromPersistValue (PersistInt64 i) = Right $ T.pack $ show i
+    fromPersistValue (PersistDouble d) = Right $ T.pack $ show d
+    fromPersistValue (PersistDay d) = Right $ T.pack $ show d
+    fromPersistValue (PersistTimeOfDay d) = Right $ T.pack $ show d
+    fromPersistValue (PersistUTCTime d) = Right $ T.pack $ show d
+    fromPersistValue PersistNull = Left "Unexpected null"
+    fromPersistValue (PersistBool b) = Right $ T.pack $ show b
+    fromPersistValue (PersistList _) = Left "Cannot convert PersistList to Text"
+    fromPersistValue (PersistMap _) = Left "Cannot convert PersistMap to Text"
+    fromPersistValue (PersistForeignKey _) = Left "Cannot convert PersistForeignKey to Text"
     sqlType _ = SqlString
 
 instance PersistField Html where
@@ -190,8 +207,8 @@
 instance PersistField Day where
     toPersistValue = PersistDay
     fromPersistValue (PersistDay d) = Right d
-    fromPersistValue x@(PersistString s) =
-        case reads s of
+    fromPersistValue x@(PersistText t) =
+        case reads $ T.unpack t of
             (d, _):_ -> Right d
             _ -> Left $ "Expected Day, received " ++ show x
     fromPersistValue x@(PersistByteString s) =
@@ -204,8 +221,8 @@
 instance PersistField TimeOfDay where
     toPersistValue = PersistTimeOfDay
     fromPersistValue (PersistTimeOfDay d) = Right d
-    fromPersistValue x@(PersistString s) =
-        case reads s of
+    fromPersistValue x@(PersistText t) =
+        case reads $ T.unpack t of
             (d, _):_ -> Right d
             _ -> Left $ "Expected TimeOfDay, received " ++ show x
     fromPersistValue x@(PersistByteString s) =
@@ -218,8 +235,8 @@
 instance PersistField UTCTime where
     toPersistValue = PersistUTCTime
     fromPersistValue (PersistUTCTime d) = Right d
-    fromPersistValue x@(PersistString s) =
-        case reads s of
+    fromPersistValue x@(PersistText t) =
+        case reads $ T.unpack t of
             (d, _):_ -> Right d
             _ -> Left $ "Expected UTCTime, received " ++ show x
     fromPersistValue x@(PersistByteString s) =
@@ -239,7 +256,7 @@
 
 -- | A single database entity. For example, if writing a blog application, a
 -- blog entry would be an entry, containing fields such as title and content.
-class PersistEntity val where
+class Show (Key val) => PersistEntity val where
     -- | The unique identifier associated with this entity. In general, backends also define a type synonym for this, such that \"type MyEntityId = Key MyEntity\".
     data Key    val
     -- | Fields which can be updated using the 'update' and 'updateWhere'
@@ -259,9 +276,8 @@
     toPersistFields :: val -> [SomePersistField]
     fromPersistValues :: [PersistValue] -> Either String val
     halfDefined :: val
-    toPersistKey :: Int64 -> Key val
-    fromPersistKey :: Key val -> Int64
-    showPersistKey :: Key val -> String
+    toPersistKey :: PersistValue -> Key val
+    fromPersistKey :: Key val -> PersistValue
 
     persistFilterToFieldName :: Filter val -> String
     persistFilterToFilter :: Filter val -> PersistFilter
@@ -318,7 +334,8 @@
 
     -- | Get all records matching the given criterion in the specified order.
     -- Returns also the identifiers.
-    select :: PersistEntity val
+    selectEnum
+           :: PersistEntity val
            => [Filter val]
            -> [Order val]
            -> Int -- ^ limit
@@ -348,6 +365,22 @@
             Nothing -> go xs
             Just z -> return $ Left z
 
+-- | A modification of 'getBy', which takes the 'PersistEntity' itself instead
+-- of a 'Unique' value. Returns a value matching /one/ of the unique keys. This
+-- function makes the most sense on entities with a single 'Unique'
+-- constructor.
+getByValue :: (PersistEntity v, PersistBackend m)
+           => v -> m (Maybe (Key v, v))
+getByValue val =
+    go $ persistUniqueKeys val
+  where
+    go [] = return Nothing
+    go (x:xs) = do
+        y <- getBy x
+        case y of
+            Nothing -> go xs
+            Just z -> return $ Just z
+
 -- | Check whether there are any conflicts for unique keys with this entity and
 -- existing entities in the database.
 --
@@ -372,7 +405,7 @@
            -> Int -- ^ offset
            -> m [(Key val, val)]
 selectList a b c d = do
-    res <- run $ select a b c d ==<< consume
+    res <- run $ selectEnum a b c d ==<< consume
     case res of
         Left e -> error $ show e
         Right x -> return x
@@ -386,36 +419,12 @@
     }
     deriving Show
 
-instance Lift EntityDef where
-    lift (EntityDef a b c d e) = do
-        x <- [|EntityDef|]
-        a' <- lift a
-        b' <- lift b
-        c' <- lift c
-        d' <- lift d
-        e' <- lift e
-        return $ x `AppE` a' `AppE` b' `AppE` c' `AppE` d' `AppE` e'
-
 data PersistFilter = Eq | Ne | Gt | Lt | Ge | Le | In | NotIn
     deriving (Read, Show)
 
-instance Lift PersistFilter where
-    lift Eq = [|Eq|]
-    lift Ne = [|Ne|]
-    lift Gt = [|Gt|]
-    lift Lt = [|Lt|]
-    lift Ge = [|Ge|]
-    lift Le = [|Le|]
-    lift In = [|In|]
-    lift NotIn = [|NotIn|]
-
 data PersistOrder = Asc | Desc
     deriving (Read, Show)
 
-instance Lift PersistOrder where
-    lift Asc = [|Asc|]
-    lift Desc = [|Desc|]
-
 class PersistEntity a => DeleteCascade a where
     deleteCascade :: PersistBackend m => Key a -> m ()
 
@@ -439,9 +448,7 @@
 data PersistUpdate = Update | Add | Subtract | Multiply | Divide
     deriving (Read, Show)
 
-instance Lift PersistUpdate where
-    lift Update = [|Update|]
-    lift Add = [|Add|]
-    lift Subtract = [|Subtract|]
-    lift Multiply = [|Multiply|]
-    lift Divide = [|Divide|]
+instance PersistField PersistValue where
+    toPersistValue = id
+    fromPersistValue = Right
+    sqlType _ = SqlInteger -- since PersistValue should only be used like this for keys, which in SQL are Int64
diff --git a/Database/Persist/GenericSql.hs b/Database/Persist/GenericSql.hs
--- a/Database/Persist/GenericSql.hs
+++ b/Database/Persist/GenericSql.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE PackageImports #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -- | This is a helper module for creating SQL backends. Regular users do not
@@ -19,7 +18,6 @@
     , runMigrationSilent
     , runMigrationUnsafe
     , migrate
-    , mkMigrate
     ) where
 
 import Database.Persist.Base
@@ -35,24 +33,24 @@
 import Database.Persist.GenericSql.Raw (SqlPersist (..))
 import Control.Monad (liftM, unless)
 import Data.Enumerator (Stream (..), Iteratee (..), Step (..))
-import Language.Haskell.TH.Syntax hiding (lift)
-import Control.Monad.IO.Peel (MonadPeelIO)
-import Control.Exception.Peel (onException)
+import Control.Monad.IO.Control (MonadControlIO)
+import Control.Exception.Control (onException)
 import Control.Exception (toException)
+import Data.Text (Text, pack, unpack)
 
 type ConnectionPool = Pool Connection
 
-withStmt' :: MonadPeelIO m => String -> [PersistValue]
+withStmt' :: MonadControlIO m => Text -> [PersistValue]
          -> (RowPopper (SqlPersist m) -> SqlPersist m a) -> SqlPersist m a
 withStmt' = R.withStmt
 
-execute' :: MonadIO m => String -> [PersistValue] -> SqlPersist m ()
+execute' :: MonadIO m => Text -> [PersistValue] -> SqlPersist m ()
 execute' = R.execute
 
-runSqlPool :: MonadPeelIO m => SqlPersist m a -> Pool Connection -> m a
+runSqlPool :: MonadControlIO m => SqlPersist m a -> Pool Connection -> m a
 runSqlPool r pconn = withPool' pconn $ runSqlConn r
 
-runSqlConn :: MonadPeelIO m => SqlPersist m a -> Connection -> m a
+runSqlConn :: MonadControlIO m => SqlPersist m a -> Connection -> m a
 runSqlConn (SqlPersist r) conn = do
     let getter = R.getStmt' conn
     liftIO $ begin conn getter
@@ -62,19 +60,19 @@
     liftIO $ commit conn getter
     return x
 
-instance MonadPeelIO m => PersistBackend (SqlPersist m) where
+instance MonadControlIO m => PersistBackend (SqlPersist m) where
     insert val = do
         conn <- SqlPersist ask
         let esql = insertSql conn (rawTableName t) (map fst3 $ tableColumns t)
         i <-
             case esql of
                 Left sql -> withStmt' sql vals $ \pop -> do
-                    Just [PersistInt64 i] <- pop
+                    Just [i] <- pop
                     return i
                 Right (sql1, sql2) -> do
                     execute' sql1 vals
                     withStmt' sql2 [] $ \pop -> do
-                        Just [PersistInt64 i] <- pop
+                        Just [i] <- pop
                         return i
         return $ toPersistKey i
       where
@@ -85,7 +83,7 @@
     replace k val = do
         conn <- SqlPersist ask
         let t = entityDef val
-        let sql = concat
+        let sql = pack $ concat
                 [ "UPDATE "
                 , escapeName conn (rawTableName t)
                 , " SET "
@@ -93,7 +91,7 @@
                 , " WHERE id=?"
                 ]
         execute' sql $ map toPersistValue (toPersistFields val)
-                       ++ [PersistInt64 $ fromPersistKey k]
+                       ++ [fromPersistKey k]
       where
         go conn x = escapeName conn x ++ "=?"
         fst3 (x, _, _) = x
@@ -103,20 +101,20 @@
         let t = entityDef $ dummyFromKey k
         let cols = intercalate ","
                  $ map (\(x, _, _) -> escapeName conn x) $ tableColumns t
-        let sql = concat
+        let sql = pack $ concat
                 [ "SELECT "
                 , cols
                 , " FROM "
                 , escapeName conn $ rawTableName t
                 , " WHERE id=?"
                 ]
-        withStmt' sql [PersistInt64 $ fromPersistKey k] $ \pop -> do
+        withStmt' sql [fromPersistKey k] $ \pop -> do
             res <- pop
             case res of
                 Nothing -> return Nothing
                 Just vals ->
                     case fromPersistValues vals of
-                        Left e -> error $ "get " ++ showPersistKey k ++ ": " ++ e
+                        Left e -> error $ "get " ++ show k ++ ": " ++ e
                         Right v -> return $ Just v
 
     count filts = do
@@ -124,8 +122,8 @@
         let wher = if null filts
                     then ""
                     else " WHERE " ++
-                         intercalate " AND " (map (filterClause conn) filts)
-        let sql = concat
+                         intercalate " AND " (map (filterClause False conn) filts)
+        let sql = pack $ concat
                 [ "SELECT COUNT(*) FROM "
                 , escapeName conn $ rawTableName t
                 , wher
@@ -136,7 +134,7 @@
       where
         t = entityDef $ dummyFromFilts filts
 
-    select filts ords limit offset =
+    selectEnum filts ords limit offset =
         Iteratee . start
       where
         start x = do
@@ -155,12 +153,7 @@
                             loop step pop
         loop step _ = return step
         t = entityDef $ dummyFromFilts filts
-        orderClause conn o =
-            escapeName conn (getFieldName t $ persistOrderToFieldName o)
-                        ++ case persistOrderToOrder o of
-                                            Asc -> ""
-                                            Desc -> " DESC"
-        fromPersistValues' (PersistInt64 x:xs) = do
+        fromPersistValues' (x:xs) = do
             case fromPersistValues xs of
                 Left e -> Left e
                 Right xs' -> Right (toPersistKey x, xs')
@@ -168,11 +161,11 @@
         wher conn = if null filts
                     then ""
                     else " WHERE " ++
-                         intercalate " AND " (map (filterClause conn) filts)
+                         intercalate " AND " (map (filterClause False conn) filts)
         ord conn = if null ords
                     then ""
                     else " ORDER BY " ++
-                         intercalate "," (map (orderClause conn) ords)
+                         intercalate "," (map (orderClause False conn) ords)
         lim conn = case (limit, offset) of
                 (0, 0) -> ""
                 (0, _) -> ' ' : noLimit conn
@@ -182,7 +175,7 @@
                     else " OFFSET " ++ show offset
         cols conn = intercalate "," $ "id"
                    : (map (\(x, _, _) -> escapeName conn x) $ tableColumns t)
-        sql conn = concat
+        sql conn = pack $ concat
             [ "SELECT "
             , cols conn
             , " FROM "
@@ -204,7 +197,7 @@
             res <- pop
             case res of
                 Nothing -> return $ Continue k
-                Just [PersistInt64 i] -> do
+                Just [i] -> do
                     step <- runIteratee $ k $ Chunks [toPersistKey i]
                     loop step pop
                 Just y -> return $ Error $ toException $ PersistMarshalException
@@ -214,8 +207,8 @@
         wher conn = if null filts
                     then ""
                     else " WHERE " ++
-                         intercalate " AND " (map (filterClause conn) filts)
-        sql conn = concat
+                         intercalate " AND " (map (filterClause False conn) filts)
+        sql conn = pack $ concat
             [ "SELECT id FROM "
             , escapeName conn $ rawTableName t
             , wher conn
@@ -223,10 +216,10 @@
 
     delete k = do
         conn <- SqlPersist ask
-        execute' (sql conn) [PersistInt64 $ fromPersistKey k]
+        execute' (sql conn) [fromPersistKey k]
       where
         t = entityDef $ dummyFromKey k
-        sql conn = concat
+        sql conn = pack $ concat
             [ "DELETE FROM "
             , escapeName conn $ rawTableName t
             , " WHERE id=?"
@@ -238,8 +231,8 @@
         let wher = if null filts
                     then ""
                     else " WHERE " ++
-                         intercalate " AND " (map (filterClause conn) filts)
-            sql = concat
+                         intercalate " AND " (map (filterClause False conn) filts)
+            sql = pack $ concat
                 [ "DELETE FROM "
                 , escapeName conn $ rawTableName t
                 , wher
@@ -253,7 +246,7 @@
         t = entityDef $ dummyFromUnique uniq
         go = map (getFieldName t) . persistUniqueToFieldNames
         go' conn x = escapeName conn x ++ "=?"
-        sql conn = concat
+        sql conn = pack $ concat
             [ "DELETE FROM "
             , escapeName conn $ rawTableName t
             , " WHERE "
@@ -269,7 +262,7 @@
             go'' n Multiply = n ++ '=' : n ++ "*?"
             go'' n Divide = n ++ '=' : n ++ "/?"
         let go' (x, pu) = go'' (escapeName conn x) pu
-        let sql = concat
+        let sql = pack $ concat
                 [ "UPDATE "
                 , escapeName conn $ rawTableName t
                 , " SET "
@@ -277,7 +270,7 @@
                 , " WHERE id=?"
                 ]
         execute' sql $
-            map persistUpdateToValue upds ++ [PersistInt64 $ fromPersistKey k]
+            map persistUpdateToValue upds ++ [fromPersistKey k]
       where
         t = entityDef $ dummyFromKey k
         go x = ( getFieldName t $ persistUpdateToFieldName x
@@ -290,8 +283,8 @@
         let wher = if null filts
                     then ""
                     else " WHERE " ++
-                         intercalate " AND " (map (filterClause conn) filts)
-        let sql = concat
+                         intercalate " AND " (map (filterClause False conn) filts)
+        let sql = pack $ concat
                 [ "UPDATE "
                 , escapeName conn $ rawTableName t
                 , " SET "
@@ -316,7 +309,7 @@
         conn <- SqlPersist ask
         let cols = intercalate "," $ "id"
                  : (map (\(x, _, _) -> escapeName conn x) $ tableColumns t)
-        let sql = concat
+        let sql = pack $ concat
                 [ "SELECT "
                 , cols
                 , " FROM "
@@ -328,7 +321,7 @@
             row <- pop
             case row of
                 Nothing -> return Nothing
-                Just (PersistInt64 k:vals) ->
+                Just (k:vals) ->
                     case fromPersistValues vals of
                         Left s -> error s
                         Right x -> return $ Just (toPersistKey k, x)
@@ -343,94 +336,11 @@
 dummyFromUnique :: Unique v -> v
 dummyFromUnique _ = error "dummyFromUnique"
 
-getFieldName :: EntityDef -> String -> RawName
-getFieldName t s = rawFieldName $ tableColumn t s
-
-tableColumn :: EntityDef -> String -> (String, String, [String])
-tableColumn _ "id" = ("id", "Int64", [])
-tableColumn t s = go $ entityColumns t
-  where
-    go [] = error $ "Unknown table column: " ++ s
-    go ((x, y, z):rest)
-        | x == s = (x, y, z)
-        | otherwise = go rest
-
 dummyFromKey :: Key v -> v
 dummyFromKey _ = error "dummyFromKey"
 
-filterClause :: PersistEntity val => Connection -> Filter val -> String
-filterClause conn f =
-    case (isNull, persistFilterToFilter f, varCount) of
-        (True, Eq, _) -> name ++ " IS NULL"
-        (True, Ne, _) -> name ++ " IS NOT NULL"
-        (False, Ne, _) -> concat
-            [ "("
-            , name
-            , " IS NULL OR "
-            , name
-            , "<>?)"
-            ]
-        -- We use 1=2 (and below 1=1) to avoid using TRUE and FALSE, since
-        -- not all databases support those words directly.
-        (_, In, 0) -> "1=2"
-        (False, In, _) -> name ++ " IN " ++ qmarks
-        (True, In, _) -> concat
-            [ "("
-            , name
-            , " IS NULL OR "
-            , name
-            , " IN "
-            , qmarks
-            , ")"
-            ]
-        (_, NotIn, 0) -> "1=1"
-        (False, NotIn, _) -> concat
-            [ "("
-            , name
-            , " IS NULL OR "
-            , name
-            , " NOT IN "
-            , qmarks
-            , ")"
-            ]
-        (True, NotIn, _) -> concat
-            [ "("
-            , name
-            , " IS NOT NULL AND "
-            , name
-            , " NOT IN "
-            , qmarks
-            , ")"
-            ]
-        _ -> name ++ showSqlFilter (persistFilterToFilter f) ++ "?"
-  where
-    isNull = any (== PersistNull)
-           $ either return id
-           $ persistFilterToValue f
-    t = entityDef $ dummyFromFilts [f]
-    name = escapeName conn $ getFieldName t $ persistFilterToFieldName f
-    qmarks = case persistFilterToValue f of
-                Left _ -> "?"
-                Right x ->
-                    let x' = filter (/= PersistNull) x
-                     in '(' : intercalate "," (map (const "?") x') ++ ")"
-    varCount = case persistFilterToValue f of
-                Left _ -> 1
-                Right x -> length x
-    showSqlFilter Eq = "="
-    showSqlFilter Ne = "<>"
-    showSqlFilter Gt = ">"
-    showSqlFilter Lt = "<"
-    showSqlFilter Ge = ">="
-    showSqlFilter Le = "<="
-    showSqlFilter In = " IN "
-    showSqlFilter NotIn = " NOT IN "
 
-dummyFromFilts :: [Filter v] -> v
-dummyFromFilts _ = error "dummyFromFilts"
-
-
-type Sql = String
+type Sql = Text
 
 -- Bool indicates if the Sql is safe
 type CautiousMigration = [(Bool, Sql)]
@@ -441,9 +351,9 @@
 safeSql :: CautiousMigration -> [Sql]
 safeSql = allSql . filter (not . fst)
 
-type Migration m = WriterT [String] (WriterT CautiousMigration m) ()
+type Migration m = WriterT [Text] (WriterT CautiousMigration m) ()
 
-parseMigration :: Monad m => Migration m -> m (Either [String] CautiousMigration)
+parseMigration :: Monad m => Migration m -> m (Either [Text] CautiousMigration)
 parseMigration =
     liftM go . runWriterT . execWriterT
   where
@@ -455,35 +365,35 @@
 parseMigration' m = do
   x <- parseMigration m
   case x of
-      Left errs -> error $ unlines errs
+      Left errs -> error $ unlines $ map unpack errs
       Right sql -> return sql
 
-printMigration :: MonadPeelIO m => Migration (SqlPersist m) -> SqlPersist m ()
+printMigration :: MonadControlIO m => Migration (SqlPersist m) -> SqlPersist m ()
 printMigration m = do
   mig <- parseMigration' m
-  mapM_ (liftIO . putStrLn) (allSql mig)
+  mapM_ (liftIO . putStrLn . unpack) (allSql mig)
 
-getMigration :: MonadPeelIO m => Migration (SqlPersist m) -> SqlPersist m [Sql]
+getMigration :: MonadControlIO m => Migration (SqlPersist m) -> SqlPersist m [Sql]
 getMigration m = do
   mig <- parseMigration' m
   return $ allSql mig
 
-runMigration :: MonadPeelIO m
+runMigration :: MonadControlIO m
              => Migration (SqlPersist m)
              -> SqlPersist m ()
 runMigration m = runMigration' m False >> return ()
 
 -- | Same as 'runMigration', but returns a list of the SQL commands executed
 -- instead of printing them to stderr.
-runMigrationSilent :: MonadPeelIO m
+runMigrationSilent :: MonadControlIO m
                    => Migration (SqlPersist m)
-                   -> SqlPersist m [String]
+                   -> SqlPersist m [Text]
 runMigrationSilent m = runMigration' m True
 
-runMigration' :: MonadPeelIO m
+runMigration' :: MonadControlIO m
               => Migration (SqlPersist m)
               -> Bool -- ^ is silent?
-              -> SqlPersist m [String]
+              -> SqlPersist m [Text]
 runMigration' m silent = do
     mig <- parseMigration' m
     case unsafeSql mig of
@@ -491,23 +401,23 @@
         errs -> error $ concat
             [ "\n\nDatabase migration: manual intervention required.\n"
             , "The following actions are considered unsafe:\n\n"
-            , unlines $ map (\s -> "    " ++ s ++ ";") $ errs
+            , unlines $ map (\s -> "    " ++ unpack s ++ ";") $ errs
             ]
 
-runMigrationUnsafe :: MonadPeelIO m
+runMigrationUnsafe :: MonadControlIO m
                    => Migration (SqlPersist m)
                    -> SqlPersist m ()
 runMigrationUnsafe m = do
     mig <- parseMigration' m
     mapM_ (executeMigrate False) $ allSql mig
 
-executeMigrate :: MonadIO m => Bool -> String -> SqlPersist m String
+executeMigrate :: MonadIO m => Bool -> Text -> SqlPersist m Text
 executeMigrate silent s = do
-    unless silent $ liftIO $ hPutStrLn stderr $ "Migrating: " ++ s
+    unless silent $ liftIO $ hPutStrLn stderr $ "Migrating: " ++ unpack s
     execute' s []
     return s
 
-migrate :: (MonadPeelIO m, PersistEntity val)
+migrate :: (MonadControlIO m, PersistEntity val)
         => val
         -> Migration (SqlPersist m)
 migrate val = do
@@ -515,40 +425,3 @@
     let getter = R.getStmt' conn
     res <- liftIO $ migrateSql conn getter val
     either tell (lift . tell) res
-
-getFiltsValues :: PersistEntity val => [Filter val] -> [PersistValue]
-getFiltsValues =
-    concatMap $ go . persistFilterToValue
-  where
-    go (Left PersistNull) = []
-    go (Left x) = [x]
-    go (Right xs) = filter (/= PersistNull) xs
-
--- | Creates a single function to perform all migrations for the entities
--- defined here. One thing to be aware of is dependencies: if you have entities
--- with foreign references, make sure to place those definitions after the
--- entities they reference.
-mkMigrate :: String -> [EntityDef] -> Q [Dec]
-mkMigrate fun defs = do
-    body' <- body
-    return
-        [ SigD (mkName fun) typ
-        , FunD (mkName fun) [Clause [] (NormalB body') []]
-        ]
-  where
-    typ = ForallT [PlainTV $ mkName "m"]
-            [ ClassP ''MonadPeelIO [VarT $ mkName "m"]
-            ]
-            $ ConT ''Migration `AppT` (ConT ''SqlPersist `AppT` VarT (mkName "m"))
-    body :: Q Exp
-    body =
-        case defs of
-            [] -> [|return ()|]
-            _ -> DoE `fmap` mapM toStmt defs
-    toStmt :: EntityDef -> Q Stmt
-    toStmt ed = do
-        let n = entityName ed
-        u <- [|undefined|]
-        m <- [|migrate|]
-        let u' = SigE u $ ConT $ mkName n
-        return $ NoBindS $ m `AppE` u'
diff --git a/Database/Persist/GenericSql/Internal.hs b/Database/Persist/GenericSql/Internal.hs
--- a/Database/Persist/GenericSql/Internal.hs
+++ b/Database/Persist/GenericSql/Internal.hs
@@ -15,6 +15,11 @@
     , rawFieldName
     , rawTableName
     , RawName (..)
+    , filterClause
+    , getFieldName
+    , dummyFromFilts
+    , getFiltsValues
+    , orderClause
     ) where
 
 import qualified Data.Map as Map
@@ -24,23 +29,25 @@
 import Database.Persist.Base
 import Data.Maybe (fromJust)
 import Control.Arrow
-import Control.Monad.IO.Peel (MonadPeelIO)
-import Control.Exception.Peel (bracket)
-import Database.Persist.TH (nullable)
+import Control.Monad.IO.Control (MonadControlIO)
+import Control.Exception.Control (bracket)
+import Database.Persist.Util (nullable)
+import Data.List (intercalate)
+import Data.Text (Text)
 
 type RowPopper m = m (Maybe [PersistValue])
 
 data Connection = Connection
-    { prepare :: String -> IO Statement
-    , insertSql :: RawName -> [RawName] -> Either String (String, String)
-    , stmtMap :: IORef (Map.Map String Statement)
+    { prepare :: Text -> IO Statement
+    , insertSql :: RawName -> [RawName] -> Either Text (Text, Text)
+    , stmtMap :: IORef (Map.Map Text Statement)
     , close :: IO ()
     , migrateSql :: forall v. PersistEntity v
-                 => (String -> IO Statement) -> v
-                 -> IO (Either [String] [(Bool, String)])
-    , begin :: (String -> IO Statement) -> IO ()
-    , commit :: (String -> IO Statement) -> IO ()
-    , rollback :: (String -> IO Statement) -> IO ()
+                 => (Text -> IO Statement) -> v
+                 -> IO (Either [Text] [(Bool, Text)])
+    , begin :: (Text -> IO Statement) -> IO ()
+    , commit :: (Text -> IO Statement) -> IO ()
+    , rollback :: (Text -> IO Statement) -> IO ()
     , escapeName :: RawName -> String
     , noLimit :: String
     }
@@ -48,15 +55,15 @@
     { finalize :: IO ()
     , reset :: IO ()
     , execute :: [PersistValue] -> IO ()
-    , withStmt :: forall a m. MonadPeelIO m
+    , withStmt :: forall a m. MonadControlIO m
                => [PersistValue] -> (RowPopper m -> m a) -> m a
     }
 
-withSqlPool :: MonadPeelIO m
+withSqlPool :: MonadControlIO m
             => IO Connection -> Int -> (Pool Connection -> m a) -> m a
 withSqlPool mkConn = createPool mkConn close'
 
-withSqlConn :: MonadPeelIO m => IO Connection -> (Connection -> m a) -> m a
+withSqlConn :: MonadControlIO m => IO Connection -> (Connection -> m a) -> m a
 withSqlConn open = bracket (liftIO open) (liftIO . close')
 
 close' :: Connection -> IO ()
@@ -125,5 +132,118 @@
         Nothing -> entityName t
         Just x -> x
 
-newtype RawName = RawName { unRawName :: String }
+newtype RawName = RawName { unRawName :: String } -- FIXME Text
     deriving (Eq, Ord)
+
+filterClause :: PersistEntity val
+             => Bool -- ^ include table name?
+             -> Connection -> Filter val -> String
+filterClause includeTable conn f =
+    case (isNull, persistFilterToFilter f, varCount) of
+        (True, Eq, _) -> name ++ " IS NULL"
+        (True, Ne, _) -> name ++ " IS NOT NULL"
+        (False, Ne, _) -> concat
+            [ "("
+            , name
+            , " IS NULL OR "
+            , name
+            , "<>?)"
+            ]
+        -- We use 1=2 (and below 1=1) to avoid using TRUE and FALSE, since
+        -- not all databases support those words directly.
+        (_, In, 0) -> "1=2"
+        (False, In, _) -> name ++ " IN " ++ qmarks
+        (True, In, _) -> concat
+            [ "("
+            , name
+            , " IS NULL OR "
+            , name
+            , " IN "
+            , qmarks
+            , ")"
+            ]
+        (_, NotIn, 0) -> "1=1"
+        (False, NotIn, _) -> concat
+            [ "("
+            , name
+            , " IS NULL OR "
+            , name
+            , " NOT IN "
+            , qmarks
+            , ")"
+            ]
+        (True, NotIn, _) -> concat
+            [ "("
+            , name
+            , " IS NOT NULL AND "
+            , name
+            , " NOT IN "
+            , qmarks
+            , ")"
+            ]
+        _ -> name ++ showSqlFilter (persistFilterToFilter f) ++ "?"
+  where
+    isNull = any (== PersistNull)
+           $ either return id
+           $ persistFilterToValue f
+    t = entityDef $ dummyFromFilts [f]
+    name =
+        (if includeTable
+            then (++) (escapeName conn (rawTableName t) ++ ".")
+            else id)
+        $ escapeName conn $ getFieldName t $ persistFilterToFieldName f
+    qmarks = case persistFilterToValue f of
+                Left _ -> "?"
+                Right x ->
+                    let x' = filter (/= PersistNull) x
+                     in '(' : intercalate "," (map (const "?") x') ++ ")"
+    varCount = case persistFilterToValue f of
+                Left _ -> 1
+                Right x -> length x
+    showSqlFilter Eq = "="
+    showSqlFilter Ne = "<>"
+    showSqlFilter Gt = ">"
+    showSqlFilter Lt = "<"
+    showSqlFilter Ge = ">="
+    showSqlFilter Le = "<="
+    showSqlFilter In = " IN "
+    showSqlFilter NotIn = " NOT IN "
+
+dummyFromFilts :: [Filter v] -> v
+dummyFromFilts _ = error "dummyFromFilts"
+
+getFieldName :: EntityDef -> String -> RawName
+getFieldName t s = rawFieldName $ tableColumn t s
+
+tableColumn :: EntityDef -> String -> (String, String, [String])
+tableColumn _ "id" = ("id", "Int64", [])
+tableColumn t s = go $ entityColumns t
+  where
+    go [] = error $ "Unknown table column: " ++ s
+    go ((x, y, z):rest)
+        | x == s = (x, y, z)
+        | otherwise = go rest
+
+getFiltsValues :: PersistEntity val => [Filter val] -> [PersistValue]
+getFiltsValues =
+    concatMap $ go . persistFilterToValue
+  where
+    go (Left PersistNull) = []
+    go (Left x) = [x]
+    go (Right xs) = filter (/= PersistNull) xs
+
+dummyFromOrder :: Order a -> a
+dummyFromOrder _ = undefined
+
+orderClause :: PersistEntity val => Bool -> Connection -> Order val -> String
+orderClause includeTable conn o =
+    name ++ case persistOrderToOrder o of
+                                    Asc -> ""
+                                    Desc -> " DESC"
+  where
+    t = entityDef $ dummyFromOrder o
+    name =
+        (if includeTable
+            then (++) (escapeName conn (rawTableName t) ++ ".")
+            else id)
+        $ escapeName conn $ getFieldName t $ persistOrderToFieldName o
diff --git a/Database/Persist/GenericSql/Raw.hs b/Database/Persist/GenericSql/Raw.hs
--- a/Database/Persist/GenericSql/Raw.hs
+++ b/Database/Persist/GenericSql/Raw.hs
@@ -18,12 +18,13 @@
 import qualified Data.Map as Map
 import Control.Applicative (Applicative)
 import Control.Monad.Trans.Class (MonadTrans (..))
-import Control.Monad.IO.Peel (MonadPeelIO (..))
+import Control.Monad.IO.Control (MonadControlIO (..))
+import Data.Text (Text)
 
 newtype SqlPersist m a = SqlPersist { unSqlPersist :: ReaderT Connection m a }
-    deriving (Monad, MonadIO, MonadTrans, Functor, Applicative, MonadPeelIO)
+    deriving (Monad, MonadIO, MonadTrans, Functor, Applicative, MonadControlIO)
 
-withStmt :: MonadPeelIO m => String -> [PersistValue]
+withStmt :: MonadControlIO m => Text -> [PersistValue]
          -> (RowPopper (SqlPersist m) -> SqlPersist m a) -> SqlPersist m a
 withStmt sql vals pop = do
     stmt <- getStmt sql
@@ -31,18 +32,18 @@
     liftIO $ reset stmt
     return ret
 
-execute :: MonadIO m => String -> [PersistValue] -> SqlPersist m ()
+execute :: MonadIO m => Text -> [PersistValue] -> SqlPersist m ()
 execute sql vals = do
     stmt <- getStmt sql
     liftIO $ I.execute stmt vals
     liftIO $ reset stmt
 
-getStmt :: MonadIO m => String -> SqlPersist m Statement
+getStmt :: MonadIO m => Text -> SqlPersist m Statement
 getStmt sql = do
     conn <- SqlPersist ask
     liftIO $ getStmt' conn sql
 
-getStmt' :: Connection -> String -> IO Statement
+getStmt' :: Connection -> Text -> IO Statement
 getStmt' conn sql = do
     smap <- liftIO $ readIORef $ stmtMap conn
     case Map.lookup sql smap of
diff --git a/Database/Persist/Join.hs b/Database/Persist/Join.hs
new file mode 100644
--- /dev/null
+++ b/Database/Persist/Join.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+module Database.Persist.Join
+    ( -- * Typeclass
+      RunJoin (..)
+      -- * One-to-many relation
+    , SelectOneMany (..)
+    , selectOneMany
+    ) where
+
+import Database.Persist.Base
+import Data.Maybe (mapMaybe)
+import qualified Data.Map as Map
+import Data.List (foldl')
+
+class RunJoin a where
+    type Result a
+    runJoin :: PersistBackend m => a -> m (Result a)
+
+data SelectOneMany one many = SelectOneMany
+    { somFilterOne :: [Filter one]
+    , somOrderOne :: [Order one]
+    , somFilterMany :: [Filter many]
+    , somOrderMany :: [Order many]
+    , somFilterKeys :: [Key one] -> Filter many
+    , somGetKey :: many -> Key one
+    , somIncludeNoMatch :: Bool
+    }
+
+selectOneMany :: ([Key one] -> Filter many) -> (many -> Key one) -> SelectOneMany one many
+selectOneMany filts get' = SelectOneMany [] [] [] [] filts get' False
+instance (PersistEntity one, PersistEntity many, Ord (Key one))
+    => RunJoin (SelectOneMany one many) where
+    type Result (SelectOneMany one many) =
+        [((Key one, one), [(Key many, many)])]
+    runJoin (SelectOneMany oneF oneO manyF manyO eq getKey isOuter) = do
+        x <- selectList oneF oneO 0 0
+        -- FIXME use select instead of selectList
+        y <- selectList (eq (map fst x) : manyF) manyO 0 0
+        let y' = foldl' go Map.empty y
+        return $ mapMaybe (go' y') x
+      where
+        go m many@(_, many') =
+            Map.insert (getKey many')
+            (case Map.lookup (getKey many') m of
+                Nothing -> (:) many
+                Just v -> v . (:) many
+                ) m
+        go' y' one@(k, _) =
+            case Map.lookup k y' of
+                Nothing ->
+                    if isOuter
+                        then Just (one, [])
+                        else Nothing
+                Just many -> Just (one, many [])
diff --git a/Database/Persist/Join/Sql.hs b/Database/Persist/Join/Sql.hs
new file mode 100644
--- /dev/null
+++ b/Database/Persist/Join/Sql.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Database.Persist.Join.Sql
+    ( RunJoin (..)
+    ) where
+
+import Database.Persist.Join hiding (RunJoin (..))
+import qualified Database.Persist.Join as J
+import Database.Persist.Base
+import Control.Monad (liftM)
+import Data.Maybe (mapMaybe)
+import Data.List (intercalate, groupBy)
+import Database.Persist.GenericSql (SqlPersist (SqlPersist))
+import Database.Persist.GenericSql.Internal hiding (withStmt)
+import Database.Persist.GenericSql.Raw (withStmt)
+import Control.Monad.Trans.Reader (ask)
+import Control.Monad.IO.Control (MonadControlIO)
+import Data.Function (on)
+import Control.Arrow ((&&&))
+import Data.Text (pack)
+
+fromPersistValuesId :: PersistEntity v => [PersistValue] -> Either String (Key v, v)
+fromPersistValuesId [] = Left "fromPersistValuesId: No values provided"
+fromPersistValuesId (i:rest) =
+    case fromPersistValues rest of
+        Left e -> Left e
+        Right x -> Right (toPersistKey i, x)
+
+class RunJoin a where
+    runJoin :: MonadControlIO m => a -> SqlPersist m (J.Result a)
+
+instance (PersistEntity one, PersistEntity many, Eq (Key one))
+    => RunJoin (SelectOneMany one many) where
+    runJoin = selectOneMany'
+
+selectOneMany' :: (MonadControlIO m,
+                  PersistEntity d,
+                  PersistEntity val1,
+                  PersistEntity val,
+                  PersistEntity b,
+                  Eq (Key b)) =>
+                 SelectOneMany val val1 -> SqlPersist m [((Key b, b), [(Key d, d)])]
+selectOneMany' (SelectOneMany oneF oneO manyF manyO eq _getKey isOuter) = do
+    conn <- SqlPersist ask
+    liftM go $ withStmt (sql conn) (getFiltsValues oneF ++ getFiltsValues manyF) $ loop id
+  where
+    go :: Eq a => [((a, b), Maybe (c, d))] -> [((a, b), [(c, d)])]
+    go = map (fst . head &&& mapMaybe snd) . groupBy ((==) `on` (fst . fst))
+    loop front popper = do
+        x <- popper
+        case x of
+            Nothing -> return $ front []
+            Just vals -> do
+                let (y, z) = splitAt oneCount vals
+                case (fromPersistValuesId y, fromPersistValuesId z) of
+                    (Right y', Right z') -> loop (front . (:) (y', Just z')) popper
+                    (Left e, _) -> error $ "selectOneMany: " ++ e
+                    (Right y', Left e) ->
+                        case z of
+                            PersistNull:_ -> loop (front . (:) (y', Nothing)) popper
+                            _ -> error $ "selectOneMany: " ++ e
+    oneCount = 1 + length (tableColumns $ entityDef one)
+    one = dummyFromFilts oneF
+    many = dummyFromFilts manyF
+    sql conn = pack $ concat
+        [ "SELECT "
+        , intercalate "," $ colsPlusId conn one ++ colsPlusId conn many
+        , " FROM "
+        , escapeName conn $ rawTableName $ entityDef one
+        , if isOuter then " LEFT JOIN " else " INNER JOIN "
+        , escapeName conn $ rawTableName $ entityDef many
+        , " ON "
+        , escapeName conn $ rawTableName $ entityDef one
+        , ".id = "
+        , escapeName conn $ rawTableName $ entityDef many
+        , "."
+        , escapeName conn $ RawName $ persistFilterToFieldName $ eq undefined
+        , if null filts
+            then ""
+            else " WHERE " ++ intercalate " AND " filts
+        , if null ords
+            then ""
+            else " ORDER BY " ++ intercalate ", " ords
+        ]
+      where
+        filts = map (filterClause True conn) oneF ++ map (filterClause True conn) manyF
+        ords = map (orderClause True conn) oneO ++ map (orderClause True conn) manyO
+
+addTable :: PersistEntity val =>
+           Connection -> val -> [Char] -> [Char]
+addTable conn e s = concat [escapeName conn $ rawTableName $ entityDef e, ".", s]
+
+colsPlusId :: PersistEntity e => Connection -> e -> [String]
+colsPlusId conn e =
+    map (addTable conn e) $
+    "id" : (map (\(x, _, _) -> escapeName conn x) cols)
+  where
+    cols = tableColumns $ entityDef e
diff --git a/Database/Persist/Quasi.hs b/Database/Persist/Quasi.hs
--- a/Database/Persist/Quasi.hs
+++ b/Database/Persist/Quasi.hs
@@ -1,35 +1,19 @@
 module Database.Persist.Quasi
-    ( persist
-    , persistFile
+    ( parse 
     ) where
 
-import Language.Haskell.TH.Quote
-import Language.Haskell.TH.Syntax
 import Database.Persist.Base
 import Data.Char
 import Data.Maybe (mapMaybe)
-import Text.ParserCombinators.Parsec hiding (token)
-import qualified System.IO as SIO
-
--- | Converts a quasi-quoted syntax into a list of entity definitions, to be
--- used as input to the template haskell generation code (mkPersist).
-persist :: QuasiQuoter
-persist = QuasiQuoter
-    { quoteExp = lift . parse_
-    }
-
-persistFile :: FilePath -> Q Exp
-persistFile fp = do
-    h <- qRunIO $ SIO.openFile fp SIO.ReadMode
-    qRunIO $ SIO.hSetEncoding h SIO.utf8_bom
-    s <- qRunIO $ SIO.hGetContents h
-    lift $ parse_ s
+import Text.ParserCombinators.Parsec hiding (parse, token)
+import qualified Text.ParserCombinators.Parsec as Parsec
 
-parse_ :: String -> [EntityDef]
-parse_ = map parse' . nest . map words'
-       . removeLeadingSpaces
-       . map killCarriage
-       . lines
+-- | Parses a quasi-quoted syntax into a list of entity definitions.
+parse :: String -> [EntityDef]
+parse = map parse' . nest . map words'
+      . removeLeadingSpaces
+      . map killCarriage
+      . lines
 
 removeLeadingSpaces :: [String] -> [String]
 removeLeadingSpaces x =
@@ -45,7 +29,7 @@
     | otherwise = s
 
 words' :: String -> (Bool, [String])
-words' s = case parse words'' s s of
+words' s = case Parsec.parse words'' s s of
             Left e -> error $ show e
             Right x -> x
 
diff --git a/Database/Persist/TH.hs b/Database/Persist/TH.hs
deleted file mode 100644
--- a/Database/Persist/TH.hs
+++ /dev/null
@@ -1,529 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE ExistentialQuantification #-}
--- | This module provides utilities for creating backends. Regular users do not
--- need to use this module.
-module Database.Persist.TH
-    ( mkPersist
-    , share
-    , share2
-    , mkSave
-    , mkDeleteCascade
-    , derivePersistField
-    , nullable
-    ) where
-
-import Database.Persist.Base
-import Language.Haskell.TH.Syntax
-import Data.Char (toLower, toUpper)
-import Data.Maybe (mapMaybe, catMaybes)
-import Web.Routes.Quasi (SinglePiece)
-import Data.Int (Int64)
-import Control.Monad (forM)
-import System.IO.Unsafe (unsafePerformIO)
-
--- | Create data types and appropriate 'PersistEntity' instances for the given
--- 'EntityDef's. Works well with the persist quasi-quoter.
-mkPersist :: [EntityDef] -> Q [Dec]
-mkPersist = fmap concat . mapM mkEntity
-
-recName :: String -> String -> String
-recName dt f = lowerFirst dt ++ upperFirst f
-
-lowerFirst :: String -> String
-lowerFirst (x:xs) = toLower x : xs
-lowerFirst [] = []
-
-upperFirst :: String -> String
-upperFirst (x:xs) = toUpper x : xs
-upperFirst [] = []
-
-dataTypeDec :: EntityDef -> Dec
-dataTypeDec t =
-    let name = mkName $ entityName t
-        cols = map (mkCol $ entityName t) $ entityColumns t
-     in DataD [] name [] [RecC name cols] $ map mkName $ entityDerives t
-  where
-    mkCol x (n, ty, as) =
-        (mkName $ recName x n, NotStrict, pairToType (ty, nullable as))
-
-keyTypeDec :: String -> Name -> EntityDef -> Dec
-keyTypeDec constr typ t =
-    NewtypeInstD [] ''Key [ConT $ mkName $ entityName t]
-                (NormalC (mkName constr) [(NotStrict, ConT typ)])
-                [''Show, ''Read, ''Num, ''Integral, ''Enum, ''Eq, ''Ord,
-                 ''Real, ''PersistField, ''SinglePiece]
-
-filterTypeDec :: EntityDef -> Dec
-filterTypeDec t =
-    DataInstD [] ''Filter [ConT $ mkName $ entityName t]
-            (NormalC (mkName $ entityName t ++ "IdIn") [(NotStrict, listOfIds)]
-            : map (mkFilter $ entityName t) filts)
-            (if null filts then [] else [''Show, ''Read, ''Eq])
-  where
-    listOfIds = ListT `AppT` (ConT ''Key `AppT` ConT (mkName $ entityName t))
-    filts = entityFilters t
-
-entityFilters :: EntityDef -> [(String, String, Bool, PersistFilter)]
-entityFilters = mapMaybe go' . concatMap go . entityColumns
-  where
-    go (x, y, as) = map (\a -> (x, y, nullable as, a)) as
-    go' (x, y, z, a) =
-        case readMay a of
-            Nothing -> Nothing
-            Just a' -> Just (x, y, z, a')
-
-readMay :: Read a => String -> Maybe a
-readMay s =
-    case reads s of
-        (x, _):_ -> Just x
-        [] -> Nothing
-
-isFilterList :: PersistFilter -> Bool
-isFilterList In = True
-isFilterList NotIn = True
-isFilterList _ = False
-
-mkFilter :: String -> (String, String, Bool, PersistFilter) -> Con
-mkFilter x (s, ty, isNull', filt) =
-    NormalC (mkName $ x ++ upperFirst s ++ show filt) [(NotStrict, ty'')]
-  where
-    ty' = pairToType (ty, isNull' && isNullableFilter filt)
-    ty'' = if isFilterList filt then ListT `AppT` ty' else ty'
-    isNullableFilter Eq = True
-    isNullableFilter Ne = True
-    isNullableFilter In = True
-    isNullableFilter NotIn = True
-    isNullableFilter Lt = False
-    isNullableFilter Le = False
-    isNullableFilter Gt = False
-    isNullableFilter Ge = False
-
-updateTypeDec :: EntityDef -> Dec
-updateTypeDec t =
-    DataInstD [] ''Update [ConT $ mkName $ entityName t]
-        (map (mkUpdate $ entityName t) tu)
-        (if null tu then [] else [''Show, ''Read, ''Eq])
-  where
-    tu = entityUpdates t
-
-entityUpdates :: EntityDef -> [(String, String, Bool, PersistUpdate)]
-entityUpdates = mapMaybe go' . concatMap go . entityColumns
-  where
-    go (x, y, as) = map (\a -> (x, y, nullable as, a)) as
-    go' (x, y, z, "update") =
-        deprecate "'update' is deprecated; please use 'Update'"
-            $ Just (x, y, z, Update)
-    go' (x, y, z, a) =
-        case readMay a of
-            Nothing -> Nothing
-            Just a' -> Just (x, y, z, a')
-
-mkUpdate :: String -> (String, String, Bool, PersistUpdate) -> Con
-mkUpdate x (s, ty, isBool, pu) =
-    NormalC (mkName $ updateConName x s pu) [(NotStrict, pairToType (ty, isBool))]
-
-orderTypeDec :: EntityDef -> Q Dec
-orderTypeDec t = do
-    ords <- entityOrders t
-    return $ DataInstD [] ''Order [ConT $ mkName $ entityName t]
-            (map (mkOrder $ entityName t) ords)
-            (if null ords then [] else [''Show, ''Read, ''Eq])
-
-entityOrders :: EntityDef -> Q [(String, String, Exp)]
-entityOrders = fmap concat . mapM go . entityColumns
-  where
-    go (x, _, ys) = fmap catMaybes $ mapM (go' x) ys
-    go' x s =
-        case reads s of
-            (y, _):_ -> do
-                z <- lift (y :: PersistOrder)
-                return $ Just (x, s, z)
-            _ -> return Nothing
-
-mkOrder :: String -> (String, String, Exp) -> Con
-mkOrder x (s, ad, _) = NormalC (mkName $ x ++ upperFirst s ++ ad) []
-
-uniqueTypeDec :: EntityDef -> Dec
-uniqueTypeDec t =
-    DataInstD [] ''Unique [ConT $ mkName $ entityName t]
-            (map (mkUnique t) $ entityUniques t)
-            (if null (entityUniques t) then [] else [''Show, ''Read, ''Eq])
-
-mkUnique :: EntityDef -> (String, [String]) -> Con
-mkUnique t (constr, fields) =
-    NormalC (mkName constr) types
-  where
-    types = map (go . flip lookup3 (entityColumns t)) fields
-    go (_, True) = error "Error: cannot have nullables in unique"
-    go x = (NotStrict, pairToType x)
-    lookup3 s [] =
-        error $ "Column not found: " ++ s ++ " in unique " ++ constr
-    lookup3 x ((x', y, z):rest)
-        | x == x' = (y, nullable z)
-        | otherwise = lookup3 x rest
-
-pairToType :: (String, Bool) -> Type
-pairToType (s, False) = ConT $ mkName s
-pairToType (s, True) = ConT (mkName "Maybe") `AppT` ConT (mkName s)
-
-degen :: [Clause] -> [Clause]
-degen [] =
-    let err = VarE (mkName "error") `AppE` LitE (StringL
-                "Degenerate case, should never happen")
-     in [Clause [WildP] (NormalB err) []]
-degen x = x
-
-mkToPersistFields :: [(String, Int)] -> Q Dec
-mkToPersistFields pairs = do
-    clauses <- mapM go pairs
-    return $ FunD (mkName "toPersistFields") $ degen clauses
-  where
-    go :: (String, Int) -> Q Clause
-    go (constr, fields) = do
-        xs <- sequence $ replicate fields $ newName "x"
-        let pat = ConP (mkName constr) $ map VarP xs
-        sp <- [|SomePersistField|]
-        let bod = ListE $ map (AppE sp . VarE) xs
-        return $ Clause [pat] (NormalB bod) []
-
-mkToFieldNames :: [(String, [String])] -> Dec
-mkToFieldNames pairs =
-        FunD (mkName "persistUniqueToFieldNames") $ degen $ map go pairs
-  where
-    go (constr, names) =
-        Clause [RecP (mkName constr) []]
-               (NormalB $ ListE $ map (LitE . StringL) names)
-               []
-
-mkToUpdate :: String -> [(String, PersistUpdate)] -> Q Dec
-mkToUpdate name pairs = do
-    pairs' <- mapM go pairs
-    return $ FunD (mkName name) $ degen pairs'
-  where
-    go (constr, pu) = do
-        pu' <- lift pu
-        return $ Clause [RecP (mkName constr) []] (NormalB pu') []
-
-mkUniqueToValues :: [(String, [String])] -> Q Dec
-mkUniqueToValues pairs = do
-    pairs' <- mapM go pairs
-    return $ FunD (mkName "persistUniqueToValues") $ degen pairs'
-  where
-    go :: (String, [String]) -> Q Clause
-    go (constr, names) = do
-        xs <- mapM (const $ newName "x") names
-        let pat = ConP (mkName constr) $ map VarP xs
-        tpv <- [|toPersistValue|]
-        let bod = ListE $ map (AppE tpv . VarE) xs
-        return $ Clause [pat] (NormalB bod) []
-
-mkToFieldName :: String -> [(String, String)] -> Dec
-mkToFieldName func pairs =
-        FunD (mkName func) $ degen $ map go pairs
-  where
-    go (constr, name) =
-        Clause [RecP (mkName constr) []] (NormalB $ LitE $ StringL name) []
-
-mkToOrder :: [(String, Exp)] -> Dec
-mkToOrder pairs =
-        FunD (mkName "persistOrderToOrder") $ degen $ map go pairs
-  where
-    go (constr, val) =
-        Clause [RecP (mkName constr) []] (NormalB val) []
-
-mkToFilter :: EntityDef -> [(String, PersistFilter, Bool)] -> Q [Dec]
-mkToFilter e pairs = do
-    c1 <- mapM go pairs
-    idIn' <- idIn
-    let _FIXMEc2 = concatMap go' pairs
-    return
-        [ FunD (mkName "persistFilterToFilter") $ idIn' : c1
-        ]
-  where
-    idIn = do
-        in_ <- [|In|]
-        return $ Clause
-            [RecP (mkName $ entityName e ++ "IdIn") []]
-            (NormalB in_)
-            []
-    go (constr, pf, _) = do
-        pf' <- lift pf
-        return $ Clause [RecP (mkName constr) []] (NormalB pf') []
-    go' (constr, _, False) =
-        [Clause [RecP (mkName constr) []]
-            (NormalB $ ConE $ mkName "False") []]
-    go' (constr, _, True) =
-        [ Clause [ConP (mkName constr) [ConP (mkName "Nothing") []]]
-            (NormalB $ ConE $ mkName "True") []
-        , Clause [ConP (mkName constr) [WildP]]
-            (NormalB $ ConE $ mkName "False") []
-        ]
-
-mkToValue :: String -> [String] -> Dec
-mkToValue func = FunD (mkName func) . degen . map go
-  where
-    go constr =
-        let x = mkName "x"
-         in Clause [ConP (mkName constr) [VarP x]]
-                   (NormalB $ VarE (mkName "toPersistValue") `AppE` VarE x)
-                   []
-
-mkToFiltValue :: EntityDef -> String -> [(String, Bool)] -> Q Dec
-mkToFiltValue e func pairs = do
-    left <- [|Left . toPersistValue|]
-    right <- [|Right . map toPersistValue|]
-    clauses <- mapM (go left right) pairs
-    inId' <- inId right
-    return $ FunD (mkName func) $ (inId' : clauses)
-  where
-    inId right = do
-        x <- newName "x"
-        return $ Clause
-            [ConP (mkName $ entityName e ++ "IdIn") [VarP x]]
-            (NormalB $ right `AppE` VarE x)
-            []
-    go left right (constr, isList) = do
-        x <- newName "x"
-        return
-            $ Clause [ConP (mkName constr) [VarP x]]
-                (NormalB $ (if isList then right else left) `AppE` VarE x)
-                []
-
-mkHalfDefined :: String -> Int -> Dec
-mkHalfDefined constr count' =
-        FunD (mkName "halfDefined")
-            [Clause [] (NormalB
-            $ foldl AppE (ConE $ mkName constr)
-                    (replicate count' $ VarE $ mkName "undefined")) []]
-
-apE :: Either x (y -> z) -> Either x y -> Either x z
-apE (Left x) _ = Left x
-apE _ (Left x) = Left x
-apE (Right f) (Right y) = Right $ f y
-
-mkFromPersistValues :: EntityDef -> Q [Clause]
-mkFromPersistValues t = do
-    nothing <- [|Left "Invalid fromPersistValues input"|]
-    let cons = ConE $ mkName $ entityName t
-    xs <- mapM (const $ newName "x") $ entityColumns t
-    fs <- [|fromPersistValue|]
-    let xs' = map (AppE fs . VarE) xs
-    let pat = ListP $ map VarP xs
-    ap' <- [|apE|]
-    just <- [|Right|]
-    let cons' = just `AppE` cons
-    return
-        [ Clause [pat] (NormalB $ foldl (go ap') cons' xs') []
-        , Clause [WildP] (NormalB nothing) []
-        ]
-  where
-    go ap' x y = InfixE (Just x) ap' (Just y)
-
-mkEntity :: EntityDef -> Q [Dec]
-mkEntity t = do
-    t' <- lift t
-    let name = entityName t
-    let clazz = ConT ''PersistEntity `AppT` ConT (mkName $ entityName t)
-    tpf <- mkToPersistFields [(name, length $ entityColumns t)]
-    fpv <- mkFromPersistValues t
-    fromIntegral' <- [|fromIntegral|]
-    utv <- mkUniqueToValues $ entityUniques t
-    show' <- [|show|]
-    entityOrders' <- entityOrders t
-    otd <- orderTypeDec t
-    puk <- mkUniqueKeys t
-    tf <- mkToFilter t
-                (map (\(x, _, z, y) ->
-                    (name ++ upperFirst x ++ show y, y, z))
-                $ entityFilters t)
-    ftv <- mkToFiltValue t "persistFilterToValue"
-                $ map (\(x, _, _, y) ->
-                    (name ++ upperFirst x ++ show y, isFilterList y))
-                $ entityFilters t
-    putu <- mkToUpdate "persistUpdateToUpdate"
-                $ map (\(s, _, _, pu) -> (updateConName name s pu, pu))
-                $ entityUpdates t
-    return
-      [ dataTypeDec t
-      , TySynD (mkName $ entityName t ++ "Id") [] $
-            ConT ''Key `AppT` ConT (mkName $ entityName t)
-      , InstanceD [] clazz $
-        [ keyTypeDec (entityName t ++ "Id") ''Int64 t
-        , filterTypeDec t
-        , updateTypeDec t
-        , otd
-        , uniqueTypeDec t
-        , FunD (mkName "entityDef") [Clause [WildP] (NormalB t') []]
-        , tpf
-        , FunD (mkName "fromPersistValues") fpv
-        , mkHalfDefined name $ length $ entityColumns t
-        , FunD (mkName "toPersistKey") [Clause [] (NormalB fromIntegral') []]
-        , FunD (mkName "fromPersistKey") [Clause [] (NormalB fromIntegral') []]
-        , FunD (mkName "showPersistKey") [Clause [] (NormalB show') []]
-        , mkToFieldName "persistOrderToFieldName"
-                $ map (\(x, y, _) -> (name ++ upperFirst x ++ y, x))
-                entityOrders'
-        , mkToOrder
-                $ map (\(x, y, z) -> (name ++ upperFirst x ++ y, z))
-                entityOrders'
-        , mkToFieldName "persistUpdateToFieldName"
-                $ map (\(s, _, _, pu) -> (updateConName name s pu, s))
-                $ entityUpdates t
-        , mkToValue "persistUpdateToValue"
-                $ map (\(s, _, _, pu) -> updateConName name s pu)
-                $ entityUpdates t
-        , putu
-        , mkToFieldName "persistFilterToFieldName"
-                $ (:) (entityName t ++ "IdIn", "id")
-                $ map (\(x, _, _, y) -> (name ++ upperFirst x ++ show y, x))
-                $ entityFilters t
-        , ftv
-        , mkToFieldNames $ entityUniques t
-        , utv
-        , puk
-        ] ++ tf
-        ]
-
-updateConName :: String -> String -> PersistUpdate -> String
-updateConName name s pu = concat
-    [ name
-    , upperFirst s
-    , case pu of
-        Update -> ""
-        _ -> show pu
-    ]
-
-share :: [[EntityDef] -> Q [Dec]] -> [EntityDef] -> Q [Dec]
-share fs x = fmap concat $ mapM ($ x) fs
-
-share2 :: ([EntityDef] -> Q [Dec])
-       -> ([EntityDef] -> Q [Dec])
-       -> [EntityDef]
-       -> Q [Dec]
-share2 f g x = do
-    y <- f x
-    z <- g x
-    return $ y ++ z
-
-mkSave :: String -> [EntityDef] -> Q [Dec]
-mkSave name' defs' = do
-    let name = mkName name'
-    defs <- lift defs'
-    return [ SigD name $ ListT `AppT` ConT ''EntityDef
-           , FunD name [Clause [] (NormalB defs) []]
-           ]
-
-data Dep = Dep
-    { depTarget :: String
-    , depSourceTable :: String
-    , depSourceField :: String
-    , depSourceNull :: Bool
-    }
-
-mkDeleteCascade :: [EntityDef] -> Q [Dec]
-mkDeleteCascade defs = do
-    let deps = concatMap getDeps defs
-    mapM (go deps) defs
-  where
-    getDeps :: EntityDef -> [Dep]
-    getDeps def =
-        concatMap getDeps' $ entityColumns def
-      where
-        getDeps' (name, typ, attribs) =
-            let isNull = nullable attribs
-                l = length typ
-                (f, b) = splitAt (l - 2) typ
-             in if b == "Id"
-                    then return Dep
-                            { depTarget = f
-                            , depSourceTable = entityName def
-                            , depSourceField = name
-                            , depSourceNull = isNull
-                            }
-                    else []
-    go :: [Dep] -> EntityDef -> Q Dec
-    go allDeps EntityDef{entityName = name} = do
-        let deps = filter (\x -> depTarget x == name) allDeps
-        key <- newName "key"
-        del <- [|delete|]
-        dcw <- [|deleteCascadeWhere|]
-        just <- [|Just|]
-        let mkStmt dep = NoBindS
-                $ dcw `AppE`
-                  ListE
-                    [ ConE (mkName filtName) `AppE` val (depSourceNull dep)
-                    ]
-              where
-                filtName =
-                    depSourceTable dep ++ upperFirst (depSourceField dep)
-                      ++ "Eq"
-                val False = VarE key
-                val True = just `AppE` VarE key
-
-
-
-        let stmts = map mkStmt deps ++ [NoBindS $ del `AppE` VarE key]
-        return $
-            InstanceD
-            []
-            (ConT ''DeleteCascade `AppT` ConT (mkName name))
-            [ FunD (mkName "deleteCascade")
-                [Clause [VarP key] (NormalB $ DoE stmts) []]
-            ]
-
-mkUniqueKeys :: EntityDef -> Q Dec
-mkUniqueKeys def = do
-    c <- clause
-    return $ FunD (mkName "persistUniqueKeys") [c]
-  where
-    clause = do
-        xs <- forM (entityColumns def) $ \(x, _, _) -> do
-            x' <- newName $ '_' : x
-            return (x, x')
-        let pcs = map (go xs) $ entityUniques def
-        let pat = ConP (mkName $ entityName def) $ map (VarP . snd) xs
-        return $ Clause [pat] (NormalB $ ListE pcs) []
-    go xs (name, cols) =
-        foldl (go' xs) (ConE (mkName name)) cols
-    go' xs front col =
-        let Just col' = lookup col xs
-         in front `AppE` VarE col'
-
--- | Automatically creates a valid 'PersistField' instance for any datatype
--- that has valid 'Show' and 'Read' instances. Can be very convenient for
--- 'Enum' types.
-derivePersistField :: String -> Q [Dec]
-derivePersistField s = do
-    ss <- [|SqlString|]
-    tpv <- [|PersistString . show|]
-    fpv <- [|\dt v ->
-                case fromPersistValue v of
-                    Left e -> Left e
-                    Right s' ->
-                        case reads s' of
-                            (x, _):_ -> Right x
-                            [] -> Left $ "Invalid " ++ dt ++ ": " ++ s'|]
-    return
-        [ InstanceD [] (ConT ''PersistField `AppT` ConT (mkName s))
-            [ FunD (mkName "sqlType")
-                [ Clause [WildP] (NormalB ss) []
-                ]
-            , FunD (mkName "toPersistValue")
-                [ Clause [] (NormalB tpv) []
-                ]
-            , FunD (mkName "fromPersistValue")
-                [ Clause [] (NormalB $ fpv `AppE` LitE (StringL s)) []
-                ]
-            ]
-        ]
-
-nullable :: [String] -> Bool
-nullable s
-    | "Maybe" `elem` s = True
-    | "null" `elem` s = deprecate "Please replace null with Maybe" True
-    | otherwise = False
-
-deprecate :: String -> a -> a
-deprecate s x = unsafePerformIO $ do
-    putStrLn $ "DEPRECATED: " ++ s
-    return x
diff --git a/Database/Persist/Util.hs b/Database/Persist/Util.hs
new file mode 100644
--- /dev/null
+++ b/Database/Persist/Util.hs
@@ -0,0 +1,17 @@
+module Database.Persist.Util
+    ( nullable
+    , deprecate
+    ) where
+
+import System.IO.Unsafe (unsafePerformIO)
+
+nullable :: [String] -> Bool
+nullable s
+    | "Maybe" `elem` s = True
+    | "null" `elem` s = deprecate "Please replace null with Maybe" True
+    | otherwise = False
+
+deprecate :: String -> a -> a
+deprecate s x = unsafePerformIO $ do
+    putStrLn $ "DEPRECATED: " ++ s
+    return x
diff --git a/persistent.cabal b/persistent.cabal
--- a/persistent.cabal
+++ b/persistent.cabal
@@ -1,5 +1,5 @@
 name:            persistent
-version:         0.4.2
+version:         0.5.0
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -13,32 +13,38 @@
 homepage:        http://docs.yesodweb.com/book/persistent
 
 library
+    if flag(test)
+        Buildable: False
     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
-                   , web-routes-quasi         >= 0.6       && < 0.7
                    , containers               >= 0.2       && < 0.5
                    , parsec                   >= 2.1       && < 4
-                   , enumerator               >= 0.4       && < 0.5
-                   , monad-peel               >= 0.1       && < 0.2
-                   , pool                     >= 0.0       && < 0.1
+                   , enumerator               >= 0.4.9     && < 0.5
+                   , monad-control            >= 0.2       && < 0.3
+                   , pool                     >= 0.1       && < 0.2
                    , blaze-html               >= 0.4       && < 0.5
     exposed-modules: Database.Persist
                      Database.Persist.Base
-                     Database.Persist.TH
                      Database.Persist.Quasi
                      Database.Persist.GenericSql
                      Database.Persist.GenericSql.Internal
                      Database.Persist.GenericSql.Raw
+                     Database.Persist.Util
+                     Database.Persist.Join
+                     Database.Persist.Join.Sql
     ghc-options:     -Wall
 
 Flag test
     Description:   Build the runtests executables.
     Default:       False
 
+Flag test-postgresql
+    Description:   Build the runtests executable with Postgresql support.
+    Default:       True
+
 executable         runtests
     if flag(test)
         Buildable: True
@@ -48,23 +54,14 @@
                          test-framework-hunit,
                          base >= 4 && < 5,
                          template-haskell >= 2.4 && < 2.6,
-                         bytestring >= 0.9.1 && < 0.10,
-                         transformers >= 0.2.1 && < 0.3,
-                         time >= 1.1.4 && < 1.3,
-                         text >= 0.7.1 && < 0.12,
-                         hamlet >= 0.5 && < 0.7,
-                         web-routes-quasi >= 0.6.0 && < 0.7,
-                         containers >= 0.2 && < 0.5,
-                         parsec >= 2.1 && < 4,
-                         enumerator >= 0.4 && < 0.5,
-                         stm >= 2.1 && < 2.3,
-                         neither >= 0.1 && < 0.2,
                          HDBC-postgresql,
                          HDBC,
-                         utf8-string
+                         web-routes-quasi >= 0.7 && < 0.8
+        if flag(test-postgresql)
+            cpp-options: -DWITH_POSTGRESQL
     else
         Buildable: False
-    hs-source-dirs: ., backends/sqlite, backends/postgresql
+    hs-source-dirs: ., packages/template, backends/sqlite, backends/postgresql
     main-is:       runtests.hs
     ghc-options:   -Wall
     extra-libraries: sqlite3
diff --git a/runtests.hs b/runtests.hs
--- a/runtests.hs
+++ b/runtests.hs
@@ -3,6 +3,8 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 import Test.Framework (defaultMain, testGroup, Test)
 import Test.Framework.Providers.HUnit
@@ -10,17 +12,23 @@
 import Test.HUnit hiding (Test)
 
 import Database.Persist.Sqlite
+#if WITH_POSTGRESQL
 import Database.Persist.Postgresql
+#endif
 import Database.Persist.TH
 import Control.Monad.IO.Class
 
+import Database.Persist.Join hiding (RunJoin)
+import qualified Database.Persist.Join
+import qualified Database.Persist.Join.Sql
+
 import Control.Monad.Trans.Reader
 import Monad (unless)
 import Data.Int
 import Data.Word
 
 import Control.Exception (SomeException)
-import qualified Control.Exception.Peel as Peel
+import qualified Control.Exception.Control as Control
 
 infix 1 /=@, @/=
 
@@ -64,13 +72,21 @@
     word32 Word32
     int64 Int64
     word64 Word64
+
+  Author
+    name String Eq Asc
+  Entry
+    author AuthorId In
+    title String Desc
 |]
 
 -- connstr = "user=test password=test host=localhost port=5432 dbname=yesod_test"
 
 runConn f = do
     (withSqlitePool "testdb" 1) $ runSqlPool f
+#if WITH_POSTGRESQL
     (withPostgresqlPool "user=test password=test host=localhost port=5432 dbname=test" 1) $ runSqlPool f
+#endif
 
 -- TODO: run tests in transaction
 sqliteTest :: SqlPersist IO () -> Assertion
@@ -83,6 +99,8 @@
   deleteWhere ([] :: [Filter Pet])
   deleteWhere ([] :: [Filter Person])
   deleteWhere ([] :: [Filter Number])
+  deleteWhere ([] :: [Filter Entry])
+  deleteWhere ([] :: [Filter Author])
 
 setup :: SqlPersist IO ()
 setup = do
@@ -110,6 +128,8 @@
     , testCase "derivePersistField" case_derivePersistField
     , testCase "afterException" case_afterException
     , testCase "idIn" case_idIn
+    , testCase "join (non-SQL)" case_joinNonSql
+    , testCase "join (SQL)" case_joinSql
     ]
 
                           
@@ -130,6 +150,8 @@
 case_derivePersistField = sqliteTest _derivePersistField
 case_afterException = (withSqlitePool "testdb" 1) $ runSqlPool _afterException
 case_idIn = sqliteTest _idIn
+case_joinNonSql = sqliteTest _joinNonSql
+case_joinSql = sqliteTest _joinSql
 
 _deleteWhere = do
   key2 <- insert $ Person "Michael2" 90 Nothing
@@ -198,6 +220,10 @@
   p @== p2
   k @== key2
   Nothing <- getBy $ PersonNameKey "Michael3"
+
+  Just (k', p') <- getByValue p2
+  k' @== k
+  p' @== p
   return ()
 
 _update = do
@@ -338,7 +364,7 @@
 
 _afterException = do
     _ <- insert $ Person "A" 0 Nothing
-    _ <- (insert (Person "A" 1 Nothing) >> return ()) `Peel.catch` catcher
+    _ <- (insert (Person "A" 1 Nothing) >> return ()) `Control.catch` catcher
     _ <- insert $ Person "B" 0 Nothing
     return ()
   where
@@ -354,3 +380,78 @@
     pid3 <- insert p3
     x <- selectList [PersonIdIn [pid1, pid3]] [] 0 0
     liftIO $ x @?= [(pid1, p1), (pid3, p3)]
+
+_joinNonSql = _joinGen Database.Persist.Join.runJoin
+_joinSql = _joinGen Database.Persist.Join.Sql.runJoin
+
+_joinGen run = do
+    a <- insert $ Author "a"
+    a1 <- insert $ Entry a "a1"
+    a2 <- insert $ Entry a "a2"
+    a3 <- insert $ Entry a "a3"
+    b <- insert $ Author "b"
+    b1 <- insert $ Entry b "b1"
+    b2 <- insert $ Entry b "b2"
+    c <- insert $ Author "c"
+
+    x <- run $ selectOneMany EntryAuthorIn entryAuthor
+    liftIO $
+        x @?=
+            [ ((a, Author "a"),
+                [ (a1, Entry a "a1")
+                , (a2, Entry a "a2")
+                , (a3, Entry a "a3")
+                ])
+            , ((b, Author "b"),
+                [ (b1, Entry b "b1")
+                , (b2, Entry b "b2")
+                ])
+            ]
+
+    y <- run $ (selectOneMany EntryAuthorIn entryAuthor)
+            { somFilterOne = [AuthorNameEq "a"]
+            }
+    liftIO $
+        y @?=
+            [ ((a, Author "a"),
+                [ (a1, Entry a "a1")
+                , (a2, Entry a "a2")
+                , (a3, Entry a "a3")
+                ])
+            ]
+
+    z <- run (selectOneMany EntryAuthorIn entryAuthor)
+            { somOrderOne = [AuthorNameAsc]
+            , somOrderMany = [EntryTitleDesc]
+            }
+    liftIO $
+        z @?=
+            [ ((a, Author "a"),
+                [ (a3, Entry a "a3")
+                , (a2, Entry a "a2")
+                , (a1, Entry a "a1")
+                ])
+            , ((b, Author "b"),
+                [ (b2, Entry b "b2")
+                , (b1, Entry b "b1")
+                ])
+            ]
+
+    w <- run (selectOneMany EntryAuthorIn entryAuthor)
+            { somOrderOne = [AuthorNameAsc]
+            , somOrderMany = [EntryTitleDesc]
+            , somIncludeNoMatch = True
+            }
+    liftIO $
+        w @?=
+            [ ((a, Author "a"),
+                [ (a3, Entry a "a3")
+                , (a2, Entry a "a2")
+                , (a1, Entry a "a1")
+                ])
+            , ((b, Author "b"),
+                [ (b2, Entry b "b2")
+                , (b1, Entry b "b1")
+                ])
+            , ((c, Author "c"), [])
+            ]