postgresql-binary 0.14.2 → 0.15
raw patch · 5 files changed
+140/−13 lines, 5 filesdep +mtl
Dependencies added: mtl
Files
- CHANGELOG.md +7/−0
- library/PostgreSQL/Binary/Decoding.hs +80/−11
- postgresql-binary.cabal +3/−1
- tasty/Main.hs +3/−1
- tasty/Main/TypedComposite.hs +47/−0
CHANGELOG.md view
@@ -1,3 +1,10 @@+# 0.15++## Breaking Changes++- Made the Composite decoder check for exact field count match+- Dropped the Monad and MonadFail instances for it+ # 0.14 - Moved to "iproute" from "network-ip" for inet datatypes
library/PostgreSQL/Binary/Decoding.hs view
@@ -54,6 +54,8 @@ composite, valueComposite, nullableValueComposite,+ typedValueComposite,+ typedNullableValueComposite, -- ** HStore hstore,@@ -83,6 +85,7 @@ where import BinaryParser+import Control.Monad.Error.Class import qualified Data.Aeson as Aeson import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as LazyByteString@@ -429,26 +432,57 @@ -- * Composite -newtype Composite a- = Composite (Value a)- deriving (Functor, Applicative, Monad, MonadFail)+data Composite a+ = Composite+ -- | Amount of fields.+ Int+ -- | Decoder for the fields by the current offset.+ (Int -> BinaryParser.BinaryParser a)+ deriving (Functor) +instance Applicative Composite where+ pure x = Composite 0 (\_ -> pure x)+ Composite n f <*> Composite m x =+ Composite (n + m) (\offset -> f offset <*> x (offset + n))+ -- | -- Unlift a 'Composite' to a value 'Value'. {-# INLINE composite #-} composite :: Composite a -> Value a-composite (Composite decoder) =- numOfComponents *> decoder- where- numOfComponents =- unitOfSize 4+composite (Composite expectedFields body) = do+ actualFields <- intOfSize 4+ if actualFields /= expectedFields+ then failure ("Unexpected amount of fields available: " <> fromString (show expectedFields) <> ", expected at least " <> fromString (show (fromIntegral actualFields)))+ else body 0 -- |--- Lift a value 'Value' into 'Composite'.+-- Nullable composite field.+{-# INLINE baseFieldValueComposite #-}+baseFieldValueComposite :: BinaryParser a -> Composite a+baseFieldValueComposite parser =+ Composite+ 1+ ( \fieldIndex ->+ catchError+ parser+ ( \err ->+ throwError+ ( mconcat+ [ "At field ",+ fromString (show fieldIndex),+ ": ",+ err+ ]+ )+ )+ )++-- |+-- Nullable composite field. {-# INLINE nullableValueComposite #-} nullableValueComposite :: Value a -> Composite (Maybe a) nullableValueComposite valueValue =- Composite (skipOid *> onContent valueValue)+ baseFieldValueComposite (skipOid *> onContent valueValue) where skipOid = unitOfSize 4@@ -458,10 +492,45 @@ {-# INLINE valueComposite #-} valueComposite :: Value a -> Composite a valueComposite valueValue =- Composite (skipOid *> onContent valueValue >>= maybe (failure "Unexpected NULL") return)+ baseFieldValueComposite+ (skipOid *> onContent valueValue >>= maybe (failure "Unexpected NULL") return) where skipOid = unitOfSize 4++-- |+-- Nullable composite field with a checked type OID.+{-# INLINE typedNullableValueComposite #-}+typedNullableValueComposite ::+ -- | Expected type OID.+ Word32 ->+ Value a ->+ Composite (Maybe a)+typedNullableValueComposite expectedOid valueParser =+ baseFieldValueComposite+ ( do+ actualOid <- intOfSize 4+ if actualOid /= expectedOid+ then throwError ("Unexpected OID: " <> fromString (show actualOid) <> ", expected " <> fromString (show expectedOid))+ else onContent valueParser+ )++-- |+-- Non-nullable composite field with a checked type OID.+{-# INLINE typedValueComposite #-}+typedValueComposite ::+ -- | Expected type OID.+ Word32 ->+ Value a ->+ Composite a+typedValueComposite expectedOid valueParser =+ baseFieldValueComposite+ ( do+ actualOid <- intOfSize 4+ if actualOid /= expectedOid+ then throwError ("Unexpected OID: " <> fromString (show actualOid) <> ", expected " <> fromString (show expectedOid))+ else onContent valueParser >>= maybe (failure "Unexpected NULL") return+ ) -- * Array
postgresql-binary.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: postgresql-binary-version: 0.14.2+version: 0.15 synopsis: Encoders and decoders for the PostgreSQL's binary format description: An API for dealing with PostgreSQL's binary data format.@@ -92,6 +92,7 @@ bytestring-strict-builder >=0.4.5.4 && <0.5, containers >=0.5 && <0.8, iproute >=1.7 && <2,+ mtl >=2.2 && <2.4, scientific >=0.3 && <0.4, text >=1.2 && <3, time >=1.9 && <2,@@ -116,6 +117,7 @@ Main.Prelude Main.Properties Main.TextEncoder+ Main.TypedComposite build-depends: QuickCheck >=2.10 && <3,
tasty/Main.hs view
@@ -11,6 +11,7 @@ import Main.Prelude hiding (empty, isLeft, isRight, select) import qualified Main.Properties as Properties import qualified Main.TextEncoder as TextEncoder+import qualified Main.TypedComposite as TypedComposite import qualified PostgreSQL.Binary.Decoding as B import qualified PostgreSQL.Binary.Encoding as A import qualified PostgreSQL.Binary.Range as S@@ -34,8 +35,9 @@ then [primitiveRoundtrip "jsonb" Gens.aeson PTI.jsonb A.jsonb_ast B.jsonb_ast] else [] other =- [ testProperty ("Composite roundtrip") $ \value ->+ [ testProperty "Composite roundtrip" $ \value -> Composite.decodingProperty value (Composite.encodeToByteString value),+ testProperty "Typed composite roundtrip" TypedComposite.roundtrip, select "select (234 :: int8)" (const B.int) (234 :: Int32), select "select (-234 :: int8)" (const B.int) (-234 :: Int32), select "select (0 :: int8)" (const B.int) (0 :: Int32),
+ tasty/Main/TypedComposite.hs view
@@ -0,0 +1,47 @@+module Main.TypedComposite where++import qualified Main.Gens as Gens+import Main.Prelude+import qualified PostgreSQL.Binary.Decoding as Decoding+import qualified PostgreSQL.Binary.Encoding as Encoding+import Test.QuickCheck++data Person = Person+ { personName :: Text,+ personAge :: Int32,+ personMaybePhone :: Maybe Text+ }+ deriving (Show, Eq)++instance Arbitrary Person where+ arbitrary =+ Person+ <$> Gens.text+ <*> arbitrary+ <*> Gens.maybeOf Gens.text++nameOid, ageOid, phoneOid :: Word32+(nameOid, ageOid, phoneOid) = (25, 23, 25) -- text, int4, text++encodePerson :: Person -> Encoding.Encoding+encodePerson (Person name age maybePhone) =+ Encoding.composite+ $ Encoding.field nameOid (Encoding.text_strict name)+ <> Encoding.field ageOid (Encoding.int4_int32 age)+ <> case maybePhone of+ Nothing -> Encoding.nullField phoneOid+ Just phone -> Encoding.field phoneOid (Encoding.text_strict phone)++decodePerson :: Decoding.Value Person+decodePerson =+ Decoding.composite+ $ Person+ <$> Decoding.typedValueComposite nameOid (Decoding.text_strict)+ <*> Decoding.typedValueComposite ageOid (Decoding.int)+ <*> Decoding.typedNullableValueComposite phoneOid (Decoding.text_strict)++roundtrip :: Person -> Property+roundtrip person =+ let encoded = Encoding.encodingBytes (encodePerson person)+ decoded = Decoding.valueParser decodePerson encoded+ in Right person === decoded