hasql 1.10.3.4 → 1.10.3.5

raw patch · 34 files changed

+796/−752 lines, 34 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Hasql.Decoders: TypeInfo :: Word32 -> Word32 -> TypeInfo

- Hasql.Decoders: [toArrayOid] :: TypeInfo -> Word32

- Hasql.Decoders: [toBaseOid] :: TypeInfo -> Word32

- Hasql.Decoders: data TypeInfo

- Hasql.Encoders: TypeInfo :: Word32 -> Word32 -> TypeInfo

- Hasql.Encoders: [toArrayOid] :: TypeInfo -> Word32

- Hasql.Encoders: [toBaseOid] :: TypeInfo -> Word32

- Hasql.Encoders: data TypeInfo

- Hasql.Decoders: custom :: Maybe Text -> Text -> Maybe TypeInfo -> [(Maybe Text, Text)] -> (((Maybe Text, Text) -> TypeInfo) -> ByteString -> Either Text a) -> Value a

+ Hasql.Decoders: custom :: Maybe Text -> Text -> Maybe (Word32, Word32) -> [(Maybe Text, Text)] -> (((Maybe Text, Text) -> (Word32, Word32)) -> ByteString -> Either Text a) -> Value a

- Hasql.Encoders: custom :: Maybe Text -> Text -> Maybe TypeInfo -> [(Maybe Text, Text)] -> (((Maybe Text, Text) -> TypeInfo) -> a -> ByteString) -> (a -> Text) -> Value a

+ Hasql.Encoders: custom :: Maybe Text -> Text -> Maybe (Word32, Word32) -> [(Maybe Text, Text)] -> (((Maybe Text, Text) -> (Word32, Word32)) -> a -> ByteString) -> (a -> Text) -> Value a

Files

hasql.cabal +13/−11
src/engine-tests/Hasql/Engine/Structures/OidCacheSpec.hs +6/−6
src/library-tests/Sharing/ByUnit/Decoders/CustomSpec.hs +4/−7
src/library-tests/Sharing/ByUnit/Encoders/CustomSpec.hs +2/−4
src/library/Hasql/Codecs/Decoders.hs +4/−4
src/library/Hasql/Codecs/Decoders/Composite.hs +6/−6
src/library/Hasql/Codecs/Decoders/Value.hs +51/−49
src/library/Hasql/Codecs/Encoders.hs +5/−5
src/library/Hasql/Codecs/Encoders/Array.hs +3/−3
src/library/Hasql/Codecs/Encoders/Composite.hs +13/−13
src/library/Hasql/Codecs/Encoders/Params.hs +42/−72
src/library/Hasql/Codecs/Encoders/Value.hs +63/−57
src/library/Hasql/Codecs/RequestingOid.hs +14/−14
src/library/Hasql/Codecs/Vocab.hs +14/−0
src/library/Hasql/Codecs/Vocab/OidCache.hs +91/−0
src/library/Hasql/Codecs/Vocab/ParamMeta.hs +13/−0
src/library/Hasql/Codecs/Vocab/QualifiedTypeName.hs +43/−0
src/library/Hasql/Codecs/Vocab/TypeInfo.hs +230/−0
src/library/Hasql/Codecs/Vocab/TypeRef.hs +20/−0
src/library/Hasql/Decoders.hs +0/−4
src/library/Hasql/Encoders.hs +0/−4
src/library/Hasql/Engine/Contexts/Pipeline.hs +17/−25
src/library/Hasql/Engine/Contexts/Session.hs +13/−22
src/library/Hasql/Engine/Decoders/Row.hs +6/−6
src/library/Hasql/Engine/PqProcedures/SelectTypeInfo.hs +22/−26
src/library/Hasql/Engine/Statement.hs +98/−28
src/library/Hasql/Engine/Structures/ConnectionState.hs +1/−1
src/library/Hasql/Engine/Structures/OidCache.hs +0/−73
src/library/Hasql/Kernel.hs +0/−10
src/library/Hasql/Kernel/QualifiedTypeName.hs +0/−43
src/library/Hasql/Kernel/TypeInfo.hs +0/−230
src/library/Hasql/Kernel/TypeRef.hs +0/−20
src/library/Hasql/Pipeline.hs +1/−2
src/library/Hasql/Session.hs +1/−7

hasql.cabal view

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-version: 1.10.3.4+version: 1.10.3.5 category: Hasql, Database, PostgreSQL synopsis: Fast PostgreSQL driver with a flexible mapping API description:@@ -125,6 +125,12 @@     Hasql.Codecs.Encoders.Value     Hasql.Codecs.RequestingOid     Hasql.Codecs.RequestingOid.LookingUp+    Hasql.Codecs.Vocab+    Hasql.Codecs.Vocab.OidCache+    Hasql.Codecs.Vocab.ParamMeta+    Hasql.Codecs.Vocab.QualifiedTypeName+    Hasql.Codecs.Vocab.TypeInfo+    Hasql.Codecs.Vocab.TypeRef     Hasql.Comms.Recv     Hasql.Comms.ResultDecoder     Hasql.Comms.Roundtrip@@ -142,12 +148,7 @@     Hasql.Engine.PqProcedures.SelectTypeInfo     Hasql.Engine.Statement     Hasql.Engine.Structures.ConnectionState-    Hasql.Engine.Structures.OidCache     Hasql.Engine.Structures.StatementCache-    Hasql.Kernel-    Hasql.Kernel.QualifiedTypeName-    Hasql.Kernel.TypeInfo-    Hasql.Kernel.TypeRef     Hasql.Platform.Prelude     Hasql.Platform.Prelude.Text     Hasql.Pq@@ -264,14 +265,15 @@    main-is: Main.hs   other-modules:-    Hasql.Engine.Structures.OidCache+    Hasql.Codecs.Vocab+    Hasql.Codecs.Vocab.OidCache+    Hasql.Codecs.Vocab.ParamMeta+    Hasql.Codecs.Vocab.QualifiedTypeName+    Hasql.Codecs.Vocab.TypeInfo+    Hasql.Codecs.Vocab.TypeRef     Hasql.Engine.Structures.OidCacheSpec     Hasql.Engine.Structures.StatementCache     Hasql.Engine.Structures.StatementCacheSpec-    Hasql.Kernel-    Hasql.Kernel.QualifiedTypeName-    Hasql.Kernel.TypeInfo-    Hasql.Kernel.TypeRef     Hasql.Platform.Prelude     Hasql.Platform.Prelude.Text     Hasql.Pq

src/engine-tests/Hasql/Engine/Structures/OidCacheSpec.hs view

@@ -1,8 +1,8 @@ module Hasql.Engine.Structures.OidCacheSpec (spec) where  import Data.HashSet qualified as HashSet-import Hasql.Engine.Structures.OidCache qualified as OidCache-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName+import Hasql.Codecs.Vocab.OidCache qualified as OidCache+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName import Test.Hspec import Prelude @@ -55,7 +55,7 @@    describe "selectUnknownNames" do     it "returns all names when cache is empty" do-      let names = HashSet.fromList [Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int4", Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int8"]+      let names = HashSet.fromList [Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int4", Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int8"]       OidCache.selectUnknownNames names OidCache.empty         `shouldBe` names @@ -67,15 +67,15 @@               23               1007               (OidCache.insertScalar Nothing "int8" 20 1016 OidCache.empty)-          names = HashSet.fromList [Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int4", Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int8"]+          names = HashSet.fromList [Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int4", Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int8"]       OidCache.selectUnknownNames names cache         `shouldBe` HashSet.empty      it "returns only unknown names" do       let cache = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty-          names = HashSet.fromList [Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int4", Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int8"]+          names = HashSet.fromList [Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int4", Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int8"]       OidCache.selectUnknownNames names cache-        `shouldBe` HashSet.fromList [Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int8"]+        `shouldBe` HashSet.fromList [Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int8"]    describe "Semigroup" do     it "right operand takes precedence for duplicate keys" do

@@ -4,7 +4,6 @@ import Data.HashSet qualified as HashSet import Data.Text.Encoding (encodeUtf8) import Hasql.Connection qualified as Connection-import Hasql.Decoders (TypeInfo (..)) import Hasql.Decoders qualified as Decoders import Hasql.Encoders qualified as Encoders import Hasql.Errors qualified as Errors@@ -67,7 +66,7 @@                           ( Decoders.custom                               Nothing                               "int4"-                              (Just (TypeInfo 23 1007))+                              (Just (23, 1007))                               []                               (\_ bytes -> Right (ByteString.length bytes))                           )@@ -108,10 +107,8 @@                               Nothing                               [(Nothing, enumName), (Nothing, "int4")]                               ( \lookupOid bytes -> do-                                  let enumTypeInfo = lookupOid (Nothing, enumName)-                                      int4TypeInfo = lookupOid (Nothing, "int4")-                                      enumOidScalar = toBaseOid enumTypeInfo-                                      int4OidScalar = toBaseOid int4TypeInfo+                                  let (enumOidScalar, _enumOidArray) = lookupOid (Nothing, enumName)+                                      (int4OidScalar, _int4OidArray) = lookupOid (Nothing, "int4")                                   -- Verify we got valid OIDs                                   if enumOidScalar > 0 && int4OidScalar > 0                                     then Right (enumOidScalar, int4OidScalar, ByteString.length bytes)@@ -206,7 +203,7 @@                           ( Decoders.custom                               Nothing                               "int4"-                              (Just (TypeInfo 23 1007))+                              (Just (23, 1007))                               []                               (\_ _ -> Left "Custom decoding error")                           )

@@ -4,7 +4,6 @@ import Data.Text.Encoding (encodeUtf8) import Hasql.Connection qualified as Connection import Hasql.Decoders qualified as Decoders-import Hasql.Encoders (TypeInfo (..)) import Hasql.Encoders qualified as Encoders import Hasql.Errors qualified as Errors import Hasql.Session qualified as Session@@ -58,7 +57,7 @@                       ( Encoders.custom                           Nothing                           "text"-                          (Just (TypeInfo 25 1009))+                          (Just (25, 1009))                           []                           (\_ val -> encodeUtf8 val)                           id@@ -90,8 +89,7 @@                           Nothing                           [(Nothing, enumName)]                           ( \lookupOid val -> do-                              let enumTypeInfo = lookupOid (Nothing, enumName)-                                  enumOidScalar = toBaseOid enumTypeInfo+                              let (enumOidScalar, _enumOidArray) = lookupOid (Nothing, enumName)                               -- Verify we got a valid OID (non-zero)                               if enumOidScalar > 0                                 then encodeUtf8 val

src/library/Hasql/Codecs/Decoders.hs view

@@ -70,7 +70,7 @@ import Hasql.Codecs.Decoders.Composite qualified as Composite import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot import Hasql.Codecs.Decoders.Value qualified as Value-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo import Hasql.Platform.Prelude  -- * Value@@ -139,9 +139,9 @@   Value.Value     Nothing     "record"-    (Just (Kernel.TypeInfo.toBaseOid typeInfo))-    (Just (Kernel.TypeInfo.toArrayOid typeInfo))+    (Just (Vocab.TypeInfo.toBaseOid typeInfo))+    (Just (Vocab.TypeInfo.toArrayOid typeInfo))     0     (Composite.toValueDecoder composite)   where-    typeInfo = Kernel.TypeInfo.record+    typeInfo = Vocab.TypeInfo.record

src/library/Hasql/Codecs/Decoders/Composite.hs view

@@ -3,8 +3,8 @@ import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot import Hasql.Codecs.Decoders.Value qualified as Value import Hasql.Codecs.RequestingOid qualified as RequestingOid-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo import Hasql.Platform.Prelude import PostgreSQL.Binary.Decoding qualified as Binary @@ -33,8 +33,8 @@           Nothing ->             Composite               ( RequestingOid.hoistLookingUp-                  (Kernel.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))-                  (\typeInfo decoder -> Binary.typedValueComposite (if dimensionality == 0 then Kernel.TypeInfo.toBaseOid typeInfo else Kernel.TypeInfo.toArrayOid typeInfo) decoder)+                  (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))+                  (\typeInfo decoder -> Binary.typedValueComposite (if dimensionality == 0 then Vocab.TypeInfo.toBaseOid typeInfo else Vocab.TypeInfo.toArrayOid typeInfo) decoder)                   (Value.toDecoder imp)               )   NullableOrNot.Nullable imp ->@@ -46,7 +46,7 @@           Nothing ->             Composite               ( RequestingOid.hoistLookingUp-                  (Kernel.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))-                  (\typeInfo decoder -> Binary.typedNullableValueComposite (if dimensionality == 0 then Kernel.TypeInfo.toBaseOid typeInfo else Kernel.TypeInfo.toArrayOid typeInfo) decoder)+                  (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))+                  (\typeInfo decoder -> Binary.typedNullableValueComposite (if dimensionality == 0 then Vocab.TypeInfo.toBaseOid typeInfo else Vocab.TypeInfo.toArrayOid typeInfo) decoder)                   (Value.toDecoder imp)               )

src/library/Hasql/Codecs/Decoders/Value.hs view

