Updating for UnliftIO, Conduit 1.3, Persistent 2.8
This commit is contained in:
Chris Allen
parent
52d546f60b
commit
0acb568445
1
.gitignore
vendored
1
.gitignore
vendored
@ -3,3 +3,4 @@
|
||||
*~
|
||||
.cabal-sandbox/
|
||||
cabal.sandbox.config
|
||||
.hspec-failures
|
||||
|
||||
4
Makefile
4
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 ^.
|
||||
|
||||
@ -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'." #-}
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
@ -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
|
||||
@ -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
|
||||
|
||||
@ -1 +1 @@
|
||||
stack-8.0.yaml
|
||||
stack-8.2.yaml
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user