persistent-test 2.0.3.3 → 2.0.3.4
raw patch · 16 files changed
+367/−108 lines, 16 files
Files
- ChangeLog.md +4/−0
- persistent-test.cabal +3/−1
- src/CompositeTest.hs +5/−5
- src/ForeignKey.hs +206/−42
- src/GeneratedColumnTestSQL.hs +53/−0
- src/HtmlTest.hs +1/−1
- src/Init.hs +20/−9
- src/MigrationTest.hs +3/−3
- src/PersistUniqueTest.hs +15/−0
- src/PersistentTest.hs +24/−20
- src/RawSqlTest.hs +10/−10
- src/ReadWriteTest.hs +3/−3
- src/RenameTest.hs +18/−11
- src/TransactionLevelTest.hs +1/−1
- src/TreeTest.hs +0/−1
- src/UpsertTest.hs +1/−1
ChangeLog.md view
@@ -1,5 +1,9 @@ ## Unreleased changes +## 2.0.3.4++* lots of stuff actually :\ should probably start tracking this more!+ ## 2.0.3.3 * Fix RawSqlTest, which could fail non-deterministically for Postgres [#1139](https://github.com/yesodweb/persistent/pull/1139)
persistent-test.cabal view
@@ -1,5 +1,5 @@ name: persistent-test-version: 2.0.3.3+version: 2.0.3.4 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -39,6 +39,7 @@ PersistentTest PersistentTestModels PersistentTestModelsImports+ GeneratedColumnTestSQL PersistTestPetType PersistTestPetCollarType PersistUniqueTest@@ -97,6 +98,7 @@ StandaloneDeriving DerivingStrategies GeneralizedNewtypeDeriving+ DataKinds source-repository head type: git
src/CompositeTest.hs view
@@ -135,7 +135,7 @@ it "Extract Parent Foreign Key from Child value" $ runDb $ do kp1 <- insert p1- _ <- insert p2+ insert_ p2 kc1 <- insert c1 mc <- get kc1 isJust mc @== True@@ -144,9 +144,9 @@ testChildFkparent c11 @== kp1 it "Validate Key contents" $ runDb $ do- _ <- insert p1- _ <- insert p2- _ <- insert p3+ insert_ p1+ insert_ p2+ insert_ p3 xs <- selectKeysList [] [Asc TestParentName] length xs @== 3 let [kps1,kps2,kps3] = xs@@ -178,7 +178,7 @@ it "Replace Child" $ runDb $ do -- c1 FKs p1- _ <- insert p1+ insert_ p1 kc1 <- insert c1 _ <- replace kc1 c1' newc1 <- get kc1
src/ForeignKey.hs view
@@ -1,66 +1,230 @@ {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE AllowAmbiguousTypes, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications, UndecidableInstances #-}+ module ForeignKey where +import Data.Proxy+import qualified Data.List as List import Init -- mpsGeneric = False is due to a bug or at least lack of a feature in mkKeyTypeDec TH.hs share [mkPersist persistSettings { mpsGeneric = False }, mkMigrate "compositeMigrate"] [persistLowerCase|- Parent- name String+SimpleCascadeChild+ ref SimpleCascadeId OnDeleteCascade+ deriving Show Eq++SimpleCascade+ name Int+ deriving Show Eq++Parent+ name Int Primary name - Child- pname String+Child+ pname Int Foreign Parent OnDeleteCascade OnUpdateCascade fkparent pname deriving Show Eq - ParentComposite- name String- lastName String+ParentImplicit+ name Int++ChildImplicit+ pname Int+ parentId ParentImplicitId noreference+ Foreign ParentImplicit OnDeleteCascade OnUpdateCascade fkparent parentId+ deriving Show Eq++ParentComposite+ name Int+ lastName Int Primary name lastName - ChildComposite- pname String- plastName String+ChildComposite+ pname Int+ plastName Int Foreign ParentComposite OnDeleteCascade fkparent pname plastName deriving Show Eq - SelfReferenced- name String- pname String+SelfReferenced+ name Int+ pname Int Primary name Foreign SelfReferenced OnDeleteCascade fkparent pname deriving Show Eq++A+ aa Int+ ab Int+ U1 aa++B+ ba Int+ bb Int+ Foreign A OnDeleteCascade fkA ba References aa+ deriving Show Eq++AComposite+ aa Int+ ab Int+ U2 aa ab++BComposite+ ba Int+ bb Int+ Foreign AComposite OnDeleteCascade fkAComposite ba bb References aa ab+ deriving Show Eq++BExplicit+ ba AId noreference+ Foreign A OnDeleteCascade fkAI ba References Id+ deriving Show Eq++Chain+ name Int+ previous ChainId Maybe noreference+ Foreign Chain OnDeleteSetNull fkChain previous References Id+ deriving Show Eq Ord++Chain2+ name Int+ previous Chain2Id Maybe noreference+ Foreign Chain2 OnDeleteCascade fkChain previous References Id+ deriving Show Eq |] specsWith :: (MonadIO m, MonadFail m) => RunDb SqlBackend m -> Spec specsWith runDb = describe "foreign keys options" $ do- it "delete cascades" $ runDb $ do- kf <- insert $ Parent "A"- kc <- insert $ Child "A"- delete kf- cs <- selectList [] []- let expected = [] :: [Entity Child]- cs @== expected- it "update cascades" $ runDb $ do- kf <- insert $ Parent "A"- kc <- insert $ Child "A"- update kf [ParentName =. "B"]- cs <- selectList [] []- fmap (childPname . entityVal) cs @== ["B"]- it "delete Composite cascades" $ runDb $ do- kf <- insert $ ParentComposite "A" "B"- kc <- insert $ ChildComposite "A" "B"- delete kf- cs <- selectList [] []- let expected = [] :: [Entity ChildComposite]- cs @== expected- it "delete self referenced cascades" $ runDb $ do- kf <- insert $ SelfReferenced "A" "A" -- bootstrap self reference- kc <- insert $ SelfReferenced "B" "A"- delete kf- srs <- selectList [] []- let expected = [] :: [Entity SelfReferenced]- srs @== expected+ it "delete cascades" $ runDb $ do+ kf <- insert $ Parent 1+ insert_ $ Child 1+ delete kf+ cs <- selectList [] []+ let expected = [] :: [Entity Child]+ cs @== expected+ it "update cascades" $ runDb $ do+ kf <- insert $ Parent 1+ insert_ $ Child 1+ update kf [ParentName =. 2]+ cs <- selectList [] []+ fmap (childPname . entityVal) cs @== [2]+ it "delete Composite cascades" $ runDb $ do+ kf <- insert $ ParentComposite 1 2+ insert_ $ ChildComposite 1 2+ delete kf+ cs <- selectList [] []+ let expected = [] :: [Entity ChildComposite]+ cs @== expected+ it "delete self referenced cascades" $ runDb $ do+ kf <- insert $ SelfReferenced 1 1+ insert_ $ SelfReferenced 2 1+ delete kf+ srs <- selectList [] []+ let expected = [] :: [Entity SelfReferenced]+ srs @== expected+ it "delete cascade works on simple references" $ runDb $ do+ scId <- insert $ SimpleCascade 1+ sccId <- insert $ SimpleCascadeChild scId+ Just _ <- get sccId+ delete scId+ mres <- get sccId+ mxs <- selectList @SimpleCascadeChild [] []+ liftIO $ do+ mres `shouldBe` Nothing+ mxs `shouldBe` []+ it "delete cascades with explicit Reference" $ runDb $ do+ kf <- insert $ A 1 40+ insert_ $ B 1 15+ delete kf+ return ()+ cs <- selectList [] []+ let expected = [] :: [Entity B]+ cs @== expected+ it "delete cascades with explicit Composite Reference" $ runDb $ do+ kf <- insert $ AComposite 1 20+ insert_ $ BComposite 1 20+ delete kf+ return ()+ cs <- selectList [] []+ let expected = [] :: [Entity B]+ cs @== expected+ it "delete cascades with explicit Composite Reference" $ runDb $ do+ kf <- insert $ AComposite 1 20+ insert_ $ BComposite 1 20+ delete kf+ return ()+ cs <- selectList [] []+ let expected = [] :: [Entity B]+ cs @== expected+ it "delete cascades with explicit Id field" $ runDb $ do+ kf <- insert $ A 1 20+ insert_ $ BExplicit kf+ delete kf+ return ()+ cs <- selectList [] []+ let expected = [] :: [Entity B]+ cs @== expected+ it "deletes sets null with self reference" $ runDb $ do+ kf <- insert $ Chain 1 Nothing+ kf' <- insert $ Chain 2 (Just kf)+ delete kf+ cs <- selectList [] []+ let expected = [Entity {entityKey = kf', entityVal = Chain 2 Nothing}]+ List.sort cs @== List.sort expected+ it "deletes cascades with self reference to the whole chain" $ runDb $ do+ k1 <- insert $ Chain2 1 Nothing+ k2 <- insert $ Chain2 2 (Just k1)+ insert_ $ Chain2 3 (Just k2)+ delete k1+ cs <- selectList [] []+ let expected = [] :: [Entity Chain2]+ cs @== expected++ describe "EntityDef" $ do+ let ed =+ entityDef (Proxy @SimpleCascadeChild)+ isRefCol =+ (HaskellName "ref" ==) . fieldHaskell+ expected = FieldCascade+ { fcOnUpdate = Nothing+ , fcOnDelete = Just Cascade+ }+ Just refField =+ List.find isRefCol (entityFields ed)++ it "parses into fieldCascade" $ do+ fieldCascade refField `shouldBe` expected++ it "shouldn't have cascade in extras" $ do+ entityExtra ed+ `shouldBe`+ mempty++cleanDB :: (MonadIO m) => SqlPersistT m ()+cleanDB = do+ del @SimpleCascadeChild+ del @SimpleCascade+ del @Parent+ del @ParentComposite+ del @ParentImplicit+ del @Child+ del @ChildComposite+ del @ChildImplicit+ del @SelfReferenced+ del @A+ del @AComposite+ del @B+ del @BExplicit+ del @BComposite+ del @Chain+ del @Chain2++del+ :: forall a m.+ ( PersistEntity a+ , PersistEntityBackend a ~ SqlBackend+ , MonadIO m+ )+ => SqlPersistT m ()+del = deleteWhere @_ @_ @a []
+ src/GeneratedColumnTestSQL.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+module GeneratedColumnTestSQL (specsWith) where++import Database.Persist.TH+import Init++share [mkPersist sqlSettings, mkMigrate "migrate1", mkDeleteCascade sqlSettings] [persistLowerCase|+GenTest sql=gen_test+ fieldOne Text Maybe+ fieldTwo Text Maybe+ fieldThree Text Maybe generated=COALESCE(field_one,field_two)+ deriving Show Eq++MigrateTestV1 sql=gen_migrate_test+ sickness Int+ cromulence Int generated=5+|]++share [mkPersist sqlSettings, mkMigrate "migrate2", mkDeleteCascade sqlSettings] [persistLowerCase|+MigrateTestV2 sql=gen_migrate_test+ sickness Int generated=3+ cromulence Int+|]++specsWith :: Runner SqlBackend m => RunDb SqlBackend m -> Spec+specsWith runDB = describe "PersistLiteral field" $ do+ it "should read a generated column" $ runDB $ do+ rawExecute "DROP TABLE IF EXISTS gen_test;" []+ rawExecute "DROP TABLE IF EXISTS gen_migrate_test;" []+ runMigration migrate1++ insert_ GenTest+ { genTestFieldOne = Just "like, literally this exact string"+ , genTestFieldTwo = Just "like, totally some other string"+ , genTestFieldThree = Nothing+ }+ Just (Entity _ GenTest{..}) <- selectFirst [] []+ liftIO $ genTestFieldThree @?= Just "like, literally this exact string"++ k1 <- insert $ MigrateTestV1 0 0+ Just (MigrateTestV1 sickness1 cromulence1) <- get k1+ liftIO $ sickness1 @?= 0+ liftIO $ cromulence1 @?= 5++ it "should support adding or removing generation expressions from columns" $ runDB $ do+ runMigration migrate2++ k2 <- insert $ MigrateTestV2 0 0+ Just (MigrateTestV2 sickness2 cromulence2) <- get k2+ liftIO $ sickness2 @?= 3+ liftIO $ cromulence2 @?= 0
src/HtmlTest.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds, UndecidableInstances #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} module HtmlTest (specsWith, cleanDB, htmlMigrate) where
src/Init.hs view
@@ -41,21 +41,28 @@ , arbText , liftA2 , changeBackend+ , Proxy(..) ) where +#if !MIN_VERSION_monad_logger(0,3,30)+-- Needed for GHC versions 7.10.3. Can drop when we drop support for GHC+-- 7.10.3+import Control.Monad.IO.Class+import Control.Monad.Logger+import qualified Control.Monad.Fail as MonadFail+#endif+ -- needed for backwards compatibility import Control.Monad.Base import Control.Monad.Catch import Control.Monad.IO.Unlift-import qualified Control.Monad.Fail as MonadFail-import Control.Monad.Logger import Control.Monad.Trans.Class import Control.Monad.Trans.Control import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource.Internal -- re-exports-import Control.Applicative (liftA2)+import Control.Applicative (liftA2, (<|>)) import Control.Exception (SomeException) import Control.Monad (void, replicateM, liftM, when, forM_) import Control.Monad.Fail (MonadFail)@@ -66,6 +73,7 @@ import Data.Time import Test.Hspec import Test.QuickCheck.Instances ()+import Data.Proxy import Database.Persist.TH (mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase, MkPersistSettings(..)) @@ -74,7 +82,6 @@ import Test.QuickCheck import Control.Monad (unless, (>=>))-import Control.Monad.IO.Class import Control.Monad.IO.Unlift (MonadUnliftIO) import qualified Data.ByteString as BS import Data.IORef@@ -119,11 +126,15 @@ assertNotEmpty xs = liftIO $ assertBool "" (not (null xs)) isTravis :: IO Bool-isTravis = do- env <- liftIO getEnvironment- return $ case lookup "TRAVIS" env of- Just "true" -> True- _ -> False+isTravis = isCI++isCI :: IO Bool+isCI = do+ env <- liftIO getEnvironment+ return $ case lookup "TRAVIS" env <|> lookup "CI" env of+ Just "true" -> True+ _ -> False+ persistSettings :: MkPersistSettings persistSettings = sqlSettings { mpsGeneric = True }
src/MigrationTest.hs view
@@ -42,14 +42,14 @@ again <- getMigration migrationMigrate liftIO $ again @?= [] it "really is idempotent" $ runDb $ do- runMigrationSilent migrationMigrate- runMigrationSilent migrationMigrate+ void $ runMigrationSilent migrationMigrate+ void $ runMigrationSilent migrationMigrate again <- getMigration migrationMigrate liftIO $ again @?= [] it "can add an extra column" $ runDb $ do -- Failing test case for #735. Foreign-key checking, switched on in -- version 2.6.1, caused persistent-sqlite to generate a `references` -- constraint in a *temporary* table during migration, which fails.- _ <- runMigrationSilent migrationAddCol+ void $ runMigrationSilent migrationAddCol again <- getMigration migrationAddCol liftIO $ again @?= []
src/PersistUniqueTest.hs view
@@ -31,3 +31,18 @@ Just (Entity _ insertedFoValue) <- insertUniqueEntity fo Nothing <- insertUniqueEntity fo fo @== insertedFoValue+ it "checkUniqueUpdateable" $ runDb $ do+ let f = 3+ let b = 5+ let fo = Fo f b+ k <- insert fo+ Just _ <- checkUnique fo -- conflicts with itself++ let fo' = Fo (f + 1) b+ Just _ <- checkUnique fo' -- conflicts with fo+ Nothing <- checkUniqueUpdateable $ Entity k fo' -- but fo can be updated to fo'++ let fo'' = Fo (f + 1) (b + 1)+ insert_ fo''+ Just (UniqueBar conflict) <- checkUniqueUpdateable $ Entity k fo'' -- fo can't be updated to fo''+ conflict @== b + 1
src/PersistentTest.hs view
@@ -14,7 +14,6 @@ import Control.Monad.IO.Class import Data.Aeson import Data.Conduit-import qualified Data.Text as T import qualified Data.Conduit.List as CL import Data.Functor.Constant import Data.Functor.Identity@@ -28,7 +27,6 @@ import Data.Proxy (Proxy(..)) import Database.Persist-import Database.Persist.Quasi import Init import PersistentTestModels import PersistTestPetType@@ -48,12 +46,12 @@ filterOrSpecs runDb = describe "FilterOr" $ do it "FilterOr []" $ runDb $ do let p = Person "z" 1 Nothing- _ <- insert p+ insert_ p ps <- selectList [FilterOr []] [Desc PersonAge] assertEmpty ps it "||. []" $ runDb $ do let p = Person "z" 1 Nothing- _ <- insert p+ insert_ p c <- count $ [PersonName ==. "a"] ||. [] c @== (1::Int) @@ -62,7 +60,7 @@ _polymorphic = do ((Entity id' _):_) <- selectList [] [LimitTo 1] _ <- selectList [PetOwnerId ==. id'] []- _ <- insert $ Pet id' "foo" Cat+ insert_ $ Pet id' "foo" Cat return () -- Some lens stuff@@ -86,7 +84,7 @@ it "FilterAnd []" $ runDb $ do let p = Person "z" 1 Nothing- _ <- insert p+ insert_ p ps <- selectList [FilterAnd []] [Desc PersonAge] assertNotEmpty ps @@ -139,13 +137,21 @@ Just mic29 <- get micK personAge mic29 @== 29 + let louis = Person "Louis" 55 $ Just "brown"+ ex0 <- exists [PersonName ==. "Louis"]+ ex0 @== False+ louisK <- insert louis+ ex1 <- exists [PersonName ==. "Louis"]+ ex1 @== True+ delete louisK+ let eli = Person "Eliezer" 2 $ Just "blue"- _ <- insert eli+ insert_ eli pasc <- selectList [] [Asc PersonAge] map entityVal pasc @== [eli, mic29] let abe30 = Person "Abe" 30 $ Just "black"- _ <- insert abe30+ insert_ abe30 -- pdesc <- selectList [PersonAge <. 30] [Desc PersonName] map entityVal pasc @== [eli, mic29] @@ -179,9 +185,9 @@ it "!=." $ runDb $ do deleteWhere ([] :: [Filter (PersonGeneric backend)]) let mic = Person "Michael" 25 Nothing- _ <- insert mic+ insert_ mic let eli = Person "Eliezer" 25 (Just "Red")- _ <- insert eli+ insert_ eli pne <- selectList [PersonName !=. "Michael"] [] map entityVal pne @== [eli]@@ -196,9 +202,9 @@ it "Double Maybe" $ runDb $ do deleteWhere ([] :: [Filter (PersonMayGeneric backend)]) let mic = PersonMay (Just "Michael") Nothing- _ <- insert mic+ insert_ mic let eli = PersonMay (Just "Eliezer") (Just "Red")- _ <- insert eli+ insert_ eli pe <- selectList [PersonMayName ==. Nothing, PersonMayColor ==. Nothing] [] map entityVal pe @== [] pne <- selectList [PersonMayName !=. Nothing, PersonMayColor !=. Nothing] []@@ -258,7 +264,7 @@ it "deleteBy" $ runDb $ do- _ <- insert $ Person "Michael2" 27 Nothing+ insert_ $ Person "Michael2" 27 Nothing let p3 = Person "Michael3" 27 Nothing key3 <- insert p3 @@ -437,7 +443,7 @@ e4 @== Nothing it "selectFirst" $ runDb $ do- _ <- insert $ Person "Michael" 26 Nothing+ insert_ $ Person "Michael" 26 Nothing let pOld = Person "Oldie" 75 Nothing kOld <- insert pOld @@ -577,7 +583,7 @@ p2 = Person "E" 1 Nothing p3 = Person "F" 2 Nothing pid1 <- insert p1- _ <- insert p2+ insert_ p2 pid3 <- insert p3 x <- selectList [PersonId <-. [pid1, pid3]] [] liftIO $ x @?= [Entity pid1 p1, Entity pid3 p3]@@ -630,7 +636,7 @@ `shouldBe` Just "This is a doc comment for a relationship.\nYou need to put the pipe character for each line of documentation.\nBut you can resume the doc comments afterwards.\n" it "provides comments on the field" $ do- let [nameField, parentField] = entityFields edef+ let [nameField, _] = entityFields edef fieldComments nameField `shouldBe` Just "Fields should be documentable.\n"@@ -653,11 +659,11 @@ it "decodes without an ID field" $ do let- json = encode . Object . M.fromList $+ json_ = encode . Object . M.fromList $ [ ("name", String "Bob") , ("age", toJSON (32 :: Int)) ]- decode json+ decode json_ `shouldBe` Just subjectEntity @@ -703,5 +709,3 @@ , ("blood", toJSON jsonEncoding2Blood) , ("id", toJSON key) ])--
src/RawSqlTest.hs view
@@ -36,16 +36,16 @@ Entity _ _ <- insertEntity $ Pet p3k "Abacate" Cat escape <- getEscape person <- getTableName (error "rawSql Person" :: Person)- name <- getFieldName PersonName+ name_ <- getFieldName PersonName pet <- getTableName (error "rawSql Pet" :: Pet)- petName <- getFieldName PetName+ petName_ <- getFieldName PetName let query = T.concat [ "SELECT ??, ?? " , "FROM ", person , ", ", escape "Pet" , " WHERE ", person, ".", escape "age", " >= ? " , "AND ", escape "Pet", ".", escape "ownerId", " = " , person, ".", escape "id"- , " ORDER BY ", person, ".", name, ", ", pet, ".", petName+ , " ORDER BY ", person, ".", name_, ", ", pet, ".", petName_ ] ret <- rawSql query [PersistInt64 20] liftIO $ ret @?= [ (Entity p1k p1, Entity a1k a1)@@ -150,9 +150,9 @@ let p = Person1 "foo" 0 - _ <- insert p- _ <- insert p- _ <- insert p+ insert_ p+ insert_ p+ insert_ p c1 <- count filt c1 @== 3@@ -161,15 +161,15 @@ c2 <- count filt c2 @== 3 - _ <- insert p+ insert_ p transactionUndo c3 <- count filt c3 @== 3 - _ <- insert p+ insert_ p transactionSave- _ <- insert p- _ <- insert p+ insert_ p+ insert_ p transactionUndo c4 <- count filt c4 @== 4
src/ReadWriteTest.hs view
@@ -46,10 +46,10 @@ it "type checks on PersistUniqueWrite/Read functions" $ do runDb $ do- let name = "Matt Parsons New"- person = Person name 30 Nothing+ let name_ = "Matt Parsons New"+ person = Person name_ 30 Nothing _mkey0 <- insertUnique person mkey1 <- insertUnique person mkey1 @== Nothing- mperson <- selectFirst [PersonName ==. name] []+ mperson <- selectFirst [PersonName ==. name_] [] fmap entityVal mperson @== Just person
src/RenameTest.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications, UndecidableInstances #-}+ module RenameTest where import qualified Data.Map as Map@@ -72,17 +73,23 @@ => RunDb backend m -> Spec specsWith runDb = describe "rename specs" $ do+ describe "LowerCaseTable" $ do+ it "LowerCaseTable has the right sql name" $ do+ fieldDB (entityId (entityDef (Proxy @LowerCaseTable)))+ `shouldBe`+ DBName "my_id"+ it "user specified id, insertKey, no default=" $ runDb $ do- let rec2 = IdTable "Foo2" Nothing- let rec1 = IdTable "Foo1" $ Just rec2- let rec = IdTable "Foo" $ Just rec1- now <- liftIO getCurrentTime- let key = IdTableKey $ utctDay now- insertKey key rec- Just rec' <- get key- rec' @== rec- (Entity key' _):_ <- selectList ([] :: [Filter (IdTableGeneric backend)]) []- key' @== key+ let rec2 = IdTable "Foo2" Nothing+ let rec1 = IdTable "Foo1" $ Just rec2+ let rec = IdTable "Foo" $ Just rec1+ now <- liftIO getCurrentTime+ let key = IdTableKey $ utctDay now+ insertKey key rec+ Just rec' <- get key+ rec' @== rec+ (Entity key' _):_ <- selectList ([] :: [Filter (IdTableGeneric backend)]) []+ key' @== key it "extra blocks" $ entityExtra (entityDef (Nothing :: Maybe LowerCaseTable)) @?=
src/TransactionLevelTest.hs view
@@ -22,6 +22,6 @@ it (show il ++ " works") $ runDb $ do transactionUndoWithIsolation il deleteWhere ([] :: [Filter Wombat])- _ <- insert item+ insert_ item Just item' <- get (WombatKey "uno") item' @== item
src/TreeTest.hs view
@@ -6,7 +6,6 @@ import Init import Database.Persist.TH (mkDeleteCascade)-import Data.Proxy -- mpsGeneric = False is due to a bug or at least lack of a feature in
src/UpsertTest.hs view
@@ -148,7 +148,7 @@ describe "putMany" $ do it "adds new rows when entity has no unique constraints" $ runDb $ do- let mkPerson name = Person1 name 25+ let mkPerson name_ = Person1 name_ 25 let names = ["putMany bob", "putMany bob", "putMany smith"] let records = map mkPerson names _ <- putMany records