@@ -58,9 +58,9 @@ import Data.Aeson qualified as Aeson import Data.IP qualified as Iproute import Hasql.Codecs.RequestingOid qualified as RequestingOid-import Hasql.Kernel qualified as Kernel-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo import Hasql.Platform.Prelude hiding (bool) import PostgreSQL.Binary.Decoding qualified as Binary import PostgreSQL.Binary.Range qualified as R@@ -93,9 +93,9 @@ -- | -- Create a decoder from TypeInfo metadata and a decoding function. {-# INLINE primitive #-}-primitive :: Text -> Kernel.TypeInfo.TypeInfo -> Binary.Value a -> Value a+primitive :: Text -> Vocab.TypeInfo.TypeInfo -> Binary.Value a -> Value a primitive typeName pti decoder =-  Value Nothing typeName (Just (Kernel.TypeInfo.toBaseOid pti)) (Just (Kernel.TypeInfo.toArrayOid pti)) 0 (RequestingOid.lift decoder)+  Value Nothing typeName (Just (Vocab.TypeInfo.toBaseOid pti)) (Just (Vocab.TypeInfo.toArrayOid pti)) 0 (RequestingOid.lift decoder)  -- * Static types @@ -103,19 +103,19 @@ -- Decoder of the @BOOL@ values. {-# INLINEABLE bool #-} bool :: Value Bool-bool = primitive "bool" Kernel.TypeInfo.bool Binary.bool+bool = primitive "bool" Vocab.TypeInfo.bool Binary.bool  -- | -- Decoder of the @INT2@ values. {-# INLINEABLE int2 #-} int2 :: Value Int16-int2 = primitive "int2" Kernel.TypeInfo.int2 Binary.int+int2 = primitive "int2" Vocab.TypeInfo.int2 Binary.int  -- | -- Decoder of the @INT4@ values. {-# INLINEABLE int4 #-} int4 :: Value Int32-int4 = primitive "int4" Kernel.TypeInfo.int4 Binary.int+int4 = primitive "int4" Vocab.TypeInfo.int4 Binary.int  -- | -- Decoder of the @INT8@ values.@@ -123,68 +123,68 @@ int8 :: Value Int64 int8 =   {-# SCC "int8" #-}-  primitive "int8" Kernel.TypeInfo.int8 ({-# SCC "int8.int" #-} Binary.int)+  primitive "int8" Vocab.TypeInfo.int8 ({-# SCC "int8.int" #-} Binary.int)  -- | -- Decoder of the @FLOAT4@ values. {-# INLINEABLE float4 #-} float4 :: Value Float-float4 = primitive "float4" Kernel.TypeInfo.float4 Binary.float4+float4 = primitive "float4" Vocab.TypeInfo.float4 Binary.float4  -- | -- Decoder of the @FLOAT8@ values. {-# INLINEABLE float8 #-} float8 :: Value Double-float8 = primitive "float8" Kernel.TypeInfo.float8 Binary.float8+float8 = primitive "float8" Vocab.TypeInfo.float8 Binary.float8  -- | -- Decoder of the @NUMERIC@ values. {-# INLINEABLE numeric #-} numeric :: Value Scientific-numeric = primitive "numeric" Kernel.TypeInfo.numeric Binary.numeric+numeric = primitive "numeric" Vocab.TypeInfo.numeric Binary.numeric  -- | -- Decoder of the @CHAR@ values. -- Note that it supports Unicode values. {-# INLINEABLE char #-} char :: Value Char-char = primitive "char" Kernel.TypeInfo.char Binary.char+char = primitive "char" Vocab.TypeInfo.char Binary.char  -- | -- Decoder of the @TEXT@ values. {-# INLINEABLE text #-} text :: Value Text-text = primitive "text" Kernel.TypeInfo.text Binary.text_strict+text = primitive "text" Vocab.TypeInfo.text Binary.text_strict  -- | -- Decoder of the @VARCHAR@ values. {-# INLINEABLE varchar #-} varchar :: Value Text-varchar = primitive "varchar" Kernel.TypeInfo.varchar Binary.text_strict+varchar = primitive "varchar" Vocab.TypeInfo.varchar Binary.text_strict  -- | -- Decoder of @BPCHAR@ or @CHAR(n)@, @CHARACTER(n)@ values. {-# INLINEABLE bpchar #-} bpchar :: Value Text-bpchar = primitive "bpchar" Kernel.TypeInfo.bpchar Binary.text_strict+bpchar = primitive "bpchar" Vocab.TypeInfo.bpchar Binary.text_strict  -- | -- Decoder of the @BYTEA@ values. {-# INLINEABLE bytea #-} bytea :: Value ByteString-bytea = primitive "bytea" Kernel.TypeInfo.bytea Binary.bytea_strict+bytea = primitive "bytea" Vocab.TypeInfo.bytea Binary.bytea_strict  -- | -- Decoder of the @DATE@ values. {-# INLINEABLE date #-} date :: Value Day-date = primitive "date" Kernel.TypeInfo.date Binary.date+date = primitive "date" Vocab.TypeInfo.date Binary.date  -- | -- Decoder of the @TIMESTAMP@ values. {-# INLINEABLE timestamp #-} timestamp :: Value LocalTime-timestamp = primitive "timestamp" Kernel.TypeInfo.timestamp Binary.timestamp_int+timestamp = primitive "timestamp" Vocab.TypeInfo.timestamp Binary.timestamp_int  -- | -- Decoder of the @TIMESTAMPTZ@ values.@@ -198,13 +198,13 @@ -- and communicates with Postgres using the UTC values directly. {-# INLINEABLE timestamptz #-} timestamptz :: Value UTCTime-timestamptz = primitive "timestamptz" Kernel.TypeInfo.timestamptz Binary.timestamptz_int+timestamptz = primitive "timestamptz" Vocab.TypeInfo.timestamptz Binary.timestamptz_int  -- | -- Decoder of the @TIME@ values. {-# INLINEABLE time #-} time :: Value TimeOfDay-time = primitive "time" Kernel.TypeInfo.time Binary.time_int+time = primitive "time" Vocab.TypeInfo.time Binary.time_int  -- | -- Decoder of the @TIMETZ@ values.@@ -216,25 +216,25 @@ -- to represent a value on the Haskell's side. {-# INLINEABLE timetz #-} timetz :: Value (TimeOfDay, TimeZone)-timetz = primitive "timetz" Kernel.TypeInfo.timetz Binary.timetz_int+timetz = primitive "timetz" Vocab.TypeInfo.timetz Binary.timetz_int  -- | -- Decoder of the @INTERVAL@ values. {-# INLINEABLE interval #-} interval :: Value DiffTime-interval = primitive "interval" Kernel.TypeInfo.interval Binary.interval_int+interval = primitive "interval" Vocab.TypeInfo.interval Binary.interval_int  -- | -- Decoder of the @UUID@ values. {-# INLINEABLE uuid #-} uuid :: Value UUID-uuid = primitive "uuid" Kernel.TypeInfo.uuid Binary.uuid+uuid = primitive "uuid" Vocab.TypeInfo.uuid Binary.uuid  -- | -- Decoder of the @INET@ values. {-# INLINEABLE inet #-} inet :: Value Iproute.IPRange-inet = primitive "inet" Kernel.TypeInfo.inet Binary.inet+inet = primitive "inet" Vocab.TypeInfo.inet Binary.inet  -- | -- Decoder of the @MACADDR@ values.@@ -245,103 +245,103 @@ -- > (\(a,b,c,d,e,f) -> fromOctets a b c d e f) <$> macaddr {-# INLINEABLE macaddr #-} macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)-macaddr = primitive "macaddr" Kernel.TypeInfo.macaddr Binary.macaddr+macaddr = primitive "macaddr" Vocab.TypeInfo.macaddr Binary.macaddr  -- | -- Decoder of the @JSON@ values into a JSON AST. {-# INLINEABLE json #-} json :: Value Aeson.Value-json = primitive "json" Kernel.TypeInfo.json Binary.json_ast+json = primitive "json" Vocab.TypeInfo.json Binary.json_ast  -- | -- Decoder of the @JSON@ values into a raw JSON 'ByteString'. {-# INLINEABLE jsonBytes #-} jsonBytes :: (ByteString -> Either Text a) -> Value a-jsonBytes fn = primitive "json" Kernel.TypeInfo.json (Binary.json_bytes fn)+jsonBytes fn = primitive "json" Vocab.TypeInfo.json (Binary.json_bytes fn)  -- | -- Decoder of the @JSONB@ values into a JSON AST. {-# INLINEABLE jsonb #-} jsonb :: Value Aeson.Value-jsonb = primitive "jsonb" Kernel.TypeInfo.jsonb Binary.jsonb_ast+jsonb = primitive "jsonb" Vocab.TypeInfo.jsonb Binary.jsonb_ast  -- | -- Decoder of the @JSONB@ values into a raw JSON 'ByteString'. {-# INLINEABLE jsonbBytes #-} jsonbBytes :: (ByteString -> Either Text a) -> Value a-jsonbBytes fn = primitive "jsonb" Kernel.TypeInfo.jsonb (Binary.jsonb_bytes fn)+jsonbBytes fn = primitive "jsonb" Vocab.TypeInfo.jsonb (Binary.jsonb_bytes fn)  -- | -- Decoder of the @INT4RANGE@ values. {-# INLINEABLE int4range #-} int4range :: Value (R.Range Int32)-int4range = primitive "int4range" Kernel.TypeInfo.int4range Binary.int4range+int4range = primitive "int4range" Vocab.TypeInfo.int4range Binary.int4range  -- | -- Decoder of the @INT8RANGE@ values. {-# INLINEABLE int8range #-} int8range :: Value (R.Range Int64)-int8range = primitive "int8range" Kernel.TypeInfo.int8range Binary.int8range+int8range = primitive "int8range" Vocab.TypeInfo.int8range Binary.int8range  -- | -- Decoder of the @NUMRANGE@ values. {-# INLINEABLE numrange #-} numrange :: Value (R.Range Scientific)-numrange = primitive "numrange" Kernel.TypeInfo.numrange Binary.numrange+numrange = primitive "numrange" Vocab.TypeInfo.numrange Binary.numrange  -- | -- Decoder of the @TSRANGE@ values. {-# INLINEABLE tsrange #-} tsrange :: Value (R.Range LocalTime)-tsrange = primitive "tsrange" Kernel.TypeInfo.tsrange Binary.tsrange_int+tsrange = primitive "tsrange" Vocab.TypeInfo.tsrange Binary.tsrange_int  -- | -- Decoder of the @TSTZRANGE@ values. {-# INLINEABLE tstzrange #-} tstzrange :: Value (R.Range UTCTime)-tstzrange = primitive "tstzrange" Kernel.TypeInfo.tstzrange Binary.tstzrange_int+tstzrange = primitive "tstzrange" Vocab.TypeInfo.tstzrange Binary.tstzrange_int  -- | -- Decoder of the @DATERANGE@ values. {-# INLINEABLE daterange #-} daterange :: Value (R.Range Day)-daterange = primitive "daterange" Kernel.TypeInfo.daterange Binary.daterange+daterange = primitive "daterange" Vocab.TypeInfo.daterange Binary.daterange  -- | -- Decoder of the @INT4MULTIRANGE@ values. {-# INLINEABLE int4multirange #-} int4multirange :: Value (R.Multirange Int32)-int4multirange = primitive "int4multirange" Kernel.TypeInfo.int4multirange Binary.int4multirange+int4multirange = primitive "int4multirange" Vocab.TypeInfo.int4multirange Binary.int4multirange  -- | -- Decoder of the @INT8MULTIRANGE@ values. {-# INLINEABLE int8multirange #-} int8multirange :: Value (R.Multirange Int64)-int8multirange = primitive "int8multirange" Kernel.TypeInfo.int8multirange Binary.int8multirange+int8multirange = primitive "int8multirange" Vocab.TypeInfo.int8multirange Binary.int8multirange  -- | -- Decoder of the @NUMMULTIRANGE@ values. {-# INLINEABLE nummultirange #-} nummultirange :: Value (R.Multirange Scientific)-nummultirange = primitive "nummultirange" Kernel.TypeInfo.nummultirange Binary.nummultirange+nummultirange = primitive "nummultirange" Vocab.TypeInfo.nummultirange Binary.nummultirange  -- | -- Decoder of the @TSMULTIRANGE@ values. {-# INLINEABLE tsmultirange #-} tsmultirange :: Value (R.Multirange LocalTime)-tsmultirange = primitive "tsmultirange" Kernel.TypeInfo.tsmultirange Binary.tsmultirange_int+tsmultirange = primitive "tsmultirange" Vocab.TypeInfo.tsmultirange Binary.tsmultirange_int  -- | -- Decoder of the @TSTZMULTIRANGE@ values. {-# INLINEABLE tstzmultirange #-} tstzmultirange :: Value (R.Multirange UTCTime)-tstzmultirange = primitive "tstzmultirange" Kernel.TypeInfo.tstzmultirange Binary.tstzmultirange_int+tstzmultirange = primitive "tstzmultirange" Vocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int  -- | -- Decoder of the @DATEMULTIRANGE@ values. {-# INLINEABLE datemultirange #-} datemultirange :: Value (R.Multirange Day)-datemultirange = primitive "datemultirange" Kernel.TypeInfo.datemultirange Binary.datemultirange+datemultirange = primitive "datemultirange" Vocab.TypeInfo.datemultirange Binary.datemultirange  -- | -- Decoder of the @CITEXT@ values.@@ -362,7 +362,7 @@   -- | Possible static OIDs for the type. The first is for scalar values the second is for arrays.   --   -- When unspecified, the OIDs will be automatically determined at runtime by looking up by name.-  Maybe Kernel.TypeInfo.TypeInfo ->+  Maybe (Word32, Word32) ->   -- | Other named types whose OIDs are needed for deserializing.   --   -- E.g., when decoding composite types you can check the OIDs of its fields against the ones specified by Postgres.@@ -373,7 +373,7 @@   --   -- It's safe to assume that all of the requested types will be present.   -- In case you run the provided lookup function with unmentioned type names it will produce OID of 0 for them, standing for unknown type in Postgres.-  ( ((Maybe Text, Text) -> Kernel.TypeInfo.TypeInfo) ->+  ( ((Maybe Text, Text) -> (Word32, Word32)) ->     ByteString ->     Either Text a   ) ->@@ -382,10 +382,12 @@   Value     schema     typeName-    (fmap Kernel.TypeInfo.toBaseOid staticOids)-    (fmap Kernel.TypeInfo.toArrayOid staticOids)+    (fmap fst staticOids)+    (fmap snd staticOids)     0-    (RequestingOid.requestAndHandle (fmap Kernel.QualifiedTypeName.fromNameTuple requestedTypes) (\lookup -> Binary.fn (fn (lookup . Kernel.QualifiedTypeName.fromNameTuple))))+    (RequestingOid.requestAndHandle (fmap Vocab.QualifiedTypeName.fromNameTuple requestedTypes) (\lookup -> Binary.fn (fn (toTuple . lookup . Vocab.QualifiedTypeName.fromNameTuple))))+  where+    toTuple typeInfo = (Vocab.TypeInfo.toBaseOid typeInfo, Vocab.TypeInfo.toArrayOid typeInfo)  -- | -- Refine a value decoder, lifting the possible error to the session level.@@ -448,11 +450,11 @@ toDecoder (Value _ _ _ _ _ decoder) = decoder  {-# INLINE toHandler #-}-toHandler :: Value a -> HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo -> Binary.Value a+toHandler :: Value a -> Vocab.OidCache -> Binary.Value a toHandler (Value _ _ _ _ _ decoder) = RequestingOid.toBase decoder  {-# INLINE toByteStringParser #-}-toByteStringParser :: Value a -> (HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo -> ByteString -> Either Text a)+toByteStringParser :: Value a -> (Vocab.OidCache -> ByteString -> Either Text a) toByteStringParser (Value _ _ _ _ _ decoder) oidCache = Binary.valueParser (RequestingOid.toBase decoder oidCache)  isArray :: Value a -> Bool

src/library/Hasql/Codecs/Encoders.hs view

@@ -83,8 +83,8 @@ import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot import Hasql.Codecs.Encoders.Params qualified as Params import Hasql.Codecs.Encoders.Value qualified as Value-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo import Hasql.Platform.Prelude hiding (bool) import PostgreSQL.Binary.Encoding qualified as Binary import TextBuilder qualified@@ -122,11 +122,11 @@               asum                 [ scalarOidIfKnown,                   oidCache-                    & HashMap.lookup (Kernel.QualifiedTypeName.QualifiedTypeName baseTypeSchema baseTypeName)-                    & fmap Kernel.TypeInfo.toBaseOid+                    & HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName baseTypeSchema baseTypeName)+                    & fmap Vocab.TypeInfo.toBaseOid                 ]                 -- Should only happen on a bug.-                & fromMaybe (Kernel.TypeInfo.toBaseOid Kernel.TypeInfo.unknown)+                & fromMaybe (Vocab.TypeInfo.toBaseOid Vocab.TypeInfo.unknown)          in Binary.array resolvedOid (arrayEncoder oidCache input)    in Value.Value baseTypeSchema baseTypeName scalarOidIfKnown arrayOidIfKnown dimensionality False unknownTypes encoder renderer

