persistent-test 2.12.0.0 → 2.13.0.0

raw patch · 15 files changed

+125/−128 lines, 15 filesdep +http-api-datadep ~basedep ~persistentPVP ok

version bump matches the API change (PVP)

Dependencies added: http-api-data

Dependency ranges changed: base, persistent

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• persistent-test.cabal +3/−2
• src/CompositeTest.hs +3/−2
• src/ForeignKey.hs +3/−1
• src/GeneratedColumnTestSQL.hs +2/−2
• src/Init.hs +57/−8
• src/LongIdentifierTest.hs +1/−1
• src/MigrationOnlyTest.hs +26/−2
• src/MigrationTest.hs +2/−2
• src/PersistentTest.hs +2/−71
• src/PersistentTestModels.hs +5/−25
• src/RawSqlTest.hs +2/−1
• src/Recursive.hs +5/−0
• src/RenameTest.hs +3/−3
• src/TreeTest.hs +6/−8

@@ -1,5 +1,10 @@ ## Unreleased changes +## 2.13.0.0 (unreleased)++* [#1225](https://github.com/yesodweb/persistent/pull/1225)+    * Support `persistent-2.13` changes for SqlBackend being made internal.+ ## 2.12.0.0  * Decomposed `HaskellName` into `ConstraintNameHS`, `EntityNameHS`, `FieldNameHS`. Decomposed `DBName` into `ConstraintNameDB`, `EntityNameDB`, `FieldNameDB` respectively. [#1174](https://github.com/yesodweb/persistent/pull/1174)

@@ -1,5 +1,5 @@ name:            persistent-test-version:         2.12.0.0+version:         2.13.0.0 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -60,7 +60,6 @@      build-depends:          base                     >= 4.9       && < 5-      , persistent               >= 2.12      && < 2.13       , aeson                    >= 1.0       , blaze-html               >= 0.9       , bytestring               >= 0.10@@ -69,11 +68,13 @@       , exceptions               >= 0.8       , hspec                    >= 2.4       , hspec-expectations+      , http-api-data       , HUnit       , monad-control       , monad-logger             >= 0.3.25       , mtl       , path-pieces              >= 0.2+      , persistent               >= 2.13      && < 2.14       , QuickCheck               >= 2.9       , quickcheck-instances     >= 0.3       , random                   >= 1.1

@@ -7,12 +7,11 @@ import qualified Data.Map as Map import Data.Maybe (isJust) -import Database.Persist.TH (mkDeleteCascade) 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", mkDeleteCascade persistSettings { mpsGeneric = False }] [persistLowerCase|+share [mkPersist persistSettings { mpsGeneric = False }, mkMigrate "compositeMigrate"] [persistLowerCase|   TestParent       name  String maxlen=20       name2 String maxlen=20@@ -233,6 +232,8 @@      it "RawSql Entity instance" $ runDb $ do       key <- insert p1+      Just x <- get key+      x @== p1       newp1 <- rawSql "SELECT ?? FROM test_parent LIMIT 1" []       [Entity key p1] @== newp1 

@@ -8,6 +8,8 @@ import qualified Data.List as List import Init +import Database.Persist.EntityDef.Internal (entityExtra)+ -- 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| SimpleCascadeChild@@ -204,7 +206,7 @@                 , fcOnDelete = Just Cascade                 }             Just refField =-                List.find isRefCol (entityFields ed)+                List.find isRefCol (getEntityFields ed)          it "parses into fieldCascade"  $ do             fieldCascade refField `shouldBe` expected

