beam-postgres 0.5.4.1 → 0.5.4.2
raw patch · 4 files changed
+80/−8 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +6/−0
- Database/Beam/Postgres/Types.hs +1/−6
- beam-postgres.cabal +2/−2
- test/Database/Beam/Postgres/Test/Marshal.hs +71/−0
ChangeLog.md view
@@ -1,3 +1,9 @@+# 0.5.4.2++## Bug fixes++ * Fixed an issue where columns of type `Maybe (Vector a)` did not marshall correctly from the database. In particular, querying a `Nothing` would return `Just (Vector.fromList [])` instead (#692).+ # 0.5.4.1 ## Bug fixes
Database/Beam/Postgres/Types.hs view
@@ -155,12 +155,7 @@ instance FromBackendRow Postgres (Ratio Integer) instance FromBackendRow Postgres (CI Text) instance FromBackendRow Postgres (CI TL.Text)-instance (Pg.FromField a, Typeable a) => FromBackendRow Postgres (Vector a) where- fromBackendRow = do- isNull <- peekField- case isNull of- Just SqlNull -> pure mempty- Nothing -> parseOneField @Postgres @(Vector a)+instance (Pg.FromField a, Typeable a) => FromBackendRow Postgres (Vector a) instance (Pg.FromField a, Typeable a) => FromBackendRow Postgres (Pg.PGArray a) instance FromBackendRow Postgres (Pg.Binary ByteString) instance FromBackendRow Postgres (Pg.Binary BL.ByteString)
beam-postgres.cabal view
@@ -1,5 +1,5 @@ name: beam-postgres-version: 0.5.4.1+version: 0.5.4.2 synopsis: Connection layer between beam and postgres description: Beam driver for <https://www.postgresql.org/ PostgreSQL>, an advanced open-source RDBMS homepage: https://haskell-beam.github.io/beam/user-guide/backends/beam-postgres@@ -43,7 +43,7 @@ bytestring >=0.10 && <0.13, attoparsec >=0.13 && <0.15,- hashable >=1.1 && <1.5,+ hashable >=1.1 && <1.6, lifted-base >=0.2 && <0.3, free >=4.12 && <5.3, time >=1.6 && <1.13,
test/Database/Beam/Postgres/Test/Marshal.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE StandaloneDeriving #-} module Database.Beam.Postgres.Test.Marshal where import Database.Beam@@ -9,6 +10,7 @@ import Database.Beam.Postgres import Database.Beam.Postgres.Migrate (migrationBackend) import Database.Beam.Postgres.Test+import Database.PostgreSQL.Simple (execute_) import Data.ByteString (ByteString) import Data.Functor.Classes@@ -17,6 +19,7 @@ import Data.Typeable import Data.UUID (UUID, fromWords) import Data.Word+import qualified Data.Vector as Vector import qualified Hedgehog import Hedgehog ((===))@@ -28,6 +31,7 @@ import Unsafe.Coerce + textGen :: Hedgehog.Gen T.Text textGen = Gen.text (Range.constant 0 1000) $ Gen.filter (/= '\NUL') Gen.unicode @@ -86,6 +90,7 @@ , marshalTest (Gen.maybe (Gen.integral (Range.constantBounded @Word64))) postgresConn , marshalTest (Gen.maybe textGen) postgresConn , marshalTest (Gen.maybe uuidGen) postgresConn+ , marshalTest692 postgresConn , marshalTest' (\a b -> Hedgehog.assert (liftEq ptCmp a b)) (Gen.maybe pointGen) postgresConn , marshalTest' (\a b -> Hedgehog.assert (liftEq boxCmp a b)) (Gen.maybe boxGen) postgresConn@@ -160,3 +165,69 @@ assertBool "Hedgehog test failed" passes ++-- Ensure that both `Vector Text` and `Maybe (Vector Text)` can be +-- marshalled correctly (see issue 692).+--+-- At this time, the postgres migration backend can't create columns of arrays,+-- and hence this test does not use `marshalTest`.+marshalTest692 :: IO ByteString -> TestTree+marshalTest692 postgresConn = + testCase "Can marshal Vector Text and Maybe (Vector Text) (#692)" $ + withTestPostgres ("db_marshal_maybe_vector_text_issue_692") postgresConn $ \conn -> do+ liftIO $ execute_ conn $ "CREATE TABLE mytable (\nmyid SERIAL PRIMARY KEY, mycolumn text[], mynullablecolumn text[]\n);"++ passes <- Hedgehog.check . Hedgehog.property $ do+ nullable <- Hedgehog.forAll (Gen.maybe (Vector.fromList <$> (Gen.list (Range.linear 0 10) textGen)))+ nonnull <- Hedgehog.forAll (Vector.fromList <$> (Gen.list (Range.linear 0 10) textGen))++ [MkTbl692 rowId v vnull] <-+ liftIO . runBeamPostgres conn + $ runInsertReturningList + $ insert (_myTable myDB) + $ insertExpressions [ MkTbl692 default_ (val_ nonnull) (val_ nullable) ]++ v === nonnull+ vnull === nullable++ Just (MkTbl692 _ v' vnull') <-+ liftIO . runBeamPostgres conn + $ runSelectReturningOne (lookup_ (_myTable myDB) (Tbl692Key rowId))+ v' === nonnull+ vnull' === nullable++ assertBool "Hedgehog test failed" passes+ where+ myDB :: DatabaseSettings Postgres MyDB692+ myDB = defaultDbSettings `withDbModification`+ MkMyDB692 {+ _myTable =+ setEntityName "mytable" <>+ modifyTableFields+ tableModification {+ myid = fieldNamed "myid",+ mycolumn = fieldNamed "mycolumn",+ mynullablecolumn = fieldNamed "mynullablecolumn"+ }+ }++data Tbl692 f+ = MkTbl692 + { myid :: C f (SqlSerial Int32)+ , mycolumn :: C f (Vector.Vector T.Text)+ , mynullablecolumn :: C f (Maybe (Vector.Vector T.Text)) + }+ deriving (Generic, Beamable)++deriving instance Show (Tbl692 Identity)+deriving instance Eq (Tbl692 Identity)++instance Table Tbl692 where+ data PrimaryKey Tbl692 f = Tbl692Key (C f (SqlSerial Int32))+ deriving (Generic, Beamable)+ primaryKey = Tbl692Key <$> myid+data MyDB692 entity+ = MkMyDB692+ { _myTable :: entity (TableEntity Tbl692)+ } deriving (Generic)+instance Database Postgres MyDB692