From fe4a78d4b66f92986919b5866d4335f291db3134 Mon Sep 17 00:00:00 2001 From: Fintan Halpenny Date: Wed, 9 Aug 2017 00:19:09 +0100 Subject: [PATCH] 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. --- esqueleto.cabal | 18 +- test/Test.hs | 2822 ++++++++++++++++++++++++++--------------------- 2 files changed, 1587 insertions(+), 1253 deletions(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index debe59f..815bf9d 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -107,18 +107,16 @@ test-suite test -- This library , esqueleto - if flag(postgresql) - build-depends: - postgresql-simple >= 0.2 - , postgresql-libpq >= 0.6 - , persistent-postgresql >= 2.0 + , postgresql-simple >= 0.2 + , postgresql-libpq >= 0.6 + , persistent-postgresql >= 2.0 + , 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) - build-depends: - mysql-simple >= 0.2.2.3 - , mysql >= 0.1.1.3 - , persistent-mysql >= 2.0 - cpp-options: -DWITH_MYSQL diff --git a/test/Test.hs b/test/Test.hs index 5616f71..105e4e7 100644 --- a/test/Test.hs +++ b/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,1343 +131,1683 @@ 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 - describe "select" $ do - it "works for a single value" $ - run $ do - ret <- select $ return $ val (3 :: Int) - liftIO $ ret `shouldBe` [ Value 3 ] +p2 :: Person +p2 = Person "Rachel" Nothing (Just 37) 2 - it "works for a pair of a single value and ()" $ - run $ do - ret <- select $ return (val (3 :: Int), ()) - liftIO $ ret `shouldBe` [ (Value 3, ()) ] +p3 :: Person +p3 = Person "Mike" (Just 17) Nothing 3 - it "works for a single ()" $ - run $ do - ret <- select $ return () - liftIO $ ret `shouldBe` [ () ] +p4 :: Person +p4 = Person "Livia" (Just 17) (Just 18) 4 - it "works for a single NULL value" $ - run $ do - ret <- select $ return nothing - liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ] +p5 :: Person +p5 = Person "Mitch" Nothing Nothing 5 - describe "selectSource" $ do - it "works for a simple example" $ - run $ do - let query = selectSource $ - from $ \person -> - return person - p1e <- insert' p1 - ret <- query $$ CL.consume - liftIO $ ret `shouldBe` [ p1e ] +l1 :: Lord +l1 = Lord "Cornwall" (Just 36) - it "can run a query many times" $ - run $ do - let query = selectSource $ - from $ \person -> - return person - p1e <- insert' p1 - ret0 <- query $$ CL.consume - ret1 <- query $$ CL.consume - liftIO $ ret0 `shouldBe` [ p1e ] - liftIO $ ret1 `shouldBe` [ p1e ] +l2 :: Lord +l2 = Lord "Dorset" Nothing - it "works on repro" $ do - let selectPerson :: R.MonadResource m => String -> Source (SqlPersistT m) (Key Person) - selectPerson name = do - let source = selectSource $ from $ \person -> do - where_ $ person ^. PersonName ==. val name - return $ person ^. PersonId - source =$= CL.map unValue - run $ do - p1e <- insert' p1 - p2e <- insert' p2 - r1 <- selectPerson (personName p1) $$ CL.consume - r2 <- selectPerson (personName p2) $$ CL.consume - liftIO $ do - r1 `shouldBe` [ entityKey p1e ] - r2 `shouldBe` [ entityKey p2e ] +l3 :: Lord +l3 = Lord "Chester" (Just 17) - describe "select/from" $ do - it "works for a simple example" $ - run $ do - p1e <- insert' p1 - ret <- select $ - from $ \person -> - return person - liftIO $ ret `shouldBe` [ p1e ] - - it "works for a simple self-join (one entity)" $ - run $ do - p1e <- insert' p1 - ret <- select $ - from $ \(person1, person2) -> - return (person1, person2) - liftIO $ ret `shouldBe` [ (p1e, p1e) ] - - it "works for a simple self-join (two entities)" $ - run $ do - p1e <- insert' p1 - p2e <- insert' p2 - ret <- select $ - from $ \(person1, person2) -> - return (person1, person2) - liftIO $ ret `shouldSatisfy` sameElementsAs [ (p1e, p1e) - , (p1e, p2e) - , (p2e, p1e) - , (p2e, p2e) ] - - it "works for a self-join via sub_select" $ - run $ do - p1k <- insert p1 - p2k <- insert p2 - _f1k <- insert (Follow p1k p2k) - _f2k <- insert (Follow p2k p1k) - ret <- select $ - from $ \followA -> do - let subquery = - from $ \followB -> do - where_ $ followA ^. FollowFollower ==. followB ^. FollowFollowed - return $ followB ^. FollowFollower - where_ $ followA ^. FollowFollowed ==. sub_select subquery - return followA - liftIO $ length ret `shouldBe` 2 - - it "works for a self-join via exists" $ - run $ do - p1k <- insert p1 - p2k <- insert p2 - _f1k <- insert (Follow p1k p2k) - _f2k <- insert (Follow p2k p1k) - ret <- select $ - from $ \followA -> do - where_ $ exists $ - from $ \followB -> - where_ $ followA ^. FollowFollower ==. followB ^. FollowFollowed - return followA - liftIO $ length ret `shouldBe` 2 +------------------------------------------------------------------------------- - it "works for a simple projection" $ - run $ do - p1k <- insert p1 - p2k <- insert p2 - ret <- select $ - from $ \p -> - return (p ^. PersonId, p ^. PersonName) - liftIO $ ret `shouldBe` [ (Value p1k, Value (personName p1)) - , (Value p2k, Value (personName p2)) ] +testSelect :: SpecWith (Arg (IO ())) +testSelect = do + describe "select" $ do + it "works for a single value" $ + run $ do + ret <- select $ return $ val (3 :: Int) + liftIO $ ret `shouldBe` [ Value 3 ] - it "works for a simple projection with a simple implicit self-join" $ - run $ do - _ <- insert p1 - _ <- insert p2 - ret <- select $ - from $ \(pa, pb) -> - return (pa ^. PersonName, pb ^. PersonName) - liftIO $ ret `shouldSatisfy` sameElementsAs - [ (Value (personName p1), Value (personName p1)) - , (Value (personName p1), Value (personName p2)) - , (Value (personName p2), Value (personName p1)) - , (Value (personName p2), Value (personName p2)) ] + it "works for a pair of a single value and ()" $ + run $ do + ret <- select $ return (val (3 :: Int), ()) + liftIO $ ret `shouldBe` [ (Value 3, ()) ] - it "works with many kinds of LIMITs and OFFSETs" $ - run $ do - [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4] - let people = from $ \p -> do - orderBy [asc (p ^. PersonName)] - return p - ret1 <- select $ do - p <- people - limit 2 - limit 1 - return p - liftIO $ ret1 `shouldBe` [ p1e ] - ret2 <- select $ do - p <- people - limit 1 - limit 2 - return p - liftIO $ ret2 `shouldBe` [ p1e, p4e ] - ret3 <- select $ do - p <- people - offset 3 - offset 2 - return p - liftIO $ ret3 `shouldBe` [ p3e, p2e ] - ret4 <- select $ do - p <- people - offset 3 - limit 5 - offset 2 - limit 3 - offset 1 - limit 2 - return p - liftIO $ ret4 `shouldBe` [ p4e, p3e ] - ret5 <- select $ do - p <- people - offset 1000 - limit 1 - limit 1000 - offset 0 - return p - liftIO $ ret5 `shouldBe` [ p1e, p4e, p3e, p2e ] + it "works for a single ()" $ + run $ do + ret <- select $ return () + liftIO $ ret `shouldBe` [ () ] - it "works with non-id primary key" $ - run $ do - let fc = Frontcover number "" - number = 101 - Right thePk = keyFromValues [toPersistValue number] - fcPk <- insert fc - [Entity _ ret] <- select $ from return - liftIO $ do - ret `shouldBe` fc - fcPk `shouldBe` thePk - - it "works when returning a custom non-composite primary key from a query" $ - run $ do - let name = "foo" - t = Tag name - Right thePk = keyFromValues [toPersistValue name] - tagPk <- insert t - [Value ret] <- select $ from $ \t' -> return (t'^.TagId) - liftIO $ do - ret `shouldBe` thePk - thePk `shouldBe` tagPk - - it "works when returning a composite primary key from a query" $ - run $ do - let p = Point 10 20 "" - thePk <- insert p - [Value ppk] <- select $ from $ \p' -> return (p'^.PointId) - liftIO $ ppk `shouldBe` thePk + it "works for a single NULL value" $ + run $ do + ret <- select $ return nothing + liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ] - describe "select/JOIN" $ do - it "works with a LEFT OUTER JOIN" $ - run $ do - p1e <- insert' p1 - p2e <- insert' p2 - p3e <- insert' p3 - p4e <- insert' p4 - b12e <- insert' $ BlogPost "b" (entityKey p1e) - b11e <- insert' $ BlogPost "a" (entityKey p1e) - b31e <- insert' $ BlogPost "c" (entityKey p3e) - ret <- select $ - from $ \(p `LeftOuterJoin` mb) -> do - on (just (p ^. PersonId) ==. mb ?. BlogPostAuthorId) - orderBy [ asc (p ^. PersonName), asc (mb ?. BlogPostTitle) ] - return (p, mb) - liftIO $ ret `shouldBe` [ (p1e, Just b11e) - , (p1e, Just b12e) - , (p4e, Nothing) - , (p3e, Just b31e) - , (p2e, Nothing) ] +------------------------------------------------------------------------------- - it "typechecks (A LEFT OUTER JOIN (B LEFT OUTER JOIN C))" $ - let _ = run $ - select $ - from $ \(a `LeftOuterJoin` (b `LeftOuterJoin` c)) -> - let _ = [a, b, c] :: [ SqlExpr (Entity Person) ] - in return a - in return () :: IO () - it "typechecks ((A LEFT OUTER JOIN B) LEFT OUTER JOIN C)" $ - let _ = run $ - select $ - from $ \((a `LeftOuterJoin` b) `LeftOuterJoin` c) -> - let _ = [a, b, c] :: [ SqlExpr (Entity Person) ] - in return a - in return () :: IO () +testSelectSource :: SpecWith (Arg (IO ())) +testSelectSource = do + describe "selectSource" $ do + it "works for a simple example" $ + run $ do + let query = selectSource $ + from $ \person -> + return person + p1e <- insert' p1 + ret <- query $$ CL.consume + liftIO $ ret `shouldBe` [ p1e ] - it "throws an error for using on without joins" $ - run (select $ - from $ \(p, mb) -> do - on (just (p ^. PersonId) ==. mb ?. BlogPostAuthorId) - orderBy [ asc (p ^. PersonName), asc (mb ?. BlogPostTitle) ] - return (p, mb) - ) `shouldThrow` (\(OnClauseWithoutMatchingJoinException _) -> True) + it "can run a query many times" $ + run $ do + let query = selectSource $ + from $ \person -> + return person + p1e <- insert' p1 + ret0 <- query $$ CL.consume + ret1 <- query $$ CL.consume + liftIO $ ret0 `shouldBe` [ p1e ] + liftIO $ ret1 `shouldBe` [ p1e ] - it "throws an error for using too many ons" $ - run (select $ - from $ \(p `FullOuterJoin` mb) -> do - on (just (p ^. PersonId) ==. mb ?. BlogPostAuthorId) - on (just (p ^. PersonId) ==. mb ?. BlogPostAuthorId) - orderBy [ asc (p ^. PersonName), asc (mb ?. BlogPostTitle) ] - return (p, mb) - ) `shouldThrow` (\(OnClauseWithoutMatchingJoinException _) -> True) + it "works on repro" $ do + let selectPerson :: R.MonadResource m => String -> Source (SqlPersistT m) (Key Person) + selectPerson name = do + let source = selectSource $ from $ \person -> do + where_ $ person ^. PersonName ==. val name + return $ person ^. PersonId + source =$= CL.map unValue + run $ do + p1e <- insert' p1 + p2e <- insert' p2 + r1 <- selectPerson (personName p1) $$ CL.consume + r2 <- selectPerson (personName p2) $$ CL.consume + liftIO $ do + r1 `shouldBe` [ entityKey p1e ] + r2 `shouldBe` [ entityKey p2e ] - it "works with ForeignKey to a non-id primary key returning one entity" $ - run $ do - let fc = Frontcover number "" - article = Article "Esqueleto supports composite pks!" number - number = 101 - Right thePk = keyFromValues [toPersistValue number] - fcPk <- insert fc - insert_ article - [Entity _ retFc] <- select $ - from $ \(a `InnerJoin` f) -> do - on (f^.FrontcoverNumber ==. a^.ArticleFrontcoverNumber) - return f - liftIO $ do - retFc `shouldBe` fc - fcPk `shouldBe` thePk - it "works with a ForeignKey to a non-id primary key returning both entities" $ - run $ do - let fc = Frontcover number "" - article = Article "Esqueleto supports composite pks!" number - number = 101 - Right thePk = keyFromValues [toPersistValue number] - fcPk <- insert fc - insert_ article - [(Entity _ retFc, Entity _ retArt)] <- select $ - from $ \(a `InnerJoin` f) -> do - on (f^.FrontcoverNumber ==. a^.ArticleFrontcoverNumber) - return (f, a) - liftIO $ do - retFc `shouldBe` fc - retArt `shouldBe` article - fcPk `shouldBe` thePk - articleFkfrontcover retArt `shouldBe` thePk +------------------------------------------------------------------------------- - it "works with a non-id primary key returning one entity" $ - run $ do - let fc = Frontcover number "" - article = Article2 "Esqueleto supports composite pks!" thePk - number = 101 - Right thePk = keyFromValues [toPersistValue number] - fcPk <- insert fc - insert_ article - [Entity _ retFc] <- select $ - from $ \(a `InnerJoin` f) -> do - on (f^.FrontcoverId ==. a^.Article2FrontcoverId) - return f - liftIO $ do - retFc `shouldBe` fc - fcPk `shouldBe` thePk - it "works with a composite primary key" $ - pendingWith "Persistent does not create the CircleFkPoint constructor. See: https://github.com/yesodweb/persistent/issues/341" - {- - run $ do - let p = Point x y "" - c = Circle x y "" - x = 10 - y = 15 - Right thePk = keyFromValues [toPersistValue x, toPersistValue y] - pPk <- insert p - insert_ c - [Entity _ ret] <- select $ from $ \(c' `InnerJoin` p') -> do - on (p'^.PointId ==. c'^.CircleFkpoint) - return p' - liftIO $ do - ret `shouldBe` p - pPk `shouldBe` thePk - -} +testSelectFrom :: SpecWith (Arg (IO ())) +testSelectFrom = do + describe "select/from" $ do + it "works for a simple example" $ + run $ do + p1e <- insert' p1 + ret <- select $ + from $ \person -> + return person + liftIO $ ret `shouldBe` [ p1e ] - it "works when joining via a non-id primary key" $ - run $ do - let fc = Frontcover number "" - article = Article "Esqueleto supports composite pks!" number - tag = Tag "foo" - otherTag = Tag "ignored" - number = 101 - insert_ fc - insert_ otherTag - artId <- insert article - tagId <- insert tag - insert_ $ ArticleTag artId tagId - [(Entity _ retArt, Entity _ retTag)] <- select $ - from $ \(a `InnerJoin` at `InnerJoin` t) -> do - on (t^.TagId ==. at^.ArticleTagTagId) - on (a^.ArticleId ==. at^.ArticleTagArticleId) - return (a, t) - liftIO $ do - retArt `shouldBe` article - retTag `shouldBe` tag + it "works for a simple self-join (one entity)" $ + run $ do + p1e <- insert' p1 + ret <- select $ + from $ \(person1, person2) -> + return (person1, person2) + liftIO $ ret `shouldBe` [ (p1e, p1e) ] - it "respects the associativity of joins" $ - run $ do - void $ insert p1 - ps <- select . from $ - \((p :: SqlExpr (Entity Person)) - `LeftOuterJoin` - ((_q :: SqlExpr (Entity Person)) - `InnerJoin` (_r :: SqlExpr (Entity Person)))) -> do - on (val False) -- Inner join is empty - on (val True) + it "works for a simple self-join (two entities)" $ + run $ do + p1e <- insert' p1 + p2e <- insert' p2 + ret <- select $ + from $ \(person1, person2) -> + return (person1, person2) + liftIO $ ret `shouldSatisfy` sameElementsAs [ (p1e, p1e) + , (p1e, p2e) + , (p2e, p1e) + , (p2e, p2e) ] + + it "works for a self-join via sub_select" $ + run $ do + p1k <- insert p1 + p2k <- insert p2 + _f1k <- insert (Follow p1k p2k) + _f2k <- insert (Follow p2k p1k) + ret <- select $ + from $ \followA -> do + let subquery = + from $ \followB -> do + where_ $ followA ^. FollowFollower ==. followB ^. FollowFollowed + return $ followB ^. FollowFollower + where_ $ followA ^. FollowFollowed ==. sub_select subquery + return followA + liftIO $ length ret `shouldBe` 2 + + it "works for a self-join via exists" $ + run $ do + p1k <- insert p1 + p2k <- insert p2 + _f1k <- insert (Follow p1k p2k) + _f2k <- insert (Follow p2k p1k) + ret <- select $ + from $ \followA -> do + where_ $ exists $ + from $ \followB -> + where_ $ followA ^. FollowFollower ==. followB ^. FollowFollowed + return followA + liftIO $ length ret `shouldBe` 2 + + + it "works for a simple projection" $ + run $ do + p1k <- insert p1 + p2k <- insert p2 + ret <- select $ + from $ \p -> + return (p ^. PersonId, p ^. PersonName) + liftIO $ ret `shouldBe` [ (Value p1k, Value (personName p1)) + , (Value p2k, Value (personName p2)) ] + + it "works for a simple projection with a simple implicit self-join" $ + run $ do + _ <- insert p1 + _ <- insert p2 + ret <- select $ + from $ \(pa, pb) -> + return (pa ^. PersonName, pb ^. PersonName) + liftIO $ ret `shouldSatisfy` sameElementsAs + [ (Value (personName p1), Value (personName p1)) + , (Value (personName p1), Value (personName p2)) + , (Value (personName p2), Value (personName p1)) + , (Value (personName p2), Value (personName p2)) ] + + it "works with many kinds of LIMITs and OFFSETs" $ + run $ do + [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4] + let people = from $ \p -> do + orderBy [asc (p ^. PersonName)] + return p + ret1 <- select $ do + p <- people + limit 2 + limit 1 return p - liftIO $ (entityVal <$> ps) `shouldBe` [p1] + liftIO $ ret1 `shouldBe` [ p1e ] + ret2 <- select $ do + p <- people + limit 1 + limit 2 + return p + liftIO $ ret2 `shouldBe` [ p1e, p4e ] + ret3 <- select $ do + p <- people + offset 3 + offset 2 + return p + liftIO $ ret3 `shouldBe` [ p3e, p2e ] + ret4 <- select $ do + p <- people + offset 3 + limit 5 + offset 2 + limit 3 + offset 1 + limit 2 + return p + liftIO $ ret4 `shouldBe` [ p4e, p3e ] + ret5 <- select $ do + p <- people + offset 1000 + limit 1 + limit 1000 + offset 0 + return p + liftIO $ ret5 `shouldBe` [ p1e, p4e, p3e, p2e ] - describe "select/where_" $ do - it "works for a simple example with (==.)" $ - run $ do - p1e <- insert' p1 - _ <- insert' p2 - _ <- insert' p3 - ret <- select $ - from $ \p -> do - where_ (p ^. PersonName ==. val "John") - return p - liftIO $ ret `shouldBe` [ p1e ] + it "works with non-id primary key" $ + run $ do + let fc = Frontcover number "" + number = 101 + Right thePk = keyFromValues [toPersistValue number] + fcPk <- insert fc + [Entity _ ret] <- select $ from return + liftIO $ do + ret `shouldBe` fc + fcPk `shouldBe` thePk - it "works for a simple example with (==.) and (||.)" $ - run $ do - p1e <- insert' p1 - p2e <- insert' p2 - _ <- insert' p3 - ret <- select $ - from $ \p -> do - where_ (p ^. PersonName ==. val "John" ||. p ^. PersonName ==. val "Rachel") - return p - liftIO $ ret `shouldBe` [ p1e, p2e ] + it "works when returning a custom non-composite primary key from a query" $ + run $ do + let name = "foo" + t = Tag name + Right thePk = keyFromValues [toPersistValue name] + tagPk <- insert t + [Value ret] <- select $ from $ \t' -> return (t'^.TagId) + liftIO $ do + ret `shouldBe` thePk + thePk `shouldBe` tagPk - it "works for a simple example with (>.) [uses val . Just]" $ - run $ do - p1e <- insert' p1 - _ <- insert' p2 - _ <- insert' p3 - ret <- select $ - from $ \p -> do - where_ (p ^. PersonAge >. val (Just 17)) - return p - liftIO $ ret `shouldBe` [ p1e ] + it "works when returning a composite primary key from a query" $ + run $ do + let p = Point 10 20 "" + thePk <- insert p + [Value ppk] <- select $ from $ \p' -> return (p'^.PointId) + liftIO $ ppk `shouldBe` thePk - it "works for a simple example with (>.) and not_ [uses just . val]" $ - run $ do - _ <- insert' p1 - _ <- insert' p2 - p3e <- insert' p3 - ret <- select $ - from $ \p -> do - where_ (not_ $ p ^. PersonAge >. just (val 17)) - 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) +------------------------------------------------------------------------------- + + +testSelectJoin :: SpecWith (Arg (IO ())) +testSelectJoin = do + describe "select/JOIN" $ do + it "works with a LEFT OUTER JOIN" $ + run $ do + p1e <- insert' p1 + p2e <- insert' p2 + p3e <- insert' p3 + p4e <- insert' p4 + b12e <- insert' $ BlogPost "b" (entityKey p1e) + b11e <- insert' $ BlogPost "a" (entityKey p1e) + b31e <- insert' $ BlogPost "c" (entityKey p3e) + ret <- select $ + from $ \(p `LeftOuterJoin` mb) -> do + on (just (p ^. PersonId) ==. mb ?. BlogPostAuthorId) + orderBy [ asc (p ^. PersonName), asc (mb ?. BlogPostTitle) ] + return (p, mb) + liftIO $ ret `shouldBe` [ (p1e, Just b11e) + , (p1e, Just b12e) + , (p4e, Nothing) + , (p3e, Just b31e) + , (p2e, Nothing) ] + + it "typechecks (A LEFT OUTER JOIN (B LEFT OUTER JOIN C))" $ + let _ = run $ + select $ + from $ \(a `LeftOuterJoin` (b `LeftOuterJoin` c)) -> + let _ = [a, b, c] :: [ SqlExpr (Entity Person) ] + in return a + in return () :: IO () + + it "typechecks ((A LEFT OUTER JOIN B) LEFT OUTER JOIN C)" $ + let _ = run $ + select $ + from $ \((a `LeftOuterJoin` b) `LeftOuterJoin` c) -> + let _ = [a, b, c] :: [ SqlExpr (Entity Person) ] + in return a + in return () :: IO () + + it "throws an error for using on without joins" $ + run (select $ + from $ \(p, mb) -> do + on (just (p ^. PersonId) ==. mb ?. BlogPostAuthorId) + orderBy [ asc (p ^. PersonName), asc (mb ?. BlogPostTitle) ] + return (p, mb) + ) `shouldThrow` (\(OnClauseWithoutMatchingJoinException _) -> True) + + it "throws an error for using too many ons" $ + run (select $ + from $ \(p `FullOuterJoin` mb) -> do + on (just (p ^. PersonId) ==. mb ?. BlogPostAuthorId) + on (just (p ^. PersonId) ==. mb ?. BlogPostAuthorId) + orderBy [ asc (p ^. PersonName), asc (mb ?. BlogPostTitle) ] + return (p, mb) + ) `shouldThrow` (\(OnClauseWithoutMatchingJoinException _) -> True) + + it "works with ForeignKey to a non-id primary key returning one entity" $ + run $ do + let fc = Frontcover number "" + article = Article "Esqueleto supports composite pks!" number + number = 101 + Right thePk = keyFromValues [toPersistValue number] + fcPk <- insert fc + insert_ article + [Entity _ retFc] <- select $ + from $ \(a `InnerJoin` f) -> do + on (f^.FrontcoverNumber ==. a^.ArticleFrontcoverNumber) + return f + liftIO $ do + retFc `shouldBe` fc + fcPk `shouldBe` thePk + + it "works with a ForeignKey to a non-id primary key returning both entities" $ + run $ do + let fc = Frontcover number "" + article = Article "Esqueleto supports composite pks!" number + number = 101 + Right thePk = keyFromValues [toPersistValue number] + fcPk <- insert fc + insert_ article + [(Entity _ retFc, Entity _ retArt)] <- select $ + from $ \(a `InnerJoin` f) -> do + on (f^.FrontcoverNumber ==. a^.ArticleFrontcoverNumber) + return (f, a) + liftIO $ do + retFc `shouldBe` fc + retArt `shouldBe` article + fcPk `shouldBe` thePk + articleFkfrontcover retArt `shouldBe` thePk + + it "works with a non-id primary key returning one entity" $ + run $ do + let fc = Frontcover number "" + article = Article2 "Esqueleto supports composite pks!" thePk + number = 101 + Right thePk = keyFromValues [toPersistValue number] + fcPk <- insert fc + insert_ article + [Entity _ retFc] <- select $ + from $ \(a `InnerJoin` f) -> do + on (f^.FrontcoverId ==. a^.Article2FrontcoverId) + return f + liftIO $ do + retFc `shouldBe` fc + fcPk `shouldBe` thePk + + it "works with a composite primary key" $ + pendingWith "Persistent does not create the CircleFkPoint constructor. See: https://github.com/yesodweb/persistent/issues/341" + {- + run $ do + let p = Point x y "" + c = Circle x y "" + x = 10 + y = 15 + Right thePk = keyFromValues [toPersistValue x, toPersistValue y] + pPk <- insert p + insert_ c + [Entity _ ret] <- select $ from $ \(c' `InnerJoin` p') -> do + on (p'^.PointId ==. c'^.CircleFkpoint) + return p' + liftIO $ do + ret `shouldBe` p + pPk `shouldBe` thePk + -} + + it "works when joining via a non-id primary key" $ + run $ do + let fc = Frontcover number "" + article = Article "Esqueleto supports composite pks!" number + tag = Tag "foo" + otherTag = Tag "ignored" + number = 101 + insert_ fc + insert_ otherTag + artId <- insert article + tagId <- insert tag + insert_ $ ArticleTag artId tagId + [(Entity _ retArt, Entity _ retTag)] <- select $ + from $ \(a `InnerJoin` at `InnerJoin` t) -> do + on (t^.TagId ==. at^.ArticleTagTagId) + on (a^.ArticleId ==. at^.ArticleTagArticleId) + return (a, t) + liftIO $ do + retArt `shouldBe` article + retTag `shouldBe` tag + + it "respects the associativity of joins" $ + run $ do + void $ insert p1 + ps <- select . from $ + \((p :: SqlExpr (Entity Person)) + `LeftOuterJoin` + ((_q :: SqlExpr (Entity Person)) + `InnerJoin` (_r :: SqlExpr (Entity Person)))) -> do + on (val False) -- Inner join is empty + on (val True) + 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 + p1e <- insert' p1 + _ <- insert' p2 + _ <- insert' p3 + ret <- select $ + from $ \p -> do + where_ (p ^. PersonName ==. val "John") + return p + liftIO $ ret `shouldBe` [ p1e ] + + it "works for a simple example with (==.) and (||.)" $ + run $ do + p1e <- insert' p1 + p2e <- insert' p2 + _ <- insert' p3 + ret <- select $ + from $ \p -> do + where_ (p ^. PersonName ==. val "John" ||. p ^. PersonName ==. val "Rachel") + return p + liftIO $ ret `shouldBe` [ p1e, p2e ] + + it "works for a simple example with (>.) [uses val . Just]" $ + run $ do + p1e <- insert' p1 + _ <- insert' p2 + _ <- insert' p3 + ret <- select $ + from $ \p -> do + where_ (p ^. PersonAge >. val (Just 17)) + return p + liftIO $ ret `shouldBe` [ p1e ] + + it "works for a simple example with (>.) and not_ [uses just . val]" $ + run $ do + _ <- insert' p1 + _ <- insert' p2 + p3e <- insert' p3 + ret <- select $ + from $ \p -> do + where_ (not_ $ p ^. PersonAge >. just (val 17)) + return p + liftIO $ ret `shouldBe` [ p3e ] + #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_" $ - run $ do - _ <- insert' p1 - _ <- insert' p2 - _ <- insert' p3 - _ <- insert' p4 - ret <- select $ - from $ \p-> - return $ joinV $ avg_ (p ^. PersonAge) - liftIO $ ret `shouldBe` [ Value $ Just ((36 + 17 + 17) / 3 :: Double) ] + it "works with avg_" $ + run $ do + _ <- insert' p1 + _ <- insert' p2 + _ <- insert' p3 + _ <- insert' p4 + ret <- select $ + from $ \p-> + return $ joinV $ avg_ (p ^. PersonAge) + liftIO $ ret `shouldBe` [ Value $ Just ((36 + 17 + 17) / 3 :: Double) ] - it "works with min_" $ - run $ do - _ <- insert' p1 - _ <- insert' p2 - _ <- insert' p3 - _ <- insert' p4 - ret <- select $ - from $ \p-> - return $ joinV $ min_ (p ^. PersonAge) - liftIO $ ret `shouldBe` [ Value $ Just (17 :: Int) ] + it "works with min_" $ + run $ do + _ <- insert' p1 + _ <- insert' p2 + _ <- insert' p3 + _ <- insert' p4 + ret <- select $ + from $ \p-> + return $ joinV $ min_ (p ^. PersonAge) + liftIO $ ret `shouldBe` [ Value $ Just (17 :: Int) ] - it "works with max_" $ - run $ do - _ <- insert' p1 - _ <- insert' p2 - _ <- insert' p3 - _ <- insert' p4 - ret <- select $ - from $ \p-> - return $ joinV $ max_ (p ^. PersonAge) - liftIO $ ret `shouldBe` [ Value $ Just (36 :: Int) ] + it "works with max_" $ + run $ do + _ <- insert' p1 + _ <- insert' p2 + _ <- insert' p3 + _ <- insert' p4 + ret <- select $ + from $ \p-> + return $ joinV $ max_ (p ^. PersonAge) + liftIO $ ret `shouldBe` [ Value $ Just (36 :: Int) ] - it "works with lower_" $ - run $ do - p1e <- insert' p1 - p2e@(Entity _ bob) <- insert' $ Person "bob" (Just 36) Nothing 1 + it "works with lower_" $ + run $ do + p1e <- insert' p1 + p2e@(Entity _ bob) <- insert' $ Person "bob" (Just 36) Nothing 1 - -- lower(name) == 'john' - ret1 <- select $ - from $ \p-> do - where_ (lower_ (p ^. PersonName) ==. val (map toLower $ personName p1)) - return p - liftIO $ ret1 `shouldBe` [ p1e ] + -- lower(name) == 'john' + ret1 <- select $ + from $ \p-> do + where_ (lower_ (p ^. PersonName) ==. val (map toLower $ personName p1)) + return p + liftIO $ ret1 `shouldBe` [ p1e ] - -- name == lower('BOB') - ret2 <- select $ - from $ \p-> do - where_ (p ^. PersonName ==. lower_ (val $ map toUpper $ personName bob)) - 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)) -#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) -#endif - - it "works with round_" $ - run $ do - ret <- select $ return $ round_ (val (16.2 :: Double)) - liftIO $ ret `shouldBe` [ Value (16 :: Double) ] - - it "works with isNothing" $ - run $ do - _ <- insert' p1 - p2e <- insert' p2 - _ <- insert' p3 - ret <- select $ - from $ \p -> do - where_ $ isNothing (p ^. PersonAge) - return p - liftIO $ ret `shouldBe` [ p2e ] - - it "works with not_ . isNothing" $ - run $ do - p1e <- insert' p1 - _ <- insert' p2 - ret <- select $ - from $ \p -> do - where_ $ not_ (isNothing (p ^. PersonAge)) - return p - liftIO $ ret `shouldBe` [ p1e ] - - it "works for a many-to-many implicit join" $ - run $ do - p1e@(Entity p1k _) <- insert' p1 - p2e@(Entity p2k _) <- insert' p2 - _ <- insert' p3 - p4e@(Entity p4k _) <- insert' p4 - f12 <- insert' (Follow p1k p2k) - f21 <- insert' (Follow p2k p1k) - f42 <- insert' (Follow p4k p2k) - f11 <- insert' (Follow p1k p1k) - ret <- select $ - from $ \(follower, follows, followed) -> do - where_ $ follower ^. PersonId ==. follows ^. FollowFollower &&. - followed ^. PersonId ==. follows ^. FollowFollowed - orderBy [ asc (follower ^. PersonName) - , asc (followed ^. PersonName) ] - return (follower, follows, followed) - liftIO $ ret `shouldBe` [ (p1e, f11, p1e) - , (p1e, f12, p2e) - , (p4e, f42, p2e) - , (p2e, f21, p1e) ] - - it "works for a many-to-many explicit join" $ - run $ do - p1e@(Entity p1k _) <- insert' p1 - p2e@(Entity p2k _) <- insert' p2 - _ <- insert' p3 - p4e@(Entity p4k _) <- insert' p4 - f12 <- insert' (Follow p1k p2k) - f21 <- insert' (Follow p2k p1k) - f42 <- insert' (Follow p4k p2k) - f11 <- insert' (Follow p1k p1k) - ret <- select $ - from $ \(follower `InnerJoin` follows `InnerJoin` followed) -> do - on $ followed ^. PersonId ==. follows ^. FollowFollowed - on $ follower ^. PersonId ==. follows ^. FollowFollower - orderBy [ asc (follower ^. PersonName) - , asc (followed ^. PersonName) ] - return (follower, follows, followed) - liftIO $ ret `shouldBe` [ (p1e, f11, p1e) - , (p1e, f12, p2e) - , (p4e, f42, p2e) - , (p2e, f21, p1e) ] - - it "works for a many-to-many explicit join with LEFT OUTER JOINs" $ - run $ do - p1e@(Entity p1k _) <- insert' p1 - p2e@(Entity p2k _) <- insert' p2 - p3e <- insert' p3 - p4e@(Entity p4k _) <- insert' p4 - f12 <- insert' (Follow p1k p2k) - f21 <- insert' (Follow p2k p1k) - f42 <- insert' (Follow p4k p2k) - f11 <- insert' (Follow p1k p1k) - ret <- select $ - from $ \(follower `LeftOuterJoin` mfollows `LeftOuterJoin` mfollowed) -> do - on $ mfollowed ?. PersonId ==. mfollows ?. FollowFollowed - on $ just (follower ^. PersonId) ==. mfollows ?. FollowFollower - orderBy [ asc ( follower ^. PersonName) - , asc (mfollowed ?. PersonName) ] - return (follower, mfollows, mfollowed) - liftIO $ ret `shouldBe` [ (p1e, Just f11, Just p1e) - , (p1e, Just f12, Just p2e) - , (p4e, Just f42, Just p2e) - , (p3e, Nothing, Nothing) - , (p2e, Just f21, Just p1e) ] - - it "works with a composite primary key" $ - run $ do - let p = Point x y "" - x = 10 - y = 15 - Right thePk = keyFromValues [toPersistValue x, toPersistValue y] - pPk <- insert p - [Entity _ ret] <- select $ from $ \p' -> do - where_ (p'^.PointId ==. val pPk) - return p' - liftIO $ do - ret `shouldBe` p - pPk `shouldBe` thePk - - - describe "select/orderBy" $ do - it "works with a single ASC field" $ - run $ do - p1e <- insert' p1 - p2e <- insert' p2 - p3e <- insert' p3 - ret <- select $ - from $ \p -> do - orderBy [asc $ p ^. PersonName] - 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 ] -#else - -- in SQLite and MySQL, its the reverse - liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ] -#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 ] -#else - liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ] -#endif - - it "works with a sub_select" $ - run $ do - [p1k, p2k, p3k, p4k] <- mapM insert [p1, p2, p3, p4] - [b1k, b2k, b3k, b4k] <- mapM (insert . BlogPost "") [p1k, p2k, p3k, p4k] - ret <- select $ - from $ \b -> do - orderBy [desc $ sub_select $ - from $ \p -> do - where_ (p ^. PersonId ==. b ^. BlogPostAuthorId) - return (p ^. PersonName) - ] - return (b ^. BlogPostId) - liftIO $ ret `shouldBe` (Value <$> [b2k, b3k, b4k, b1k]) - - it "works with asc random_" $ - run $ do - _p1e <- insert' p1 - _p2e <- insert' p2 - _p3e <- insert' p3 - _p4e <- insert' p4 - rets <- - fmap S.fromList $ - replicateM 11 $ - select $ - from $ \p -> do - orderBy [asc (random_ :: SqlExpr (Value Double))] - return (p ^. PersonId :: SqlExpr (Value PersonId)) - -- There are 2^4 = 16 possible orderings. The chance - -- of 11 random samplings returning the same ordering - -- is 1/2^40, so this test should pass almost everytime. - liftIO $ S.size rets `shouldSatisfy` (>2) - - it "works on a composite primary key" $ - run $ do - let ps = [Point 2 1 "", Point 1 2 ""] - mapM_ insert ps - eps <- select $ - from $ \p' -> do - orderBy [asc (p'^.PointId)] - return p' - liftIO $ map entityVal eps `shouldBe` reverse ps - - - 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 - p1k <- insert p1 - let (t1, t2, t3) = ("a", "b", "c") - mapM_ (insert . flip BlogPost p1k) [t1, t3, t2, t2, t1] - ret <- q $ - from $ \b -> do - let title = b ^. BlogPostTitle - orderBy [asc title] - return title - liftIO $ ret `shouldBe` [ Value t1, Value t2, Value t3 ] - it "works on a simple example (selectDistinct)" $ - selDistTest selectDistinct - - it "works on a simple example (select . distinct)" $ - selDistTest (select . distinct) - - it "works on a simple example (distinct (return ()))" $ - selDistTest (\act -> select $ distinct (return ()) >> act) - -#if defined(WITH_POSTGRESQL) - describe "SELECT DISTINCT ON" $ do - it "works on a simple example" $ do - run $ do - [p1k, p2k, _] <- mapM insert [p1, p2, p3] - [_, bpB, bpC] <- mapM insert' - [ BlogPost "A" p1k - , BlogPost "B" p1k - , BlogPost "C" p2k ] - ret <- select $ - from $ \bp -> - distinctOn [don (bp ^. BlogPostAuthorId)] $ do - orderBy [asc (bp ^. BlogPostAuthorId), desc (bp ^. BlogPostTitle)] - return bp - liftIO $ ret `shouldBe` L.sortBy (comparing (blogPostAuthorId . entityVal)) [bpB, bpC] - - let slightlyLessSimpleTest q = - run $ do - [p1k, p2k, _] <- mapM insert [p1, p2, p3] - [bpA, bpB, bpC] <- mapM insert' - [ BlogPost "A" p1k - , BlogPost "B" p1k - , BlogPost "C" p2k ] - ret <- select $ - from $ \bp -> - 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 - - describe "coalesce/coalesceDefault" $ do - it "works on a simple example" $ - run $ do - mapM_ insert' [p1, p2, p3, p4, p5] - ret1 <- select $ - from $ \p -> do - orderBy [asc (p ^. PersonId)] - return (coalesce [p ^. PersonAge, p ^. PersonWeight]) - liftIO $ ret1 `shouldBe` [ Value (Just (36 :: Int)) - , Value (Just 37) - , Value (Just 17) - , Value (Just 17) - , Value Nothing - ] - - ret2 <- select $ - from $ \p -> do - orderBy [asc (p ^. PersonId)] - return (coalesceDefault [p ^. PersonAge, p ^. PersonWeight] (p ^. PersonFavNum)) - liftIO $ ret2 `shouldBe` [ Value (36 :: Int) - , Value 37 - , Value 17 - , Value 17 - , Value 5 - ] - - it "works with sub-queries" $ - run $ do - p1id <- insert p1 - p2id <- insert p2 - p3id <- insert p3 - _ <- insert p4 - _ <- insert p5 - _ <- insert $ BlogPost "a" p1id - _ <- insert $ BlogPost "b" p2id - _ <- insert $ BlogPost "c" p3id - ret <- select $ - from $ \b -> do - let sub = - from $ \p -> do - where_ (p ^. PersonId ==. b ^. BlogPostAuthorId) - return $ p ^. PersonAge - return $ coalesceDefault [sub_select sub] (val (42 :: Int)) - liftIO $ ret `shouldBe` [ Value (36 :: Int) - , Value 42 - , Value 17 - ] + -- name == lower('BOB') + ret2 <- select $ + from $ \p-> do + where_ (p ^. PersonName ==. lower_ (val $ map toUpper $ personName bob)) + return p + liftIO $ ret2 `shouldBe` [ p2e ] #if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL) - it "works on PostgreSQL and MySQL with <2 arguments" $ - run $ do - _ :: [Value (Maybe Int)] <- - select $ - from $ \p -> do - return (coalesce [p ^. PersonAge]) - return () + testPostgresqlRandom >> testMysqlRandom #else - it "throws an exception on SQLite with <2 arguments" $ - run (select $ + testSqliteRandom +#endif + + it "works with round_" $ + run $ do + ret <- select $ return $ round_ (val (16.2 :: Double)) + liftIO $ ret `shouldBe` [ Value (16 :: Double) ] + + it "works with isNothing" $ + run $ do + _ <- insert' p1 + p2e <- insert' p2 + _ <- insert' p3 + ret <- select $ + from $ \p -> do + where_ $ isNothing (p ^. PersonAge) + return p + liftIO $ ret `shouldBe` [ p2e ] + + it "works with not_ . isNothing" $ + run $ do + p1e <- insert' p1 + _ <- insert' p2 + ret <- select $ + from $ \p -> do + where_ $ not_ (isNothing (p ^. PersonAge)) + return p + liftIO $ ret `shouldBe` [ p1e ] + + it "works for a many-to-many implicit join" $ + run $ do + p1e@(Entity p1k _) <- insert' p1 + p2e@(Entity p2k _) <- insert' p2 + _ <- insert' p3 + p4e@(Entity p4k _) <- insert' p4 + f12 <- insert' (Follow p1k p2k) + f21 <- insert' (Follow p2k p1k) + f42 <- insert' (Follow p4k p2k) + f11 <- insert' (Follow p1k p1k) + ret <- select $ + from $ \(follower, follows, followed) -> do + where_ $ follower ^. PersonId ==. follows ^. FollowFollower &&. + followed ^. PersonId ==. follows ^. FollowFollowed + orderBy [ asc (follower ^. PersonName) + , asc (followed ^. PersonName) ] + return (follower, follows, followed) + liftIO $ ret `shouldBe` [ (p1e, f11, p1e) + , (p1e, f12, p2e) + , (p4e, f42, p2e) + , (p2e, f21, p1e) ] + + it "works for a many-to-many explicit join" $ + run $ do + p1e@(Entity p1k _) <- insert' p1 + p2e@(Entity p2k _) <- insert' p2 + _ <- insert' p3 + p4e@(Entity p4k _) <- insert' p4 + f12 <- insert' (Follow p1k p2k) + f21 <- insert' (Follow p2k p1k) + f42 <- insert' (Follow p4k p2k) + f11 <- insert' (Follow p1k p1k) + ret <- select $ + from $ \(follower `InnerJoin` follows `InnerJoin` followed) -> do + on $ followed ^. PersonId ==. follows ^. FollowFollowed + on $ follower ^. PersonId ==. follows ^. FollowFollower + orderBy [ asc (follower ^. PersonName) + , asc (followed ^. PersonName) ] + return (follower, follows, followed) + liftIO $ ret `shouldBe` [ (p1e, f11, p1e) + , (p1e, f12, p2e) + , (p4e, f42, p2e) + , (p2e, f21, p1e) ] + + it "works for a many-to-many explicit join with LEFT OUTER JOINs" $ + run $ do + p1e@(Entity p1k _) <- insert' p1 + p2e@(Entity p2k _) <- insert' p2 + p3e <- insert' p3 + p4e@(Entity p4k _) <- insert' p4 + f12 <- insert' (Follow p1k p2k) + f21 <- insert' (Follow p2k p1k) + f42 <- insert' (Follow p4k p2k) + f11 <- insert' (Follow p1k p1k) + ret <- select $ + from $ \(follower `LeftOuterJoin` mfollows `LeftOuterJoin` mfollowed) -> do + on $ mfollowed ?. PersonId ==. mfollows ?. FollowFollowed + on $ just (follower ^. PersonId) ==. mfollows ?. FollowFollower + orderBy [ asc ( follower ^. PersonName) + , asc (mfollowed ?. PersonName) ] + return (follower, mfollows, mfollowed) + liftIO $ ret `shouldBe` [ (p1e, Just f11, Just p1e) + , (p1e, Just f12, Just p2e) + , (p4e, Just f42, Just p2e) + , (p3e, Nothing, Nothing) + , (p2e, Just f21, Just p1e) ] + + it "works with a composite primary key" $ + run $ do + let p = Point x y "" + x = 10 + y = 15 + Right thePk = keyFromValues [toPersistValue x, toPersistValue y] + pPk <- insert p + [Entity _ ret] <- select $ from $ \p' -> do + where_ (p'^.PointId ==. val pPk) + return p' + liftIO $ do + ret `shouldBe` p + 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 - return (coalesce [p ^. PersonAge]) :: SqlQuery (SqlExpr (Value (Maybe Int)))) - `shouldThrow` (\(_ :: SqliteException) -> True) + 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 + p1e <- insert' p1 + p2e <- insert' p2 + p3e <- insert' p3 + ret <- select $ + from $ \p -> do + orderBy [asc $ p ^. PersonName] + return p + liftIO $ ret `shouldBe` [ p1e, p3e, p2e ] + +#ifdef WITH_POSTGRESQL + testPostgresqlTwoAscFields +#else + testMysqlTwoAscFields >> testSqliteTwoAscFields #endif - describe "text functions" $ do - it "like, (%) and (++.) work on a simple example" $ - run $ do - [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4] - let nameContains t expected = do - ret <- select $ - from $ \p -> do - where_ (p ^. PersonName `like` (%) ++. val t ++. (%)) - orderBy [asc (p ^. PersonName)] - return p - liftIO $ ret `shouldBe` expected - nameContains "h" [p1e, p2e] - nameContains "i" [p4e, p3e] - nameContains "iv" [p4e] +#ifdef WITH_POSTGRESQL + testPostgresqlOneAscOneDesc +#else + testMysqlOneAscOneDesc >> testSqliteOneAscOneDesc +#endif + + it "works with a sub_select" $ + run $ do + [p1k, p2k, p3k, p4k] <- mapM insert [p1, p2, p3, p4] + [b1k, b2k, b3k, b4k] <- mapM (insert . BlogPost "") [p1k, p2k, p3k, p4k] + ret <- select $ + from $ \b -> do + orderBy [desc $ sub_select $ + from $ \p -> do + where_ (p ^. PersonId ==. b ^. BlogPostAuthorId) + return (p ^. PersonName) + ] + return (b ^. BlogPostId) + liftIO $ ret `shouldBe` (Value <$> [b2k, b3k, b4k, b1k]) + + it "works with asc random_" $ + run $ do + _p1e <- insert' p1 + _p2e <- insert' p2 + _p3e <- insert' p3 + _p4e <- insert' p4 + rets <- + fmap S.fromList $ + replicateM 11 $ + select $ + from $ \p -> do + orderBy [asc (random_ :: SqlExpr (Value Double))] + return (p ^. PersonId :: SqlExpr (Value PersonId)) + -- There are 2^4 = 16 possible orderings. The chance + -- of 11 random samplings returning the same ordering + -- is 1/2^40, so this test should pass almost everytime. + liftIO $ S.size rets `shouldSatisfy` (>2) + + it "works on a composite primary key" $ + run $ do + let ps = [Point 2 1 "", Point 1 2 ""] + mapM_ insert ps + eps <- select $ + from $ \p' -> do + orderBy [asc (p'^.PointId)] + return p' + 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 + p1k <- insert p1 + let (t1, t2, t3) = ("a", "b", "c") + mapM_ (insert . flip BlogPost p1k) [t1, t3, t2, t2, t1] + ret <- q $ + from $ \b -> do + let title = b ^. BlogPostTitle + orderBy [asc title] + return title + liftIO $ ret `shouldBe` [ Value t1, Value t2, Value t3 ] + + it "works on a simple example (selectDistinct)" $ + selDistTest selectDistinct + + it "works on a simple example (select . distinct)" $ + selDistTest (select . distinct) + + it "works on a simple example (distinct (return ()))" $ + selDistTest (\act -> select $ distinct (return ()) >> act) + + +------------------------------------------------------------------------------- + + +testSelectDistinctOn :: SpecWith (Arg (IO ())) +testSelectDistinctOn = do + describe "SELECT DISTINCT ON" $ do + it "works on a simple example" $ do + run $ do + [p1k, p2k, _] <- mapM insert [p1, p2, p3] + [_, bpB, bpC] <- mapM insert' + [ BlogPost "A" p1k + , BlogPost "B" p1k + , BlogPost "C" p2k ] + ret <- select $ + from $ \bp -> + distinctOn [don (bp ^. BlogPostAuthorId)] $ do + orderBy [asc (bp ^. BlogPostAuthorId), desc (bp ^. BlogPostTitle)] + return bp + liftIO $ ret `shouldBe` L.sortBy (comparing (blogPostAuthorId . entityVal)) [bpB, bpC] + + let slightlyLessSimpleTest q = + run $ do + [p1k, p2k, _] <- mapM insert [p1, p2, p3] + [bpA, bpB, bpC] <- mapM insert' + [ BlogPost "A" p1k + , BlogPost "B" p1k + , BlogPost "C" p2k ] + ret <- select $ + from $ \bp -> + 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)] + + +------------------------------------------------------------------------------- + + +testCoasleceDefault :: SpecWith (Arg (IO ())) +testCoasleceDefault = do + describe "coalesce/coalesceDefault" $ do + it "works on a simple example" $ + run $ do + mapM_ insert' [p1, p2, p3, p4, p5] + ret1 <- select $ + from $ \p -> do + orderBy [asc (p ^. PersonId)] + return (coalesce [p ^. PersonAge, p ^. PersonWeight]) + liftIO $ ret1 `shouldBe` [ Value (Just (36 :: Int)) + , Value (Just 37) + , Value (Just 17) + , Value (Just 17) + , Value Nothing + ] + + ret2 <- select $ + from $ \p -> do + orderBy [asc (p ^. PersonId)] + return (coalesceDefault [p ^. PersonAge, p ^. PersonWeight] (p ^. PersonFavNum)) + liftIO $ ret2 `shouldBe` [ Value (36 :: Int) + , Value 37 + , Value 17 + , Value 17 + , Value 5 + ] + + it "works with sub-queries" $ + run $ do + p1id <- insert p1 + p2id <- insert p2 + p3id <- insert p3 + _ <- insert p4 + _ <- insert p5 + _ <- insert $ BlogPost "a" p1id + _ <- insert $ BlogPost "b" p2id + _ <- insert $ BlogPost "c" p3id + ret <- select $ + from $ \b -> do + let sub = + from $ \p -> do + where_ (p ^. PersonId ==. b ^. BlogPostAuthorId) + return $ p ^. PersonAge + return $ coalesceDefault [sub_select sub] (val (42 :: Int)) + liftIO $ ret `shouldBe` [ Value (36 :: Int) + , Value 42 + , Value 17 + ] + +#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)] <- + select $ + from $ \p -> do + return (coalesce [p ^. PersonAge]) + return () + +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) + +------------------------------------------------------------------------------- + + +testTextFunctions :: SpecWith (Arg (IO ())) +testTextFunctions = do + describe "text functions" $ do + it "like, (%) and (++.) work on a simple example" $ + run $ do + [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4] + let nameContains t expected = do + ret <- select $ + from $ \p -> do + where_ (p ^. PersonName `like` (%) ++. val t ++. (%)) + orderBy [asc (p ^. PersonName)] + return p + liftIO $ ret `shouldBe` expected + nameContains "h" [p1e, p2e] + nameContains "i" [p4e, p3e] + nameContains "iv" [p4e] #if defined(WITH_POSTGRESQL) - it "ilike, (%) and (++.) work on a simple example on PostgreSQL" $ - run $ do - [p1e, _, p3e, _, p5e] <- mapM insert' [p1, p2, p3, p4, p5] - let nameContains t expected = do - ret <- select $ - from $ \p -> do - where_ (p ^. PersonName `ilike` (%) ++. val t ++. (%)) - orderBy [asc (p ^. PersonName)] - return p - liftIO $ ret `shouldBe` expected - nameContains "mi" [p3e, p5e] - nameContains "JOHN" [p1e] + testPostgresqlTextFunction #endif - describe "delete" $ - it "works on a simple example" $ - run $ do - p1e <- insert' p1 - p2e <- insert' p2 - p3e <- insert' p3 - let getAll = select $ - from $ \p -> do - orderBy [asc (p ^. PersonName)] - return p - ret1 <- getAll - liftIO $ ret1 `shouldBe` [ p1e, p3e, p2e ] - () <- delete $ - from $ \p -> - where_ (p ^. PersonName ==. val (personName p1)) - ret2 <- getAll - liftIO $ ret2 `shouldBe` [ p3e, p2e ] - n <- deleteCount $ - from $ \p -> - return ((p :: SqlExpr (Entity Person)) `seq` ()) - ret3 <- getAll - liftIO $ (n, ret3) `shouldBe` (2, []) +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] + let nameContains t expected = do + ret <- select $ + from $ \p -> do + where_ (p ^. PersonName `ilike` (%) ++. val t ++. (%)) + orderBy [asc (p ^. PersonName)] + return p + liftIO $ ret `shouldBe` expected + nameContains "mi" [p3e, p5e] + nameContains "JOHN" [p1e] - describe "update" $ 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 - -- PostgreSQL: nulls are bigger than data, and update returns - -- matched rows, not actually changed rows. + +------------------------------------------------------------------------------- + + +testDelete :: SpecWith (Arg (IO ())) +testDelete = do + describe "delete" $ + it "works on a simple example" $ + run $ do + p1e <- insert' p1 + p2e <- insert' p2 + p3e <- insert' p3 + let getAll = select $ + from $ \p -> do + orderBy [asc (p ^. PersonName)] + return p + ret1 <- getAll + liftIO $ ret1 `shouldBe` [ p1e, p3e, p2e ] + () <- delete $ + from $ \p -> + where_ (p ^. PersonName ==. val (personName p1)) + ret2 <- getAll + liftIO $ ret2 `shouldBe` [ p3e, p2e ] + n <- deleteCount $ + from $ \p -> + return ((p :: SqlExpr (Entity Person)) `seq` ()) + ret3 <- getAll + liftIO $ (n, ret3) `shouldBe` (2, []) + + +------------------------------------------------------------------------------- + +testPostgresqlUpdate :: SpecWith (Arg (IO ())) +testPostgresqlUpdate = 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 + -- PostgreSQL: nulls are bigger than data, and update returns + -- matched rows, not actually changed rows. + 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 + 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 ] + +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) - 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 ] - -- MySQL: nulls appear first, and update returns actual number - -- of changed rows + testPostgresqlUpdate #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 ] + testMysqlUpdate #else - -- 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 ] + testSqliteUpdate #endif - it "works with a subexpression having COUNT(*)" $ - run $ do - p1k <- insert p1 - p2k <- insert p2 - p3k <- insert p3 - replicateM_ 3 (insert $ BlogPost "" p1k) - replicateM_ 7 (insert $ BlogPost "" p3k) - let blogPostsBy p = - from $ \b -> do - where_ (b ^. BlogPostAuthorId ==. p ^. PersonId) - return countRows - () <- update $ \p -> do - set p [ PersonAge =. just (sub_select (blogPostsBy p)) ] - ret <- select $ - from $ \p -> do - orderBy [ asc (p ^. PersonName) ] - return p - liftIO $ ret `shouldBe` [ Entity p1k p1 { personAge = Just 3 } - , Entity p3k p3 { personAge = Just 7 } - , Entity p2k p2 { personAge = Just 0 } ] + it "works with a subexpression having COUNT(*)" $ + run $ do + p1k <- insert p1 + p2k <- insert p2 + p3k <- insert p3 + replicateM_ 3 (insert $ BlogPost "" p1k) + replicateM_ 7 (insert $ BlogPost "" p3k) + let blogPostsBy p = + from $ \b -> do + where_ (b ^. BlogPostAuthorId ==. p ^. PersonId) + return countRows + () <- update $ \p -> do + set p [ PersonAge =. just (sub_select (blogPostsBy p)) ] + ret <- select $ + from $ \p -> do + orderBy [ asc (p ^. PersonName) ] + return p + liftIO $ ret `shouldBe` [ Entity p1k p1 { personAge = Just 3 } + , Entity p3k p3 { personAge = Just 7 } + , Entity p2k p2 { personAge = Just 0 } ] - it "works with a composite primary key" $ - pendingWith "Need refactor to support composite pks on ESet" - {- - run $ do - let p = Point x y "" - x = 10 - y = 15 - newX = 20 - newY = 25 - Right newPk = keyFromValues [toPersistValue newX, toPersistValue newY] - insert_ p - () <- update $ \p' -> do - set p' [PointId =. val newPk] - [Entity _ ret] <- select $ from $ return - liftIO $ do - ret `shouldBe` Point newX newY [] - -} + it "works with a composite primary key" $ + pendingWith "Need refactor to support composite pks on ESet" + {- + run $ do + let p = Point x y "" + x = 10 + y = 15 + newX = 20 + newY = 25 + Right newPk = keyFromValues [toPersistValue newX, toPersistValue newY] + insert_ p + () <- update $ \p' -> do + set p' [PointId =. val newPk] + [Entity _ ret] <- select $ from $ return + liftIO $ do + ret `shouldBe` Point newX newY [] + -} - it "GROUP BY works with COUNT" $ - run $ do - p1k <- insert p1 - p2k <- insert p2 - p3k <- insert p3 - replicateM_ 3 (insert $ BlogPost "" p1k) - replicateM_ 7 (insert $ BlogPost "" p3k) - ret <- select $ - from $ \(p `LeftOuterJoin` b) -> do - on (p ^. PersonId ==. b ^. BlogPostAuthorId) - groupBy (p ^. PersonId) - let cnt = count (b ^. BlogPostId) - orderBy [ asc cnt ] - return (p, cnt) - liftIO $ ret `shouldBe` [ (Entity p2k p2, Value (0 :: Int)) - , (Entity p1k p1, Value 3) - , (Entity p3k p3, Value 7) ] + it "GROUP BY works with COUNT" $ + run $ do + p1k <- insert p1 + p2k <- insert p2 + p3k <- insert p3 + replicateM_ 3 (insert $ BlogPost "" p1k) + replicateM_ 7 (insert $ BlogPost "" p3k) + ret <- select $ + from $ \(p `LeftOuterJoin` b) -> do + on (p ^. PersonId ==. b ^. BlogPostAuthorId) + groupBy (p ^. PersonId) + let cnt = count (b ^. BlogPostId) + orderBy [ asc cnt ] + return (p, cnt) + liftIO $ ret `shouldBe` [ (Entity p2k p2, Value (0 :: Int)) + , (Entity p1k p1, Value 3) + , (Entity p3k p3, Value 7) ] - it "GROUP BY works with COUNT and InnerJoin" $ - run $ do - l1k <- insert l1 - l2k <- insert l2 - l3k <- insert l3 - mapM_ (\k -> insert $ Deed k l1k) (map show [1..3]) + it "GROUP BY works with COUNT and InnerJoin" $ + run $ do + l1k <- insert l1 + l2k <- insert l2 + l3k <- insert l3 + 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 - on $ lord ^. LordId ==. deed ^. DeedOwnerId - groupBy (lord ^. LordId) - return (lord ^. LordId, count $ deed ^. DeedId) - liftIO $ ret `shouldMatchList` [ (Value l3k, Value 7) - , (Value l1k, Value 3) ] - it "GROUP BY works with HAVING" $ - run $ do - p1k <- insert p1 - _p2k <- insert p2 - p3k <- insert p3 - replicateM_ 3 (insert $ BlogPost "" p1k) - replicateM_ 7 (insert $ BlogPost "" p3k) - ret <- select $ - from $ \(p `LeftOuterJoin` b) -> do - on (p ^. PersonId ==. b ^. BlogPostAuthorId) - let cnt = count (b ^. BlogPostId) - groupBy (p ^. PersonId) - having (cnt >. (val 0)) - orderBy [ asc cnt ] - return (p, cnt) - liftIO $ ret `shouldBe` [ (Entity p1k p1, Value (3 :: Int)) - , (Entity p3k p3, Value 7) ] + (ret :: [(Value (Key Lord), Value Int)]) <- select $ from $ + \ ( lord `InnerJoin` deed ) -> do + on $ lord ^. LordId ==. deed ^. DeedOwnerId + groupBy (lord ^. LordId) + return (lord ^. LordId, count $ deed ^. DeedId) + liftIO $ ret `shouldMatchList` [ (Value l3k, Value 7) + , (Value l1k, Value 3) ] + it "GROUP BY works with HAVING" $ + run $ do + p1k <- insert p1 + _p2k <- insert p2 + p3k <- insert p3 + replicateM_ 3 (insert $ BlogPost "" p1k) + replicateM_ 7 (insert $ BlogPost "" p3k) + ret <- select $ + from $ \(p `LeftOuterJoin` b) -> do + on (p ^. PersonId ==. b ^. BlogPostAuthorId) + let cnt = count (b ^. BlogPostId) + groupBy (p ^. PersonId) + having (cnt >. (val 0)) + orderBy [ asc cnt ] + return (p, cnt) + liftIO $ ret `shouldBe` [ (Entity p1k p1, Value (3 :: Int)) + , (Entity p3k p3, Value 7) ] - describe "lists of values" $ do - it "IN works for valList" $ - run $ do - p1k <- insert p1 - p2k <- insert p2 - _p3k <- insert p3 - ret <- select $ - from $ \p -> do - where_ (p ^. PersonName `in_` valList (personName <$> [p1, p2])) - return p - liftIO $ ret `shouldBe` [ Entity p1k p1 - , Entity p2k p2 ] - it "IN works for valList (null list)" $ - run $ do - _p1k <- insert p1 - _p2k <- insert p2 - _p3k <- insert p3 - ret <- select $ - from $ \p -> do - where_ (p ^. PersonName `in_` valList []) - return p - liftIO $ ret `shouldBe` [] +------------------------------------------------------------------------------- - it "IN works for subList_select" $ - run $ do - p1k <- insert p1 - _p2k <- insert p2 - p3k <- insert p3 - _ <- insert (BlogPost "" p1k) - _ <- insert (BlogPost "" p3k) - ret <- select $ - from $ \p -> do - let subquery = - from $ \bp -> do - orderBy [ asc (bp ^. BlogPostAuthorId) ] - return (bp ^. BlogPostAuthorId) - where_ (p ^. PersonId `in_` subList_select subquery) - return p - liftIO $ ret `shouldBe` [ Entity p1k p1 - , Entity p3k p3 ] - it "NOT IN works for subList_select" $ - run $ do - p1k <- insert p1 - p2k <- insert p2 - p3k <- insert p3 - _ <- insert (BlogPost "" p1k) - _ <- insert (BlogPost "" p3k) - ret <- select $ - from $ \p -> do - let subquery = - from $ \bp -> - return (bp ^. BlogPostAuthorId) - where_ (p ^. PersonId `notIn` subList_select subquery) - return p - liftIO $ ret `shouldBe` [ Entity p2k p2 ] +testListOfValues :: SpecWith (Arg (IO ())) +testListOfValues = do + describe "lists of values" $ do + it "IN works for valList" $ + run $ do + p1k <- insert p1 + p2k <- insert p2 + _p3k <- insert p3 + ret <- select $ + from $ \p -> do + where_ (p ^. PersonName `in_` valList (personName <$> [p1, p2])) + return p + liftIO $ ret `shouldBe` [ Entity p1k p1 + , Entity p2k p2 ] - it "EXISTS works for subList_select" $ - run $ do - p1k <- insert p1 - _p2k <- insert p2 - p3k <- insert p3 - _ <- insert (BlogPost "" p1k) - _ <- insert (BlogPost "" p3k) - ret <- select $ - from $ \p -> do - where_ $ exists $ - from $ \bp -> do - where_ (bp ^. BlogPostAuthorId ==. p ^. PersonId) - orderBy [asc (p ^. PersonName)] - return p - liftIO $ ret `shouldBe` [ Entity p1k p1 - , Entity p3k p3 ] + it "IN works for valList (null list)" $ + run $ do + _p1k <- insert p1 + _p2k <- insert p2 + _p3k <- insert p3 + ret <- select $ + from $ \p -> do + where_ (p ^. PersonName `in_` valList []) + return p + liftIO $ ret `shouldBe` [] - it "EXISTS works for subList_select" $ - run $ do - p1k <- insert p1 - p2k <- insert p2 - p3k <- insert p3 - _ <- insert (BlogPost "" p1k) - _ <- insert (BlogPost "" p3k) - ret <- select $ - from $ \p -> do - where_ $ notExists $ - from $ \bp -> do - where_ (bp ^. BlogPostAuthorId ==. p ^. PersonId) - return p - liftIO $ ret `shouldBe` [ Entity p2k p2 ] + it "IN works for subList_select" $ + run $ do + p1k <- insert p1 + _p2k <- insert p2 + p3k <- insert p3 + _ <- insert (BlogPost "" p1k) + _ <- insert (BlogPost "" p3k) + ret <- select $ + from $ \p -> do + let subquery = + from $ \bp -> do + orderBy [ asc (bp ^. BlogPostAuthorId) ] + return (bp ^. BlogPostAuthorId) + where_ (p ^. PersonId `in_` subList_select subquery) + return p + liftIO $ ret `shouldBe` [ Entity p1k p1 + , Entity p3k p3 ] - describe "list fields" $ do - -- - it "can update list fields" $ - run $ do - cclist <- insert $ CcList [] - update $ \p -> do - set p [ CcListNames =. val ["fred"]] - where_ (p ^. CcListId ==. val cclist) + it "NOT IN works for subList_select" $ + run $ do + p1k <- insert p1 + p2k <- insert p2 + p3k <- insert p3 + _ <- insert (BlogPost "" p1k) + _ <- insert (BlogPost "" p3k) + ret <- select $ + from $ \p -> do + let subquery = + from $ \bp -> + return (bp ^. BlogPostAuthorId) + where_ (p ^. PersonId `notIn` subList_select subquery) + return p + liftIO $ ret `shouldBe` [ Entity p2k p2 ] - describe "inserts by select" $ do - it "IN works for insertSelect" $ - run $ do - _ <- insert p1 - _ <- insert p2 - _ <- insert p3 - insertSelect $ from $ \p -> do - return $ BlogPost <# val "FakePost" <&> (p ^. PersonId) - ret <- select $ from (\(_::(SqlExpr (Entity BlogPost))) -> return countRows) - liftIO $ ret `shouldBe` [Value (3::Int)] + it "EXISTS works for subList_select" $ + run $ do + p1k <- insert p1 + _p2k <- insert p2 + p3k <- insert p3 + _ <- insert (BlogPost "" p1k) + _ <- insert (BlogPost "" p3k) + ret <- select $ + from $ \p -> do + where_ $ exists $ + from $ \bp -> do + where_ (bp ^. BlogPostAuthorId ==. p ^. PersonId) + orderBy [asc (p ^. PersonName)] + return p + liftIO $ ret `shouldBe` [ Entity p1k p1 + , Entity p3k p3 ] - describe "inserts by select, returns count" $ do - it "IN works for insertSelectCount" $ - run $ do - _ <- insert p1 - _ <- insert p2 - _ <- insert p3 - cnt <- insertSelectCount $ from $ \p -> do - return $ BlogPost <# val "FakePost" <&> (p ^. PersonId) - ret <- select $ from (\(_::(SqlExpr (Entity BlogPost))) -> return countRows) - liftIO $ ret `shouldBe` [Value (3::Int)] - liftIO $ cnt `shouldBe` 3 + it "EXISTS works for subList_select" $ + run $ do + p1k <- insert p1 + p2k <- insert p2 + p3k <- insert p3 + _ <- insert (BlogPost "" p1k) + _ <- insert (BlogPost "" p3k) + ret <- select $ + from $ \p -> do + where_ $ notExists $ + from $ \bp -> do + where_ (bp ^. BlogPostAuthorId ==. p ^. PersonId) + return p + liftIO $ ret `shouldBe` [ Entity p2k p2 ] - describe "Math-related functions" $ do - it "rand returns result in random order" $ - run $ do - replicateM_ 20 $ do - _ <- insert p1 - _ <- insert p2 - _ <- insert p3 - _ <- insert p4 - _ <- insert $ Person "Jane" Nothing Nothing 0 - _ <- insert $ Person "Mark" Nothing Nothing 0 - _ <- insert $ Person "Sarah" Nothing Nothing 0 - insert $ Person "Paul" Nothing Nothing 0 - ret1 <- fmap (map unValue) $ select $ from $ \p -> do - orderBy [rand] - return (p ^. PersonId) - ret2 <- fmap (map unValue) $ select $ from $ \p -> do - orderBy [rand] - return (p ^. PersonId) - liftIO $ (ret1 == ret2) `shouldBe` False +------------------------------------------------------------------------------- - it "castNum works for multiplying Int and Double" $ - run $ do - mapM_ insert [Numbers 2 3.4, Numbers 7 1.1] - ret <- - select $ - from $ \n -> do - let r = castNum (n ^. NumbersInt) *. n ^. NumbersDouble - orderBy [asc r] - return r - liftIO $ length ret `shouldBe` 2 - let [Value a, Value b] = ret - liftIO $ max (abs (a - 6.8)) (abs (b - 7.7)) `shouldSatisfy` (< 0.01) - describe "case" $ do - it "Works for a simple value based when - False" $ - run $ do - ret <- select $ - return $ - case_ - [ when_ (val False) then_ (val (1 :: Int)) ] - (else_ (val 2)) +testListFields :: SpecWith (Arg (IO ())) +testListFields = do + describe "list fields" $ do + -- + it "can update list fields" $ + run $ do + cclist <- insert $ CcList [] + update $ \p -> do + set p [ CcListNames =. val ["fred"]] + where_ (p ^. CcListId ==. val cclist) - liftIO $ ret `shouldBe` [ Value 2 ] - it "Works for a simple value based when - True" $ - run $ do - ret <- select $ - return $ - case_ - [ when_ (val True) then_ (val (1 :: Int)) ] - (else_ (val 2)) +------------------------------------------------------------------------------- - liftIO $ ret `shouldBe` [ Value 1 ] - it "works for a semi-complicated query" $ - run $ do +testInsertsBySelect :: SpecWith (Arg (IO ())) +testInsertsBySelect = do + describe "inserts by select" $ do + it "IN works for insertSelect" $ + run $ do + _ <- insert p1 + _ <- insert p2 + _ <- insert p3 + insertSelect $ from $ \p -> do + return $ BlogPost <# val "FakePost" <&> (p ^. PersonId) + 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 + _ <- insert p1 + _ <- insert p2 + _ <- insert p3 + cnt <- insertSelectCount $ from $ \p -> do + return $ BlogPost <# val "FakePost" <&> (p ^. PersonId) + ret <- select $ from (\(_::(SqlExpr (Entity BlogPost))) -> return countRows) + 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 + replicateM_ 20 $ do _ <- insert p1 _ <- insert p2 _ <- insert p3 _ <- insert p4 - _ <- insert p5 - ret <- select $ - return $ - case_ - [ when_ - (exists $ from $ \p -> do - where_ (p ^. PersonName ==. val "Mike")) - then_ - (sub_select $ from $ \v -> do - let sub = - from $ \c -> do - where_ (c ^. PersonName ==. val "Mike") - return (c ^. PersonFavNum) - where_ (v ^. PersonFavNum >. sub_select sub) - return $ count (v ^. PersonName) +. val (1 :: Int)) ] - (else_ $ val (-1)) + _ <- insert $ Person "Jane" Nothing Nothing 0 + _ <- insert $ Person "Mark" Nothing Nothing 0 + _ <- insert $ Person "Sarah" Nothing Nothing 0 + insert $ Person "Paul" Nothing Nothing 0 + ret1 <- fmap (map unValue) $ select $ from $ \p -> do + orderBy [rand] + return (p ^. PersonId) + ret2 <- fmap (map unValue) $ select $ from $ \p -> do + orderBy [rand] + return (p ^. PersonId) - liftIO $ ret `shouldBe` [ Value (3) ] + liftIO $ (ret1 == ret2) `shouldBe` False - 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 - -- care about the text of the rest, nor with the RDBMS' - -- reaction to the clause. - let sanityCheck kind syntax = do - let complexQuery = - from $ \(p1 `InnerJoin` p2) -> do - on (p1 ^. PersonName ==. p2 ^. PersonName) - where_ (p1 ^. PersonFavNum >. val 2) - orderBy [desc (p2 ^. PersonAge)] - limit 3 - offset 9 - groupBy (p1 ^. PersonId) - having (countRows <. val (0 :: Int)) - return (p1, p2) - queryWithClause1 = do - r <- complexQuery - locking kind - return r - queryWithClause2 = do - locking ForUpdate - r <- complexQuery - locking ForShare - locking kind - return r - queryWithClause3 = do - locking kind - complexQuery - toText conn q = - let (tlb, _) = EI.toRawSql EI.SELECT (conn, EI.initialIdentState) q - in TLB.toLazyText tlb - [complex, with1, with2, with3] <- - runNoLoggingT $ withConn $ \conn -> return $ - map (toText conn) [complexQuery, queryWithClause1, queryWithClause2, queryWithClause3] - let expected = complex <> "\n" <> syntax - (with1, with2, with3) `shouldBe` (expected, expected, expected) + it "castNum works for multiplying Int and Double" $ + run $ do + mapM_ insert [Numbers 2 3.4, Numbers 7 1.1] + ret <- + select $ + from $ \n -> do + let r = castNum (n ^. NumbersInt) *. n ^. NumbersDouble + orderBy [asc r] + return r + liftIO $ length ret `shouldBe` 2 + let [Value a, Value b] = ret + liftIO $ max (abs (a - 6.8)) (abs (b - 7.7)) `shouldSatisfy` (< 0.01) - it "looks sane for ForUpdate" $ sanityCheck ForUpdate "FOR UPDATE" - it "looks sane for ForShare" $ sanityCheck ForShare "FOR SHARE" - it "looks sane for LockInShareMode" $ sanityCheck LockInShareMode "LOCK IN SHARE MODE" - describe "counting rows" $ do - forM_ [ ("count (test A)", count . (^. PersonAge), 4) - , ("count (test B)", count . (^. PersonWeight), 5) - , ("countRows", const countRows, 5) - , ("countDistinct", countDistinct . (^. PersonAge), 2) ] $ - \(title, countKind, expected) -> - it (title ++ " works as expected") $ - run $ do - mapM_ insert - [ Person "" (Just 1) (Just 1) 1 - , Person "" (Just 2) (Just 1) 1 - , Person "" (Just 2) (Just 1) 1 - , Person "" (Just 2) (Just 2) 1 - , Person "" Nothing (Just 3) 1] - [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 ()) - it "arrayAgg looks sane" $ +testCase :: SpecWith (Arg (IO ())) +testCase = do + describe "case" $ do + it "Works for a simple value based when - False" $ + run $ do + ret <- select $ + return $ + case_ + [ when_ (val False) then_ (val (1 :: Int)) ] + (else_ (val 2)) + + liftIO $ ret `shouldBe` [ Value 2 ] + + it "Works for a simple value based when - True" $ + run $ do + ret <- select $ + return $ + case_ + [ when_ (val True) then_ (val (1 :: Int)) ] + (else_ (val 2)) + + liftIO $ ret `shouldBe` [ Value 1 ] + + it "works for a semi-complicated query" $ + run $ do + _ <- insert p1 + _ <- insert p2 + _ <- insert p3 + _ <- insert p4 + _ <- insert p5 + ret <- select $ + return $ + case_ + [ when_ + (exists $ from $ \p -> do + where_ (p ^. PersonName ==. val "Mike")) + then_ + (sub_select $ from $ \v -> do + let sub = + from $ \c -> do + where_ (c ^. PersonName ==. val "Mike") + return (c ^. PersonFavNum) + where_ (v ^. PersonFavNum >. sub_select sub) + return $ count (v ^. PersonName) +. val (1 :: Int)) ] + (else_ $ val (-1)) + + 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 + -- care about the text of the rest, nor with the RDBMS' + -- reaction to the clause. + let sanityCheck kind syntax = do + let complexQuery = + from $ \(p1 `InnerJoin` p2) -> do + on (p1 ^. PersonName ==. p2 ^. PersonName) + where_ (p1 ^. PersonFavNum >. val 2) + orderBy [desc (p2 ^. PersonAge)] + limit 3 + offset 9 + groupBy (p1 ^. PersonId) + having (countRows <. val (0 :: Int)) + return (p1, p2) + queryWithClause1 = do + r <- complexQuery + locking kind + return r + queryWithClause2 = do + locking ForUpdate + r <- complexQuery + locking ForShare + locking kind + return r + queryWithClause3 = do + locking kind + complexQuery + toText conn q = + let (tlb, _) = EI.toRawSql EI.SELECT (conn, EI.initialIdentState) q + in TLB.toLazyText tlb + [complex, with1, with2, with3] <- + runNoLoggingT $ withConn $ \conn -> return $ + map (toText conn) [complexQuery, queryWithClause1, queryWithClause2, queryWithClause3] + let expected = complex <> "\n" <> syntax + (with1, with2, with3) `shouldBe` (expected, expected, expected) + + it "looks sane for ForUpdate" $ sanityCheck ForUpdate "FOR UPDATE" + 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) + , ("countRows", const countRows, 5) + , ("countDistinct", countDistinct . (^. PersonAge), 2) ] $ + \(title, countKind, expected) -> + it (title ++ " works as expected") $ run $ do - let people = [p1, p2, p3, p4, p5] - mapM_ insert people - [Value ret] <- - select . from $ \p -> return (EP.arrayAgg (p ^. PersonName)) - liftIO $ L.sort ret `shouldBe` L.sort (map personName people) + mapM_ insert + [ Person "" (Just 1) (Just 1) 1 + , Person "" (Just 2) (Just 1) 1 + , Person "" (Just 2) (Just 1) 1 + , Person "" (Just 2) (Just 2) 1 + , Person "" Nothing (Just 3) 1] + [Value n] <- select $ from $ return . countKind + liftIO $ (n :: Int) `shouldBe` expected - it "stringAgg looks sane" $ - run $ do - let people = [p1, p2, p3, p4, p5] - mapM_ insert people - [Value ret] <- - select $ - from $ \p -> do - return (EP.stringAgg (p ^. PersonName) (val " ")) - liftIO $ L.sort (words ret) `shouldBe` L.sort (map personName people) - it "chr looks sane" $ - run $ do - [Value (ret :: String)] <- select $ return (EP.chr (val 65)) - liftIO $ ret `shouldBe` "A" +------------------------------------------------------------------------------- + + +testPostgresModule :: SpecWith (Arg (IO ())) +testPostgresModule = do + describe "PostgreSQL module" $ do + it "arrayAgg looks sane" $ + run $ do + let people = [p1, p2, p3, p4, p5] + mapM_ insert people + [Value ret] <- + select . from $ \p -> return (EP.arrayAgg (p ^. PersonName)) + liftIO $ L.sort ret `shouldBe` L.sort (map personName people) + + it "stringAgg looks sane" $ + run $ do + let people = [p1, p2, p3, p4, p5] + mapM_ insert people + [Value ret] <- + select $ + from $ \p -> do + return (EP.stringAgg (p ^. PersonName) (val " ")) + liftIO $ L.sort (words ret) `shouldBe` L.sort (map personName people) + + it "chr looks sane" $ + 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