src/library/Hasql/Codecs/Encoders/Array.hs view

@@ -2,7 +2,7 @@  import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot import Hasql.Codecs.Encoders.Value qualified as Value-import Hasql.Kernel qualified as Kernel+import Hasql.Codecs.Vocab qualified as Vocab import Hasql.Platform.Prelude import PostgreSQL.Binary.Encoding qualified as Binary import TextBuilder qualified as TextBuilder@@ -34,9 +34,9 @@       -- | OID of the array type.       (Maybe Word32)       -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.-      (HashSet Kernel.QualifiedTypeName)+      (HashSet Vocab.QualifiedTypeName)       -- | Serialization function given the dictionary of resolved OIDs.-      (HashMap Kernel.QualifiedTypeName Kernel.TypeInfo -> a -> Binary.Array)+      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo -> a -> Binary.Array)       -- | Render function for error messages.       (a -> TextBuilder.TextBuilder)

src/library/Hasql/Codecs/Encoders/Composite.hs view

@@ -4,9 +4,9 @@ import Data.HashSet qualified as HashSet import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot import Hasql.Codecs.Encoders.Value qualified as Value-import Hasql.Kernel qualified as Kernel-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo import Hasql.Platform.Prelude hiding (bool) import PostgreSQL.Binary.Encoding qualified as Binary import TextBuilder qualified@@ -16,9 +16,9 @@ data Composite a   = Composite       -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.-      (HashSet Kernel.QualifiedTypeName)+      (HashSet Vocab.QualifiedTypeName)       -- | Serialization function given the dictionary of resolved OIDs.-      (HashMap Kernel.QualifiedTypeName Kernel.TypeInfo -> a -> Binary.Composite)+      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo -> a -> Binary.Composite)       -- | Render function for error messages.       (a -> [TextBuilder.TextBuilder]) @@ -57,10 +57,10 @@               (\val -> [print val])           Nothing ->             Composite-              (HashSet.insert (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes)+              (HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes)               ( \oidCache val ->-                  let typeInfo = HashMap.lookup (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache-                      oid = if dimensionality == 0 then maybe 0 Kernel.TypeInfo.toBaseOid typeInfo else maybe 0 Kernel.TypeInfo.toArrayOid typeInfo+                  let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache+                      oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo                    in Binary.field oid (encode oidCache val)               )               (\val -> [print val])@@ -80,15 +80,15 @@               )           Nothing ->             Composite-              (HashSet.insert (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes)+              (HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes)               ( \oidCache -> \case                   Nothing ->-                    let typeInfo = HashMap.lookup (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache-                        oid = if dimensionality == 0 then maybe 0 Kernel.TypeInfo.toBaseOid typeInfo else maybe 0 Kernel.TypeInfo.toArrayOid typeInfo+                    let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache+                        oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo                      in Binary.nullField oid                   Just val ->-                    let typeInfo = HashMap.lookup (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache-                        oid = if dimensionality == 0 then maybe 0 Kernel.TypeInfo.toBaseOid typeInfo else maybe 0 Kernel.TypeInfo.toArrayOid typeInfo+                    let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache+                        oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo                      in Binary.field oid (encode oidCache val)               )               ( \case

src/library/Hasql/Codecs/Encoders/Params.hs view

@@ -1,76 +1,46 @@-module Hasql.Codecs.Encoders.Params where+module Hasql.Codecs.Encoders.Params+  ( Params,+    noParams,+    param,+    toColumnsMetadata,+    toUnknownTypes,+    toSerializer,+    toPrinter,+  )+where -import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet+import Data.Vector qualified as Vector import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot import Hasql.Codecs.Encoders.Value qualified as Value-import Hasql.Kernel qualified as Kernel-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo-import Hasql.Kernel.TypeRef qualified as Kernel.TypeRef+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache+import Hasql.Codecs.Vocab.ParamMeta (ParamMeta (..))+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeRef qualified as Vocab.TypeRef import Hasql.Platform.Prelude import PostgreSQL.Binary.Encoding qualified as Binary import TextBuilder qualified -renderReadable :: Params a -> a -> [Text]-renderReadable (Params _ _ _ _ printer) params =-  printer params-    & toList--compilePreparedStatementData ::-  Params a ->-  HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo ->-  a ->-  ([Word32], [Maybe (ByteString, Bool)])-compilePreparedStatementData (Params _ _ columnsMetadata serializer _) oidCache input =-  (oidList, valueAndFormatList)+-- | Frozen per-parameter metadata: type reference, dimensionality, text-format flag.+toColumnsMetadata :: Params a -> Vector ParamMeta+toColumnsMetadata (Params _ _ columnsMetadata _ _) = freezeColumnsMetadata columnsMetadata   where-    (oidList, formatList) =-      columnsMetadata-        & toList-        & fmap-          ( \case-              (Kernel.TypeRef.NamedType name, dimensionality, format) ->-                case HashMap.lookup name oidCache of-                  Just typeInfo ->-                    ( if dimensionality == 0 then Kernel.TypeInfo.toBaseOid typeInfo else Kernel.TypeInfo.toArrayOid typeInfo,-                      format-                    )-                  Nothing ->-                    (0, format)-              (Kernel.TypeRef.KnownOid oid, _, format) ->-                (oid, format)-          )-        & unzip--    valueAndFormatList =-      serializer oidCache input-        & toList-        & zipWith (\format encoding -> (,format) <$> encoding) formatList--compileUnpreparedStatementData ::-  Params a ->-  HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo ->-  a ->-  [Maybe (Word32, ByteString, Bool)]-compileUnpreparedStatementData (Params _ _ columnsMetadata serializer _) oidCache input =-  zipWith-    ( \(nameOrOid, dimensionality, format) encoding ->-        let oid = case nameOrOid of-              Kernel.TypeRef.NamedType name -> case HashMap.lookup name oidCache of-                Just typeInfo ->-                  if dimensionality == 0 then Kernel.TypeInfo.toBaseOid typeInfo else Kernel.TypeInfo.toArrayOid typeInfo-                Nothing -> 0-              Kernel.TypeRef.KnownOid oid -> oid-         in (,,) <$> Just oid <*> encoding <*> Just format-    )-    (toList columnsMetadata)-    (toList (serializer oidCache input))+    freezeColumnsMetadata =+      Vector.fromList . toList -toUnknownTypes :: Params a -> HashSet Kernel.QualifiedTypeName+toUnknownTypes :: Params a -> HashSet Vocab.QualifiedTypeName toUnknownTypes (Params _ unknownTypes _ _ _) =   unknownTypes +-- | Serialise params to encoded wire values given a resolved OID cache.+toSerializer :: Params a -> Vocab.OidCache -> a -> [Maybe ByteString]+toSerializer (Params _ _ _ serializer _) = serializer++-- | Render params in human-readable form (for error reporting).+toPrinter :: Params a -> a -> [Text]+toPrinter (Params _ _ _ _ printer) = toList . printer+ -- | -- Encoder of some representation of a parameters product. --@@ -87,7 +57,7 @@ -- -- As a general solution for tuples of any arity, instead of 'fst' and 'snd', -- consider the functions of the @contrazip@ family--- from the \"contravariant-extras\" package.+-- from the "contravariant-extras" package. -- E.g., here's how you can achieve the same as the above: -- -- @@@ -117,10 +87,10 @@ -- @ data Params a = Params   { size :: Int,-    unknownTypes :: HashSet Kernel.QualifiedTypeName,+    unknownTypes :: HashSet Vocab.QualifiedTypeName,     -- | (Type reference, dimensionality, Text Format) for each parameter.-    columnsMetadata :: DList (Kernel.TypeRef, Word, Bool),-    serializer :: HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo -> a -> DList (Maybe ByteString),+    columnsMetadata :: DList ParamMeta,+    serializer :: Vocab.OidCache -> a -> [Maybe ByteString],     printer :: a -> DList Text   } @@ -169,7 +139,7 @@ value :: Value.Value a -> Params a value (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) =   let staticOid = if dimensionality == 0 then scalarOid else arrayOid-      serializer oidCache = pure . Just . Binary.encodingBytes . serialize oidCache+      serializer oidCache = pure . Just . Binary.encodingBytes . serialize (Vocab.OidCache.toHashMap oidCache)       printer = pure . TextBuilder.toText . print       size = 1    in case staticOid of@@ -177,15 +147,15 @@           Params             { size,               unknownTypes,-              columnsMetadata = pure (Kernel.TypeRef.KnownOid oid, dimensionality, textFormat),+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.KnownOid oid) dimensionality textFormat),               serializer,               printer             }         Nothing ->           Params             { size,-              unknownTypes = HashSet.insert (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,-              columnsMetadata = pure (Kernel.TypeRef.NamedType (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName), dimensionality, textFormat),+              unknownTypes = HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.NamedType (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)) dimensionality textFormat),               serializer,               printer             }@@ -193,7 +163,7 @@ nullableValue :: Value.Value a -> Params (Maybe a) nullableValue (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) =   let staticOid = if dimensionality == 0 then scalarOid else arrayOid-      serializer oidCache = pure . fmap (Binary.encodingBytes . serialize oidCache)+      serializer oidCache = pure . fmap (Binary.encodingBytes . serialize (Vocab.OidCache.toHashMap oidCache))       printer = pure . maybe "null" (TextBuilder.toText . print)       size = 1    in case staticOid of@@ -201,15 +171,15 @@           Params             { size,               unknownTypes,-              columnsMetadata = pure (Kernel.TypeRef.KnownOid oid, dimensionality, textFormat),+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.KnownOid oid) dimensionality textFormat),               serializer,               printer             }         Nothing ->           Params             { size,-              unknownTypes = HashSet.insert (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,-              columnsMetadata = pure (Kernel.TypeRef.NamedType (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName), dimensionality, textFormat),+              unknownTypes = HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.NamedType (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)) dimensionality textFormat),               serializer,               printer             }

src/library/Hasql/Codecs/Encoders/Value.hs view

@@ -6,9 +6,9 @@ import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet import Data.IP qualified as Iproute-import Hasql.Kernel qualified as Kernel-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo import Hasql.Platform.Prelude import PostgreSQL.Binary.Encoding qualified as Binary import PostgreSQL.Binary.Range qualified as Range@@ -34,9 +34,9 @@       -- | Text format?       Bool       -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.-      (HashSet Kernel.QualifiedTypeName)+      (HashSet Vocab.QualifiedTypeName)       -- | Serialization function on the resolved OIDs.-      (HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo -> a -> Binary.Encoding)+      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo.TypeInfo -> a -> Binary.Encoding)       -- | Render function for error messages.       (a -> TextBuilder.TextBuilder) @@ -46,13 +46,13 @@     Value schemaName typeName valueOid arrayOid dimensionality textFormat unknownTypes (\hashMap -> encode hashMap . f) (render . f)  {-# INLINE primitive #-}-primitive :: Text -> Bool -> Kernel.TypeInfo.TypeInfo -> (a -> Binary.Encoding) -> (a -> TextBuilder.TextBuilder) -> Value a+primitive :: Text -> Bool -> Vocab.TypeInfo.TypeInfo -> (a -> Binary.Encoding) -> (a -> TextBuilder.TextBuilder) -> Value a primitive typeName isText typeInfo encode render =   Value     Nothing     typeName-    (Just (Kernel.TypeInfo.toBaseOid typeInfo))-    (Just (Kernel.TypeInfo.toArrayOid typeInfo))+    (Just (Vocab.TypeInfo.toBaseOid typeInfo))+    (Just (Vocab.TypeInfo.toArrayOid typeInfo))     0     isText     HashSet.empty@@ -63,43 +63,43 @@ -- Encoder of @BOOL@ values. {-# INLINEABLE bool #-} bool :: Value Bool-bool = primitive "bool" False Kernel.TypeInfo.bool Binary.bool (TextBuilder.string . show)+bool = primitive "bool" False Vocab.TypeInfo.bool Binary.bool (TextBuilder.string . show)  -- | -- Encoder of @INT2@ values. {-# INLINEABLE int2 #-} int2 :: Value Int16-int2 = primitive "int2" False Kernel.TypeInfo.int2 Binary.int2_int16 (TextBuilder.string . show)+int2 = primitive "int2" False Vocab.TypeInfo.int2 Binary.int2_int16 (TextBuilder.string . show)  -- | -- Encoder of @INT4@ values. {-# INLINEABLE int4 #-} int4 :: Value Int32-int4 = primitive "int4" False Kernel.TypeInfo.int4 Binary.int4_int32 (TextBuilder.string . show)+int4 = primitive "int4" False Vocab.TypeInfo.int4 Binary.int4_int32 (TextBuilder.string . show)  -- | -- Encoder of @INT8@ values. {-# INLINEABLE int8 #-} int8 :: Value Int64-int8 = primitive "int8" False Kernel.TypeInfo.int8 Binary.int8_int64 (TextBuilder.string . show)+int8 = primitive "int8" False Vocab.TypeInfo.int8 Binary.int8_int64 (TextBuilder.string . show)  -- | -- Encoder of @FLOAT4@ values. {-# INLINEABLE float4 #-} float4 :: Value Float-float4 = primitive "float4" False Kernel.TypeInfo.float4 Binary.float4 (TextBuilder.string . show)+float4 = primitive "float4" False Vocab.TypeInfo.float4 Binary.float4 (TextBuilder.string . show)  -- | -- Encoder of @FLOAT8@ values. {-# INLINEABLE float8 #-} float8 :: Value Double-float8 = primitive "float8" False Kernel.TypeInfo.float8 Binary.float8 (TextBuilder.string . show)+float8 = primitive "float8" False Vocab.TypeInfo.float8 Binary.float8 (TextBuilder.string . show)  -- | -- Encoder of @NUMERIC@ values. {-# INLINEABLE numeric #-} numeric :: Value Scientific-numeric = primitive "numeric" False Kernel.TypeInfo.numeric Binary.numeric (TextBuilder.string . show)+numeric = primitive "numeric" False Vocab.TypeInfo.numeric Binary.numeric (TextBuilder.string . show)  -- | -- Encoder of @CHAR@ values.@@ -108,79 +108,79 @@ -- identifies itself under the @TEXT@ OID because of that. {-# INLINEABLE char #-} char :: Value Char-char = primitive "char" False Kernel.TypeInfo.text Binary.char_utf8 (TextBuilder.string . show)+char = primitive "char" False Vocab.TypeInfo.text Binary.char_utf8 (TextBuilder.string . show)  -- | -- Encoder of @TEXT@ values. {-# INLINEABLE text #-} text :: Value Text-text = primitive "text" False Kernel.TypeInfo.text Binary.text_strict (TextBuilder.string . show)+text = primitive "text" False Vocab.TypeInfo.text Binary.text_strict (TextBuilder.string . show)  -- | -- Encoder of @VARCHAR@ values. {-# INLINEABLE varchar #-} varchar :: Value Text-varchar = primitive "varchar" False Kernel.TypeInfo.varchar Binary.text_strict (TextBuilder.string . show)+varchar = primitive "varchar" False Vocab.TypeInfo.varchar Binary.text_strict (TextBuilder.string . show)  -- | -- Encoder of @BPCHAR@ or @CHAR(n)@, @CHARACTER(n)@ values. {-# INLINEABLE bpchar #-} bpchar :: Value Text-bpchar = primitive "bpchar" False Kernel.TypeInfo.bpchar Binary.text_strict (TextBuilder.string . show)+bpchar = primitive "bpchar" False Vocab.TypeInfo.bpchar Binary.text_strict (TextBuilder.string . show)  -- | -- Encoder of @BYTEA@ values. {-# INLINEABLE bytea #-} bytea :: Value ByteString-bytea = primitive "bytea" False Kernel.TypeInfo.bytea Binary.bytea_strict (TextBuilder.string . show)+bytea = primitive "bytea" False Vocab.TypeInfo.bytea Binary.bytea_strict (TextBuilder.string . show)  -- | -- Encoder of @DATE@ values. {-# INLINEABLE date #-} date :: Value Day-date = primitive "date" False Kernel.TypeInfo.date Binary.date (TextBuilder.string . show)+date = primitive "date" False Vocab.TypeInfo.date Binary.date (TextBuilder.string . show)  -- | -- Encoder of @TIMESTAMP@ values. {-# INLINEABLE timestamp #-} timestamp :: Value LocalTime-timestamp = primitive "timestamp" False Kernel.TypeInfo.timestamp Binary.timestamp_int (TextBuilder.string . show)+timestamp = primitive "timestamp" False Vocab.TypeInfo.timestamp Binary.timestamp_int (TextBuilder.string . show)  -- | -- Encoder of @TIMESTAMPTZ@ values. {-# INLINEABLE timestamptz #-} timestamptz :: Value UTCTime-timestamptz = primitive "timestamptz" False Kernel.TypeInfo.timestamptz Binary.timestamptz_int (TextBuilder.string . show)+timestamptz = primitive "timestamptz" False Vocab.TypeInfo.timestamptz Binary.timestamptz_int (TextBuilder.string . show)  -- | -- Encoder of @TIME@ values. {-# INLINEABLE time #-} time :: Value TimeOfDay-time = primitive "time" False Kernel.TypeInfo.time Binary.time_int (TextBuilder.string . show)+time = primitive "time" False Vocab.TypeInfo.time Binary.time_int (TextBuilder.string . show)  -- | -- Encoder of @TIMETZ@ values. {-# INLINEABLE timetz #-} timetz :: Value (TimeOfDay, TimeZone)-timetz = primitive "timetz" False Kernel.TypeInfo.timetz Binary.timetz_int (TextBuilder.string . show)+timetz = primitive "timetz" False Vocab.TypeInfo.timetz Binary.timetz_int (TextBuilder.string . show)  -- | -- Encoder of @INTERVAL@ values. {-# INLINEABLE interval #-} interval :: Value DiffTime-interval = primitive "interval" False Kernel.TypeInfo.interval Binary.interval_int (TextBuilder.string . show)+interval = primitive "interval" False Vocab.TypeInfo.interval Binary.interval_int (TextBuilder.string . show)  -- | -- Encoder of @UUID@ values. {-# INLINEABLE uuid #-} uuid :: Value UUID-uuid = primitive "uuid" False Kernel.TypeInfo.uuid Binary.uuid (TextBuilder.string . show)+uuid = primitive "uuid" False Vocab.TypeInfo.uuid Binary.uuid (TextBuilder.string . show)  -- | -- Encoder of @INET@ values. {-# INLINEABLE inet #-} inet :: Value Iproute.IPRange-inet = primitive "inet" False Kernel.TypeInfo.inet Binary.inet (TextBuilder.string . show)+inet = primitive "inet" False Vocab.TypeInfo.inet Binary.inet (TextBuilder.string . show)  -- | -- Encoder of @MACADDR@ values.@@ -191,127 +191,127 @@ -- > toOctets >$< macaddr {-# INLINEABLE macaddr #-} macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)-macaddr = primitive "macaddr" False Kernel.TypeInfo.macaddr Binary.macaddr (TextBuilder.string . show)+macaddr = primitive "macaddr" False Vocab.TypeInfo.macaddr Binary.macaddr (TextBuilder.string . show)  -- | -- Encoder of @JSON@ values from JSON AST. {-# INLINEABLE json #-} json :: Value Aeson.Value-json = primitive "json" False Kernel.TypeInfo.json Binary.json_ast (TextBuilder.string . show)+json = primitive "json" False Vocab.TypeInfo.json Binary.json_ast (TextBuilder.string . show)  -- | -- Encoder of @JSON@ values from raw JSON. {-# INLINEABLE jsonBytes #-} jsonBytes :: Value ByteString-jsonBytes = primitive "json" False Kernel.TypeInfo.json Binary.json_bytes (TextBuilder.string . show)+jsonBytes = primitive "json" False Vocab.TypeInfo.json Binary.json_bytes (TextBuilder.string . show)  -- | -- Encoder of @JSON@ values from raw JSON as lazy ByteString. {-# INLINEABLE jsonLazyBytes #-} jsonLazyBytes :: Value LazyByteString.ByteString-jsonLazyBytes = primitive "json" False Kernel.TypeInfo.json Binary.json_bytes_lazy (TextBuilder.string . show)+jsonLazyBytes = primitive "json" False Vocab.TypeInfo.json Binary.json_bytes_lazy (TextBuilder.string . show)  -- | -- Encoder of @JSONB@ values from JSON AST. {-# INLINEABLE jsonb #-} jsonb :: Value Aeson.Value-jsonb = primitive "jsonb" False Kernel.TypeInfo.jsonb Binary.jsonb_ast (TextBuilder.string . show)+jsonb = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_ast (TextBuilder.string . show)  -- | -- Encoder of @JSONB@ values from raw JSON. {-# INLINEABLE jsonbBytes #-} jsonbBytes :: Value ByteString-jsonbBytes = primitive "jsonb" False Kernel.TypeInfo.jsonb Binary.jsonb_bytes (TextBuilder.string . show)+jsonbBytes = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_bytes (TextBuilder.string . show)  -- | -- Encoder of @JSONB@ values from raw JSON as lazy ByteString. {-# INLINEABLE jsonbLazyBytes #-} jsonbLazyBytes :: Value LazyByteString.ByteString-jsonbLazyBytes = primitive "jsonb" False Kernel.TypeInfo.jsonb Binary.jsonb_bytes_lazy (TextBuilder.string . show)+jsonbLazyBytes = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_bytes_lazy (TextBuilder.string . show)  -- | -- Encoder of @OID@ values. {-# INLINEABLE oid #-} oid :: Value Int32-oid = primitive "oid" False Kernel.TypeInfo.oid Binary.int4_int32 (TextBuilder.string . show)+oid = primitive "oid" False Vocab.TypeInfo.oid Binary.int4_int32 (TextBuilder.string . show)  -- | -- Encoder of @NAME@ values. {-# INLINEABLE name #-} name :: Value Text-name = primitive "name" False Kernel.TypeInfo.name Binary.text_strict (TextBuilder.string . show)+name = primitive "name" False Vocab.TypeInfo.name Binary.text_strict (TextBuilder.string . show)  -- | -- Encoder of @INT4RANGE@ values. {-# INLINEABLE int4range #-} int4range :: Value (Range.Range Int32)-int4range = primitive "int4range" False Kernel.TypeInfo.int4range Binary.int4range (TextBuilder.string . show)+int4range = primitive "int4range" False Vocab.TypeInfo.int4range Binary.int4range (TextBuilder.string . show)  -- | -- Encoder of @INT8RANGE@ values. {-# INLINEABLE int8range #-} int8range :: Value (Range.Range Int64)-int8range = primitive "int8range" False Kernel.TypeInfo.int8range Binary.int8range (TextBuilder.string . show)+int8range = primitive "int8range" False Vocab.TypeInfo.int8range Binary.int8range (TextBuilder.string . show)  -- | -- Encoder of @NUMRANGE@ values. {-# INLINEABLE numrange #-} numrange :: Value (Range.Range Scientific)-numrange = primitive "numrange" False Kernel.TypeInfo.numrange Binary.numrange (TextBuilder.string . show)+numrange = primitive "numrange" False Vocab.TypeInfo.numrange Binary.numrange (TextBuilder.string . show)  -- | -- Encoder of @TSRANGE@ values. {-# INLINEABLE tsrange #-} tsrange :: Value (Range.Range LocalTime)-tsrange = primitive "tsrange" False Kernel.TypeInfo.tsrange Binary.tsrange_int (TextBuilder.string . show)+tsrange = primitive "tsrange" False Vocab.TypeInfo.tsrange Binary.tsrange_int (TextBuilder.string . show)  -- | -- Encoder of @TSTZRANGE@ values. {-# INLINEABLE tstzrange #-} tstzrange :: Value (Range.Range UTCTime)-tstzrange = primitive "tstzrange" False Kernel.TypeInfo.tstzrange Binary.tstzrange_int (TextBuilder.string . show)+tstzrange = primitive "tstzrange" False Vocab.TypeInfo.tstzrange Binary.tstzrange_int (TextBuilder.string . show)  -- | -- Encoder of @DATERANGE@ values. {-# INLINEABLE daterange #-} daterange :: Value (Range.Range Day)-daterange = primitive "daterange" False Kernel.TypeInfo.daterange Binary.daterange (TextBuilder.string . show)+daterange = primitive "daterange" False Vocab.TypeInfo.daterange Binary.daterange (TextBuilder.string . show)  -- | -- Encoder of @INT4MULTIRANGE@ values. {-# INLINEABLE int4multirange #-} int4multirange :: Value (Range.Multirange Int32)-int4multirange = primitive "int4multirange" False Kernel.TypeInfo.int4multirange Binary.int4multirange (TextBuilder.string . show)+int4multirange = primitive "int4multirange" False Vocab.TypeInfo.int4multirange Binary.int4multirange (TextBuilder.string . show)  -- | -- Encoder of @INT8MULTIRANGE@ values. {-# INLINEABLE int8multirange #-} int8multirange :: Value (Range.Multirange Int64)-int8multirange = primitive "int8multirange" False Kernel.TypeInfo.int8multirange Binary.int8multirange (TextBuilder.string . show)+int8multirange = primitive "int8multirange" False Vocab.TypeInfo.int8multirange Binary.int8multirange (TextBuilder.string . show)  -- | -- Encoder of @NUMMULTIRANGE@ values. {-# INLINEABLE nummultirange #-} nummultirange :: Value (Range.Multirange Scientific)-nummultirange = primitive "nummultirange" False Kernel.TypeInfo.nummultirange Binary.nummultirange (TextBuilder.string . show)+nummultirange = primitive "nummultirange" False Vocab.TypeInfo.nummultirange Binary.nummultirange (TextBuilder.string . show)  -- | -- Encoder of @TSMULTIRANGE@ values. {-# INLINEABLE tsmultirange #-} tsmultirange :: Value (Range.Multirange LocalTime)-tsmultirange = primitive "tsmultirange" False Kernel.TypeInfo.tsmultirange Binary.tsmultirange_int (TextBuilder.string . show)+tsmultirange = primitive "tsmultirange" False Vocab.TypeInfo.tsmultirange Binary.tsmultirange_int (TextBuilder.string . show)  -- | -- Encoder of @TSTZMULTIRANGE@ values. {-# INLINEABLE tstzmultirange #-} tstzmultirange :: Value (Range.Multirange UTCTime)-tstzmultirange = primitive "tstzmultirange" False Kernel.TypeInfo.tstzmultirange Binary.tstzmultirange_int (TextBuilder.string . show)+tstzmultirange = primitive "tstzmultirange" False Vocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int (TextBuilder.string . show)  -- | -- Encoder of @DATEMULTIRANGE@ values. {-# INLINEABLE datemultirange #-} datemultirange :: Value (Range.Multirange Day)-datemultirange = primitive "datemultirange" False Kernel.TypeInfo.datemultirange Binary.datemultirange (TextBuilder.string . show)+datemultirange = primitive "datemultirange" False Vocab.TypeInfo.datemultirange Binary.datemultirange (TextBuilder.string . show)  -- | -- Encoder of @CITEXT@ values.@@ -351,7 +351,7 @@     Nothing     0     False-    (HashSet.singleton (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName))+    (HashSet.singleton (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName))     (const (Binary.text_strict . mapping))     (TextBuilder.text . mapping) @@ -369,7 +369,7 @@ {-# DEPRECATED unknown "Use 'custom' instead." #-} {-# INLINEABLE unknown #-} unknown :: Value ByteString-unknown = primitive "unknown" True Kernel.TypeInfo.unknown Binary.bytea_strict (TextBuilder.string . show)+unknown = primitive "unknown" True Vocab.TypeInfo.unknown Binary.bytea_strict (TextBuilder.string . show)  -- | -- Low level API for defining custom value encoders.@@ -382,7 +382,7 @@   -- | Possible static OIDs for the type. The first is for scalar values the second is for arrays.   --   -- When unspecified, the OIDs will be automatically determined at runtime by looking up by name.-  Maybe Kernel.TypeInfo.TypeInfo ->+  Maybe (Word32, Word32) ->   -- | Other named types whose OIDs are needed for serializing.   --   -- E.g., when encoding composite types Postgres requires specifying OIDs of all of its fields.@@ -393,7 +393,7 @@   --   -- It's safe to assume that all of the requested types will be present.   -- In case you run the provided lookup function with unmentioned type names it will produce OID of 0 for them, standing for unknown type in Postgres.-  ( ((Maybe Text, Text) -> Kernel.TypeInfo.TypeInfo) ->+  ( ((Maybe Text, Text) -> (Word32, Word32)) ->     a ->     ByteString   ) ->@@ -404,13 +404,19 @@   Value     schemaName     typeName-    (fmap Kernel.TypeInfo.toBaseOid staticOids)-    (fmap Kernel.TypeInfo.toArrayOid staticOids)+    (fmap fst staticOids)+    (fmap snd staticOids)     0     False-    (HashSet.fromList (fmap Kernel.QualifiedTypeName.fromNameTuple requiredTypes))+    (HashSet.fromList (fmap Vocab.QualifiedTypeName.fromNameTuple requiredTypes))     ( \hashMap ->-        ByteString.StrictBuilder.bytes . encode (\name -> fromMaybe (Kernel.TypeInfo.TypeInfo 0 0) (HashMap.lookup (Kernel.QualifiedTypeName.fromNameTuple name) hashMap))+        ByteString.StrictBuilder.bytes+          . encode+            ( \name ->+                fromMaybe (0, 0)+                  $ HashMap.lookup (Vocab.QualifiedTypeName.fromNameTuple name) hashMap+                  <&> \typeInfo -> (Vocab.TypeInfo.toBaseOid typeInfo, Vocab.TypeInfo.toArrayOid typeInfo)+            )     )     (TextBuilder.text . render)

src/library/Hasql/Codecs/RequestingOid.hs view

@@ -11,38 +11,38 @@   ) where -import Data.HashMap.Strict qualified as HashMap import Hasql.Codecs.RequestingOid.LookingUp qualified as LookingUp-import Hasql.Kernel qualified as Kernel-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo import Hasql.Platform.Prelude hiding (lift, lookup)  type RequestingOid =   LookingUp.LookingUp-    Kernel.QualifiedTypeName-    Kernel.TypeInfo.TypeInfo+    Vocab.QualifiedTypeName+    Vocab.TypeInfo.TypeInfo  {-# INLINE toUnknownTypes #-} toUnknownTypes ::   RequestingOid a ->-  HashSet Kernel.QualifiedTypeName+  HashSet Vocab.QualifiedTypeName toUnknownTypes (LookingUp.LookingUp unknownTypes _) =   fromList unknownTypes  {-# INLINE toBase #-} toBase ::   RequestingOid a ->-  HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo ->+  Vocab.OidCache ->   a toBase (LookingUp.LookingUp _unknownTypes decoder) oidCache =   decoder \key ->-    HashMap.lookup key oidCache-      & fromMaybe (Kernel.TypeInfo.TypeInfo 0 0)+    Vocab.OidCache.lookupTypeInfo key oidCache+      & fromMaybe (Vocab.TypeInfo.TypeInfo 0 0)  {-# INLINE requestAndHandle #-} requestAndHandle ::-  [Kernel.QualifiedTypeName] ->-  ((Kernel.QualifiedTypeName -> Kernel.TypeInfo.TypeInfo) -> a) ->+  [Vocab.QualifiedTypeName] ->+  ((Vocab.QualifiedTypeName -> Vocab.TypeInfo.TypeInfo) -> a) ->   RequestingOid a requestAndHandle keys fn = LookingUp.LookingUp keys fn @@ -55,13 +55,13 @@ hoist fn (LookingUp.LookingUp keys use) = LookingUp.LookingUp keys (fn . use)  {-# INLINE lookup #-}-lookup :: Kernel.QualifiedTypeName -> RequestingOid Kernel.TypeInfo.TypeInfo+lookup :: Vocab.QualifiedTypeName -> RequestingOid Vocab.TypeInfo.TypeInfo lookup = LookingUp.lookup  {-# INLINE lookingUp #-}-lookingUp :: Kernel.QualifiedTypeName -> (Kernel.TypeInfo.TypeInfo -> a) -> RequestingOid a+lookingUp :: Vocab.QualifiedTypeName -> (Vocab.TypeInfo.TypeInfo -> a) -> RequestingOid a lookingUp = LookingUp.lookingUp  {-# INLINE hoistLookingUp #-}-hoistLookingUp :: Kernel.QualifiedTypeName -> (Kernel.TypeInfo.TypeInfo -> a -> b) -> RequestingOid a -> RequestingOid b+hoistLookingUp :: Vocab.QualifiedTypeName -> (Vocab.TypeInfo.TypeInfo -> a -> b) -> RequestingOid a -> RequestingOid b hoistLookingUp = LookingUp.hoistLookingUp

+ src/library/Hasql/Codecs/Vocab.hs view

@@ -0,0 +1,14 @@+module Hasql.Codecs.Vocab+  ( QualifiedTypeName,+    TypeInfo,+    TypeRef,+    ParamMeta,+    OidCache,+  )+where++import Hasql.Codecs.Vocab.OidCache (OidCache)+import Hasql.Codecs.Vocab.ParamMeta (ParamMeta)+import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)+import Hasql.Codecs.Vocab.TypeInfo (TypeInfo)+import Hasql.Codecs.Vocab.TypeRef (TypeRef)

+ src/library/Hasql/Codecs/Vocab/OidCache.hs view

@@ -0,0 +1,91 @@+module Hasql.Codecs.Vocab.OidCache+  ( OidCache,++    -- * Accessors+    toHashMap,+    lookupScalar,+    lookupArray,+    lookupTypeNameScalar,+    lookupTypeNameArray,+    lookupTypeInfo,++    -- * Constructors+    fromHashMap,+    empty,+    selectUnknownNames,+    insertScalar,+  )+where++import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as TypeInfo+import Hasql.Platform.Prelude hiding (empty, insert, lookup, reset)++-- | Pure registry state containing the hash map and counter+newtype OidCache+  = OidCache+      -- | By name of the type.+      --+      -- > scalar name -> TypeInfo (scalar OID, array OID)+      (HashMap QualifiedTypeName TypeInfo.TypeInfo)+  deriving stock (Show, Eq)++instance Semigroup OidCache where+  OidCache byNameL <> OidCache byNameR =+    OidCache (HashMap.union byNameR byNameL)++instance Monoid OidCache where+  mempty = OidCache mempty++{-# INLINEABLE empty #-}+empty :: OidCache+empty =+  OidCache HashMap.empty++-- | Having a set of required type names, select those that are not present in the cache.+{-# INLINE selectUnknownNames #-}+selectUnknownNames :: HashSet QualifiedTypeName -> OidCache -> HashSet QualifiedTypeName+selectUnknownNames keys (OidCache byName) =+  HashSet.filter (\key -> not (HashMap.member key byName)) keys++insertScalar :: Maybe Text -> Text -> Word32 -> Word32 -> OidCache -> OidCache+insertScalar schema name scalar array (OidCache byName) =+  OidCache (HashMap.insert (QualifiedTypeName.QualifiedTypeName schema name) (TypeInfo.TypeInfo scalar array) byName)++{-# INLINE fromHashMap #-}+fromHashMap :: HashMap QualifiedTypeName TypeInfo.TypeInfo -> OidCache+fromHashMap byName = OidCache byName++-- * Accessors++{-# INLINE lookupScalar #-}+lookupScalar :: Maybe Text -> Text -> OidCache -> Maybe Word32+lookupScalar schema name (OidCache byName) =+  HashMap.lookup (QualifiedTypeName.QualifiedTypeName schema name) byName <&> \info -> TypeInfo.toBaseOid info++{-# INLINE lookupArray #-}+lookupArray :: Maybe Text -> Text -> OidCache -> Maybe Word32+lookupArray schema name (OidCache byName) =+  HashMap.lookup (QualifiedTypeName.QualifiedTypeName schema name) byName <&> \info -> TypeInfo.toArrayOid info++{-# INLINE lookupTypeNameScalar #-}+lookupTypeNameScalar :: QualifiedTypeName -> OidCache -> Maybe Word32+lookupTypeNameScalar name (OidCache byName) =+  HashMap.lookup name byName <&> TypeInfo.toBaseOid++{-# INLINE lookupTypeNameArray #-}+lookupTypeNameArray :: QualifiedTypeName -> OidCache -> Maybe Word32+lookupTypeNameArray name (OidCache byName) =+  HashMap.lookup name byName <&> TypeInfo.toArrayOid++{-# INLINE lookupTypeInfo #-}+lookupTypeInfo :: QualifiedTypeName -> OidCache -> Maybe TypeInfo.TypeInfo+lookupTypeInfo name (OidCache byName) =+  HashMap.lookup name byName++{-# INLINE toHashMap #-}+toHashMap :: OidCache -> HashMap QualifiedTypeName TypeInfo.TypeInfo+toHashMap (OidCache byName) = byName

+ src/library/Hasql/Codecs/Vocab/ParamMeta.hs view

@@ -0,0 +1,13 @@+module Hasql.Codecs.Vocab.ParamMeta+  ( ParamMeta (..),+  )+where++import Hasql.Codecs.Vocab.TypeRef (TypeRef)+import Hasql.Platform.Prelude++-- | Per-parameter metadata: type reference, array dimensionality, text-format flag.+data ParamMeta = ParamMeta TypeRef Word Bool+  deriving stock (Eq, Ord, Show, Generic)++instance Hashable ParamMeta

+ src/library/Hasql/Codecs/Vocab/QualifiedTypeName.hs view

@@ -0,0 +1,43 @@+module Hasql.Codecs.Vocab.QualifiedTypeName+  ( QualifiedTypeName (..),+    fromNameTuple,+    toNameTuple,+  )+where++import Hasql.Platform.Prelude++-- |+-- A Postgres type identified by name: an optional schema together with a+-- required type name.+--+-- A 'Nothing' schema means the name is unqualified and is resolved via the+-- server's search path.+--+-- Used as the key under which a type's OIDs are resolved and cached.+data QualifiedTypeName = QualifiedTypeName+  { schema :: Maybe Text,+    name :: Text+  }+  deriving stock (Eq, Ord, Show, Generic)++instance Hashable QualifiedTypeName++-- | An unqualified name constructor for convenience.+instance IsString QualifiedTypeName where+  fromString = QualifiedTypeName Nothing . fromString++-- |+-- Convert from the legacy @(schema, name)@ tuple representation.+--+-- Used at public-API boundaries (e.g. the @custom@ codecs and error types)+-- where the tuple is still exposed but internals operate on 'QualifiedTypeName'.+fromNameTuple :: (Maybe Text, Text) -> QualifiedTypeName+fromNameTuple (schema, name) = QualifiedTypeName schema name++-- |+-- Convert to the legacy @(schema, name)@ tuple representation.+--+-- See 'fromNameTuple'.+toNameTuple :: QualifiedTypeName -> (Maybe Text, Text)+toNameTuple (QualifiedTypeName schema name) = (schema, name)

+ src/library/Hasql/Codecs/Vocab/TypeInfo.hs view

@@ -0,0 +1,230 @@+module Hasql.Codecs.Vocab.TypeInfo where++import Hasql.Platform.Prelude hiding (bool)++-- | A Postgresql type info+data TypeInfo+  = TypeInfo {toBaseOid :: Word32, toArrayOid :: Word32}+  deriving (Eq, Ord, Show)++abstime :: TypeInfo+abstime = TypeInfo 702 1023++aclitem :: TypeInfo+aclitem = TypeInfo 1033 1034++bit :: TypeInfo+bit = TypeInfo 1560 1561++bool :: TypeInfo+bool = TypeInfo 16 1000++box :: TypeInfo+box = TypeInfo 603 1020++bpchar :: TypeInfo+bpchar = TypeInfo 1042 1014++bytea :: TypeInfo+bytea = TypeInfo 17 1001++char :: TypeInfo+char = TypeInfo 18 1002++cid :: TypeInfo+cid = TypeInfo 29 1012++cidr :: TypeInfo+cidr = TypeInfo 650 651++circle :: TypeInfo+circle = TypeInfo 718 719++cstring :: TypeInfo+cstring = TypeInfo 2275 1263++date :: TypeInfo+date = TypeInfo 1082 1182++daterange :: TypeInfo+daterange = TypeInfo 3912 3913++datemultirange :: TypeInfo+datemultirange = TypeInfo 4535 6155++float4 :: TypeInfo+float4 = TypeInfo 700 1021++float8 :: TypeInfo+float8 = TypeInfo 701 1022++gtsvector :: TypeInfo+gtsvector = TypeInfo 3642 3644++inet :: TypeInfo+inet = TypeInfo 869 1041++int2 :: TypeInfo+int2 = TypeInfo 21 1005++int2vector :: TypeInfo+int2vector = TypeInfo 22 1006++int4 :: TypeInfo+int4 = TypeInfo 23 1007++int4range :: TypeInfo+int4range = TypeInfo 3904 3905++int4multirange :: TypeInfo+int4multirange = TypeInfo 4451 6150++int8 :: TypeInfo+int8 = TypeInfo 20 1016++int8range :: TypeInfo+int8range = TypeInfo 3926 3927++int8multirange :: TypeInfo+int8multirange = TypeInfo 4536 6157++interval :: TypeInfo+interval = TypeInfo 1186 1187++json :: TypeInfo+json = TypeInfo 114 199++jsonb :: TypeInfo+jsonb = TypeInfo 3802 3807++line :: TypeInfo+line = TypeInfo 628 629++lseg :: TypeInfo+lseg = TypeInfo 601 1018++macaddr :: TypeInfo+macaddr = TypeInfo 829 1040++money :: TypeInfo+money = TypeInfo 790 791++name :: TypeInfo+name = TypeInfo 19 1003++numeric :: TypeInfo+numeric = TypeInfo 1700 1231++numrange :: TypeInfo+numrange = TypeInfo 3906 3907++nummultirange :: TypeInfo+nummultirange = TypeInfo 4532 6151++oid :: TypeInfo+oid = TypeInfo 26 1028++oidvector :: TypeInfo+oidvector = TypeInfo 30 1013++path :: TypeInfo+path = TypeInfo 602 1019++point :: TypeInfo+point = TypeInfo 600 1017++polygon :: TypeInfo+polygon = TypeInfo 604 1027++record :: TypeInfo+record = TypeInfo 2249 2287++refcursor :: TypeInfo+refcursor = TypeInfo 1790 2201++regclass :: TypeInfo+regclass = TypeInfo 2205 2210++regconfig :: TypeInfo+regconfig = TypeInfo 3734 3735++regdictionary :: TypeInfo+regdictionary = TypeInfo 3769 3770++regoper :: TypeInfo+regoper = TypeInfo 2203 2208++regoperator :: TypeInfo+regoperator = TypeInfo 2204 2209++regproc :: TypeInfo+regproc = TypeInfo 24 1008++regprocedure :: TypeInfo+regprocedure = TypeInfo 2202 2207++regtype :: TypeInfo+regtype = TypeInfo 2206 2211++reltime :: TypeInfo+reltime = TypeInfo 703 1024++text :: TypeInfo+text = TypeInfo 25 1009++tid :: TypeInfo+tid = TypeInfo 27 1010++time :: TypeInfo+time = TypeInfo 1083 1183++timestamp :: TypeInfo+timestamp = TypeInfo 1114 1115++timestamptz :: TypeInfo+timestamptz = TypeInfo 1184 1185++timetz :: TypeInfo+timetz = TypeInfo 1266 1270++tinterval :: TypeInfo+tinterval = TypeInfo 704 1025++tsquery :: TypeInfo+tsquery = TypeInfo 3615 3645++tsrange :: TypeInfo+tsrange = TypeInfo 3908 3909++tsmultirange :: TypeInfo+tsmultirange = TypeInfo 4533 6152++tstzrange :: TypeInfo+tstzrange = TypeInfo 3910 3911++tstzmultirange :: TypeInfo+tstzmultirange = TypeInfo 4534 6153++tsvector :: TypeInfo+tsvector = TypeInfo 3614 3643++txid_snapshot :: TypeInfo+txid_snapshot = TypeInfo 2970 2949++unknown :: TypeInfo+unknown = TypeInfo 705 705++uuid :: TypeInfo+uuid = TypeInfo 2950 2951++varbit :: TypeInfo+varbit = TypeInfo 1562 1563++varchar :: TypeInfo+varchar = TypeInfo 1043 1015++xid :: TypeInfo+xid = TypeInfo 28 1011++xml :: TypeInfo+xml = TypeInfo 142 143

+ src/library/Hasql/Codecs/Vocab/TypeRef.hs view

@@ -0,0 +1,20 @@+module Hasql.Codecs.Vocab.TypeRef+  ( TypeRef (..),+  )+where++import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)+import Hasql.Platform.Prelude++-- |+-- How a parameter's Postgres type is identified within parameter metadata:+-- either an already-known OID, or a 'QualifiedTypeName' still pending OID+-- resolution against the server.+data TypeRef+  = -- | The type's OID is statically known.+    KnownOid Word32+  | -- | The type is named and its OID must be resolved before execution.+    NamedType QualifiedTypeName+  deriving stock (Eq, Ord, Show, Generic)++instance Hashable TypeRef

src/library/Hasql/Decoders.hs view

@@ -83,13 +83,9 @@     -- * Composite     Composite,     field,--    -- * TypeInfo-    TypeInfo (..),   ) where  import Hasql.Codecs.Decoders import Hasql.Engine.Decoders.Result import Hasql.Engine.Decoders.Row-import Hasql.Kernel.TypeInfo (TypeInfo (..))

src/library/Hasql/Encoders.hs view

@@ -74,11 +74,7 @@     -- * Composite     Composite,     field,--    -- * TypeInfo-    TypeInfo (..),   ) where  import Hasql.Codecs.Encoders-import Hasql.Kernel.TypeInfo (TypeInfo (..))

src/library/Hasql/Engine/Contexts/Pipeline.hs view

@@ -7,17 +7,15 @@  import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet-import Hasql.Codecs.Encoders.Params qualified as Params import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as OidCache+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip-import Hasql.Engine.Decoders.Result qualified as Decoders.Result import Hasql.Engine.Errors qualified as Errors import Hasql.Engine.PqProcedures.SelectTypeInfo qualified as PqProcedures.SelectTypeInfo-import Hasql.Engine.Structures.OidCache qualified as OidCache+import Hasql.Engine.Statement qualified as Statement import Hasql.Engine.Structures.StatementCache qualified as StatementCache-import Hasql.Kernel qualified as Kernel-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo import Hasql.Platform.Prelude import Hasql.Pq qualified as Pq @@ -46,13 +44,13 @@             let foundTypes = HashMap.keysSet oidCacheUpdates                 notFoundTypes = HashSet.difference missingTypes foundTypes              in if not (HashSet.null notFoundTypes)-                  then Left (Errors.MissingTypesSessionError (HashSet.map Kernel.QualifiedTypeName.toNameTuple notFoundTypes))+                  then Left (Errors.MissingTypesSessionError (HashSet.map Vocab.QualifiedTypeName.toNameTuple notFoundTypes))                   else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates)   case resolvedOidCache of     Left err -> pure (Left err, oidCache, statementCache)     Right newOidCache -> do       let (roundtrip, newStatementCache) =-            runPipeline 0 usePreparedStatements (OidCache.toHashMap newOidCache) statementCache+            runPipeline 0 usePreparedStatements newOidCache statementCache           contextualRoundtrip = first Just roundtrip        executionResult <- Comms.Roundtrip.toPipelineIO contextualRoundtrip Nothing connection@@ -147,7 +145,7 @@       -- It can be assumed in the execution function that these types are always present in the cache.       -- To achieve that property we will be validating the presence of all requested types in the database or failing before running the pipeline.       -- In the execution function we will be defaulting to 'Pq.Oid 0' for unknown types as a fallback in case of bugs.-      (HashSet Kernel.QualifiedTypeName)+      (HashSet Vocab.QualifiedTypeName)       -- | Function that runs the pipeline.       --       -- The integer parameter indicates the current offset of the statement in the pipeline (0-based).@@ -164,7 +162,7 @@       -- committed cache from statement contexts carried by roundtrip errors.       ( Int ->         Bool ->-        HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo ->+        OidCache.OidCache ->         StatementCache.StatementCache ->         (Comms.Roundtrip.Roundtrip Context a, StatementCache.StatementCache)       )@@ -207,37 +205,32 @@ -- | -- Execute a statement in pipelining mode. statement ::-  ByteString ->-  Params.Params params ->-  Decoders.Result.Result result ->-  Bool ->+  Statement.Statement params result ->   params ->   Pipeline result-statement sql encoder (Decoders.Result.unwrap -> decoder) preparable params =-  Pipeline 1 unknownTypes run+statement stmt params =+  Pipeline 1 (Statement.unknownTypes stmt) run   where-    unknownTypes =-      Params.toUnknownTypes encoder-        <> RequestingOid.toUnknownTypes decoder+    sql = Statement.sql stmt     run offset usePreparedStatements oidCache =       if prepare         then runPrepared         else runUnprepared       where         (oidList, valueAndFormatList) =-          Params.compilePreparedStatementData encoder oidCache params+          Statement.compilePreparedStatementData stmt oidCache params          pqOidList =           fmap (Pq.Oid . fromIntegral) oidList          prepare =-          usePreparedStatements && preparable+          usePreparedStatements && Statement.isPrepared stmt          context soFarStatementCache =           Context             offset             sql-            (Params.renderReadable encoder params)+            (Statement.printer stmt params)             prepare             soFarStatementCache @@ -268,9 +261,8 @@               Comms.Roundtrip.queryParams (context statementCache) sql encodedParams Pq.Binary decoder'               where                 encodedParams =-                  params-                    & Params.compileUnpreparedStatementData encoder oidCache+                  Statement.compileUnpreparedStatementData stmt oidCache params                     & fmap (fmap (\(oid, bytes, format) -> (Pq.Oid (fromIntegral oid), bytes, bool Pq.Binary Pq.Text format)))          decoder' =-          RequestingOid.toBase decoder oidCache+          RequestingOid.toBase (Statement.decoder stmt) oidCache

src/library/Hasql/Engine/Contexts/Session.hs view

@@ -2,17 +2,16 @@  import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet-import Hasql.Codecs.Encoders.Params qualified as Params import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab.OidCache qualified as OidCache+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip import Hasql.Engine.Contexts.Pipeline qualified as Pipeline-import Hasql.Engine.Decoders.Result qualified as Decoders.Result import Hasql.Engine.Errors qualified as Errors import Hasql.Engine.PqProcedures.SelectTypeInfo qualified as PqProcedures.SelectTypeInfo+import Hasql.Engine.Statement qualified as Statement import Hasql.Engine.Structures.ConnectionState qualified as ConnectionState-import Hasql.Engine.Structures.OidCache qualified as OidCache import Hasql.Engine.Structures.StatementCache qualified as StatementCache-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName import Hasql.Platform.Prelude import Hasql.Pq qualified as Pq @@ -78,23 +77,17 @@ -- -- To batch multiple statements into fewer roundtrips, use 'pipeline' instead. statement ::-  ByteString ->-  Params.Params params ->-  Decoders.Result.Result result ->-  Bool ->+  Statement.Statement params result ->   params ->   Session result-statement sql paramsEncoder decoder preparable params =+statement stmt params =   Session \connectionState -> do     let usePreparedStatements = ConnectionState.preparedStatements connectionState         statementCache = ConnectionState.statementCache connectionState         oidCache = ConnectionState.oidCache connectionState         connection = ConnectionState.connection connectionState-        requestingDecoder = Decoders.Result.unwrap decoder-        unknownTypes =-          Params.toUnknownTypes paramsEncoder-            <> RequestingOid.toUnknownTypes requestingDecoder-        missingTypes = OidCache.selectUnknownNames unknownTypes oidCache+        sql = Statement.sql stmt+        missingTypes = OidCache.selectUnknownNames (Statement.unknownTypes stmt) oidCache     resolvedOidCache <-       if HashSet.null missingTypes         then pure (Right oidCache)@@ -107,17 +100,16 @@               let foundTypes = HashMap.keysSet oidCacheUpdates                   notFoundTypes = HashSet.difference missingTypes foundTypes                in if not (HashSet.null notFoundTypes)-                    then Left (Errors.MissingTypesSessionError (HashSet.map Kernel.QualifiedTypeName.toNameTuple notFoundTypes))+                    then Left (Errors.MissingTypesSessionError (HashSet.map Vocab.QualifiedTypeName.toNameTuple notFoundTypes))                     else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates)     case resolvedOidCache of       Left err -> pure (Left err, connectionState)       Right newOidCache -> do-        let oidHashMap = OidCache.toHashMap newOidCache-            decoder' = RequestingOid.toBase requestingDecoder oidHashMap-            prepared = usePreparedStatements && preparable+        let decoder' = RequestingOid.toBase (Statement.decoder stmt) newOidCache+            prepared = usePreparedStatements && Statement.isPrepared stmt             -- Single-statement context for error reporting:             -- total statements 1, index 0.-            context = Just (1, 0, sql, Params.renderReadable paramsEncoder params, prepared)+            context = Just (1, 0, sql, Statement.printer stmt params, prepared)             mapError = \case               Comms.Roundtrip.ClientError _ details ->                 Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)@@ -134,7 +126,7 @@           $ if prepared             then do               let (oidList, valueAndFormatList) =-                    Params.compilePreparedStatementData paramsEncoder oidHashMap params+                    Statement.compilePreparedStatementData stmt newOidCache params                   pqOidList = fmap (Pq.Oid . fromIntegral) oidList                   encodedParams =                     valueAndFormatList@@ -168,8 +160,7 @@                       pure (result, newStatementCache)             else do               let encodedParams =-                    params-                      & Params.compileUnpreparedStatementData paramsEncoder oidHashMap+                    Statement.compileUnpreparedStatementData stmt newOidCache params                       & fmap (fmap (\(oid, bytes, format) -> (Pq.Oid (fromIntegral oid), bytes, bool Pq.Binary Pq.Text format)))               result <-                 Comms.Roundtrip.toSerialIO

