Minor changes
This commit is contained in:
parent
1dd2e045b3
commit
5ff30e7c5c
24
test/Test.hs
24
test/Test.hs
@ -27,7 +27,9 @@ import Database.Persist.Postgresql (withPostgresqlConn)
|
|||||||
import Database.Persist.MySQL ( withMySQLConn
|
import Database.Persist.MySQL ( withMySQLConn
|
||||||
, connectHost
|
, connectHost
|
||||||
, connectDatabase
|
, connectDatabase
|
||||||
,connectUser,connectPassword,defaultConnectInfo)
|
, connectUser
|
||||||
|
, connectPassword
|
||||||
|
, defaultConnectInfo)
|
||||||
#endif
|
#endif
|
||||||
import Database.Persist.TH
|
import Database.Persist.TH
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
@ -55,8 +57,8 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
|
|||||||
|
|
||||||
-- | this could be achieved with S.fromList, but not all lists
|
-- | this could be achieved with S.fromList, but not all lists
|
||||||
-- have Ord instances
|
-- have Ord instances
|
||||||
sameElements :: Eq a => [a] -> [a] -> Bool
|
sameElementsAs :: Eq a => [a] -> [a] -> Bool
|
||||||
sameElements l1 l2 = null (l1 L.\\ l2)
|
sameElementsAs l1 l2 = null (l1 L.\\ l2)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
@ -110,10 +112,10 @@ main = do
|
|||||||
ret <- select $
|
ret <- select $
|
||||||
from $ \(person1, person2) ->
|
from $ \(person1, person2) ->
|
||||||
return (person1, person2)
|
return (person1, person2)
|
||||||
liftIO $ ret `shouldSatisfy` sameElements [ (p1e, p1e)
|
liftIO $ ret `shouldSatisfy` sameElementsAs [ (p1e, p1e)
|
||||||
, (p1e, p2e)
|
, (p1e, p2e)
|
||||||
, (p2e, p1e)
|
, (p2e, p1e)
|
||||||
, (p2e, p2e) ]
|
, (p2e, p2e) ]
|
||||||
|
|
||||||
it "works for a simple projection" $
|
it "works for a simple projection" $
|
||||||
run $ do
|
run $ do
|
||||||
@ -132,7 +134,7 @@ main = do
|
|||||||
ret <- select $
|
ret <- select $
|
||||||
from $ \(pa, pb) ->
|
from $ \(pa, pb) ->
|
||||||
return (pa ^. PersonName, pb ^. PersonName)
|
return (pa ^. PersonName, pb ^. PersonName)
|
||||||
liftIO $ ret `shouldSatisfy` sameElements
|
liftIO $ ret `shouldSatisfy` sameElementsAs
|
||||||
[ (Value (personName p1), Value (personName p1))
|
[ (Value (personName p1), Value (personName p1))
|
||||||
, (Value (personName p1), Value (personName p2))
|
, (Value (personName p1), Value (personName p2))
|
||||||
, (Value (personName p2), Value (personName p1))
|
, (Value (personName p2), Value (personName p1))
|
||||||
@ -771,6 +773,10 @@ type RunDbMonad m = ( MonadBaseControl IO m, MonadIO m, MonadLogger m
|
|||||||
, C.MonadUnsafeIO m, C.MonadThrow m )
|
, C.MonadUnsafeIO m, C.MonadThrow m )
|
||||||
|
|
||||||
#if defined (WITH_POSTGRESQL) || defined (WITH_MYSQL)
|
#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.
|
||||||
|
-- TODO: there is certainly a better way...
|
||||||
cleanDB
|
cleanDB
|
||||||
:: (forall m. RunDbMonad m
|
:: (forall m. RunDbMonad m
|
||||||
=> SqlPersistT (C.ResourceT m) ())
|
=> SqlPersistT (C.ResourceT m) ())
|
||||||
@ -798,7 +804,7 @@ run_worker :: RunDbMonad m => SqlPersistT (C.ResourceT m) a -> m a
|
|||||||
run_worker act =
|
run_worker act =
|
||||||
C.runResourceT .
|
C.runResourceT .
|
||||||
#if defined(WITH_POSTGRESQL)
|
#if defined(WITH_POSTGRESQL)
|
||||||
withPostgresqlConn "host=localhost port=5432 user=test dbname=test" .
|
withPostgresqlConn "host=localhost port=5432 user=joao dbname=esqueleto" .
|
||||||
#elif defined (WITH_MYSQL)
|
#elif defined (WITH_MYSQL)
|
||||||
withMySQLConn defaultConnectInfo
|
withMySQLConn defaultConnectInfo
|
||||||
{ connectHost = "localhost"
|
{ connectHost = "localhost"
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user