@@ -6,7 +6,7 @@ import Database.Persist.TH import Init -share [mkPersist sqlSettings, mkMigrate "migrate1", mkDeleteCascade sqlSettings] [persistLowerCase|+share [mkPersist sqlSettings, mkMigrate "migrate1"] [persistLowerCase| GenTest sql=gen_test   fieldOne Text Maybe   fieldTwo Text Maybe@@ -18,7 +18,7 @@   cromulence Int generated=5 |] -share [mkPersist sqlSettings, mkMigrate "migrate2", mkDeleteCascade sqlSettings] [persistLowerCase|+share [mkPersist sqlSettings, mkMigrate "migrate2"] [persistLowerCase| MigrateTestV2 sql=gen_migrate_test   sickness Int generated=3   cromulence Int

@@ -1,6 +1,8 @@-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -42,14 +44,16 @@   , liftA2   , changeBackend   , Proxy(..)+  , UUID(..)+  , sqlSettingsUuid   ) 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 qualified Control.Monad.Fail as MonadFail import Control.Monad.IO.Class import Control.Monad.Logger-import qualified Control.Monad.Fail as MonadFail #endif  -- needed for backwards compatibility@@ -64,21 +68,35 @@ -- re-exports import Control.Applicative (liftA2, (<|>)) import Control.Exception (SomeException)-import Control.Monad (void, replicateM, liftM, when, forM_)+import Control.Monad (forM_, liftM, replicateM, void, when) import Control.Monad.Fail (MonadFail) import Control.Monad.Reader-import Data.Char (generalCategory, GeneralCategory(..))-import Data.Fixed (Pico,Micro)+import Data.Char (GeneralCategory(..), generalCategory)+import Data.Fixed (Micro, Pico)+import Data.Proxy import qualified Data.Text as T import Data.Time import Test.Hspec import Test.QuickCheck.Instances ()-import Data.Proxy -import Database.Persist.TH (mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase, MkPersistSettings(..))+import Data.Aeson (FromJSON, ToJSON, Value(..))+import qualified Data.Text.Encoding as TE+import Database.Persist.ImplicitIdDef (mkImplicitIdDef)+import Database.Persist.TH+       ( MkPersistSettings(..)+       , mkMigrate+       , mkPersist+       , persistLowerCase+       , persistUpperCase+       , setImplicitIdDef+       , share+       , sqlSettings+       )+import Web.Internal.HttpApiData+import Web.PathPieces  -- testing-import Test.HUnit ((@?=),(@=?), Assertion, assertFailure, assertBool)+import Test.HUnit (Assertion, assertBool, assertFailure, (@=?), (@?=)) import Test.QuickCheck  import Control.Monad (unless, (>=>))@@ -247,3 +265,34 @@              f $ runInBase . (\(ResourceT r) -> r reader')      restoreM = ResourceT . const . restoreM #endif++-- * For implicit ID spec++newtype UUID = UUID { unUUID :: Text }+    deriving stock+        (Show, Eq, Ord, Read)+    deriving newtype+        (ToJSON, FromJSON, FromHttpApiData, ToHttpApiData, PathPiece)++instance PersistFieldSql UUID where+    sqlType _ = SqlOther "UUID"++instance PersistField UUID where+    toPersistValue (UUID txt) =+        PersistLiteral_ Escaped (TE.encodeUtf8 txt)+    fromPersistValue pv =+        case pv of+            PersistLiteral_ Escaped bs ->+                Right $ UUID (TE.decodeUtf8 bs)+            _ ->+                Left "Nope"++sqlSettingsUuid :: Text -> MkPersistSettings+sqlSettingsUuid defExpr =+    let+        uuidDef =+           mkImplicitIdDef @UUID defExpr+        settings =+            setImplicitIdDef uuidDef sqlSettings+     in+        settings

@@ -18,7 +18,7 @@ -- This test creates very long identifier names. The generated foreign key is over the length limit for Postgres and MySQL -- persistent-postgresql handles this by truncating foreign key names using the same algorithm that Postgres itself does (see 'refName' in Postgresql.hs) -- MySQL currently doesn't run this test, and needs truncation logic for it to pass.-share [mkPersist sqlSettings, mkMigrate "migration", mkDeleteCascade sqlSettings] [persistLowerCase|+share [mkPersist sqlSettings, mkMigrate "migration"] [persistLowerCase| TableAnExtremelyFantasticallySuperLongNameParent     field1 Int TableAnExtremelyFantasticallySuperLongNameChild

@@ -1,11 +1,14 @@-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications, UndecidableInstances #-}+ {-# OPTIONS_GHC -Wno-unused-top-binds #-}+ module MigrationOnlyTest (specsWith, migrateAll1, migrateAll2) where  import qualified Data.Text as T  import Database.Persist.TH import Init+import Database.Persist.EntityDef  share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "migrateAll1"] [persistLowerCase| TwoField1 sql=two_field@@ -15,7 +18,7 @@     deriving Eq Show |] -share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "migrateAll2", mkDeleteCascade sqlSettings] [persistLowerCase|+share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "migrateAll2"] [persistLowerCase| TwoField     field1 Int     field2 T.Text@@ -33,6 +36,27 @@     -> Maybe (ReaderT backend m a)     -> Spec specsWith runDb mmigrate = describe "MigrationOnly field" $ do+    let+        edef =+            entityDef $ Proxy @TwoField+    describe "getEntityFields" $ do+        let+            fields =+                getEntityFields edef+        it "should have two fields" $ do+            length fields `shouldBe` 2+        it "should not have any migration only fields" $ do+            fields `shouldSatisfy` all isHaskellField++    describe "getEntityFieldsDatabase" $ do+        let+            fields =+                getEntityFieldsDatabase edef+        it "should have three fields" $ do+            length fields `shouldBe` 3+        it "should have at one migration only field" $ do+            length (filter (not . isHaskellField) fields) `shouldBe` 1+     it "doesn't have the field in the Haskell entity" $ asIO $ runDb $ do         sequence_ mmigrate         sequence_ mmigrate

@@ -7,7 +7,7 @@  import Init -share [mkPersist sqlSettings, mkMigrate "migrationMigrate", mkDeleteCascade sqlSettings] [persistLowerCase|+share [mkPersist sqlSettings, mkMigrate "migrationMigrate"] [persistLowerCase| Target     field1 Int     field2 T.Text@@ -23,7 +23,7 @@     Primary pk |] -share [mkPersist sqlSettings, mkMigrate "migrationAddCol", mkDeleteCascade sqlSettings] [persistLowerCase|+share [mkPersist sqlSettings, mkMigrate "migrationAddCol"] [persistLowerCase| Target1 sql=target     field1 Int     field2 T.Text

@@ -632,80 +632,11 @@   describe "documentation syntax" $ do     let edef = entityDef (Proxy :: Proxy Relationship)     it "provides comments on entity def" $ do-      entityComments edef+      getEntityComments edef         `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, _] = entityFields edef+      let [nameField, _] = getEntityFields edef       fieldComments nameField         `shouldBe`           Just "Fields should be documentable.\n"--  describe "JsonEncoding" $ do-    let-      subject =-        JsonEncoding "Bob" 32-      subjectEntity =-        Entity (JsonEncodingKey (jsonEncodingName subject)) subject--    it "encodes without an ID field" $ do-      toJSON subjectEntity-        `shouldBe`-          Object (M.fromList-            [ ("name", String "Bob")-            , ("age", toJSON (32 :: Int))-            , ("id", String "Bob")-            ])--    it "decodes without an ID field" $ do-      let-        json_ = encode . Object . M.fromList $-          [ ("name", String "Bob")-          , ("age", toJSON (32 :: Int))-          ]-      decode json_-        `shouldBe`-          Just subjectEntity--    prop "works with a Primary" $ \jsonEncoding -> do-      let-        ent =-          Entity (JsonEncodingKey (jsonEncodingName jsonEncoding)) jsonEncoding-      decode (encode ent)-        `shouldBe`-          Just ent--    prop "excuse me what" $ \j@JsonEncoding{..} -> do-      let-        ent =-          Entity (JsonEncodingKey jsonEncodingName) j-      toJSON ent-        `shouldBe`-          Object (M.fromList-            [ ("name", toJSON jsonEncodingName)-            , ("age", toJSON jsonEncodingAge)-            , ("id", toJSON jsonEncodingName)-            ])--    prop "round trip works with composite key" $ \j@JsonEncoding2{..} -> do-      let-        key = JsonEncoding2Key jsonEncoding2Name jsonEncoding2Blood-        ent =-          Entity key j-      decode (encode ent)-        `shouldBe`-          Just ent--    prop "works with a composite key" $ \j@JsonEncoding2{..} -> do-      let-        key = JsonEncoding2Key jsonEncoding2Name jsonEncoding2Blood-        ent =-          Entity key j-      toJSON ent-        `shouldBe`-          Object (M.fromList-            [ ("name", toJSON jsonEncoding2Name)-            , ("age", toJSON jsonEncoding2Age)-            , ("blood", toJSON jsonEncoding2Blood)-            , ("id", toJSON key)-            ])

@@ -6,6 +6,7 @@  import Data.Aeson +import qualified Data.List.NonEmpty as NEL import Data.Proxy import Test.QuickCheck import Database.Persist.Sql@@ -18,7 +19,7 @@ -- just need to ensure this compiles import PersistentTestModelsImports() -share [mkPersist persistSettings { mpsGeneric = True },  mkMigrate "testMigrate", mkDeleteCascade persistSettings, mkSave "_ignoredSave"] [persistUpperCase|+share [mkPersist persistSettings { mpsGeneric = True },  mkMigrate "testMigrate"] [persistUpperCase|  -- Dedented comment   -- Header-level comment@@ -140,27 +141,6 @@  |] -share [mkMigrate "testNonGenericMigrate", mkPersist sqlSettings] [persistLowerCase|-JsonEncoding json-    name Text-    age  Int-    Primary name-    deriving Show Eq--JsonEncoding2 json-    name Text-    age Int-    blood Text-    Primary name blood-    deriving Show Eq-|]--instance Arbitrary JsonEncoding where-    arbitrary = JsonEncoding <$> arbitrary <*> arbitrary--instance Arbitrary JsonEncoding2 where-    arbitrary = JsonEncoding2 <$> arbitrary <*> arbitrary <*> arbitrary- deriving instance Show (BackendKey backend) => Show (NoPrefix1Generic backend) deriving instance Eq (BackendKey backend) => Eq (NoPrefix1Generic backend) @@ -225,7 +205,7 @@       where         unRfoProxy :: proxy (ReverseFieldOrder a) -> Proxy a         unRfoProxy _ = Proxy-        revFields ed = ed { entityFields = reverse (entityFields ed) }+        revFields = overEntityFields reverse      toPersistFields = reverse . toPersistFields . unRFO     newtype EntityField (ReverseFieldOrder a) b = EFRFO {unEFRFO :: EntityField a b}@@ -233,9 +213,9 @@     fromPersistValues = fmap RFO . fromPersistValues . reverse      newtype Unique      (ReverseFieldOrder a)   = URFO  {unURFO  :: Unique      a  }-    persistUniqueToFieldNames = reverse . persistUniqueToFieldNames . unURFO+    persistUniqueToFieldNames = NEL.reverse . persistUniqueToFieldNames . unURFO     persistUniqueToValues = reverse . persistUniqueToValues . unURFO-    persistUniqueKeys = map URFO . reverse . persistUniqueKeys . unRFO+    persistUniqueKeys = fmap URFO . reverse . persistUniqueKeys . unRFO      persistIdField = error "ReverseFieldOrder.persistIdField"     fieldLens = error "ReverseFieldOrder.fieldLens"

@@ -8,6 +8,7 @@ import qualified Data.Text as T  import Init+import Database.Persist.SqlBackend import PersistTestPetType import PersistentTestModels @@ -141,7 +142,7 @@         liftIO $ ret @?= [(Single (1::Int), Single (2::Int), Single (3::Int), Single (4::Int), Single (5::Int), Single (6::Int), Single (7::Int), Single (8::Int), Single (9::Int), Single (10::Int), Single (11::Int), Single (12::Int), Single (13::Int), Single (14::Int), Single (15::Int))]  getEscape :: MonadReader SqlBackend m => m (Text -> Text)-getEscape = asks connEscapeRawName+getEscape = getEscapeRawNameFunction  caseCommitRollback :: Runner SqlBackend m => RunDb SqlBackend m -> Assertion caseCommitRollback runDb = runDb $ do

@@ -1,16 +1,21 @@ {-# LANGUAGE UndecidableInstances #-}+ {-# OPTIONS_GHC -Wno-unused-top-binds #-}+ module Recursive (specsWith, recursiveMigrate, cleanup) where  import Init  share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "recursiveMigrate"] [persistLowerCase|+ SubType   object [MenuObject]   deriving Show Eq+ MenuObject   sub SubType Maybe   deriving Show Eq+ |]  cleanup

@@ -75,9 +75,9 @@ specsWith runDb = describe "rename specs" $ do     describe "LowerCaseTable" $ do         it "LowerCaseTable has the right sql name" $ do-            fieldDB (entityId (entityDef (Proxy @LowerCaseTable)))+            fmap fieldDB (getEntityIdField (entityDef (Proxy @LowerCaseTable)))                 `shouldBe`-                    FieldNameDB "my_id"+                    Just (FieldNameDB "my_id")      it "user specified id, insertKey, no default=" $ runDb $ do         let rec2 = IdTable "Foo2" Nothing@@ -92,7 +92,7 @@         key' @== key      it "extra blocks" $-        entityExtra (entityDef (Nothing :: Maybe LowerCaseTable)) @?=+        getEntityExtra (entityDef (Nothing :: Maybe LowerCaseTable)) @?=             Map.fromList                 [ ("ExtraBlock", map T.words ["foo bar", "baz", "bin"])                 , ("ExtraBlock2", map T.words ["something"])

@@ -5,15 +5,13 @@  import Init -import Database.Persist.TH (mkDeleteCascade) - -- mpsGeneric = False is due to a bug or at least lack of a feature in -- mkKeyTypeDec TH.hs share     [ mkPersist persistSettings { mpsGeneric = False }     , mkMigrate "treeMigrate"-    , mkDeleteCascade persistSettings { mpsGeneric = False } ] [persistLowerCase|+    ] [persistLowerCase|   Tree sql=trees       name    Text       parent  Text Maybe@@ -41,14 +39,14 @@         gp <- getJust kgp         treeFkparent gp @== Nothing     describe "entityDef" $ do-        let EntityDef{..} = entityDef (Proxy :: Proxy Tree)+        let ed = entityDef (Proxy :: Proxy Tree)         it "has the right haskell name" $ do-            entityHaskell `shouldBe` EntityNameHS "Tree"+            getEntityHaskellName ed `shouldBe` EntityNameHS "Tree"         it "has the right DB name" $ do-            entityDB `shouldBe` EntityNameDB "trees"+            getEntityDBName ed `shouldBe` EntityNameDB "trees"      describe "foreign ref" $ do-        let [ForeignDef{..}] = entityForeigns (entityDef (Proxy :: Proxy Tree))+        let [ForeignDef{..}] = getEntityForeignDefs (entityDef (Proxy :: Proxy Tree))         it "has the right haskell name" $ do             foreignRefTableHaskell `shouldBe`                 EntityNameHS "Tree"@@ -60,7 +58,7 @@                 ConstraintNameHS "fkparent"         it "has the right DB constraint name" $ do             foreignConstraintNameDBName `shouldBe`-                ConstraintNameDB "treesfkparent"+                ConstraintNameDB "treefkparent"         it "has the right fields" $ do             foreignFields `shouldBe`                 [ ( (FieldNameHS "parent", FieldNameDB "parent")