src/library/Hasql/Engine/Decoders/Row.hs view

@@ -3,9 +3,9 @@ import Hasql.Codecs.Decoders import Hasql.Codecs.Decoders.Value qualified as Value import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo import Hasql.Comms.RowDecoder qualified-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo import Hasql.Platform.Prelude import PostgreSQL.Binary.Decoding qualified as Binary @@ -42,7 +42,7 @@           (Value.toDecoder valueDecoder)       Nothing -> do         RequestingOid.hoistLookingUp-          (Kernel.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))+          (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))           ( \lookupResult decoder ->               Hasql.Comms.RowDecoder.nullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder)           )@@ -55,11 +55,11 @@           (Value.toDecoder valueDecoder)       Nothing -> do         RequestingOid.hoistLookingUp-          (Kernel.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))+          (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))           (\lookupResult decoder -> Hasql.Comms.RowDecoder.nonNullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder))           (Value.toDecoder valueDecoder)   where     chooseLookedUpOid valueDecoder typeInfo =       if Value.toDimensionality valueDecoder > 0-        then Kernel.TypeInfo.toArrayOid typeInfo-        else Kernel.TypeInfo.toBaseOid typeInfo+        then Vocab.TypeInfo.toArrayOid typeInfo+        else Vocab.TypeInfo.toBaseOid typeInfo

