From 0acb5684455caa9689dae4e3c507efce8fc0dfef Mon Sep 17 00:00:00 2001 From: Chris Allen Date: Tue, 27 Feb 2018 17:45:25 -0600 Subject: [PATCH] Updating for UnliftIO, Conduit 1.3, Persistent 2.8 --- .gitignore | 1 + Makefile | 4 +- esqueleto.cabal | 50 +++++------ src/Database/Esqueleto.hs | 8 +- src/Database/Esqueleto/Internal/Language.hs | 9 -- src/Database/Esqueleto/Internal/Sql.hs | 46 ++-------- src/Database/Esqueleto/PostgreSQL.hs | 6 +- stack-7.10.yaml | 13 --- stack-8.0.yaml | 25 ------ stack-8.2.yaml | 40 ++------- stack.yaml | 2 +- test/Common/Test.hs | 94 ++++++++------------- test/MySQL/Test.hs | 29 +++---- test/PostgreSQL/Test.hs | 29 ++++--- test/SQLite/Test.hs | 19 +++-- 15 files changed, 121 insertions(+), 254 deletions(-) delete mode 100644 stack-7.10.yaml delete mode 100644 stack-8.0.yaml diff --git a/.gitignore b/.gitignore index 82711d4..6a8c43a 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ *~ .cabal-sandbox/ cabal.sandbox.config +.hspec-failures diff --git a/Makefile b/Makefile index bb3245a..fd5f70b 100644 --- a/Makefile +++ b/Makefile @@ -14,10 +14,10 @@ test: # Intended for use in local dev test-postgresql: reset-pgsql - stack test --flag esqueleto:postgresql + stack test esqueleto:postgresql test-mysql: - stack test --flag esqueleto:mysql + stack test esqueleto:mysql test-ghci: stack ghci esqueleto:test:test diff --git a/esqueleto.cabal b/esqueleto.cabal index 8412ac6..7d62fcc 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 2.5.3 +version: 2.6.0 synopsis: Type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/bitemyapp/esqueleto license: BSD3 @@ -87,25 +87,25 @@ test-suite postgresql base, persistent, transformers, resourcet, text -- Test-only dependencies - , conduit >= 1.1 + , conduit , containers , HUnit , QuickCheck - , hspec >= 1.8 + , hspec , monad-control - , time >= 1.5.0.1 && <= 1.8.0.2 + , time -- This library , esqueleto - , postgresql-simple >= 0.2 - , postgresql-libpq >= 0.6 - , persistent-postgresql >= 2.0 + , postgresql-simple + , postgresql-libpq + , persistent-postgresql -- , persistent-sqlite >= 2.8.0 - , persistent-template >= 2.1 + , persistent-template , monad-control - , monad-logger >= 0.3 - + , monad-logger + , unliftio test-suite mysql type: exitcode-stdio-1.0 @@ -119,23 +119,24 @@ test-suite mysql base, persistent, transformers, resourcet, text -- Test-only dependencies - , conduit >= 1.1 + , conduit , containers , HUnit , QuickCheck - , hspec >= 1.8 + , hspec , monad-control - , time >= 1.5.0.1 && <= 1.8.0.2 + , time -- This library , esqueleto - , mysql-simple >= 0.2.2.3 - , mysql >= 0.1.1.3 - , persistent-mysql >= 2.0 - , persistent-template >= 2.1 + , mysql-simple + , mysql + , persistent-mysql + , persistent-template , monad-control - , monad-logger >= 0.3 + , monad-logger + , unliftio test-suite sqlite @@ -150,17 +151,18 @@ test-suite sqlite base, persistent, transformers, resourcet, text -- Test-only dependencies - , conduit >= 1.1 + , conduit , containers , HUnit , QuickCheck - , hspec >= 1.8 + , hspec , monad-control - , time >= 1.5.0.1 && <= 1.8.0.2 + , time -- This library , esqueleto - , persistent-sqlite >= 2.1.3 - , persistent-template >= 2.1 - , monad-logger >= 0.3 + , persistent-sqlite + , persistent-template + , monad-logger + , unliftio diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 4ad2da5..84261fa 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -40,7 +40,7 @@ module Database.Esqueleto -- * @esqueleto@'s Language Esqueleto( where_, on, groupBy, orderBy, rand, asc, desc, limit, offset , distinct, distinctOn, don, distinctOnOrderBy, having, locking - , sub_select, sub_selectDistinct, (^.), (?.) + , sub_select, (^.), (?.) , val, isNothing, just, nothing, joinV, withNonNull , countRows, count, countDistinct , not_, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.) @@ -49,7 +49,7 @@ module Database.Esqueleto , min_, max_, sum_, avg_, castNum, castNumM , coalesce, coalesceDefault , lower_, like, ilike, (%), concat_, (++.), castString - , subList_select, subList_selectDistinct, valList, justList + , subList_select, valList, justList , in_, notIn, exists, notExists , set, (=.), (+=.), (-=.), (*=.), (/=.) , case_, toBaseId) @@ -59,7 +59,6 @@ module Database.Esqueleto , else_ , from , Value(..) - , unValue , ValueList(..) , OrderBy , DistinctOn @@ -78,16 +77,13 @@ module Database.Esqueleto , SqlExpr , SqlEntity , select - , selectDistinct , selectSource - , selectDistinctSource , delete , deleteCount , update , updateCount , insertSelect , insertSelectCount - , insertSelectDistinct , (<#) , (<&>) -- * Internal.Language diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index 3017b6c..f5b1c9c 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -292,9 +292,6 @@ class (Functor query, Applicative query, Monad query) => -- is guaranteed to return just one row. sub_select :: PersistField a => query (expr (Value a)) -> expr (Value a) - -- | Same as 'sub_select' but using @SELECT DISTINCT@. - sub_selectDistinct :: PersistField a => query (expr (Value a)) -> expr (Value a) - -- | Project a field of an entity. (^.) :: (PersistEntity val, PersistField typ) => expr (Entity val) -> EntityField val typ -> expr (Value typ) @@ -447,9 +444,6 @@ class (Functor query, Applicative query, Monad query) => -- list of values. subList_select :: PersistField a => query (expr (Value a)) -> expr (ValueList a) - -- | Same as 'sublist_select' but using @SELECT DISTINCT@. - subList_selectDistinct :: PersistField a => query (expr (Value a)) -> expr (ValueList a) - -- | Lift a list of constant value from Haskell-land to the query. valList :: PersistField typ => [typ] -> expr (ValueList typ) @@ -595,9 +589,6 @@ class (Functor query, Applicative query, Monad query) => -- /Since: 2.4.3/ toBaseId :: ToBaseId ent => expr (Value (Key ent)) -> expr (Value (Key (BaseEnt ent))) -{-# DEPRECATED sub_selectDistinct "Since 2.2.4: use 'sub_select' and 'distinct'." #-} -{-# DEPRECATED subList_selectDistinct "Since 2.2.4: use 'subList_select' and 'distinct'." #-} - -- Fixity declarations infixl 9 ^. diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index f7cd378..4704911 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -21,13 +21,10 @@ module Database.Esqueleto.Internal.Sql , SqlEntity , select , selectSource - , selectDistinct - , selectDistinctSource , delete , deleteCount , update , updateCount - , insertSelectDistinct , insertSelect , insertSelectCount -- * The guts @@ -456,9 +453,10 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where where toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn toDistinctOn (EOrderBy _ f) = EDistinctOn f + toDistinctOn EOrderRandom = + error "We can't select distinct by a random order!" sub_select = sub SELECT - sub_selectDistinct = sub_select . distinct (^.) :: forall val typ. (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ) @@ -536,7 +534,6 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where castString = veryUnsafeCoerceSqlExprValue subList_select = EList . sub_select - subList_selectDistinct = subList_select . distinct valList [] = EEmptyList valList vals = EList $ ERaw Parens $ const ( uncommas ("?" <$ vals) @@ -797,13 +794,13 @@ rawSelectSource :: ( SqlSelect a r ) => Mode -> SqlQuery a - -> SqlReadT m1 (Acquire (C.Source m2 r)) + -> SqlReadT m1 (Acquire (C.ConduitT () r m2 ())) rawSelectSource mode query = do conn <- projectBackend <$> R.ask let _ = conn :: SqlBackend res <- R.withReaderT (const conn) (run conn) - return $ (C.$= massage) `fmap` res + return $ (C..| massage) `fmap` res where run conn = @@ -830,7 +827,7 @@ selectSource :: ( SqlSelect a r , PersistStoreRead backend, PersistUniqueRead backend , MonadResource m ) => SqlQuery a - -> C.Source (R.ReaderT backend m) r + -> C.ConduitT () r (R.ReaderT backend m) () selectSource query = do res <- lift $ rawSelectSource SELECT query (key, src) <- lift $ allocateAcquire res @@ -887,33 +884,11 @@ select query = do conn <- R.ask liftIO $ with res $ flip R.runReaderT conn . runSource - --- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside --- @persistent@'s 'SqlPersistT' monad and return a 'C.Source' of --- rows. -selectDistinctSource - :: ( SqlSelect a r - , MonadResource m ) - => SqlQuery a - -> C.Source (SqlPersistT m) r -selectDistinctSource = selectSource . distinct -{-# DEPRECATED selectDistinctSource "Since 2.2.4: use 'selectSource' and 'distinct'." #-} - - --- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside --- @persistent@'s 'SqlPersistT' monad and return a list of rows. -selectDistinct :: ( SqlSelect a r - , MonadIO m ) - => SqlQuery a -> SqlPersistT m [r] -selectDistinct = select . distinct -{-# DEPRECATED selectDistinct "Since 2.2.4: use 'select' and 'distinct'." #-} - - -- | (Internal) Run a 'C.Source' of rows. runSource :: Monad m => - C.Source (R.ReaderT backend m) r + C.ConduitT () r (R.ReaderT backend m) () -> R.ReaderT backend m [r] -runSource src = src C.$$ CL.consume +runSource src = C.runConduit $ src C..| CL.consume ---------------------------------------------------------------------- @@ -1812,10 +1787,3 @@ insertSelect = void . insertSelectCount insertSelectCount :: (MonadIO m, PersistEntity a) => SqlQuery (SqlExpr (Insertion a)) -> SqlWriteT m Int64 insertSelectCount = rawEsqueleto INSERT_INTO . fmap EInsertFinal - - --- | Insert a 'PersistField' for every unique selected value. -insertSelectDistinct :: (MonadIO m, PersistEntity a) => - SqlQuery (SqlExpr (Insertion a)) -> SqlWriteT m () -insertSelectDistinct = insertSelect . distinct -{-# DEPRECATED insertSelectDistinct "Since 2.2.4: use 'insertSelect' and 'distinct'." #-} diff --git a/src/Database/Esqueleto/PostgreSQL.hs b/src/Database/Esqueleto/PostgreSQL.hs index 5f8bb9e..5e118fd 100644 --- a/src/Database/Esqueleto/PostgreSQL.hs +++ b/src/Database/Esqueleto/PostgreSQL.hs @@ -21,9 +21,9 @@ import Data.Time.Clock (UTCTime) -- -- /Since: 2.5.3/ arrayAggDistinct :: SqlExpr (Value a) -> SqlExpr (Value [a]) -arrayAggDistinct = arrayAgg . distinct +arrayAggDistinct = arrayAgg . distinct' where - distinct = unsafeSqlBinOp " " (unsafeSqlValue "DISTINCT") + distinct' = unsafeSqlBinOp " " (unsafeSqlValue "DISTINCT") -- | (@array_agg@) Concatenate input values, including @NULL@s, -- into an array. @@ -37,7 +37,7 @@ arrayAgg = unsafeSqlFunction "array_agg" -- -- /Since: 2.5.3/ arrayRemove :: SqlExpr (Value [a]) -> SqlExpr (Value a) -> SqlExpr (Value [a]) -arrayRemove arr elem = unsafeSqlFunction "array_remove" (arr, elem) +arrayRemove arr elem' = unsafeSqlFunction "array_remove" (arr, elem') -- | (@string_agg@) Concatenate input values separated by a -- delimiter. diff --git a/stack-7.10.yaml b/stack-7.10.yaml deleted file mode 100644 index 3db00fd..0000000 --- a/stack-7.10.yaml +++ /dev/null @@ -1,13 +0,0 @@ -flags: {} -packages: -- '.' -- location: - git: https://github.com/parsonsmatt/persistent - commit: a4f21ad5db9b65a5febf79a1be091597210a73ca - subdirs: - - persistent - extra-dep: true - -resolver: lts-6.12 -extra-deps: - # - persistent-2.7.1 diff --git a/stack-8.0.yaml b/stack-8.0.yaml deleted file mode 100644 index 4f41cf0..0000000 --- a/stack-8.0.yaml +++ /dev/null @@ -1,25 +0,0 @@ -# resolver: nightly-2017-01-10 -resolver: lts-8.8 -# compiler: ghc-8.0.2 - -packages: -- '.' -- location: - git: https://github.com/parsonsmatt/persistent - commit: a4f21ad5db9b65a5febf79a1be091597210a73ca - subdirs: - - persistent - extra-dep: true - -extra-deps: -- doctest-prop-0.2.0.1 -- quickcheck-properties-0.1 - # - persistent-2.7.1 -# - http-client-0.5.0 -# - fail-4.9.0.0 -# - http-types-0.9 -# - attoparsec-0.13.0.1 -# - doctest-0.10.1 -# - semigroups-0.18.0.1 -# - uri-bytestring-0.1.9 -# - temporary-resourcet-0.1.0.0 diff --git a/stack-8.2.yaml b/stack-8.2.yaml index 57b8420..0351cb8 100644 --- a/stack-8.2.yaml +++ b/stack-8.2.yaml @@ -1,42 +1,14 @@ -# resolver: nightly-2017-01-10 -resolver: lts-10.4 -# compiler: ghc-8.0.2 +resolver: lts-10.6 packages: - '.' - # - location: - # git: https://github.com/yesodweb/persistent - # commit: 4d0a6f3a4abde46c82691414e0e283a933a39f3e - # extra-dep: true - # subdirs: - # - persistent - # - persistent-sqlite - # - location: - # git: https://github.com/snoyberg/conduit - # commit: 7f75bfca8d479e1737861a75437a288af662a3cf - # extra-dep: true - # subdirs: - # - conduit - # - conduit-extra - # - resourcet +# - examples extra-deps: - # - doctest-prop-0.2.0.1 - # - quickcheck-properties-0.1 - # - monad-logger-0.3.28 - # - mono-traversable-1.0.8.1 - # - typed-process-0.2.1.0 -- persistent-2.8.0 -- persistent-sqlite-2.8.0 +- persistent-2.8.1 +- persistent-mysql-2.8.1 +- persistent-postgresql-2.8.1 +- persistent-sqlite-2.8.1 - conduit-1.3.0 - conduit-extra-1.3.0 - resourcet-1.2.0 - # - persistent-2.7.1 -# - http-client-0.5.0 -# - fail-4.9.0.0 -# - http-types-0.9 -# - attoparsec-0.13.0.1 -# - doctest-0.10.1 -# - semigroups-0.18.0.1 -# - uri-bytestring-0.1.9 -# - temporary-resourcet-0.1.0.0 diff --git a/stack.yaml b/stack.yaml index 12a3c04..d0c1516 120000 --- a/stack.yaml +++ b/stack.yaml @@ -1 +1 @@ -stack-8.0.yaml \ No newline at end of file +stack-8.2.yaml \ No newline at end of file diff --git a/test/Common/Test.hs b/test/Common/Test.hs index 3a2aa5c..928bfde 100644 --- a/test/Common/Test.hs +++ b/test/Common/Test.hs @@ -48,25 +48,26 @@ module Common.Test import Control.Monad (forM_, replicateM, replicateM_, void) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Logger (MonadLogger (..), NoLoggingT, runNoLoggingT) -import Control.Monad.Trans.Control (MonadBaseControl(..)) import Control.Monad.Trans.Reader (ReaderT) import Data.Char (toLower, toUpper) import Data.Monoid ((<>)) import Database.Esqueleto import Database.Persist.TH import Test.Hspec +import UnliftIO -import Data.Conduit (($$), (=$=), Source) +import Data.Conduit (ConduitT, (.|), runConduit) import qualified Data.Conduit.List as CL -import qualified Control.Monad.Trans.Resource as R +import Control.Monad.Trans.Resource (MonadThrow) import qualified Data.List as L import qualified Data.Set as S import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Internal.Lazy as TL import qualified Database.Esqueleto.Internal.Sql as EI +import qualified UnliftIO.Resource as R + -------------------------------------------------------------------------------- -- Test schema share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| Foo @@ -147,13 +148,12 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| |] -------------------------------------------------------------------------------- -- | 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) +sameElementsAs l1' l2' = null (l1' L.\\ l2') -- | Helper for rounding to a specific digit -- Prelude> map (flip roundTo 12.3456) [0..5] @@ -187,8 +187,6 @@ l3 :: Lord l3 = Lord "Chester" (Just 17) -------------------------------------------------------------------------------- - testSelect :: Run -> Spec testSelect run = do @@ -214,8 +212,6 @@ testSelect run = do liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ] -------------------------------------------------------------------------------- - testSelectSource :: Run -> Spec testSelectSource run = do @@ -226,7 +222,7 @@ testSelectSource run = do from $ \person -> return person p1e <- insert' p1 - ret <- query $$ CL.consume + ret <- runConduit $ query .| CL.consume liftIO $ ret `shouldBe` [ p1e ] it "can run a query many times" $ @@ -235,30 +231,30 @@ testSelectSource run = do from $ \person -> return person p1e <- insert' p1 - ret0 <- query $$ CL.consume - ret1 <- query $$ CL.consume + ret0 <- runConduit $ query .| CL.consume + ret1 <- runConduit $ query .| CL.consume liftIO $ ret0 `shouldBe` [ p1e ] liftIO $ ret1 `shouldBe` [ p1e ] it "works on repro" $ do - let selectPerson :: R.MonadResource m => String -> Source (SqlPersistT m) (Key Person) + let selectPerson :: R.MonadResource m => String -> ConduitT () (Key Person) (SqlPersistT m) () selectPerson name = do let source = selectSource $ from $ \person -> do where_ $ person ^. PersonName ==. val name return $ person ^. PersonId - source =$= CL.map unValue + source .| CL.map unValue run $ do p1e <- insert' p1 p2e <- insert' p2 - r1 <- selectPerson (personName p1) $$ CL.consume - r2 <- selectPerson (personName p2) $$ CL.consume + r1 <- runConduit $ + selectPerson (personName p1) .| CL.consume + r2 <- runConduit $ + selectPerson (personName p2) .| CL.consume liftIO $ do r1 `shouldBe` [ entityKey p1e ] r2 `shouldBe` [ entityKey p2e ] -------------------------------------------------------------------------------- - testSelectFrom :: Run -> Spec testSelectFrom run = do @@ -418,8 +414,6 @@ testSelectFrom run = do liftIO $ ppk `shouldBe` thePk -------------------------------------------------------------------------------- - testSelectJoin :: Run -> Spec testSelectJoin run = do @@ -581,8 +575,6 @@ testSelectJoin run = do liftIO $ (entityVal <$> ps) `shouldBe` [p1] -------------------------------------------------------------------------------- - testSelectWhere :: Run -> Spec testSelectWhere run = do @@ -641,10 +633,10 @@ testSelectWhere run = do from $ \p-> return $ joinV $ avg_ (p ^. PersonAge) let testV :: Double - testV = roundTo 4 $ (36 + 17 + 17) / 3 + testV = roundTo (4 :: Integer) $ (36 + 17 + 17) / (3 :: Double) retV :: [Value (Maybe Double)] - retV = map (Value . fmap (roundTo 4) . unValue) (ret :: [Value (Maybe Double)]) + retV = map (Value . fmap (roundTo (4 :: Integer)) . unValue) (ret :: [Value (Maybe Double)]) liftIO $ retV `shouldBe` [ Value $ Just testV ] it "works with min_" $ @@ -796,8 +788,6 @@ testSelectWhere run = do pPk `shouldBe` thePk -------------------------------------------------------------------------------- - testSelectOrderBy :: Run -> Spec testSelectOrderBy run = do @@ -856,8 +846,6 @@ testSelectOrderBy run = do liftIO $ map entityVal eps `shouldBe` reverse ps -------------------------------------------------------------------------------- - testSelectDistinct :: Run -> Spec testSelectDistinct run = do @@ -878,9 +866,6 @@ testSelectDistinct run = do 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) @@ -888,8 +873,6 @@ testSelectDistinct run = do selDistTest (\act -> select $ distinct (return ()) >> act) -------------------------------------------------------------------------------- - testCoasleceDefault :: Run -> Spec testCoasleceDefault run = do @@ -942,8 +925,6 @@ testCoasleceDefault run = do ] -------------------------------------------------------------------------------- - testDelete :: Run -> Spec testDelete run = do @@ -971,8 +952,6 @@ testDelete run = do liftIO $ (n, ret3) `shouldBe` (2, []) -------------------------------------------------------------------------------- - testUpdate :: Run -> Spec testUpdate run = do @@ -1038,7 +1017,6 @@ testUpdate run = do 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]) @@ -1071,8 +1049,6 @@ testUpdate run = do , (Entity p3k p3, Value 7) ] -------------------------------------------------------------------------------- - testListOfValues :: Run -> Spec testListOfValues run = do @@ -1167,7 +1143,7 @@ testListOfValues run = do liftIO $ ret `shouldBe` [ Entity p2k p2 ] -------------------------------------------------------------------------------- + testListFields :: Run -> Spec @@ -1182,7 +1158,7 @@ testListFields run = do where_ (p ^. CcListId ==. val cclist) -------------------------------------------------------------------------------- + testInsertsBySelect :: Run -> Spec @@ -1199,7 +1175,7 @@ testInsertsBySelect run = do liftIO $ ret `shouldBe` [Value (3::Int)] -------------------------------------------------------------------------------- + testInsertsBySelectReturnsCount :: Run -> Spec @@ -1217,7 +1193,7 @@ testInsertsBySelectReturnsCount run = do liftIO $ cnt `shouldBe` 3 -------------------------------------------------------------------------------- + testMathFunctions :: Run -> Spec @@ -1257,7 +1233,7 @@ testMathFunctions run = do liftIO $ max (abs (a - 6.8)) (abs (b - 7.7)) `shouldSatisfy` (< 0.01) -------------------------------------------------------------------------------- + testCase :: Run -> Spec @@ -1309,7 +1285,7 @@ testCase run = do liftIO $ ret `shouldBe` [ Value (3) ] -------------------------------------------------------------------------------- + testLocking :: WithConn (NoLoggingT IO) [TL.Text] -> Spec @@ -1321,15 +1297,15 @@ testLocking withConn = do -- 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)] + 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) + groupBy (p1' ^. PersonId) having (countRows <. val (0 :: Int)) - return (p1, p2) + return (p1', p2') queryWithClause1 = do r <- complexQuery locking kind @@ -1357,7 +1333,7 @@ testLocking withConn = do it "looks sane for LockInShareMode" $ sanityCheck LockInShareMode "LOCK IN SHARE MODE" -------------------------------------------------------------------------------- + testCountingRows :: Run -> Spec @@ -1380,7 +1356,7 @@ testCountingRows run = do liftIO $ (n :: Int) `shouldBe` expected -------------------------------------------------------------------------------- + tests :: Run -> Spec @@ -1403,7 +1379,7 @@ tests run = do testCase run testCountingRows run -------------------------------------------------------------------------------- + insert' :: ( Functor m @@ -1415,8 +1391,10 @@ insert' :: ( Functor m insert' v = flip Entity v <$> insert v -type RunDbMonad m = ( MonadBaseControl IO m, MonadIO m, MonadLogger m - , R.MonadThrow m ) +type RunDbMonad m = ( MonadUnliftIO m + , MonadIO m + , MonadLogger m + , MonadThrow m ) type Run = forall a. (forall m. RunDbMonad m => SqlPersistT (R.ResourceT m) a) -> IO a diff --git a/test/MySQL/Test.hs b/test/MySQL/Test.hs index d350c27..1aa6356 100644 --- a/test/MySQL/Test.hs +++ b/test/MySQL/Test.hs @@ -22,18 +22,18 @@ import Test.Hspec import Common.Test -------------------------------------------------------------------------------- -testMysqlRandom :: Spec -testMysqlRandom = do - it "works with random_" $ - run $ do - _ <- select $ return (random_ :: SqlExpr (Value Double)) - return () +-- testMysqlRandom :: Spec +-- testMysqlRandom = do +-- -- This is known not to work until +-- -- we can differentiate behavior by database +-- it "works with random_" $ +-- run $ do +-- _ <- select $ return (random_ :: SqlExpr (Value Double)) +-- return () -------------------------------------------------------------------------------- testMysqlSum :: Spec @@ -50,7 +50,6 @@ testMysqlSum = do liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Double ) ] -------------------------------------------------------------------------------- testMysqlTwoAscFields :: Spec @@ -68,7 +67,6 @@ testMysqlTwoAscFields = do liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ] -------------------------------------------------------------------------------- testMysqlOneAscOneDesc :: Spec @@ -87,7 +85,6 @@ testMysqlOneAscOneDesc = do liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ] -------------------------------------------------------------------------------- testMysqlCoalesce :: Spec @@ -101,7 +98,6 @@ testMysqlCoalesce = do return () -------------------------------------------------------------------------------- testMysqlUpdate :: Spec @@ -131,10 +127,10 @@ testMysqlUpdate = do , Entity p3k p3 ] -------------------------------------------------------------------------------- nameContains :: (BaseBackend backend ~ SqlBackend, + BackendCompatible SqlBackend backend, Esqueleto query expr backend, MonadIO m, SqlString s, IsPersistBackend backend, PersistQueryRead backend, PersistUniqueRead backend) @@ -166,7 +162,6 @@ testMysqlTextFunctions = do nameContains like "iv" [p4e] -------------------------------------------------------------------------------- main :: IO () main = do @@ -177,7 +172,8 @@ main = do testLocking withConn describe "MySQL specific tests" $ do - testMysqlRandom + -- definitely doesn't work at the moment + -- testMysqlRandom testMysqlSum testMysqlTwoAscFields testMysqlOneAscOneDesc @@ -186,7 +182,6 @@ main = do testMysqlTextFunctions -------------------------------------------------------------------------------- run, runSilent, runVerbose :: Run @@ -199,7 +194,7 @@ run = verbose :: Bool -verbose = True +verbose = False run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a diff --git a/test/PostgreSQL/Test.hs b/test/PostgreSQL/Test.hs index f8fc8b5..377450d 100644 --- a/test/PostgreSQL/Test.hs +++ b/test/PostgreSQL/Test.hs @@ -23,7 +23,7 @@ import Data.Time.Clock (getCurrentTime, diffUTCTime) import Common.Test -------------------------------------------------------------------------------- + testPostgresqlCoalesce :: Spec @@ -37,10 +37,11 @@ testPostgresqlCoalesce = do return () -------------------------------------------------------------------------------- + nameContains :: (BaseBackend backend ~ SqlBackend, + BackendCompatible SqlBackend backend, Esqueleto query expr backend, MonadIO m, SqlString s, IsPersistBackend backend, PersistQueryRead backend, PersistUniqueRead backend) @@ -74,18 +75,18 @@ testPostgresqlTextFunctions = 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 + 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] + nameContains' "mi" [p3e, p5e] + nameContains' "JOHN" [p1e] + -------------------------------------------------------------------------------- testPostgresqlUpdate :: Spec @@ -115,7 +116,7 @@ testPostgresqlUpdate = do , Entity p3k p3 ] -------------------------------------------------------------------------------- + testPostgresqlRandom :: Spec @@ -126,7 +127,7 @@ testPostgresqlRandom = do return () -------------------------------------------------------------------------------- + testPostgresqlSum :: Spec @@ -143,7 +144,7 @@ testPostgresqlSum = do liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Rational ) ] -------------------------------------------------------------------------------- + testPostgresqlTwoAscFields :: Spec @@ -162,7 +163,7 @@ testPostgresqlTwoAscFields = do liftIO $ ret `shouldBe` [ p4e, p3e, p1e , p2e ] -------------------------------------------------------------------------------- + testPostgresqlOneAscOneDesc :: Spec @@ -181,7 +182,7 @@ testPostgresqlOneAscOneDesc = do liftIO $ ret `shouldBe` [ p2e, p1e, p4e, p3e ] -------------------------------------------------------------------------------- + testSelectDistinctOn :: Spec @@ -232,7 +233,7 @@ testSelectDistinctOn = do distinctOnOrderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)] -------------------------------------------------------------------------------- + testPostgresModule :: Spec @@ -277,7 +278,7 @@ testPostgresModule = do liftIO $ diffUTCTime nowUtc now `shouldSatisfy` (< halfSecond) -------------------------------------------------------------------------------- + main :: IO () @@ -300,7 +301,7 @@ main = do testPostgresqlTextFunctions -------------------------------------------------------------------------------- + run, runSilent, runVerbose :: Run diff --git a/test/SQLite/Test.hs b/test/SQLite/Test.hs index b4d2c0e..ef77273 100644 --- a/test/SQLite/Test.hs +++ b/test/SQLite/Test.hs @@ -19,7 +19,7 @@ import Test.Hspec import Common.Test -------------------------------------------------------------------------------- + testSqliteRandom :: Spec @@ -30,7 +30,7 @@ testSqliteRandom = do return () -------------------------------------------------------------------------------- + testSqliteSum :: Spec @@ -47,7 +47,7 @@ testSqliteSum = do liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Int) ] -------------------------------------------------------------------------------- + testSqliteTwoAscFields :: Spec @@ -66,7 +66,7 @@ testSqliteTwoAscFields = do liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ] -------------------------------------------------------------------------------- + testSqliteOneAscOneDesc :: Spec @@ -85,7 +85,7 @@ testSqliteOneAscOneDesc = do liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ] -------------------------------------------------------------------------------- + testSqliteCoalesce :: Spec @@ -97,7 +97,7 @@ testSqliteCoalesce = do `shouldThrow` (\(_ :: SqliteException) -> True) -------------------------------------------------------------------------------- + testSqliteUpdate :: Spec @@ -126,10 +126,11 @@ testSqliteUpdate = do , Entity p3k p3 ] -------------------------------------------------------------------------------- + nameContains :: (BaseBackend backend ~ SqlBackend, + BackendCompatible SqlBackend backend, Esqueleto query expr backend, MonadIO m, SqlString s, IsPersistBackend backend, PersistQueryRead backend, PersistUniqueRead backend) @@ -160,7 +161,7 @@ testSqliteTextFunctions = do nameContains like "iv" [p4e] -------------------------------------------------------------------------------- + main :: IO () @@ -181,7 +182,7 @@ main = do testSqliteTextFunctions -------------------------------------------------------------------------------- + run, runSilent, runVerbose :: Run