persistent 0.3.1.3 → 0.4.0

raw patch · 8 files changed

+432/−142 lines, 8 filesdep +HDBCdep +HDBC-postgresqldep +HUnitdep ~bytestringdep ~template-haskelldep ~textnew-component:exe:runtests

Dependencies added: HDBC, HDBC-postgresql, HUnit, blaze-html, haskell98, monad-peel, pool, test-framework, test-framework-hunit, utf8-string

Dependency ranges changed: bytestring, template-haskell, text, web-routes-quasi

Files

Database/Persist/Base.hs +2/−1
Database/Persist/GenericSql.hs +15/−14
Database/Persist/GenericSql/Internal.hs +6/−5
Database/Persist/GenericSql/Raw.hs +3/−13
Database/Persist/Pool.hs +0/−92
Database/Persist/Quasi.hs +12/−1
persistent.cabal +49/−16
runtests.hs +345/−0

Database/Persist/Base.hs view

@@ -38,7 +38,8 @@ import Data.Typeable (Typeable) import Data.Int (Int8, Int16, Int32, Int64) import Data.Word (Word8, Word16, Word32, Word64)-import Text.Hamlet+import Text.Blaze (Html, unsafeByteString)+import Text.Blaze.Renderer.Utf8 (renderHtml) import qualified Data.Text as T import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L

Database/Persist/GenericSql.hs view

@@ -27,7 +27,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Reader import Control.Monad.Trans.Class (MonadTrans (..))-import Database.Persist.Pool+import Data.Pool import Control.Monad.Trans.Writer import System.IO import Database.Persist.GenericSql.Internal@@ -36,22 +36,23 @@ import Control.Monad (liftM, unless) import Data.Enumerator (Stream (..), Iteratee (..), Step (..)) import Language.Haskell.TH.Syntax hiding (lift)-import Control.Monad.Invert (MonadInvertIO, onException)+import Control.Monad.IO.Peel (MonadPeelIO)+import Control.Exception.Peel (onException) import Control.Exception (toException)  type ConnectionPool = Pool Connection -withStmt' :: MonadInvertIO m => String -> [PersistValue]+withStmt' :: MonadPeelIO m => String -> [PersistValue]          -> (RowPopper (SqlPersist m) -> SqlPersist m a) -> SqlPersist m a withStmt' = R.withStmt  execute' :: MonadIO m => String -> [PersistValue] -> SqlPersist m () execute' = R.execute -runSqlPool :: MonadInvertIO m => SqlPersist m a -> Pool Connection -> m a+runSqlPool :: MonadPeelIO m => SqlPersist m a -> Pool Connection -> m a runSqlPool r pconn = withPool' pconn $ runSqlConn r -runSqlConn :: MonadInvertIO m => SqlPersist m a -> Connection -> m a+runSqlConn :: MonadPeelIO m => SqlPersist m a -> Connection -> m a runSqlConn (SqlPersist r) conn = do     let getter = R.getStmt' conn     liftIO $ begin conn getter@@ -61,7 +62,7 @@     liftIO $ commit conn getter     return x -instance MonadInvertIO m => PersistBackend (SqlPersist m) where+instance MonadPeelIO m => PersistBackend (SqlPersist m) where     insert val = do         conn <- SqlPersist ask         let esql = insertSql conn (rawTableName t) (map fst3 $ tableColumns t)@@ -456,29 +457,29 @@       Left errs -> error $ unlines errs       Right sql -> return sql -printMigration :: MonadInvertIO m => Migration (SqlPersist m) -> SqlPersist m ()+printMigration :: MonadPeelIO m => Migration (SqlPersist m) -> SqlPersist m () printMigration m = do   mig <- parseMigration' m   mapM_ (liftIO . putStrLn) (allSql mig) -getMigration :: MonadInvertIO m => Migration (SqlPersist m) -> SqlPersist m [Sql]+getMigration :: MonadPeelIO m => Migration (SqlPersist m) -> SqlPersist m [Sql] getMigration m = do   mig <- parseMigration' m   return $ allSql mig -runMigration :: MonadInvertIO m+runMigration :: MonadPeelIO 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 :: MonadInvertIO m+runMigrationSilent :: MonadPeelIO m                    => Migration (SqlPersist m)                    -> SqlPersist m [String] runMigrationSilent m = runMigration' m True -runMigration' :: MonadInvertIO m+runMigration' :: MonadPeelIO m               => Migration (SqlPersist m)               -> Bool -- ^ is silent?               -> SqlPersist m [String]@@ -492,7 +493,7 @@             , unlines $ map (\s -> "    " ++ s ++ ";") $ errs             ] -runMigrationUnsafe :: MonadInvertIO m+runMigrationUnsafe :: MonadPeelIO m                    => Migration (SqlPersist m)                    -> SqlPersist m () runMigrationUnsafe m = do@@ -505,7 +506,7 @@     execute' s []     return s -migrate :: (MonadInvertIO m, PersistEntity val)+migrate :: (MonadPeelIO m, PersistEntity val)         => val         -> Migration (SqlPersist m) migrate val = do@@ -535,7 +536,7 @@         ]   where     typ = ForallT [PlainTV $ mkName "m"]-            [ ClassP ''MonadInvertIO [VarT $ mkName "m"]+            [ ClassP ''MonadPeelIO [VarT $ mkName "m"]             ]             $ ConT ''Migration `AppT` (ConT ''SqlPersist `AppT` VarT (mkName "m"))     body =