src/library/Hasql/Engine/PqProcedures/SelectTypeInfo.hs view

@@ -8,26 +8,25 @@ import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet import Hasql.Codecs.Decoders.Value qualified as Decoders.Value-import Hasql.Codecs.Encoders qualified as Encoders-import Hasql.Codecs.Encoders.Params qualified as Encoders.Params+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo import Hasql.Comms.ResultDecoder qualified import Hasql.Comms.Roundtrip qualified import Hasql.Comms.RowDecoder qualified import Hasql.Engine.Errors qualified as Errors-import Hasql.Kernel qualified as Kernel-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo import Hasql.Platform.Prelude import Hasql.Pq qualified as Pq+import PostgreSQL.Binary.Encoding qualified as Binary  newtype SelectTypeInfo = SelectTypeInfo   { -- | Set of (schema name, type name) pairs to look up.-    keys :: HashSet Kernel.QualifiedTypeName+    keys :: HashSet Vocab.QualifiedTypeName   }  -- | Result maps (schema name, type name) pairs to TypeInfo (scalar OID, array OID). type SelectTypeInfoResult =-  HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo+  HashMap Vocab.QualifiedTypeName Vocab.TypeInfo.TypeInfo  run :: Pq.Connection -> SelectTypeInfo -> IO (Either Errors.SessionError SelectTypeInfoResult) run connection (SelectTypeInfo keys) =@@ -75,33 +74,30 @@ roundtrip params =   Hasql.Comms.Roundtrip.queryParams () sql (encodeParams params) Pq.Binary decoder +-- | Encode the two text-array parameters directly.+-- Text OID is 25; text-array OID is 1009. encodeParams :: SelectTypeInfo -> [Maybe (Pq.Oid, ByteString, Pq.Format)]-encodeParams =-  fmap-    ( fmap-        ( \(oid, bytes, format) ->-            ( Pq.Oid (fromIntegral oid),-              bytes,-              bool Pq.Binary Pq.Text format-            )-        )-    )-    . Encoders.Params.compileUnpreparedStatementData paramsEncoder mempty--paramsEncoder :: Encoders.Params SelectTypeInfo-paramsEncoder =-  (\(SelectTypeInfo keys) -> unzip (fmap Kernel.QualifiedTypeName.toNameTuple (HashSet.toList keys)))-    >$< mconcat-      [ fst >$< Encoders.param (Encoders.nonNullable (Encoders.foldableArray (Encoders.nullable Encoders.text))),-        snd >$< Encoders.param (Encoders.nonNullable (Encoders.foldableArray (Encoders.nonNullable Encoders.text)))+encodeParams (SelectTypeInfo keys) =+  let (schemaNames, typeNames) = unzip (fmap Vocab.QualifiedTypeName.toNameTuple (HashSet.toList keys))+      schemaArray = Binary.encodingBytes (Binary.array 25 (encodeTextArray (encodeMaybeText schemaNames)))+      typeArray = Binary.encodingBytes (Binary.array 25 (encodeTextArray (fmap (Binary.encodingArray . Binary.text_strict) typeNames)))+   in [ Just (Pq.Oid 1009, schemaArray, Pq.Binary),+        Just (Pq.Oid 1009, typeArray, Pq.Binary)       ]+  where+    encodeTextArray elements =+      Binary.dimensionArray foldl' id elements+    encodeMaybeText =+      fmap \case+        Nothing -> Binary.nullArray+        Just text -> Binary.encodingArray (Binary.text_strict text)  decoder :: Hasql.Comms.ResultDecoder.ResultDecoder SelectTypeInfoResult decoder =   Hasql.Comms.ResultDecoder.foldl step HashMap.empty rowDecoder   where     step acc (schemaName, typeName, typeOid, arrayOid) =-      HashMap.insert (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) (Kernel.TypeInfo.TypeInfo typeOid arrayOid) acc+      HashMap.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) (Vocab.TypeInfo.TypeInfo typeOid arrayOid) acc  rowDecoder :: Hasql.Comms.RowDecoder.RowDecoder (Maybe Text, Text, Word32, Word32) rowDecoder =

src/library/Hasql/Engine/Statement.hs view

@@ -4,13 +4,23 @@     unpreparable,     refineResult,     toSql,+    compilePreparedStatementData,+    compileUnpreparedStatementData,   ) where  import Data.Text.Encoding qualified as TextEncoding+import Data.Vector qualified as Vector+import Hasql.Codecs.Encoders.Params qualified as Params+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache+import Hasql.Codecs.Vocab.ParamMeta (ParamMeta (..))+import Hasql.Codecs.Vocab.TypeRef qualified as Vocab.TypeRef+import Hasql.Comms.ResultDecoder qualified as ResultDecoder import Hasql.Decoders qualified as Decoders import Hasql.Encoders qualified as Encoders-import Hasql.Engine.Decoders.Result qualified+import Hasql.Engine.Decoders.Result qualified as Decoders.Result import Hasql.Platform.Prelude  -- |@@ -37,23 +47,22 @@ -- and produces a single result of type 'Int64'. data Statement params result   = Statement-      -- | SQL template pre-encoded as UTF-8 for execution.-      ---      -- Must be formatted according to the Postgres standard.-      -- The parameters must be referred to using the positional notation, as in the following:-      -- @$1@, @$2@, @$3@ and etc.-      -- These references must be used in accordance with the order in which-      -- the value encoders are specified in the parameters encoder.-      ByteString-      -- | Parameters encoder.-      (Encoders.Params params)-      -- | Decoder of result.-      (Decoders.Result result)-      -- | Flag, determining whether it can be prepared.-      ---      -- Set it to 'True' if your application has a limited amount of queries and doesn't generate the SQL dynamically.-      -- This will boost the performance by allowing Postgres to avoid reconstructing the execution plan each time the query gets executed.-      Bool+  { -- | SQL template pre-encoded as UTF-8 for execution.+    sql :: ByteString,+    -- | Frozen per-parameter metadata: type reference, dimensionality, text-format flag.+    -- Produced once at construction from the Params DList and reused across executions.+    columnsMetadata :: Vector ParamMeta,+    -- | Serialise params to encoded wire values given a resolved OID cache.+    serializer :: Vocab.OidCache -> params -> [Maybe ByteString],+    -- | Render params in human-readable form (for error reporting).+    printer :: params -> [Text],+    -- | Union of encoder and decoder unknown types, resolved once at construction.+    unknownTypes :: HashSet Vocab.QualifiedTypeName,+    -- | Unwrapped result decoder (RequestingOid layer already peeled from Result).+    decoder :: RequestingOid.RequestingOid (ResultDecoder.ResultDecoder result),+    -- | Whether this statement may be prepared on the server.+    isPrepared :: Bool+  }  -- | -- Construct a preparable statement.@@ -70,7 +79,18 @@   -- | Result decoder   Decoders.Result result ->   Statement params result-preparable sql encoder decoder = Statement (TextEncoding.encodeUtf8 sql) encoder decoder True+preparable sqlText encoder resultDecoder =+  Statement+    { sql = TextEncoding.encodeUtf8 sqlText,+      columnsMetadata = Params.toColumnsMetadata encoder,+      serializer = Params.toSerializer encoder,+      printer = Params.toPrinter encoder,+      unknownTypes = Params.toUnknownTypes encoder <> RequestingOid.toUnknownTypes rawDecoder,+      decoder = rawDecoder,+      isPrepared = True+    }+  where+    rawDecoder = Decoders.Result.unwrap resultDecoder  -- | -- Construct an unpreparable statement.@@ -87,21 +107,35 @@   -- | Result decoder   Decoders.Result result ->   Statement params result-unpreparable sql encoder decoder = Statement (TextEncoding.encodeUtf8 sql) encoder decoder False+unpreparable sqlText encoder resultDecoder =+  Statement+    { sql = TextEncoding.encodeUtf8 sqlText,+      columnsMetadata = Params.toColumnsMetadata encoder,+      serializer = Params.toSerializer encoder,+      printer = Params.toPrinter encoder,+      unknownTypes = Params.toUnknownTypes encoder <> RequestingOid.toUnknownTypes rawDecoder,+      decoder = rawDecoder,+      isPrepared = False+    }+  where+    rawDecoder = Decoders.Result.unwrap resultDecoder  instance Functor (Statement params) where   {-# INLINE fmap #-}-  fmap = rmap+  fmap f stmt = stmt {decoder = fmap (fmap f) (decoder stmt)}  instance Filterable (Statement params) where   {-# INLINE mapMaybe #-}-  mapMaybe filtrator (Statement template encoder decoder preparable) =-    Statement template encoder (mapMaybe filtrator decoder) preparable+  mapMaybe filtrator stmt = stmt {decoder = fmap (mapMaybe filtrator) (decoder stmt)}  instance Profunctor Statement where   {-# INLINE dimap #-}-  dimap f1 f2 (Statement template encoder decoder preparable) =-    Statement template (contramap f1 encoder) (fmap f2 decoder) preparable+  dimap f1 f2 stmt =+    stmt+      { serializer = \oidCache -> serializer stmt oidCache . f1,+        printer = printer stmt . f1,+        decoder = fmap (fmap f2) (decoder stmt)+      }  -- | -- Refine the result of a statement,@@ -110,9 +144,45 @@ -- This function is especially useful for refining the results of statements produced with -- <http://hackage.haskell.org/package/hasql-th the \"hasql-th\" library>. refineResult :: (a -> Either Text b) -> Statement params a -> Statement params b-refineResult refiner (Statement template encoder decoder preparable) =-  Statement template encoder (Hasql.Engine.Decoders.Result.refineResult refiner decoder) preparable+refineResult refiner stmt = stmt {decoder = fmap (ResultDecoder.refine refiner) (decoder stmt)}  -- | Extract the SQL template from a statement. toSql :: Statement params result -> Text-toSql (Statement sql _ _ _) = TextEncoding.decodeUtf8Lenient sql+toSql stmt = TextEncoding.decodeUtf8Lenient (sql stmt)++-- | Compile prepared-statement data: resolve OIDs and pair encoded values with their format flags.+compilePreparedStatementData ::+  Statement params result ->+  Vocab.OidCache ->+  params ->+  ([Word32], [Maybe (ByteString, Bool)])+compilePreparedStatementData stmt oidCache params =+  unzip+    $ zipWith+      (\(ParamMeta typeRef dim fmt) encoding -> (resolveOid typeRef dim, fmap (,fmt) encoding))+      (Vector.toList (columnsMetadata stmt))+      (serializer stmt oidCache params)+  where+    resolveOid (Vocab.TypeRef.NamedType name) dim =+      case Vocab.OidCache.lookupTypeNameScalar name oidCache of+        Just oid -> if dim == 0 then oid else fromMaybe 0 (Vocab.OidCache.lookupTypeNameArray name oidCache)+        Nothing -> 0+    resolveOid (Vocab.TypeRef.KnownOid oid) _ = oid++-- | Compile unprepared-statement data: resolve OIDs inline with encoded values.+compileUnpreparedStatementData ::+  Statement params result ->+  Vocab.OidCache ->+  params ->+  [Maybe (Word32, ByteString, Bool)]+compileUnpreparedStatementData stmt oidCache params =+  zipWith+    (\(ParamMeta typeRef dim fmt) encoding -> (,,) <$> Just (resolveOid typeRef dim) <*> encoding <*> Just fmt)+    (Vector.toList (columnsMetadata stmt))+    (serializer stmt oidCache params)+  where+    resolveOid (Vocab.TypeRef.NamedType name) dim =+      case Vocab.OidCache.lookupTypeNameScalar name oidCache of+        Just oid -> if dim == 0 then oid else fromMaybe 0 (Vocab.OidCache.lookupTypeNameArray name oidCache)+        Nothing -> 0+    resolveOid (Vocab.TypeRef.KnownOid oid) _ = oid

