Moved all describes tests into their own functions.
Factored out the db specific tests and kept the macros as placeholders. Import everything in the cabal file for now. Only using the flags to test that everything still works.
This commit is contained in:
Fintan Halpenny
parent
352fca204c
commit
fe4a78d4b6
@ -107,18 +107,16 @@ test-suite test
|
||||
-- This library
|
||||
, esqueleto
|
||||
|
||||
if flag(postgresql)
|
||||
build-depends:
|
||||
postgresql-simple >= 0.2
|
||||
, postgresql-simple >= 0.2
|
||||
, postgresql-libpq >= 0.6
|
||||
, persistent-postgresql >= 2.0
|
||||
|
||||
cpp-options: -DWITH_POSTGRESQL
|
||||
|
||||
if flag(mysql)
|
||||
build-depends:
|
||||
mysql-simple >= 0.2.2.3
|
||||
, mysql-simple >= 0.2.2.3
|
||||
, mysql >= 0.1.1.3
|
||||
, persistent-mysql >= 2.0
|
||||
|
||||
if flag(postgresql)
|
||||
cpp-options: -DWITH_POSTGRESQL
|
||||
|
||||
if flag(mysql)
|
||||
cpp-options: -DWITH_MYSQL
|
||||
|
||||
530
test/Test.hs
530
test/Test.hs
@ -26,19 +26,16 @@ import Control.Monad.Trans.Reader (ReaderT)
|
||||
import Data.Char (toLower, toUpper)
|
||||
import Data.Monoid ((<>))
|
||||
import Database.Esqueleto
|
||||
#if defined (WITH_POSTGRESQL)
|
||||
import Database.Persist.Postgresql (withPostgresqlConn)
|
||||
import Data.Ord (comparing)
|
||||
import Control.Arrow ((&&&))
|
||||
import qualified Database.Esqueleto.PostgreSQL as EP
|
||||
#elif defined (WITH_MYSQL)
|
||||
import Database.Persist.MySQL ( withMySQLConn
|
||||
, connectHost
|
||||
, connectDatabase
|
||||
, connectUser
|
||||
, connectPassword
|
||||
, defaultConnectInfo)
|
||||
#endif
|
||||
import Database.Persist.Sqlite (withSqliteConn)
|
||||
import Database.Sqlite (SqliteException)
|
||||
import Database.Persist.TH
|
||||
@ -51,9 +48,10 @@ import qualified Data.List as L
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text.Lazy.Builder as TLB
|
||||
import qualified Database.Esqueleto.Internal.Sql as EI
|
||||
import Data.Time.Clock (getCurrentTime, diffUTCTime, NominalDiffTime)
|
||||
import Data.Time.Clock (getCurrentTime, diffUTCTime)
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Test schema
|
||||
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
|
||||
Foo
|
||||
@ -133,23 +131,45 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
|
||||
double Double
|
||||
|]
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
-- | this could be achieved with S.fromList, but not all lists
|
||||
-- have Ord instances
|
||||
sameElementsAs :: Eq a => [a] -> [a] -> Bool
|
||||
sameElementsAs l1 l2 = null (l1 L.\\ l2)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
let p1 = Person "John" (Just 36) Nothing 1
|
||||
p2 = Person "Rachel" Nothing (Just 37) 2
|
||||
p3 = Person "Mike" (Just 17) Nothing 3
|
||||
p4 = Person "Livia" (Just 17) (Just 18) 4
|
||||
p5 = Person "Mitch" Nothing Nothing 5
|
||||
l1 = Lord "Cornwall" (Just 36)
|
||||
l2 = Lord "Dorset" Nothing
|
||||
l3 = Lord "Chester" (Just 17)
|
||||
p1 :: Person
|
||||
p1 = Person "John" (Just 36) Nothing 1
|
||||
|
||||
hspec $ do
|
||||
p2 :: Person
|
||||
p2 = Person "Rachel" Nothing (Just 37) 2
|
||||
|
||||
p3 :: Person
|
||||
p3 = Person "Mike" (Just 17) Nothing 3
|
||||
|
||||
p4 :: Person
|
||||
p4 = Person "Livia" (Just 17) (Just 18) 4
|
||||
|
||||
p5 :: Person
|
||||
p5 = Person "Mitch" Nothing Nothing 5
|
||||
|
||||
l1 :: Lord
|
||||
l1 = Lord "Cornwall" (Just 36)
|
||||
|
||||
l2 :: Lord
|
||||
l2 = Lord "Dorset" Nothing
|
||||
|
||||
l3 :: Lord
|
||||
l3 = Lord "Chester" (Just 17)
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testSelect :: SpecWith (Arg (IO ()))
|
||||
testSelect = do
|
||||
describe "select" $ do
|
||||
it "works for a single value" $
|
||||
run $ do
|
||||
@ -171,6 +191,12 @@ main = do
|
||||
ret <- select $ return nothing
|
||||
liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ]
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testSelectSource :: SpecWith (Arg (IO ()))
|
||||
testSelectSource = do
|
||||
describe "selectSource" $ do
|
||||
it "works for a simple example" $
|
||||
run $ do
|
||||
@ -209,6 +235,11 @@ main = do
|
||||
r2 `shouldBe` [ entityKey p2e ]
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testSelectFrom :: SpecWith (Arg (IO ()))
|
||||
testSelectFrom = do
|
||||
describe "select/from" $ do
|
||||
it "works for a simple example" $
|
||||
run $ do
|
||||
@ -365,6 +396,11 @@ main = do
|
||||
liftIO $ ppk `shouldBe` thePk
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testSelectJoin :: SpecWith (Arg (IO ()))
|
||||
testSelectJoin = do
|
||||
describe "select/JOIN" $ do
|
||||
it "works with a LEFT OUTER JOIN" $
|
||||
run $ do
|
||||
@ -522,6 +558,71 @@ main = do
|
||||
return p
|
||||
liftIO $ (entityVal <$> ps) `shouldBe` [p1]
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
testPostgresqlRandom :: SpecWith (Arg (IO ()))
|
||||
testPostgresqlRandom = do
|
||||
it "works with random_" $
|
||||
run $ do
|
||||
_ <- select $ return (random_ :: SqlExpr (Value Double))
|
||||
return ()
|
||||
|
||||
testMysqlRandom :: SpecWith (Arg (IO ()))
|
||||
testMysqlRandom = do
|
||||
it "works with random_" $
|
||||
run $ do
|
||||
_ <- select $ return (random_ :: SqlExpr (Value Double))
|
||||
return ()
|
||||
|
||||
testSqliteRandom :: SpecWith (Arg (IO ()))
|
||||
testSqliteRandom = do
|
||||
it "works with random_" $
|
||||
run $ do
|
||||
_ <- select $ return (random_ :: SqlExpr (Value Int))
|
||||
return ()
|
||||
|
||||
testPostgresqlSum :: SpecWith (Arg (IO ()))
|
||||
testPostgresqlSum = do
|
||||
it "works with sum_" $
|
||||
run $ do
|
||||
_ <- insert' p1
|
||||
_ <- insert' p2
|
||||
_ <- insert' p3
|
||||
_ <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p->
|
||||
return $ joinV $ sum_ (p ^. PersonAge)
|
||||
liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Rational ) ]
|
||||
|
||||
testMysqlSum :: SpecWith (Arg (IO ()))
|
||||
testMysqlSum = do
|
||||
it "works with sum_" $
|
||||
run $ do
|
||||
_ <- insert' p1
|
||||
_ <- insert' p2
|
||||
_ <- insert' p3
|
||||
_ <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p->
|
||||
return $ joinV $ sum_ (p ^. PersonAge)
|
||||
liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Double ) ]
|
||||
|
||||
testSqliteSum :: SpecWith (Arg (IO ()))
|
||||
testSqliteSum = do
|
||||
it "works with sum_" $
|
||||
run $ do
|
||||
_ <- insert' p1
|
||||
_ <- insert' p2
|
||||
_ <- insert' p3
|
||||
_ <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p->
|
||||
return $ joinV $ sum_ (p ^. PersonAge)
|
||||
liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Int) ]
|
||||
|
||||
testSelectWhere :: SpecWith (Arg (IO ()))
|
||||
testSelectWhere = do
|
||||
describe "select/where_" $ do
|
||||
it "works for a simple example with (==.)" $
|
||||
run $ do
|
||||
@ -567,21 +668,12 @@ main = do
|
||||
return p
|
||||
liftIO $ ret `shouldBe` [ p3e ]
|
||||
|
||||
it "works with sum_" $
|
||||
run $ do
|
||||
_ <- insert' p1
|
||||
_ <- insert' p2
|
||||
_ <- insert' p3
|
||||
_ <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p->
|
||||
return $ joinV $ sum_ (p ^. PersonAge)
|
||||
#if defined(WITH_POSTGRESQL)
|
||||
liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Rational ) ]
|
||||
testPostgresqlSum
|
||||
#elif defined(WITH_MYSQL)
|
||||
liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Double ) ]
|
||||
testMysqlSum
|
||||
#else
|
||||
liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Int) ]
|
||||
testSqliteSum
|
||||
#endif
|
||||
|
||||
it "works with avg_" $
|
||||
@ -636,30 +728,10 @@ main = do
|
||||
return p
|
||||
liftIO $ ret2 `shouldBe` [ p2e ]
|
||||
|
||||
it "works with random_" $
|
||||
run $ do
|
||||
#if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL)
|
||||
_ <- select $ return (random_ :: SqlExpr (Value Double))
|
||||
testPostgresqlRandom >> testMysqlRandom
|
||||
#else
|
||||
_ <- select $ return (random_ :: SqlExpr (Value Int))
|
||||
#endif
|
||||
return ()
|
||||
|
||||
#if defined(WITH_POSTGRESQL)
|
||||
it "works with now" $
|
||||
run $ do
|
||||
nowDb <- select $ return EP.now_
|
||||
nowUtc <- liftIO getCurrentTime
|
||||
let halfSecond = realToFrac 0.5 :: NominalDiffTime
|
||||
|
||||
-- | Check the result is not null
|
||||
liftIO $ nowDb `shouldSatisfy` (not . null)
|
||||
|
||||
-- | Unpack the now value
|
||||
let (Value now: _) = nowDb
|
||||
|
||||
-- | Get the time diff and check it's less than half a second
|
||||
liftIO $ diffUTCTime nowUtc now `shouldSatisfy` (< halfSecond)
|
||||
testSqliteRandom
|
||||
#endif
|
||||
|
||||
it "works with round_" $
|
||||
@ -770,6 +842,100 @@ main = do
|
||||
pPk `shouldBe` thePk
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
testPostgresqlTwoAscFields :: SpecWith (Arg (IO ()))
|
||||
testPostgresqlTwoAscFields = do
|
||||
it "works with two ASC fields (one call)" $
|
||||
run $ do
|
||||
p1e <- insert' p1
|
||||
p2e <- insert' p2
|
||||
p3e <- insert' p3
|
||||
p4e <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p -> do
|
||||
orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
|
||||
return p
|
||||
-- in PostgreSQL nulls are bigger than everything
|
||||
liftIO $ ret `shouldBe` [ p4e, p3e, p1e , p2e ]
|
||||
|
||||
testMysqlTwoAscFields :: SpecWith (Arg (IO ()))
|
||||
testMysqlTwoAscFields = do
|
||||
it "works with two ASC fields (one call)" $
|
||||
run $ do
|
||||
p1e <- insert' p1
|
||||
p2e <- insert' p2
|
||||
p3e <- insert' p3
|
||||
p4e <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p -> do
|
||||
orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
|
||||
return p
|
||||
-- in SQLite and MySQL, its the reverse
|
||||
liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ]
|
||||
|
||||
testSqliteTwoAscFields :: SpecWith (Arg (IO ()))
|
||||
testSqliteTwoAscFields = do
|
||||
it "works with two ASC fields (one call)" $
|
||||
run $ do
|
||||
p1e <- insert' p1
|
||||
p2e <- insert' p2
|
||||
p3e <- insert' p3
|
||||
p4e <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p -> do
|
||||
orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
|
||||
return p
|
||||
-- in SQLite and MySQL, its the reverse
|
||||
liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ]
|
||||
|
||||
testPostgresqlOneAscOneDesc :: SpecWith (Arg (IO ()))
|
||||
testPostgresqlOneAscOneDesc = do
|
||||
it "works with one ASC and one DESC field (two calls)" $
|
||||
run $ do
|
||||
p1e <- insert' p1
|
||||
p2e <- insert' p2
|
||||
p3e <- insert' p3
|
||||
p4e <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p -> do
|
||||
orderBy [desc (p ^. PersonAge)]
|
||||
orderBy [asc (p ^. PersonName)]
|
||||
return p
|
||||
liftIO $ ret `shouldBe` [ p2e, p1e, p4e, p3e ]
|
||||
|
||||
testMysqlOneAscOneDesc :: SpecWith (Arg (IO ()))
|
||||
testMysqlOneAscOneDesc = do
|
||||
it "works with one ASC and one DESC field (two calls)" $
|
||||
run $ do
|
||||
p1e <- insert' p1
|
||||
p2e <- insert' p2
|
||||
p3e <- insert' p3
|
||||
p4e <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p -> do
|
||||
orderBy [desc (p ^. PersonAge)]
|
||||
orderBy [asc (p ^. PersonName)]
|
||||
return p
|
||||
liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ]
|
||||
|
||||
testSqliteOneAscOneDesc :: SpecWith (Arg (IO ()))
|
||||
testSqliteOneAscOneDesc = do
|
||||
it "works with one ASC and one DESC field (two calls)" $
|
||||
run $ do
|
||||
p1e <- insert' p1
|
||||
p2e <- insert' p2
|
||||
p3e <- insert' p3
|
||||
p4e <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p -> do
|
||||
orderBy [desc (p ^. PersonAge)]
|
||||
orderBy [asc (p ^. PersonName)]
|
||||
return p
|
||||
liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ]
|
||||
|
||||
testSelectOrderBy :: SpecWith (Arg (IO ()))
|
||||
testSelectOrderBy = do
|
||||
describe "select/orderBy" $ do
|
||||
it "works with a single ASC field" $
|
||||
run $ do
|
||||
@ -782,39 +948,16 @@ main = do
|
||||
return p
|
||||
liftIO $ ret `shouldBe` [ p1e, p3e, p2e ]
|
||||
|
||||
it "works with two ASC fields (one call)" $
|
||||
run $ do
|
||||
p1e <- insert' p1
|
||||
p2e <- insert' p2
|
||||
p3e <- insert' p3
|
||||
p4e <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p -> do
|
||||
orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
|
||||
return p
|
||||
-- in PostgreSQL nulls are bigger than everything
|
||||
#ifdef WITH_POSTGRESQL
|
||||
liftIO $ ret `shouldBe` [ p4e, p3e, p1e , p2e ]
|
||||
testPostgresqlTwoAscFields
|
||||
#else
|
||||
-- in SQLite and MySQL, its the reverse
|
||||
liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ]
|
||||
testMysqlTwoAscFields >> testSqliteTwoAscFields
|
||||
#endif
|
||||
|
||||
it "works with one ASC and one DESC field (two calls)" $
|
||||
run $ do
|
||||
p1e <- insert' p1
|
||||
p2e <- insert' p2
|
||||
p3e <- insert' p3
|
||||
p4e <- insert' p4
|
||||
ret <- select $
|
||||
from $ \p -> do
|
||||
orderBy [desc (p ^. PersonAge)]
|
||||
orderBy [asc (p ^. PersonName)]
|
||||
return p
|
||||
#ifdef WITH_POSTGRESQL
|
||||
liftIO $ ret `shouldBe` [ p2e, p1e, p4e, p3e ]
|
||||
testPostgresqlOneAscOneDesc
|
||||
#else
|
||||
liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ]
|
||||
testMysqlOneAscOneDesc >> testSqliteOneAscOneDesc
|
||||
#endif
|
||||
|
||||
it "works with a sub_select" $
|
||||
@ -860,14 +1003,18 @@ main = do
|
||||
liftIO $ map entityVal eps `shouldBe` reverse ps
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testSelectDistinct :: SpecWith (Arg (IO ()))
|
||||
testSelectDistinct = do
|
||||
describe "SELECT DISTINCT" $ do
|
||||
let selDistTest
|
||||
:: ( forall m. RunDbMonad m
|
||||
=> SqlQuery (SqlExpr (Value String))
|
||||
-> SqlPersistT (R.ResourceT m) [Value String])
|
||||
-> IO ()
|
||||
selDistTest q =
|
||||
run $ do
|
||||
selDistTest q = run $ do
|
||||
p1k <- insert p1
|
||||
let (t1, t2, t3) = ("a", "b", "c")
|
||||
mapM_ (insert . flip BlogPost p1k) [t1, t3, t2, t2, t1]
|
||||
@ -877,6 +1024,7 @@ main = do
|
||||
orderBy [asc title]
|
||||
return title
|
||||
liftIO $ ret `shouldBe` [ Value t1, Value t2, Value t3 ]
|
||||
|
||||
it "works on a simple example (selectDistinct)" $
|
||||
selDistTest selectDistinct
|
||||
|
||||
@ -886,7 +1034,12 @@ main = do
|
||||
it "works on a simple example (distinct (return ()))" $
|
||||
selDistTest (\act -> select $ distinct (return ()) >> act)
|
||||
|
||||
#if defined(WITH_POSTGRESQL)
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testSelectDistinctOn :: SpecWith (Arg (IO ()))
|
||||
testSelectDistinctOn = do
|
||||
describe "SELECT DISTINCT ON" $ do
|
||||
it "works on a simple example" $ do
|
||||
run $ do
|
||||
@ -914,22 +1067,30 @@ main = do
|
||||
q bp $ return bp
|
||||
let cmp = (blogPostAuthorId &&& blogPostTitle) . entityVal
|
||||
liftIO $ ret `shouldBe` L.sortBy (comparing cmp) [bpA, bpB, bpC]
|
||||
|
||||
it "works on a slightly less simple example (two distinctOn calls, orderBy)" $
|
||||
slightlyLessSimpleTest $ \bp act ->
|
||||
distinctOn [don (bp ^. BlogPostAuthorId)] $
|
||||
distinctOn [don (bp ^. BlogPostTitle)] $ do
|
||||
orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
|
||||
act
|
||||
|
||||
it "works on a slightly less simple example (one distinctOn call, orderBy)" $ do
|
||||
slightlyLessSimpleTest $ \bp act ->
|
||||
distinctOn [don (bp ^. BlogPostAuthorId), don (bp ^. BlogPostTitle)] $ do
|
||||
orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
|
||||
act
|
||||
|
||||
it "works on a slightly less simple example (distinctOnOrderBy)" $ do
|
||||
slightlyLessSimpleTest $ \bp ->
|
||||
distinctOnOrderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
|
||||
#endif
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testCoasleceDefault :: SpecWith (Arg (IO ()))
|
||||
testCoasleceDefault = do
|
||||
describe "coalesce/coalesceDefault" $ do
|
||||
it "works on a simple example" $
|
||||
run $ do
|
||||
@ -979,6 +1140,13 @@ main = do
|
||||
]
|
||||
|
||||
#if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL)
|
||||
testPostgresqlCoalesce >> testMysqlCoalesce
|
||||
#else
|
||||
testSqliteCoalesce
|
||||
#endif
|
||||
|
||||
testPostgresqlCoalesce :: SpecWith (Arg (IO ()))
|
||||
testPostgresqlCoalesce = do
|
||||
it "works on PostgreSQL and MySQL with <2 arguments" $
|
||||
run $ do
|
||||
_ :: [Value (Maybe Int)] <-
|
||||
@ -986,14 +1154,30 @@ main = do
|
||||
from $ \p -> do
|
||||
return (coalesce [p ^. PersonAge])
|
||||
return ()
|
||||
#else
|
||||
|
||||
testMysqlCoalesce :: SpecWith (Arg (IO ()))
|
||||
testMysqlCoalesce = do
|
||||
it "works on PostgreSQL and MySQL with <2 arguments" $
|
||||
run $ do
|
||||
_ :: [Value (Maybe Int)] <-
|
||||
select $
|
||||
from $ \p -> do
|
||||
return (coalesce [p ^. PersonAge])
|
||||
return ()
|
||||
|
||||
testSqliteCoalesce :: SpecWith (Arg (IO ()))
|
||||
testSqliteCoalesce = do
|
||||
it "throws an exception on SQLite with <2 arguments" $
|
||||
run (select $
|
||||
from $ \p -> do
|
||||
return (coalesce [p ^. PersonAge]) :: SqlQuery (SqlExpr (Value (Maybe Int))))
|
||||
`shouldThrow` (\(_ :: SqliteException) -> True)
|
||||
#endif
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testTextFunctions :: SpecWith (Arg (IO ()))
|
||||
testTextFunctions = do
|
||||
describe "text functions" $ do
|
||||
it "like, (%) and (++.) work on a simple example" $
|
||||
run $ do
|
||||
@ -1010,6 +1194,11 @@ main = do
|
||||
nameContains "iv" [p4e]
|
||||
|
||||
#if defined(WITH_POSTGRESQL)
|
||||
testPostgresqlTextFunction
|
||||
#endif
|
||||
|
||||
testPostgresqlTextFunction :: SpecWith (Arg (IO ()))
|
||||
testPostgresqlTextFunction = do
|
||||
it "ilike, (%) and (++.) work on a simple example on PostgreSQL" $
|
||||
run $ do
|
||||
[p1e, _, p3e, _, p5e] <- mapM insert' [p1, p2, p3, p4, p5]
|
||||
@ -1022,8 +1211,13 @@ main = do
|
||||
liftIO $ ret `shouldBe` expected
|
||||
nameContains "mi" [p3e, p5e]
|
||||
nameContains "JOHN" [p1e]
|
||||
#endif
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testDelete :: SpecWith (Arg (IO ()))
|
||||
testDelete = do
|
||||
describe "delete" $
|
||||
it "works on a simple example" $
|
||||
run $ do
|
||||
@ -1047,7 +1241,11 @@ main = do
|
||||
ret3 <- getAll
|
||||
liftIO $ (n, ret3) `shouldBe` (2, [])
|
||||
|
||||
describe "update" $ do
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
testPostgresqlUpdate :: SpecWith (Arg (IO ()))
|
||||
testPostgresqlUpdate = do
|
||||
it "works on a simple example" $
|
||||
run $ do
|
||||
p1k <- insert p1
|
||||
@ -1067,24 +1265,71 @@ main = do
|
||||
return p
|
||||
-- PostgreSQL: nulls are bigger than data, and update returns
|
||||
-- matched rows, not actually changed rows.
|
||||
#if defined(WITH_POSTGRESQL)
|
||||
liftIO $ n `shouldBe` 2
|
||||
liftIO $ ret `shouldBe` [ Entity p1k (Person anon (Just 73) Nothing 1)
|
||||
, Entity p2k (Person anon Nothing (Just 37) 2)
|
||||
, Entity p3k p3 ]
|
||||
|
||||
testMysqlUpdate :: SpecWith (Arg (IO ()))
|
||||
testMysqlUpdate = do
|
||||
it "works on a simple example" $
|
||||
run $ do
|
||||
p1k <- insert p1
|
||||
p2k <- insert p2
|
||||
p3k <- insert p3
|
||||
let anon = "Anonymous"
|
||||
() <- update $ \p -> do
|
||||
set p [ PersonName =. val anon
|
||||
, PersonAge *=. just (val 2) ]
|
||||
where_ (p ^. PersonName !=. val "Mike")
|
||||
n <- updateCount $ \p -> do
|
||||
set p [ PersonAge +=. just (val 1) ]
|
||||
where_ (p ^. PersonName !=. val "Mike")
|
||||
ret <- select $
|
||||
from $ \p -> do
|
||||
orderBy [ asc (p ^. PersonName), asc (p ^. PersonAge) ]
|
||||
return p
|
||||
-- MySQL: nulls appear first, and update returns actual number
|
||||
-- of changed rows
|
||||
#elif defined(WITH_MYSQL)
|
||||
liftIO $ n `shouldBe` 1
|
||||
liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing (Just 37) 2)
|
||||
, Entity p1k (Person anon (Just 73) Nothing 1)
|
||||
, Entity p3k p3 ]
|
||||
#else
|
||||
|
||||
testSqliteUpdate :: SpecWith (Arg (IO ()))
|
||||
testSqliteUpdate = do
|
||||
it "works on a simple example" $
|
||||
run $ do
|
||||
p1k <- insert p1
|
||||
p2k <- insert p2
|
||||
p3k <- insert p3
|
||||
let anon = "Anonymous"
|
||||
() <- update $ \p -> do
|
||||
set p [ PersonName =. val anon
|
||||
, PersonAge *=. just (val 2) ]
|
||||
where_ (p ^. PersonName !=. val "Mike")
|
||||
n <- updateCount $ \p -> do
|
||||
set p [ PersonAge +=. just (val 1) ]
|
||||
where_ (p ^. PersonName !=. val "Mike")
|
||||
ret <- select $
|
||||
from $ \p -> do
|
||||
orderBy [ asc (p ^. PersonName), asc (p ^. PersonAge) ]
|
||||
return p
|
||||
-- SQLite: nulls appear first, update returns matched rows.
|
||||
liftIO $ n `shouldBe` 2
|
||||
liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing (Just 37) 2)
|
||||
, Entity p1k (Person anon (Just 73) Nothing 1)
|
||||
, Entity p3k p3 ]
|
||||
|
||||
testUpdate :: SpecWith (Arg (IO ()))
|
||||
testUpdate = do
|
||||
describe "update" $ do
|
||||
#if defined(WITH_POSTGRESQL)
|
||||
testPostgresqlUpdate
|
||||
#elif defined(WITH_MYSQL)
|
||||
testMysqlUpdate
|
||||
#else
|
||||
testSqliteUpdate
|
||||
#endif
|
||||
|
||||
it "works with a subexpression having COUNT(*)" $
|
||||
@ -1149,9 +1394,9 @@ main = do
|
||||
l1k <- insert l1
|
||||
l2k <- insert l2
|
||||
l3k <- insert l3
|
||||
mapM_ (\k -> insert $ Deed k l1k) (map show [1..3])
|
||||
mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int])
|
||||
|
||||
mapM_ (\k -> insert $ Deed k l3k) (map show [4..10])
|
||||
mapM_ (\k -> insert $ Deed k l3k) (map show [4..10 :: Int])
|
||||
|
||||
(ret :: [(Value (Key Lord), Value Int)]) <- select $ from $
|
||||
\ ( lord `InnerJoin` deed ) -> do
|
||||
@ -1178,6 +1423,12 @@ main = do
|
||||
liftIO $ ret `shouldBe` [ (Entity p1k p1, Value (3 :: Int))
|
||||
, (Entity p3k p3, Value 7) ]
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testListOfValues :: SpecWith (Arg (IO ()))
|
||||
testListOfValues = do
|
||||
describe "lists of values" $ do
|
||||
it "IN works for valList" $
|
||||
run $ do
|
||||
@ -1268,6 +1519,12 @@ main = do
|
||||
return p
|
||||
liftIO $ ret `shouldBe` [ Entity p2k p2 ]
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testListFields :: SpecWith (Arg (IO ()))
|
||||
testListFields = do
|
||||
describe "list fields" $ do
|
||||
-- <https://github.com/prowdsponsor/esqueleto/issues/100>
|
||||
it "can update list fields" $
|
||||
@ -1277,6 +1534,12 @@ main = do
|
||||
set p [ CcListNames =. val ["fred"]]
|
||||
where_ (p ^. CcListId ==. val cclist)
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testInsertsBySelect :: SpecWith (Arg (IO ()))
|
||||
testInsertsBySelect = do
|
||||
describe "inserts by select" $ do
|
||||
it "IN works for insertSelect" $
|
||||
run $ do
|
||||
@ -1288,6 +1551,12 @@ main = do
|
||||
ret <- select $ from (\(_::(SqlExpr (Entity BlogPost))) -> return countRows)
|
||||
liftIO $ ret `shouldBe` [Value (3::Int)]
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testInsertsBySelectReturnsCount :: SpecWith (Arg (IO ()))
|
||||
testInsertsBySelectReturnsCount = do
|
||||
describe "inserts by select, returns count" $ do
|
||||
it "IN works for insertSelectCount" $
|
||||
run $ do
|
||||
@ -1300,6 +1569,12 @@ main = do
|
||||
liftIO $ ret `shouldBe` [Value (3::Int)]
|
||||
liftIO $ cnt `shouldBe` 3
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testMathFunctions :: SpecWith (Arg (IO ()))
|
||||
testMathFunctions = do
|
||||
describe "Math-related functions" $ do
|
||||
it "rand returns result in random order" $
|
||||
run $ do
|
||||
@ -1334,6 +1609,12 @@ main = do
|
||||
let [Value a, Value b] = ret
|
||||
liftIO $ max (abs (a - 6.8)) (abs (b - 7.7)) `shouldSatisfy` (< 0.01)
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testCase :: SpecWith (Arg (IO ()))
|
||||
testCase = do
|
||||
describe "case" $ do
|
||||
it "Works for a simple value based when - False" $
|
||||
run $ do
|
||||
@ -1380,6 +1661,12 @@ main = do
|
||||
|
||||
liftIO $ ret `shouldBe` [ Value (3) ]
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testLocking :: SpecWith (Arg (IO ()))
|
||||
testLocking = do
|
||||
describe "locking" $ do
|
||||
-- The locking clause is the last one, so try to use many
|
||||
-- others to test if it's at the right position. We don't
|
||||
@ -1422,6 +1709,12 @@ main = do
|
||||
it "looks sane for ForShare" $ sanityCheck ForShare "FOR SHARE"
|
||||
it "looks sane for LockInShareMode" $ sanityCheck LockInShareMode "LOCK IN SHARE MODE"
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testCountingRows :: SpecWith (Arg (IO ()))
|
||||
testCountingRows = do
|
||||
describe "counting rows" $ do
|
||||
forM_ [ ("count (test A)", count . (^. PersonAge), 4)
|
||||
, ("count (test B)", count . (^. PersonWeight), 5)
|
||||
@ -1439,13 +1732,13 @@ main = do
|
||||
[Value n] <- select $ from $ return . countKind
|
||||
liftIO $ (n :: Int) `shouldBe` expected
|
||||
|
||||
describe "PostgreSQL module" $ do
|
||||
it "should be tested on the PostgreSQL database" $
|
||||
#if !defined(WITH_POSTGRESQL)
|
||||
pendingWith "test suite not running under PostgreSQL, skipping"
|
||||
#else
|
||||
(return () :: IO ())
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
testPostgresModule :: SpecWith (Arg (IO ()))
|
||||
testPostgresModule = do
|
||||
describe "PostgreSQL module" $ do
|
||||
it "arrayAgg looks sane" $
|
||||
run $ do
|
||||
let people = [p1, p2, p3, p4, p5]
|
||||
@ -1468,8 +1761,53 @@ main = do
|
||||
run $ do
|
||||
[Value (ret :: String)] <- select $ return (EP.chr (val 65))
|
||||
liftIO $ ret `shouldBe` "A"
|
||||
|
||||
it "works with now" $
|
||||
run $ do
|
||||
nowDb <- select $ return EP.now_
|
||||
nowUtc <- liftIO getCurrentTime
|
||||
let halfSecond = realToFrac (0.5 :: Double)
|
||||
|
||||
-- | Check the result is not null
|
||||
liftIO $ nowDb `shouldSatisfy` (not . null)
|
||||
|
||||
-- | Unpack the now value
|
||||
let (Value now: _) = nowDb
|
||||
|
||||
-- | Get the time diff and check it's less than half a second
|
||||
liftIO $ diffUTCTime nowUtc now `shouldSatisfy` (< halfSecond)
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
hspec $ do
|
||||
testSelect
|
||||
testSelectSource
|
||||
testSelectFrom
|
||||
testSelectJoin
|
||||
testSelectWhere
|
||||
testSelectOrderBy
|
||||
testSelectDistinct
|
||||
|
||||
#if defined(WITH_POSTGRESQL)
|
||||
testSelectDistinctOn
|
||||
testPostgresModule
|
||||
#endif
|
||||
|
||||
testCoasleceDefault
|
||||
testTextFunctions
|
||||
testDelete
|
||||
testUpdate
|
||||
testListOfValues
|
||||
testListFields
|
||||
testInsertsBySelect
|
||||
testMathFunctions
|
||||
testCase
|
||||
testLocking
|
||||
testCountingRows
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
|
||||
@ -1485,7 +1823,6 @@ insert' v = flip Entity v <$> insert v
|
||||
type RunDbMonad m = ( MonadBaseControl IO m, MonadIO m, MonadLogger m
|
||||
, R.MonadThrow m )
|
||||
|
||||
#if defined (WITH_POSTGRESQL) || defined (WITH_MYSQL)
|
||||
-- With SQLite and in-memory databases, a separate connection implies a
|
||||
-- separate database. With 'actual databases', the data is persistent and
|
||||
-- thus must be cleaned after each test.
|
||||
@ -1516,7 +1853,6 @@ cleanDB = do
|
||||
delete $ from $ \(_ :: SqlExpr (Entity Point)) -> return ()
|
||||
|
||||
delete $ from $ \(_ :: SqlExpr (Entity Numbers)) -> return ()
|
||||
#endif
|
||||
|
||||
|
||||
run, runSilent, runVerbose :: (forall m. RunDbMonad m => SqlPersistT (R.ResourceT m) a) -> IO a
|
||||
|
||||
Loading…
Reference in New Issue
Block a user