Database/Persist/GenericSql/Internal.hs view

@@ -20,11 +20,12 @@ import qualified Data.Map as Map import Data.IORef import Control.Monad.IO.Class-import Database.Persist.Pool+import Data.Pool import Database.Persist.Base import Data.Maybe (fromJust) import Control.Arrow-import Control.Monad.Invert (MonadInvertIO, bracket)+import Control.Monad.IO.Peel (MonadPeelIO)+import Control.Exception.Peel (bracket) import Database.Persist.TH (nullable)  type RowPopper m = m (Maybe [PersistValue])@@ -47,15 +48,15 @@     { finalize :: IO ()     , reset :: IO ()     , execute :: [PersistValue] -> IO ()-    , withStmt :: forall a m. MonadInvertIO m+    , withStmt :: forall a m. MonadPeelIO m                => [PersistValue] -> (RowPopper m -> m a) -> m a     } -withSqlPool :: MonadInvertIO m+withSqlPool :: MonadPeelIO m             => IO Connection -> Int -> (Pool Connection -> m a) -> m a withSqlPool mkConn = createPool mkConn close' -withSqlConn :: MonadInvertIO m => IO Connection -> (Connection -> m a) -> m a+withSqlConn :: MonadPeelIO m => IO Connection -> (Connection -> m a) -> m a withSqlConn open = bracket (liftIO open) (liftIO . close')  close' :: Connection -> IO ()

Database/Persist/GenericSql/Raw.hs view

@@ -18,22 +18,12 @@ import qualified Data.Map as Map import Control.Applicative (Applicative) import Control.Monad.Trans.Class (MonadTrans (..))-import Control.Monad.Invert (MonadInvertIO (..))-import Control.Monad (liftM)+import Control.Monad.IO.Peel (MonadPeelIO (..))  newtype SqlPersist m a = SqlPersist { unSqlPersist :: ReaderT Connection m a }-    deriving (Monad, MonadIO, MonadTrans, Functor, Applicative)--instance MonadInvertIO m => MonadInvertIO (SqlPersist m) where-    newtype InvertedIO (SqlPersist m) a =-        InvSqlPersistIO-            { runInvSqlPersistIO :: InvertedIO (ReaderT Connection m) a-            }-    type InvertedArg (SqlPersist m) = (Connection, InvertedArg m)-    invertIO = liftM (fmap InvSqlPersistIO) . invertIO . unSqlPersist-    revertIO f = SqlPersist $ revertIO $ liftM runInvSqlPersistIO . f+    deriving (Monad, MonadIO, MonadTrans, Functor, Applicative, MonadPeelIO) -withStmt :: MonadInvertIO m => String -> [PersistValue]+withStmt :: MonadPeelIO m => String -> [PersistValue]          -> (RowPopper (SqlPersist m) -> SqlPersist m a) -> SqlPersist m a withStmt sql vals pop = do     stmt <- getStmt sql

− Database/Persist/Pool.hs