src/library/Hasql/Engine/Structures/ConnectionState.hs view

@@ -15,7 +15,7 @@   ) where -import Hasql.Engine.Structures.OidCache qualified as OidCache+import Hasql.Codecs.Vocab.OidCache qualified as OidCache import Hasql.Engine.Structures.StatementCache qualified as StatementCache import Hasql.Platform.Prelude import Hasql.Pq qualified as Pq

− src/library/Hasql/Engine/Structures/OidCache.hs

@@ -1,73 +0,0 @@-module Hasql.Engine.Structures.OidCache-  ( OidCache,--    -- * Accessors-    toHashMap,-    lookupScalar,-    lookupArray,--    -- * Constructors-    fromHashMap,-    empty,-    selectUnknownNames,-    insertScalar,-  )-where--import Data.HashMap.Strict qualified as HashMap-import Data.HashSet qualified as HashSet-import Hasql.Kernel qualified as Kernel-import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName-import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo-import Hasql.Platform.Prelude hiding (empty, insert, lookup, reset)---- | Pure registry state containing the hash map and counter-newtype OidCache-  = OidCache-      -- | By name of the type.-      ---      -- > scalar name -> TypeInfo (scalar OID, array OID)-      (HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo)-  deriving stock (Show, Eq)--instance Semigroup OidCache where-  OidCache byNameL <> OidCache byNameR =-    OidCache (HashMap.union byNameR byNameL)--instance Monoid OidCache where-  mempty = OidCache mempty--{-# INLINEABLE empty #-}-empty :: OidCache-empty =-  OidCache HashMap.empty---- | Having a set of required type names, select those that are not present in the cache.-{-# INLINE selectUnknownNames #-}-selectUnknownNames :: HashSet Kernel.QualifiedTypeName -> OidCache -> HashSet Kernel.QualifiedTypeName-selectUnknownNames keys (OidCache byName) =-  HashSet.filter (\key -> not (HashMap.member key byName)) keys--insertScalar :: Maybe Text -> Text -> Word32 -> Word32 -> OidCache -> OidCache-insertScalar schema name scalar array (OidCache byName) =-  OidCache (HashMap.insert (Kernel.QualifiedTypeName.QualifiedTypeName schema name) (Kernel.TypeInfo.TypeInfo scalar array) byName)--{-# INLINE fromHashMap #-}-fromHashMap :: HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo -> OidCache-fromHashMap byName = OidCache byName---- * Accessors--{-# INLINE lookupScalar #-}-lookupScalar :: Maybe Text -> Text -> OidCache -> Maybe Word32-lookupScalar schema name (OidCache byName) =-  HashMap.lookup (Kernel.QualifiedTypeName.QualifiedTypeName schema name) byName <&> \info -> Kernel.TypeInfo.toBaseOid info--{-# INLINE lookupArray #-}-lookupArray :: Maybe Text -> Text -> OidCache -> Maybe Word32-lookupArray schema name (OidCache byName) =-  HashMap.lookup (Kernel.QualifiedTypeName.QualifiedTypeName schema name) byName <&> \info -> Kernel.TypeInfo.toArrayOid info--{-# INLINE toHashMap #-}-toHashMap :: OidCache -> HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo-toHashMap (OidCache byName) = byName

− src/library/Hasql/Kernel.hs

@@ -1,10 +0,0 @@-module Hasql.Kernel-  ( QualifiedTypeName,-    TypeInfo (..),-    TypeRef,-  )-where--import Hasql.Kernel.QualifiedTypeName (QualifiedTypeName)-import Hasql.Kernel.TypeInfo (TypeInfo)-import Hasql.Kernel.TypeRef (TypeRef)

− src/library/Hasql/Kernel/QualifiedTypeName.hs

@@ -1,43 +0,0 @@-module Hasql.Kernel.QualifiedTypeName-  ( QualifiedTypeName (..),-    fromNameTuple,-    toNameTuple,-  )-where--import Hasql.Platform.Prelude---- |--- A Postgres type identified by name: an optional schema together with a--- required type name.------ A 'Nothing' schema means the name is unqualified and is resolved via the--- server's search path.------ Used as the key under which a type's OIDs are resolved and cached.-data QualifiedTypeName = QualifiedTypeName-  { schema :: Maybe Text,-    name :: Text-  }-  deriving stock (Eq, Ord, Show, Generic)--instance Hashable QualifiedTypeName---- | An unqualified name constructor for convenience.-instance IsString QualifiedTypeName where-  fromString = QualifiedTypeName Nothing . fromString---- |--- Convert from the legacy @(schema, name)@ tuple representation.------ Used at public-API boundaries (e.g. the @custom@ codecs and error types)--- where the tuple is still exposed but internals operate on 'QualifiedTypeName'.-fromNameTuple :: (Maybe Text, Text) -> QualifiedTypeName-fromNameTuple (schema, name) = QualifiedTypeName schema name---- |--- Convert to the legacy @(schema, name)@ tuple representation.------ See 'fromNameTuple'.-toNameTuple :: QualifiedTypeName -> (Maybe Text, Text)-toNameTuple (QualifiedTypeName schema name) = (schema, name)

− src/library/Hasql/Kernel/TypeInfo.hs

@@ -1,230 +0,0 @@-module Hasql.Kernel.TypeInfo where--import Hasql.Platform.Prelude hiding (bool)---- | A Postgresql type info-data TypeInfo-  = TypeInfo {toBaseOid :: Word32, toArrayOid :: Word32}-  deriving (Eq, Ord, Show)--abstime :: TypeInfo-abstime = TypeInfo 702 1023--aclitem :: TypeInfo-aclitem = TypeInfo 1033 1034--bit :: TypeInfo-bit = TypeInfo 1560 1561--bool :: TypeInfo-bool = TypeInfo 16 1000--box :: TypeInfo-box = TypeInfo 603 1020--bpchar :: TypeInfo-bpchar = TypeInfo 1042 1014--bytea :: TypeInfo-bytea = TypeInfo 17 1001--char :: TypeInfo-char = TypeInfo 18 1002--cid :: TypeInfo-cid = TypeInfo 29 1012--cidr :: TypeInfo-cidr = TypeInfo 650 651--circle :: TypeInfo-circle = TypeInfo 718 719--cstring :: TypeInfo-cstring = TypeInfo 2275 1263--date :: TypeInfo-date = TypeInfo 1082 1182--daterange :: TypeInfo-daterange = TypeInfo 3912 3913--datemultirange :: TypeInfo-datemultirange = TypeInfo 4535 6155--float4 :: TypeInfo-float4 = TypeInfo 700 1021--float8 :: TypeInfo-float8 = TypeInfo 701 1022--gtsvector :: TypeInfo-gtsvector = TypeInfo 3642 3644--inet :: TypeInfo-inet = TypeInfo 869 1041--int2 :: TypeInfo-int2 = TypeInfo 21 1005--int2vector :: TypeInfo-int2vector = TypeInfo 22 1006--int4 :: TypeInfo-int4 = TypeInfo 23 1007--int4range :: TypeInfo-int4range = TypeInfo 3904 3905--int4multirange :: TypeInfo-int4multirange = TypeInfo 4451 6150--int8 :: TypeInfo-int8 = TypeInfo 20 1016--int8range :: TypeInfo-int8range = TypeInfo 3926 3927--int8multirange :: TypeInfo-int8multirange = TypeInfo 4536 6157--interval :: TypeInfo-interval = TypeInfo 1186 1187--json :: TypeInfo-json = TypeInfo 114 199--jsonb :: TypeInfo-jsonb = TypeInfo 3802 3807--line :: TypeInfo-line = TypeInfo 628 629--lseg :: TypeInfo-lseg = TypeInfo 601 1018--macaddr :: TypeInfo-macaddr = TypeInfo 829 1040--money :: TypeInfo-money = TypeInfo 790 791--name :: TypeInfo-name = TypeInfo 19 1003--numeric :: TypeInfo-numeric = TypeInfo 1700 1231--numrange :: TypeInfo-numrange = TypeInfo 3906 3907--nummultirange :: TypeInfo-nummultirange = TypeInfo 4532 6151--oid :: TypeInfo-oid = TypeInfo 26 1028--oidvector :: TypeInfo-oidvector = TypeInfo 30 1013--path :: TypeInfo-path = TypeInfo 602 1019--point :: TypeInfo-point = TypeInfo 600 1017--polygon :: TypeInfo-polygon = TypeInfo 604 1027--record :: TypeInfo-record = TypeInfo 2249 2287--refcursor :: TypeInfo-refcursor = TypeInfo 1790 2201--regclass :: TypeInfo-regclass = TypeInfo 2205 2210--regconfig :: TypeInfo-regconfig = TypeInfo 3734 3735--regdictionary :: TypeInfo-regdictionary = TypeInfo 3769 3770--regoper :: TypeInfo-regoper = TypeInfo 2203 2208--regoperator :: TypeInfo-regoperator = TypeInfo 2204 2209--regproc :: TypeInfo-regproc = TypeInfo 24 1008--regprocedure :: TypeInfo-regprocedure = TypeInfo 2202 2207--regtype :: TypeInfo-regtype = TypeInfo 2206 2211--reltime :: TypeInfo-reltime = TypeInfo 703 1024--text :: TypeInfo-text = TypeInfo 25 1009--tid :: TypeInfo-tid = TypeInfo 27 1010--time :: TypeInfo-time = TypeInfo 1083 1183--timestamp :: TypeInfo-timestamp = TypeInfo 1114 1115--timestamptz :: TypeInfo-timestamptz = TypeInfo 1184 1185--timetz :: TypeInfo-timetz = TypeInfo 1266 1270--tinterval :: TypeInfo-tinterval = TypeInfo 704 1025--tsquery :: TypeInfo-tsquery = TypeInfo 3615 3645--tsrange :: TypeInfo-tsrange = TypeInfo 3908 3909--tsmultirange :: TypeInfo-tsmultirange = TypeInfo 4533 6152--tstzrange :: TypeInfo-tstzrange = TypeInfo 3910 3911--tstzmultirange :: TypeInfo-tstzmultirange = TypeInfo 4534 6153--tsvector :: TypeInfo-tsvector = TypeInfo 3614 3643--txid_snapshot :: TypeInfo-txid_snapshot = TypeInfo 2970 2949--unknown :: TypeInfo-unknown = TypeInfo 705 705--uuid :: TypeInfo-uuid = TypeInfo 2950 2951--varbit :: TypeInfo-varbit = TypeInfo 1562 1563--varchar :: TypeInfo-varchar = TypeInfo 1043 1015--xid :: TypeInfo-xid = TypeInfo 28 1011--xml :: TypeInfo-xml = TypeInfo 142 143

− src/library/Hasql/Kernel/TypeRef.hs

@@ -1,20 +0,0 @@-module Hasql.Kernel.TypeRef-  ( TypeRef (..),-  )-where--import Hasql.Kernel.QualifiedTypeName (QualifiedTypeName)-import Hasql.Platform.Prelude---- |--- How a parameter's Postgres type is identified within parameter metadata:--- either an already-known OID, or a 'QualifiedTypeName' still pending OID--- resolution against the server.-data TypeRef-  = -- | The type's OID is statically known.-    KnownOid Word32-  | -- | The type is named and its OID must be resolved before execution.-    NamedType QualifiedTypeName-  deriving stock (Eq, Ord, Show, Generic)--instance Hashable TypeRef

src/library/Hasql/Pipeline.hs view

@@ -10,5 +10,4 @@ -- | -- Execute a statement by providing parameters to it. statement :: params -> Statement.Statement params result -> Pipeline.Pipeline result-statement params (Statement.Statement sql encoder decoder preparable) =-  Pipeline.statement sql encoder decoder preparable params+statement params stmt = Pipeline.statement stmt params

src/library/Hasql/Session.hs view

@@ -21,10 +21,4 @@ -- | -- Execute a statement by providing parameters to it. statement :: params -> Statement.Statement params result -> Session.Session result-statement params (Statement.Statement sql encoder decoder preparable) =-  Session.statement-    sql-    encoder-    decoder-    preparable-    params+statement params stmt = Session.statement stmt params