@@ -1,92 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE PackageImports #-}-module Database.Persist.Pool-    ( -- * Using pools-      createPool-    , withPool-    , withPool'-    , Pool-      -- * Diagnostics-    , PoolStats (..)-    , poolStats-    ) where--import Control.Concurrent.STM (atomically)-import Control.Concurrent.STM.TVar-    (TVar, newTVarIO, readTVar, writeTVar)-import Control.Exception (throwIO, Exception)-import Data.Typeable-import qualified Control.Monad.Invert as I-import Control.Monad.IO.Class-import Control.Monad--data PoolData a = PoolData-    { poolAvail :: [a]-    , poolCreated :: Int-    }--data Pool a = Pool-    { poolMax :: Int-    , poolData :: TVar (PoolData a)-    , poolMake :: IO a-    }--data PoolStats = PoolStats-    { poolStatsMax :: Int-    , poolStatsAvailable :: Int-    , poolStatsCreated :: Int-    }--poolStats :: Pool a -> IO PoolStats-poolStats (Pool m td _) = do-    d <- atomically $ readTVar td-    return $ PoolStats m (length $ poolAvail d) (poolCreated d)--createPool :: (MonadIO m, I.MonadInvertIO m)-           => IO a -> (a -> IO ()) -> Int -> (Pool a -> m b) -> m b-createPool mk fr mx f = do-    pd <- liftIO $ newTVarIO $ PoolData [] 0-    I.finally (f $ Pool mx pd mk) $ liftIO $ do-        PoolData ress _ <- atomically $ readTVar pd-        mapM_ fr ress--data PoolExhaustedException = PoolExhaustedException-    deriving (Show, Typeable)-instance Exception PoolExhaustedException--withPool' :: (MonadIO m, I.MonadInvertIO m) => Pool a -> (a -> m b) -> m b-withPool' p f = do-    x <- withPool p f-    case x of-        Nothing -> liftIO $ throwIO PoolExhaustedException-        Just x' -> return x'--withPool :: (MonadIO m, I.MonadInvertIO m)-         => Pool a -> (a -> m b) -> m (Maybe b)-withPool p f = I.block $ do-    eres <- liftIO $ atomically $ do-        pd <- readTVar $ poolData p-        let (pd', eres) =-                case poolAvail pd of-                    (x:xs) -> (pd { poolAvail = xs }, Right x)-                    [] -> (pd, Left $ poolCreated pd)-        writeTVar (poolData p) pd'-        return eres-    case eres of-        Left pc ->-            if pc >= poolMax p-                then return Nothing-                else I.bracket-                    (liftIO $ poolMake p)-                    (insertResource 1)-                    (liftM Just . I.unblock . f)-        Right res -> I.finally-                        (liftM Just $ I.unblock $ f res)-                        (insertResource 0 res)-  where-    insertResource i x = liftIO $ atomically $ do-        pd <- readTVar $ poolData p-        writeTVar (poolData p)-            pd { poolAvail = x : poolAvail pd-               , poolCreated = i + poolCreated pd-               }

Database/Persist/Quasi.hs view

@@ -1,4 +1,7 @@-module Database.Persist.Quasi (persist) where+module Database.Persist.Quasi+    ( persist+    , persistFile+    ) where  import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax@@ -6,6 +9,7 @@ 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).@@ -13,6 +17,13 @@ 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  parse_ :: String -> [EntityDef] parse_ = map parse' . nest . map words'

persistent.cabal view

@@ -1,31 +1,31 @@ name:            persistent-version:         0.3.1.3+version:         0.4.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com> maintainer:      Michael Snoyman <michael@snoyman.com> synopsis:        Type-safe, non-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+category:        Database, Yesod stability:       Stable cabal-version:   >= 1.6 build-type:      Simple homepage:        http://docs.yesodweb.com/persistent/  library-    build-depends:   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+    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+                   , blaze-html               >= 0.4       && < 0.5     exposed-modules: Database.Persist                      Database.Persist.Base                      Database.Persist.TH@@ -33,8 +33,41 @@                      Database.Persist.GenericSql                      Database.Persist.GenericSql.Internal                      Database.Persist.GenericSql.Raw-                     Database.Persist.Pool     ghc-options:     -Wall++Flag test+    Description:   Build the runtests executables.+    Default:       False++executable         runtests+    if flag(test)+        Buildable: True+        build-depends:   haskell98,+                         HUnit,+                         test-framework,+                         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+    else+        Buildable: False+    hs-source-dirs: ., backends/sqlite, backends/postgresql+    main-is:       runtests.hs+    ghc-options:   -Wall+    extra-libraries: sqlite3  source-repository head   type:     git

+ runtests.hs view

@@ -0,0 +1,345 @@+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+
+import Test.Framework (defaultMain, testGroup, Test)
+import Test.Framework.Providers.HUnit
+-- import Test.Framework.Providers.QuickCheck
+import Test.HUnit hiding (Test)
+
+import Database.Persist.Sqlite
+import Database.Persist.Postgresql
+import Database.Persist.TH
+import Control.Monad.IO.Class
+
+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
+
+infix 1 /=@, @/=
+
+(/=@) :: (Eq a, Show a, MonadIO m) => a -> a -> m ()
+expected /=@ actual = liftIO $ assertNotEqual "" expected actual
+
+(@/=) :: (Eq a, Show a, MonadIO m) => a -> a -> m ()
+actual @/= expected = liftIO $ assertNotEqual "" expected actual
+
+assertNotEqual :: (Eq a, Show a) => String -> a -> a -> Assertion
+assertNotEqual preface expected actual =
+  unless (actual /= expected) (assertFailure msg)
+  where msg = (if null preface then "" else preface ++ "\n") ++
+             "expected: " ++ show expected ++ "\n to not equal: " ++ show actual
+
+infix 1 @==, ==@
+expected @== actual = liftIO $ expected @?= actual
+expected ==@ actual = liftIO $ expected @=? actual
+
+data PetType = Cat | Dog
+    deriving (Show, Read, Eq)
+derivePersistField "PetType"
+
+  -- FIXME Empty
+share2 mkPersist (mkMigrate "testMigrate") [$persist|
+
+  Person
+    name String update Eq Ne Desc
+    age Int update "Asc" Desc Lt "some ignored -- attribute" Eq Add
+    color String Maybe Eq Ne -- this is a comment sql=foobarbaz
+    PersonNameKey name -- this is a comment sql=foobarbaz
+  Pet
+    owner PersonId
+    name String
+    type PetType
+  NeedsPet
+    pet PetId
+  Number
+    int Int
+    int32 Int32
+    word32 Word32
+    int64 Int64
+    word64 Word64
+|]
+
+-- connstr = "user=test password=test host=localhost port=5432 dbname=yesod_test"
+
+runConn f = do
+    (withSqlitePool "testdb" 1) $ runSqlPool f
+    (withPostgresqlPool "user=test password=test host=localhost port=5432 dbname=test" 1) $ runSqlPool f
+
+-- TODO: run tests in transaction
+sqliteTest :: SqlPersist IO () -> Assertion
+sqliteTest actions = do
+  runConn actions
+  runConn cleanDB
+
+cleanDB :: SqlPersist IO ()
+cleanDB = do
+  deleteWhere ([] :: [Filter Pet])
+  deleteWhere ([] :: [Filter Person])
+  deleteWhere ([] :: [Filter Number])
+
+setup :: SqlPersist IO ()
+setup = do
+  runMigration testMigrate
+  cleanDB
+
+main :: IO ()
+main = do
+  runConn setup
+  defaultMain [testSuite]
+
+testSuite :: Test
+testSuite = testGroup "Database.Persistent"
+    [
+      testCase "sqlite persistent" case_sqlitePersistent
+    , testCase "sqlite deleteWhere" case_sqliteDeleteWhere
+    , testCase "sqlite deleteBy" case_sqliteDeleteBy
+    , testCase "sqlite delete" case_sqliteDelete
+    , testCase "sqlite replace" case_sqliteReplace
+    , testCase "sqlite getBy" case_sqliteGetBy
+    , testCase "sqlite update" case_sqliteUpdate
+    , testCase "sqlite updateWhere" case_sqliteUpdateWhere
+    , testCase "sqlite selectList" case_sqliteSelectList
+    , testCase "large numbers" case_largeNumbers
+    , testCase "insertBy" case_insertBy
+    , testCase "derivePersistField" case_derivePersistField
+    , testCase "afterException" case_afterException
+    ]
+
+                          
+assertEmpty xs    = liftIO $ assertBool "" (null xs)
+assertNotEmpty xs = liftIO $ assertBool "" (not (null xs))
+
+case_sqliteDeleteWhere = sqliteTest _deleteWhere
+case_sqliteDeleteBy = sqliteTest _deleteBy
+case_sqliteDelete = sqliteTest _delete
+case_sqliteReplace = sqliteTest _replace
+case_sqliteGetBy = sqliteTest _getBy
+case_sqliteUpdate = sqliteTest _update
+case_sqliteUpdateWhere = sqliteTest _updateWhere
+case_sqliteSelectList = sqliteTest _selectList
+case_sqlitePersistent = sqliteTest _persistent
+case_largeNumbers = sqliteTest _largeNumbers
+case_insertBy = sqliteTest _insertBy
+case_derivePersistField = sqliteTest _derivePersistField
+case_afterException = sqliteTest _afterException
+
+_deleteWhere = do
+  key2 <- insert $ Person "Michael2" 90 Nothing
+  _    <- insert $ Person "Michael3" 90 Nothing
+  let p91 = Person "Michael4" 91 Nothing
+  key91 <- insert $ p91
+
+  ps90 <- selectList [PersonAgeEq 90] [] 0 0
+  assertNotEmpty ps90
+  deleteWhere [PersonAgeEq 90]
+  ps90 <- selectList [PersonAgeEq 90] [] 0 0
+  assertEmpty ps90
+  Nothing <- get key2
+
+  Just p2_91 <- get key91
+  p91 @== p2_91
+
+_deleteBy = do
+  key2 <- insert $ Person "Michael2" 27 Nothing
+  let p3 = Person "Michael3" 27 Nothing
+  key3 <- insert $ p3
+
+  ps2 <- selectList [PersonNameEq "Michael2"] [] 0 0
+  assertNotEmpty ps2
+
+  deleteBy $ PersonNameKey "Michael2"
+  ps2 <- selectList [PersonNameEq "Michael2"] [] 0 0
+  assertEmpty ps2
+
+  Just p32 <- get key3
+  p3 @== p32
+
+_delete = do
+  key2 <- insert $ Person "Michael2" 27 Nothing
+  let p3 = Person "Michael3" 27 Nothing
+  key3 <- insert $ p3
+
+  pm2 <- selectList [PersonNameEq "Michael2"] [] 0 0
+  assertNotEmpty pm2
+  delete key2
+  pm2 <- selectList [PersonNameEq "Michael2"] [] 0 0
+  assertEmpty pm2
+
+  Just p <- get key3
+  p3 @== p
+
+-- also a decent test of get
+_replace = do
+  key2 <- insert $ Person "Michael2" 27 Nothing
+  let p3 = Person "Michael3" 27 Nothing
+  replace key2 p3
+  Just p <- get key2
+  p @== p3
+
+  -- test replace an empty key
+  delete key2
+  Nothing <- get key2
+  undefined <- replace key2 p3
+  Nothing <- get key2
+  return ()
+
+_getBy = do
+  let p2 = Person "Michael2" 27 Nothing
+  key2 <- insert p2
+  Just (k, p) <- getBy $ PersonNameKey "Michael2"
+  p @== p2
+  k @== key2
+  Nothing <- getBy $ PersonNameKey "Michael3"
+  return ()
+
+_update = do
+  let p25 = Person "Michael" 25 Nothing
+  key25 <- insert p25
+  update key25 [PersonAge 28, PersonName "Updated"]
+  Just pBlue28 <- get key25
+  pBlue28 @== Person "Updated" 28 Nothing
+  update key25 [PersonAgeAdd 2]
+  Just pBlue30 <- get key25
+  pBlue30 @== Person "Updated" 30 Nothing
+
+_updateWhere = do
+  let p1 = Person "Michael" 25 Nothing
+  let p2 = Person "Michael2" 25 Nothing
+  key1 <- insert p1
+  key2 <- insert p2
+  updateWhere [PersonNameEq "Michael2"]
+              [PersonAgeAdd 3, PersonName "Updated"]
+  Just pBlue28 <- get key2
+  pBlue28 @== Person "Updated" 28 Nothing
+  Just p <- get key1
+  p @== p1
+
+_selectList = do
+  let p25 = Person "Michael" 25 Nothing
+  let p26 = Person "Michael2" 26 Nothing
+  key25 <- insert p25
+  key26 <- insert p26
+  ps <- selectList [] [] 0 0
+  ps @== [(key25, p25), (key26, p26)]
+  -- limit
+  ps <- selectList [] [] 1 0
+  ps @== [(key25, p25)]
+  -- offset -- FAILS!
+  ps <- selectList [] [] 0 1
+  ps @== [(key26, p26)]
+  -- limit & offset
+  ps <- selectList [] [] 1 1
+  ps @== [(key26, p26)]
+
+  ps <- selectList [] [PersonAgeDesc] 0 0
+  ps @== [(key26, p26), (key25, p25)]
+  ps <- selectList [PersonAgeEq 26] [] 0 0
+  ps @== [(key26, p26)]
+
+-- general tests transferred from already exising test file
+_persistent = do
+  let mic = Person "Michael" 25 Nothing
+  micK <- insert mic
+  Just p <- get micK
+  p @== mic
+
+  replace micK $ Person "Michael" 25 Nothing
+  Just p <- get micK
+  p @== mic
+
+  replace micK $ Person "Michael" 26 Nothing
+  Just mic26 <- get micK
+  mic26 @/= mic
+  personAge mic26 @== (personAge mic) + 1
+
+  results <- selectList [PersonNameEq "Michael"] [] 0 0
+  results @== [(micK, mic26)]
+
+  results <- selectList [PersonAgeLt 28] [] 0 0
+  results @== [(micK, mic26)]
+
+  update micK [PersonAge 28]
+  Just p28 <- get micK
+  personAge p28 @== 28
+
+  updateWhere [PersonNameEq "Michael"] [PersonAge 29]
+  Just mic29 <- get micK
+  personAge mic29 @== 29
+
+  let eli = Person "Eliezer" 2 $ Just "blue"
+  _ <- insert eli
+  pasc <- selectList [] [PersonAgeAsc] 0 0
+  (map snd pasc) @== [eli, mic29]
+
+  let abe30 = Person "Abe" 30 $ Just "black"
+  keyAbe30 <- insert abe30
+  pdesc <- selectList [PersonAgeLt 30] [PersonNameDesc] 0 0
+  (map snd pasc) @== [eli, mic29]
+
+  abes <- selectList [PersonNameEq "Abe"] [] 0 0
+  (map snd abes) @== [abe30]
+
+  Just (k,p) <- getBy $ PersonNameKey "Michael"
+  p @== mic29
+
+  ps <- selectList [PersonColorEq $ Just "blue"] [] 0 0
+  map snd ps @== [eli]
+
+  ps <- selectList [PersonColorEq Nothing] [] 0 0
+  map snd ps @== [mic29]
+
+  ps <- selectList [PersonColorNe Nothing] [] 0 0
+  map snd ps @== [eli, abe30]
+
+  delete micK
+  Nothing <- get micK
+  return ()
+
+_largeNumbers = do
+    go $ Number maxBound 0 0 0 0
+    go $ Number 0 maxBound 0 0 0
+    go $ Number 0 0 maxBound 0 0
+    go $ Number 0 0 0 maxBound 0
+    go $ Number 0 0 0 0 maxBound
+
+    go $ Number minBound 0 0 0 0
+    go $ Number 0 minBound 0 0 0
+    go $ Number 0 0 minBound 0 0
+    go $ Number 0 0 0 minBound 0
+    go $ Number 0 0 0 0 minBound
+  where
+    go x = do
+        xid <- insert x
+        x' <- get xid
+        liftIO $ x' @?= Just x
+
+_insertBy = do
+    Right _ <- insertBy $ Person "name" 1 Nothing
+    Left _ <- insertBy $ Person "name" 1 Nothing
+    Right _ <- insertBy $ Person "name2" 1 Nothing
+    return ()
+
+_derivePersistField = do
+    person <- insert $ Person "pet owner" 30 Nothing
+    cat <- insert $ Pet person "Mittens" Cat
+    Just cat' <- get cat
+    liftIO $ petType cat' @?= Cat
+    dog <- insert $ Pet person "Spike" Dog
+    Just dog' <- get dog
+    liftIO $ petType dog' @?= Dog
+
+_afterException = do
+    _ <- insert $ Person "A" 0 Nothing
+    _ <- (insert (Person "A" 1 Nothing) >> return ()) `Peel.catch` catcher
+    _ <- insert $ Person "B" 0 Nothing
+    return ()
+  where
+    catcher :: Monad m => SomeException -> m ()
+    catcher _ = return ()