hasql 1.10.3.3 → 1.10.3.4
raw patch · 35 files changed
+763/−572 lines, 35 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 (Word32, Word32) -> [(Maybe Text, Text)] -> (((Maybe Text, Text) -> (Word32, Word32)) -> ByteString -> Either Text a) -> Value a
+ Hasql.Decoders: custom :: Maybe Text -> Text -> Maybe TypeInfo -> [(Maybe Text, Text)] -> (((Maybe Text, Text) -> TypeInfo) -> ByteString -> Either Text a) -> 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
+ Hasql.Encoders: custom :: Maybe Text -> Text -> Maybe TypeInfo -> [(Maybe Text, Text)] -> (((Maybe Text, Text) -> TypeInfo) -> a -> ByteString) -> (a -> Text) -> Value a
Files
- hasql.cabal +10/−2
- src/benchmarks/Main.hs +2/−27
- src/engine-tests/Hasql/Engine/Structures/OidCacheSpec.hs +5/−4
- src/engine-tests/Hasql/Engine/Structures/StatementCacheSpec.hs +5/−6
- src/library-tests/Sharing/ByFeature/DecoderCompatibilityCacheSpec.hs +57/−0
- src/library-tests/Sharing/ByUnit/Decoders/CustomSpec.hs +7/−4
- src/library-tests/Sharing/ByUnit/Encoders/CustomSpec.hs +4/−2
- src/library/Hasql/Codecs/Decoders.hs +4/−4
- src/library/Hasql/Codecs/Decoders/Composite.hs +6/−4
- src/library/Hasql/Codecs/Decoders/Value.hs +49/−47
- src/library/Hasql/Codecs/Encoders.hs +5/−4
- src/library/Hasql/Codecs/Encoders/Array.hs +3/−2
- src/library/Hasql/Codecs/Encoders/Composite.hs +13/−7
- src/library/Hasql/Codecs/Encoders/Params.hs +25/−21
- src/library/Hasql/Codecs/Encoders/Value.hs +57/−55
- src/library/Hasql/Codecs/RequestingOid.hs +20/−10
- src/library/Hasql/Codecs/RequestingOid/LookingUp.hs +6/−1
- src/library/Hasql/Codecs/TypeInfo.hs +0/−228
- src/library/Hasql/Comms/RowDecoder.hs +1/−0
- src/library/Hasql/Comms/RowReader.hs +4/−3
- src/library/Hasql/Decoders.hs +4/−0
- src/library/Hasql/Encoders.hs +4/−0
- src/library/Hasql/Engine/Contexts/Pipeline.hs +43/−34
- src/library/Hasql/Engine/Contexts/Session.hs +78/−72
- src/library/Hasql/Engine/Decoders/Result.hs +8/−8
- src/library/Hasql/Engine/Decoders/Row.hs +8/−6
- src/library/Hasql/Engine/PqProcedures/SelectTypeInfo.hs +8/−5
- src/library/Hasql/Engine/Statement.hs +6/−5
- src/library/Hasql/Engine/Structures/OidCache.hs +16/−8
- src/library/Hasql/Kernel.hs +10/−0
- src/library/Hasql/Kernel/QualifiedTypeName.hs +43/−0
- src/library/Hasql/Kernel/TypeInfo.hs +230/−0
- src/library/Hasql/Kernel/TypeRef.hs +20/−0
- src/library/Hasql/Pipeline.hs +1/−2
- src/library/Hasql/Session.hs +1/−1
hasql.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-version: 1.10.3.3+version: 1.10.3.4 category: Hasql, Database, PostgreSQL synopsis: Fast PostgreSQL driver with a flexible mapping API description:@@ -125,7 +125,6 @@ Hasql.Codecs.Encoders.Value Hasql.Codecs.RequestingOid Hasql.Codecs.RequestingOid.LookingUp- Hasql.Codecs.TypeInfo Hasql.Comms.Recv Hasql.Comms.ResultDecoder Hasql.Comms.Roundtrip@@ -145,6 +144,10 @@ 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@@ -265,6 +268,10 @@ 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@@ -318,6 +325,7 @@ Pure.ByUnit.ErrorsSpec Sharing.ByBug.ExceptionConnectionResetRaceSpec Sharing.ByFeature.ConcurrencySpec+ Sharing.ByFeature.DecoderCompatibilityCacheSpec Sharing.ByFeature.DecoderCompatibilityCheckSpec Sharing.ByFeature.PreparedStatementCacheSpec Sharing.ByFeature.PreparedStatementsSpec
src/benchmarks/Main.hs view
@@ -1,4 +1,4 @@-module Main where+module Main (main) where import Criterion import Criterion.Main@@ -27,16 +27,7 @@ sessionBench "manyLargeResults" sessionWithManyLargeResults, sessionBench "manyLargeResultsViaPipeline" sessionWithManyLargeResultsViaPipeline, sessionBench "manySmallResults" sessionWithManySmallResults,- sessionBench "manySmallResultsViaPipeline" sessionWithManySmallResultsViaPipeline,- bgroup- "singleStatementOverhead"- [ sessionBench "1-sequential" sessionWith1SmallResult,- sessionBench "1-pipeline" sessionWith1SmallResultViaPipeline,- sessionBench "10-sequential" sessionWith10SmallResults,- sessionBench "10-pipeline" sessionWith10SmallResultsViaPipeline,- sessionBench "100-sequential" sessionWithManySmallResults,- sessionBench "100-pipeline" sessionWithManySmallResultsViaPipeline- ]+ sessionBench "manySmallResultsViaPipeline" sessionWithManySmallResultsViaPipeline ] where sessionBench :: (NFData a) => String -> B.Session a -> Benchmark@@ -44,22 +35,6 @@ bench name (nfIO (A.use connection session >>= either (fail . show) pure)) -- * Sessions--sessionWith1SmallResult :: B.Session (Int32, Int32)-sessionWith1SmallResult =- B.statement () statementWithSingleRow--sessionWith1SmallResultViaPipeline :: B.Session (Int32, Int32)-sessionWith1SmallResultViaPipeline =- B.pipeline (E.statement () statementWithSingleRow)--sessionWith10SmallResults :: B.Session [(Int32, Int32)]-sessionWith10SmallResults =- replicateM 10 (B.statement () statementWithSingleRow)--sessionWith10SmallResultsViaPipeline :: B.Session [(Int32, Int32)]-sessionWith10SmallResultsViaPipeline =- B.pipeline (replicateM 10 (E.statement () statementWithSingleRow)) sessionWithSingleLargeResultInVector :: B.Session (Vector (Int32, Int32)) sessionWithSingleLargeResultInVector =
src/engine-tests/Hasql/Engine/Structures/OidCacheSpec.hs view
@@ -2,6 +2,7 @@ import Data.HashSet qualified as HashSet import Hasql.Engine.Structures.OidCache qualified as OidCache+import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName import Test.Hspec import Prelude @@ -54,7 +55,7 @@ describe "selectUnknownNames" do it "returns all names when cache is empty" do- let names = HashSet.fromList [(Nothing, "int4"), (Nothing, "int8")]+ let names = HashSet.fromList [Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int4", Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int8"] OidCache.selectUnknownNames names OidCache.empty `shouldBe` names @@ -66,15 +67,15 @@ 23 1007 (OidCache.insertScalar Nothing "int8" 20 1016 OidCache.empty)- names = HashSet.fromList [(Nothing, "int4"), (Nothing, "int8")]+ names = HashSet.fromList [Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int4", Kernel.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 [(Nothing, "int4"), (Nothing, "int8")]+ names = HashSet.fromList [Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int4", Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int8"] OidCache.selectUnknownNames names cache- `shouldBe` HashSet.fromList [(Nothing, "int8")]+ `shouldBe` HashSet.fromList [Kernel.QualifiedTypeName.QualifiedTypeName Nothing "int8"] describe "Semigroup" do it "right operand takes precedence for duplicate keys" do
src/engine-tests/Hasql/Engine/Structures/StatementCacheSpec.hs view
@@ -1,10 +1,9 @@ module Hasql.Engine.Structures.StatementCacheSpec (spec) where -import Data.Maybe (isJust, isNothing)+import Data.Maybe import Database.PostgreSQL.LibPQ (Oid (..)) import Hasql.Engine.Structures.StatementCache qualified as StatementCache import Test.Hspec-import Prelude spec :: Spec spec = do@@ -42,8 +41,8 @@ StatementCache.lookup "SELECT $1" [oid25] cache2 `shouldSatisfy` isJust -- And should have different remote keys- let Just rk1 = StatementCache.lookup "SELECT $1" [oid23] cache2- Just rk2 = StatementCache.lookup "SELECT $1" [oid25] cache2+ let rk1 = StatementCache.lookup "SELECT $1" [oid23] cache2+ rk2 = StatementCache.lookup "SELECT $1" [oid25] cache2 rk1 `shouldNotBe` rk2 it "returns Nothing for a non-inserted SQL" do@@ -78,8 +77,8 @@ `shouldSatisfy` isJust StatementCache.lookup "SELECT $1, $2" oidsB cache2 `shouldSatisfy` isJust- let Just rkA = StatementCache.lookup "SELECT $1, $2" oidsA cache2- Just rkB = StatementCache.lookup "SELECT $1, $2" oidsB cache2+ let rkA = StatementCache.lookup "SELECT $1, $2" oidsA cache2+ rkB = StatementCache.lookup "SELECT $1, $2" oidsB cache2 rkA `shouldNotBe` rkB describe "reset" do
+ src/library-tests/Sharing/ByFeature/DecoderCompatibilityCacheSpec.hs view
@@ -0,0 +1,57 @@+module Sharing.ByFeature.DecoderCompatibilityCacheSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Errors qualified as Errors+import Hasql.Pipeline qualified as Pipeline+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Test.Hspec+import Prelude++spec :: SpecWith (Text, Word16)+spec = parallel do+ byExecutor "Session" (Session.statement ())+ byExecutor "Pipeline" (Session.pipeline . Pipeline.statement ())++byExecutor ::+ Text ->+ (forall a. (Show a) => Statement.Statement () a -> Session.Session a) ->+ SpecWith (Text, Word16)+byExecutor executorName executor = do+ describe (toList executorName) do+ it "does not hide decoder mismatches from a previously verified statement" \config -> do+ Scripts.onPreparableConnection config \connection -> do+ let sql = "select 1::int8, 'text'::text"+ correctStatement =+ Statement.preparable+ sql+ mempty+ ( Decoders.singleRow+ ( (,)+ <$> Decoders.column (Decoders.nonNullable Decoders.int8)+ <*> Decoders.column (Decoders.nonNullable Decoders.text)+ )+ )+ mismatchingStatement =+ Statement.preparable+ sql+ mempty+ ( Decoders.singleRow+ ( (,)+ <$> Decoders.column (Decoders.nonNullable Decoders.int8)+ <*> Decoders.column (Decoders.nonNullable Decoders.int8)+ )+ )+ firstResult <- Connection.use connection (executor correctStatement)+ shouldBe firstResult (Right (1, "text"))+ secondResult <- Connection.use connection (executor mismatchingStatement)+ case secondResult of+ Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do+ shouldBe column 1+ (expected, actual) `shouldBe` (20, 25)+ Left err ->+ expectationFailure ("Unexpected type of error: " <> show err)+ result ->+ expectationFailure ("Not an error: " <> show result)
src/library-tests/Sharing/ByUnit/Decoders/CustomSpec.hs view
@@ -4,6 +4,7 @@ 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@@ -66,7 +67,7 @@ ( Decoders.custom Nothing "int4"- (Just (23, 1007))+ (Just (TypeInfo 23 1007)) [] (\_ bytes -> Right (ByteString.length bytes)) )@@ -107,8 +108,10 @@ Nothing [(Nothing, enumName), (Nothing, "int4")] ( \lookupOid bytes -> do- let (enumOidScalar, _enumOidArray) = lookupOid (Nothing, enumName)- (int4OidScalar, _int4OidArray) = lookupOid (Nothing, "int4")+ let enumTypeInfo = lookupOid (Nothing, enumName)+ int4TypeInfo = lookupOid (Nothing, "int4")+ enumOidScalar = toBaseOid enumTypeInfo+ int4OidScalar = toBaseOid int4TypeInfo -- Verify we got valid OIDs if enumOidScalar > 0 && int4OidScalar > 0 then Right (enumOidScalar, int4OidScalar, ByteString.length bytes)@@ -203,7 +206,7 @@ ( Decoders.custom Nothing "int4"- (Just (23, 1007))+ (Just (TypeInfo 23 1007)) [] (\_ _ -> Left "Custom decoding error") )
src/library-tests/Sharing/ByUnit/Encoders/CustomSpec.hs view
@@ -4,6 +4,7 @@ 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@@ -57,7 +58,7 @@ ( Encoders.custom Nothing "text"- (Just (25, 1009))+ (Just (TypeInfo 25 1009)) [] (\_ val -> encodeUtf8 val) id@@ -89,7 +90,8 @@ Nothing [(Nothing, enumName)] ( \lookupOid val -> do- let (enumOidScalar, _) = lookupOid (Nothing, enumName)+ let enumTypeInfo = lookupOid (Nothing, enumName)+ enumOidScalar = toBaseOid enumTypeInfo -- 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.Codecs.TypeInfo qualified as TypeInfo+import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo import Hasql.Platform.Prelude -- * Value@@ -139,9 +139,9 @@ Value.Value Nothing "record"- (Just (TypeInfo.toBaseOid typeInfo))- (Just (TypeInfo.toArrayOid typeInfo))+ (Just (Kernel.TypeInfo.toBaseOid typeInfo))+ (Just (Kernel.TypeInfo.toArrayOid typeInfo)) 0 (Composite.toValueDecoder composite) where- typeInfo = TypeInfo.record+ typeInfo = Kernel.TypeInfo.record
src/library/Hasql/Codecs/Decoders/Composite.hs view
@@ -3,6 +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.Platform.Prelude import PostgreSQL.Binary.Decoding qualified as Binary @@ -31,8 +33,8 @@ Nothing -> Composite ( RequestingOid.hoistLookingUp- (Value.toSchema imp, Value.toTypeName imp)- (\(baseOid, arrayOid) decoder -> Binary.typedValueComposite (if dimensionality == 0 then baseOid else arrayOid) decoder)+ (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) (Value.toDecoder imp) ) NullableOrNot.Nullable imp ->@@ -44,7 +46,7 @@ Nothing -> Composite ( RequestingOid.hoistLookingUp- (Value.toSchema imp, Value.toTypeName imp)- (\(baseOid, arrayOid) decoder -> Binary.typedNullableValueComposite (if dimensionality == 0 then baseOid else arrayOid) decoder)+ (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) (Value.toDecoder imp) )
src/library/Hasql/Codecs/Decoders/Value.hs view
@@ -58,7 +58,9 @@ import Data.Aeson qualified as Aeson import Data.IP qualified as Iproute import Hasql.Codecs.RequestingOid qualified as RequestingOid-import Hasql.Codecs.TypeInfo qualified as TypeInfo+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 (bool) import PostgreSQL.Binary.Decoding qualified as Binary import PostgreSQL.Binary.Range qualified as R@@ -91,9 +93,9 @@ -- | -- Create a decoder from TypeInfo metadata and a decoding function. {-# INLINE primitive #-}-primitive :: Text -> TypeInfo.TypeInfo -> Binary.Value a -> Value a+primitive :: Text -> Kernel.TypeInfo.TypeInfo -> Binary.Value a -> Value a primitive typeName pti decoder =- Value Nothing typeName (Just (TypeInfo.toBaseOid pti)) (Just (TypeInfo.toArrayOid pti)) 0 (RequestingOid.lift decoder)+ Value Nothing typeName (Just (Kernel.TypeInfo.toBaseOid pti)) (Just (Kernel.TypeInfo.toArrayOid pti)) 0 (RequestingOid.lift decoder) -- * Static types @@ -101,19 +103,19 @@ -- Decoder of the @BOOL@ values. {-# INLINEABLE bool #-} bool :: Value Bool-bool = primitive "bool" TypeInfo.bool Binary.bool+bool = primitive "bool" Kernel.TypeInfo.bool Binary.bool -- | -- Decoder of the @INT2@ values. {-# INLINEABLE int2 #-} int2 :: Value Int16-int2 = primitive "int2" TypeInfo.int2 Binary.int+int2 = primitive "int2" Kernel.TypeInfo.int2 Binary.int -- | -- Decoder of the @INT4@ values. {-# INLINEABLE int4 #-} int4 :: Value Int32-int4 = primitive "int4" TypeInfo.int4 Binary.int+int4 = primitive "int4" Kernel.TypeInfo.int4 Binary.int -- | -- Decoder of the @INT8@ values.@@ -121,68 +123,68 @@ int8 :: Value Int64 int8 = {-# SCC "int8" #-}- primitive "int8" TypeInfo.int8 ({-# SCC "int8.int" #-} Binary.int)+ primitive "int8" Kernel.TypeInfo.int8 ({-# SCC "int8.int" #-} Binary.int) -- | -- Decoder of the @FLOAT4@ values. {-# INLINEABLE float4 #-} float4 :: Value Float-float4 = primitive "float4" TypeInfo.float4 Binary.float4+float4 = primitive "float4" Kernel.TypeInfo.float4 Binary.float4 -- | -- Decoder of the @FLOAT8@ values. {-# INLINEABLE float8 #-} float8 :: Value Double-float8 = primitive "float8" TypeInfo.float8 Binary.float8+float8 = primitive "float8" Kernel.TypeInfo.float8 Binary.float8 -- | -- Decoder of the @NUMERIC@ values. {-# INLINEABLE numeric #-} numeric :: Value Scientific-numeric = primitive "numeric" TypeInfo.numeric Binary.numeric+numeric = primitive "numeric" Kernel.TypeInfo.numeric Binary.numeric -- | -- Decoder of the @CHAR@ values. -- Note that it supports Unicode values. {-# INLINEABLE char #-} char :: Value Char-char = primitive "char" TypeInfo.char Binary.char+char = primitive "char" Kernel.TypeInfo.char Binary.char -- | -- Decoder of the @TEXT@ values. {-# INLINEABLE text #-} text :: Value Text-text = primitive "text" TypeInfo.text Binary.text_strict+text = primitive "text" Kernel.TypeInfo.text Binary.text_strict -- | -- Decoder of the @VARCHAR@ values. {-# INLINEABLE varchar #-} varchar :: Value Text-varchar = primitive "varchar" TypeInfo.varchar Binary.text_strict+varchar = primitive "varchar" Kernel.TypeInfo.varchar Binary.text_strict -- | -- Decoder of @BPCHAR@ or @CHAR(n)@, @CHARACTER(n)@ values. {-# INLINEABLE bpchar #-} bpchar :: Value Text-bpchar = primitive "bpchar" TypeInfo.bpchar Binary.text_strict+bpchar = primitive "bpchar" Kernel.TypeInfo.bpchar Binary.text_strict -- | -- Decoder of the @BYTEA@ values. {-# INLINEABLE bytea #-} bytea :: Value ByteString-bytea = primitive "bytea" TypeInfo.bytea Binary.bytea_strict+bytea = primitive "bytea" Kernel.TypeInfo.bytea Binary.bytea_strict -- | -- Decoder of the @DATE@ values. {-# INLINEABLE date #-} date :: Value Day-date = primitive "date" TypeInfo.date Binary.date+date = primitive "date" Kernel.TypeInfo.date Binary.date -- | -- Decoder of the @TIMESTAMP@ values. {-# INLINEABLE timestamp #-} timestamp :: Value LocalTime-timestamp = primitive "timestamp" TypeInfo.timestamp Binary.timestamp_int+timestamp = primitive "timestamp" Kernel.TypeInfo.timestamp Binary.timestamp_int -- | -- Decoder of the @TIMESTAMPTZ@ values.@@ -196,13 +198,13 @@ -- and communicates with Postgres using the UTC values directly. {-# INLINEABLE timestamptz #-} timestamptz :: Value UTCTime-timestamptz = primitive "timestamptz" TypeInfo.timestamptz Binary.timestamptz_int+timestamptz = primitive "timestamptz" Kernel.TypeInfo.timestamptz Binary.timestamptz_int -- | -- Decoder of the @TIME@ values. {-# INLINEABLE time #-} time :: Value TimeOfDay-time = primitive "time" TypeInfo.time Binary.time_int+time = primitive "time" Kernel.TypeInfo.time Binary.time_int -- | -- Decoder of the @TIMETZ@ values.@@ -214,25 +216,25 @@ -- to represent a value on the Haskell's side. {-# INLINEABLE timetz #-} timetz :: Value (TimeOfDay, TimeZone)-timetz = primitive "timetz" TypeInfo.timetz Binary.timetz_int+timetz = primitive "timetz" Kernel.TypeInfo.timetz Binary.timetz_int -- | -- Decoder of the @INTERVAL@ values. {-# INLINEABLE interval #-} interval :: Value DiffTime-interval = primitive "interval" TypeInfo.interval Binary.interval_int+interval = primitive "interval" Kernel.TypeInfo.interval Binary.interval_int -- | -- Decoder of the @UUID@ values. {-# INLINEABLE uuid #-} uuid :: Value UUID-uuid = primitive "uuid" TypeInfo.uuid Binary.uuid+uuid = primitive "uuid" Kernel.TypeInfo.uuid Binary.uuid -- | -- Decoder of the @INET@ values. {-# INLINEABLE inet #-} inet :: Value Iproute.IPRange-inet = primitive "inet" TypeInfo.inet Binary.inet+inet = primitive "inet" Kernel.TypeInfo.inet Binary.inet -- | -- Decoder of the @MACADDR@ values.@@ -243,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" TypeInfo.macaddr Binary.macaddr+macaddr = primitive "macaddr" Kernel.TypeInfo.macaddr Binary.macaddr -- | -- Decoder of the @JSON@ values into a JSON AST. {-# INLINEABLE json #-} json :: Value Aeson.Value-json = primitive "json" TypeInfo.json Binary.json_ast+json = primitive "json" Kernel.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" TypeInfo.json (Binary.json_bytes fn)+jsonBytes fn = primitive "json" Kernel.TypeInfo.json (Binary.json_bytes fn) -- | -- Decoder of the @JSONB@ values into a JSON AST. {-# INLINEABLE jsonb #-} jsonb :: Value Aeson.Value-jsonb = primitive "jsonb" TypeInfo.jsonb Binary.jsonb_ast+jsonb = primitive "jsonb" Kernel.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" TypeInfo.jsonb (Binary.jsonb_bytes fn)+jsonbBytes fn = primitive "jsonb" Kernel.TypeInfo.jsonb (Binary.jsonb_bytes fn) -- | -- Decoder of the @INT4RANGE@ values. {-# INLINEABLE int4range #-} int4range :: Value (R.Range Int32)-int4range = primitive "int4range" TypeInfo.int4range Binary.int4range+int4range = primitive "int4range" Kernel.TypeInfo.int4range Binary.int4range -- | -- Decoder of the @INT8RANGE@ values. {-# INLINEABLE int8range #-} int8range :: Value (R.Range Int64)-int8range = primitive "int8range" TypeInfo.int8range Binary.int8range+int8range = primitive "int8range" Kernel.TypeInfo.int8range Binary.int8range -- | -- Decoder of the @NUMRANGE@ values. {-# INLINEABLE numrange #-} numrange :: Value (R.Range Scientific)-numrange = primitive "numrange" TypeInfo.numrange Binary.numrange+numrange = primitive "numrange" Kernel.TypeInfo.numrange Binary.numrange -- | -- Decoder of the @TSRANGE@ values. {-# INLINEABLE tsrange #-} tsrange :: Value (R.Range LocalTime)-tsrange = primitive "tsrange" TypeInfo.tsrange Binary.tsrange_int+tsrange = primitive "tsrange" Kernel.TypeInfo.tsrange Binary.tsrange_int -- | -- Decoder of the @TSTZRANGE@ values. {-# INLINEABLE tstzrange #-} tstzrange :: Value (R.Range UTCTime)-tstzrange = primitive "tstzrange" TypeInfo.tstzrange Binary.tstzrange_int+tstzrange = primitive "tstzrange" Kernel.TypeInfo.tstzrange Binary.tstzrange_int -- | -- Decoder of the @DATERANGE@ values. {-# INLINEABLE daterange #-} daterange :: Value (R.Range Day)-daterange = primitive "daterange" TypeInfo.daterange Binary.daterange+daterange = primitive "daterange" Kernel.TypeInfo.daterange Binary.daterange -- | -- Decoder of the @INT4MULTIRANGE@ values. {-# INLINEABLE int4multirange #-} int4multirange :: Value (R.Multirange Int32)-int4multirange = primitive "int4multirange" TypeInfo.int4multirange Binary.int4multirange+int4multirange = primitive "int4multirange" Kernel.TypeInfo.int4multirange Binary.int4multirange -- | -- Decoder of the @INT8MULTIRANGE@ values. {-# INLINEABLE int8multirange #-} int8multirange :: Value (R.Multirange Int64)-int8multirange = primitive "int8multirange" TypeInfo.int8multirange Binary.int8multirange+int8multirange = primitive "int8multirange" Kernel.TypeInfo.int8multirange Binary.int8multirange -- | -- Decoder of the @NUMMULTIRANGE@ values. {-# INLINEABLE nummultirange #-} nummultirange :: Value (R.Multirange Scientific)-nummultirange = primitive "nummultirange" TypeInfo.nummultirange Binary.nummultirange+nummultirange = primitive "nummultirange" Kernel.TypeInfo.nummultirange Binary.nummultirange -- | -- Decoder of the @TSMULTIRANGE@ values. {-# INLINEABLE tsmultirange #-} tsmultirange :: Value (R.Multirange LocalTime)-tsmultirange = primitive "tsmultirange" TypeInfo.tsmultirange Binary.tsmultirange_int+tsmultirange = primitive "tsmultirange" Kernel.TypeInfo.tsmultirange Binary.tsmultirange_int -- | -- Decoder of the @TSTZMULTIRANGE@ values. {-# INLINEABLE tstzmultirange #-} tstzmultirange :: Value (R.Multirange UTCTime)-tstzmultirange = primitive "tstzmultirange" TypeInfo.tstzmultirange Binary.tstzmultirange_int+tstzmultirange = primitive "tstzmultirange" Kernel.TypeInfo.tstzmultirange Binary.tstzmultirange_int -- | -- Decoder of the @DATEMULTIRANGE@ values. {-# INLINEABLE datemultirange #-} datemultirange :: Value (R.Multirange Day)-datemultirange = primitive "datemultirange" TypeInfo.datemultirange Binary.datemultirange+datemultirange = primitive "datemultirange" Kernel.TypeInfo.datemultirange Binary.datemultirange -- | -- Decoder of the @CITEXT@ values.@@ -360,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 (Word32, Word32) ->+ Maybe Kernel.TypeInfo.TypeInfo -> -- | 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.@@ -371,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) -> (Word32, Word32)) ->+ ( ((Maybe Text, Text) -> Kernel.TypeInfo.TypeInfo) -> ByteString -> Either Text a ) ->@@ -380,10 +382,10 @@ Value schema typeName- (fst <$> staticOids)- (snd <$> staticOids)+ (fmap Kernel.TypeInfo.toBaseOid staticOids)+ (fmap Kernel.TypeInfo.toArrayOid staticOids) 0- (RequestingOid.requestAndHandle requestedTypes (Binary.fn . fn))+ (RequestingOid.requestAndHandle (fmap Kernel.QualifiedTypeName.fromNameTuple requestedTypes) (\lookup -> Binary.fn (fn (lookup . Kernel.QualifiedTypeName.fromNameTuple)))) -- | -- Refine a value decoder, lifting the possible error to the session level.@@ -446,11 +448,11 @@ toDecoder (Value _ _ _ _ _ decoder) = decoder {-# INLINE toHandler #-}-toHandler :: Value a -> HashMap (Maybe Text, Text) (Word32, Word32) -> Binary.Value a+toHandler :: Value a -> HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo -> Binary.Value a toHandler (Value _ _ _ _ _ decoder) = RequestingOid.toBase decoder {-# INLINE toByteStringParser #-}-toByteStringParser :: Value a -> (HashMap (Maybe Text, Text) (Word32, Word32) -> ByteString -> Either Text a)+toByteStringParser :: Value a -> (HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo -> 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,7 +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.Codecs.TypeInfo qualified as TypeInfo+import Hasql.Kernel.QualifiedTypeName qualified as Kernel.QualifiedTypeName+import Hasql.Kernel.TypeInfo qualified as Kernel.TypeInfo import Hasql.Platform.Prelude hiding (bool) import PostgreSQL.Binary.Encoding qualified as Binary import TextBuilder qualified@@ -121,11 +122,11 @@ asum [ scalarOidIfKnown, oidCache- & HashMap.lookup (baseTypeSchema, baseTypeName)- & fmap fst+ & HashMap.lookup (Kernel.QualifiedTypeName.QualifiedTypeName baseTypeSchema baseTypeName)+ & fmap Kernel.TypeInfo.toBaseOid ] -- Should only happen on a bug.- & fromMaybe (TypeInfo.toBaseOid TypeInfo.unknown)+ & fromMaybe (Kernel.TypeInfo.toBaseOid Kernel.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,6 +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.Platform.Prelude import PostgreSQL.Binary.Encoding qualified as Binary import TextBuilder qualified as TextBuilder@@ -33,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 (Maybe Text, Text))+ (HashSet Kernel.QualifiedTypeName) -- | Serialization function given the dictionary of resolved OIDs.- (HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Binary.Array)+ (HashMap Kernel.QualifiedTypeName Kernel.TypeInfo -> a -> Binary.Array) -- | Render function for error messages. (a -> TextBuilder.TextBuilder)
src/library/Hasql/Codecs/Encoders/Composite.hs view
@@ -4,6 +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.Platform.Prelude hiding (bool) import PostgreSQL.Binary.Encoding qualified as Binary import TextBuilder qualified@@ -13,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 (Maybe Text, Text))+ (HashSet Kernel.QualifiedTypeName) -- | Serialization function given the dictionary of resolved OIDs.- (HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Binary.Composite)+ (HashMap Kernel.QualifiedTypeName Kernel.TypeInfo -> a -> Binary.Composite) -- | Render function for error messages. (a -> [TextBuilder.TextBuilder]) @@ -54,9 +57,10 @@ (\val -> [print val]) Nothing -> Composite- (HashSet.insert (schemaName, typeName) unknownTypes)+ (HashSet.insert (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes) ( \oidCache val ->- let oid = if dimensionality == 0 then maybe 0 fst (HashMap.lookup (schemaName, typeName) oidCache) else maybe 0 snd (HashMap.lookup (schemaName, typeName) oidCache)+ 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 in Binary.field oid (encode oidCache val) ) (\val -> [print val])@@ -76,13 +80,15 @@ ) Nothing -> Composite- (HashSet.insert (schemaName, typeName) unknownTypes)+ (HashSet.insert (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes) ( \oidCache -> \case Nothing ->- let oid = if dimensionality == 0 then maybe 0 fst (HashMap.lookup (schemaName, typeName) oidCache) else maybe 0 snd (HashMap.lookup (schemaName, typeName) oidCache)+ 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 in Binary.nullField oid Just val ->- let oid = if dimensionality == 0 then maybe 0 fst (HashMap.lookup (schemaName, typeName) oidCache) else maybe 0 snd (HashMap.lookup (schemaName, typeName) oidCache)+ 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 in Binary.field oid (encode oidCache val) ) ( \case
src/library/Hasql/Codecs/Encoders/Params.hs view
@@ -4,6 +4,10 @@ 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.Kernel.TypeRef qualified as Kernel.TypeRef import Hasql.Platform.Prelude import PostgreSQL.Binary.Encoding qualified as Binary import TextBuilder qualified@@ -15,7 +19,7 @@ compilePreparedStatementData :: Params a ->- HashMap (Maybe Text, Text) (Word32, Word32) ->+ HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo -> a -> ([Word32], [Maybe (ByteString, Bool)]) compilePreparedStatementData (Params _ _ columnsMetadata serializer _) oidCache input =@@ -26,15 +30,15 @@ & toList & fmap ( \case- (Left name, dimensionality, format) ->+ (Kernel.TypeRef.NamedType name, dimensionality, format) -> case HashMap.lookup name oidCache of- Just (baseOid, arrayOid) ->- ( if dimensionality == 0 then baseOid else arrayOid,+ Just typeInfo ->+ ( if dimensionality == 0 then Kernel.TypeInfo.toBaseOid typeInfo else Kernel.TypeInfo.toArrayOid typeInfo, format ) Nothing -> (0, format)- (Right oid, _, format) ->+ (Kernel.TypeRef.KnownOid oid, _, format) -> (oid, format) ) & unzip@@ -46,24 +50,24 @@ compileUnpreparedStatementData :: Params a ->- HashMap (Maybe Text, Text) (Word32, Word32) ->+ 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- Left name -> case HashMap.lookup name oidCache of- Just (baseOid, arrayOid) ->- if dimensionality == 0 then baseOid else arrayOid+ 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- Right oid -> oid+ Kernel.TypeRef.KnownOid oid -> oid in (,,) <$> Just oid <*> encoding <*> Just format ) (toList columnsMetadata) (toList (serializer oidCache input)) -toUnknownTypes :: Params a -> HashSet (Maybe Text, Text)+toUnknownTypes :: Params a -> HashSet Kernel.QualifiedTypeName toUnknownTypes (Params _ unknownTypes _ _ _) = unknownTypes @@ -113,10 +117,10 @@ -- @ data Params a = Params { size :: Int,- unknownTypes :: HashSet (Maybe Text, Text),- -- | (Name or OID, dimensionality, Text Format) for each parameter.- columnsMetadata :: DList (Either (Maybe Text, Text) Word32, Word, Bool),- serializer :: HashMap (Maybe Text, Text) (Word32, Word32) -> a -> DList (Maybe ByteString),+ unknownTypes :: HashSet Kernel.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), printer :: a -> DList Text } @@ -173,15 +177,15 @@ Params { size, unknownTypes,- columnsMetadata = pure (Right oid, dimensionality, textFormat),+ columnsMetadata = pure (Kernel.TypeRef.KnownOid oid, dimensionality, textFormat), serializer, printer } Nothing -> Params { size,- unknownTypes = HashSet.insert (schemaName, typeName) unknownTypes,- columnsMetadata = pure (Left (schemaName, typeName), dimensionality, textFormat),+ unknownTypes = HashSet.insert (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,+ columnsMetadata = pure (Kernel.TypeRef.NamedType (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName), dimensionality, textFormat), serializer, printer }@@ -197,15 +201,15 @@ Params { size, unknownTypes,- columnsMetadata = pure (Right oid, dimensionality, textFormat),+ columnsMetadata = pure (Kernel.TypeRef.KnownOid oid, dimensionality, textFormat), serializer, printer } Nothing -> Params { size,- unknownTypes = HashSet.insert (schemaName, typeName) unknownTypes,- columnsMetadata = pure (Left (schemaName, typeName), dimensionality, textFormat),+ unknownTypes = HashSet.insert (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,+ columnsMetadata = pure (Kernel.TypeRef.NamedType (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName), dimensionality, textFormat), serializer, printer }
src/library/Hasql/Codecs/Encoders/Value.hs view
@@ -6,7 +6,9 @@ import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet import Data.IP qualified as Iproute-import Hasql.Codecs.TypeInfo qualified as TypeInfo+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 PostgreSQL.Binary.Encoding qualified as Binary import PostgreSQL.Binary.Range qualified as Range@@ -32,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 (Maybe Text, Text))+ (HashSet Kernel.QualifiedTypeName) -- | Serialization function on the resolved OIDs.- (HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Binary.Encoding)+ (HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo -> a -> Binary.Encoding) -- | Render function for error messages. (a -> TextBuilder.TextBuilder) @@ -44,13 +46,13 @@ Value schemaName typeName valueOid arrayOid dimensionality textFormat unknownTypes (\hashMap -> encode hashMap . f) (render . f) {-# INLINE primitive #-}-primitive :: Text -> Bool -> TypeInfo.TypeInfo -> (a -> Binary.Encoding) -> (a -> TextBuilder.TextBuilder) -> Value a+primitive :: Text -> Bool -> Kernel.TypeInfo.TypeInfo -> (a -> Binary.Encoding) -> (a -> TextBuilder.TextBuilder) -> Value a primitive typeName isText typeInfo encode render = Value Nothing typeName- (Just (TypeInfo.toBaseOid typeInfo))- (Just (TypeInfo.toArrayOid typeInfo))+ (Just (Kernel.TypeInfo.toBaseOid typeInfo))+ (Just (Kernel.TypeInfo.toArrayOid typeInfo)) 0 isText HashSet.empty@@ -61,43 +63,43 @@ -- Encoder of @BOOL@ values. {-# INLINEABLE bool #-} bool :: Value Bool-bool = primitive "bool" False TypeInfo.bool Binary.bool (TextBuilder.string . show)+bool = primitive "bool" False Kernel.TypeInfo.bool Binary.bool (TextBuilder.string . show) -- | -- Encoder of @INT2@ values. {-# INLINEABLE int2 #-} int2 :: Value Int16-int2 = primitive "int2" False TypeInfo.int2 Binary.int2_int16 (TextBuilder.string . show)+int2 = primitive "int2" False Kernel.TypeInfo.int2 Binary.int2_int16 (TextBuilder.string . show) -- | -- Encoder of @INT4@ values. {-# INLINEABLE int4 #-} int4 :: Value Int32-int4 = primitive "int4" False TypeInfo.int4 Binary.int4_int32 (TextBuilder.string . show)+int4 = primitive "int4" False Kernel.TypeInfo.int4 Binary.int4_int32 (TextBuilder.string . show) -- | -- Encoder of @INT8@ values. {-# INLINEABLE int8 #-} int8 :: Value Int64-int8 = primitive "int8" False TypeInfo.int8 Binary.int8_int64 (TextBuilder.string . show)+int8 = primitive "int8" False Kernel.TypeInfo.int8 Binary.int8_int64 (TextBuilder.string . show) -- | -- Encoder of @FLOAT4@ values. {-# INLINEABLE float4 #-} float4 :: Value Float-float4 = primitive "float4" False TypeInfo.float4 Binary.float4 (TextBuilder.string . show)+float4 = primitive "float4" False Kernel.TypeInfo.float4 Binary.float4 (TextBuilder.string . show) -- | -- Encoder of @FLOAT8@ values. {-# INLINEABLE float8 #-} float8 :: Value Double-float8 = primitive "float8" False TypeInfo.float8 Binary.float8 (TextBuilder.string . show)+float8 = primitive "float8" False Kernel.TypeInfo.float8 Binary.float8 (TextBuilder.string . show) -- | -- Encoder of @NUMERIC@ values. {-# INLINEABLE numeric #-} numeric :: Value Scientific-numeric = primitive "numeric" False TypeInfo.numeric Binary.numeric (TextBuilder.string . show)+numeric = primitive "numeric" False Kernel.TypeInfo.numeric Binary.numeric (TextBuilder.string . show) -- | -- Encoder of @CHAR@ values.@@ -106,79 +108,79 @@ -- identifies itself under the @TEXT@ OID because of that. {-# INLINEABLE char #-} char :: Value Char-char = primitive "char" False TypeInfo.text Binary.char_utf8 (TextBuilder.string . show)+char = primitive "char" False Kernel.TypeInfo.text Binary.char_utf8 (TextBuilder.string . show) -- | -- Encoder of @TEXT@ values. {-# INLINEABLE text #-} text :: Value Text-text = primitive "text" False TypeInfo.text Binary.text_strict (TextBuilder.string . show)+text = primitive "text" False Kernel.TypeInfo.text Binary.text_strict (TextBuilder.string . show) -- | -- Encoder of @VARCHAR@ values. {-# INLINEABLE varchar #-} varchar :: Value Text-varchar = primitive "varchar" False TypeInfo.varchar Binary.text_strict (TextBuilder.string . show)+varchar = primitive "varchar" False Kernel.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 TypeInfo.bpchar Binary.text_strict (TextBuilder.string . show)+bpchar = primitive "bpchar" False Kernel.TypeInfo.bpchar Binary.text_strict (TextBuilder.string . show) -- | -- Encoder of @BYTEA@ values. {-# INLINEABLE bytea #-} bytea :: Value ByteString-bytea = primitive "bytea" False TypeInfo.bytea Binary.bytea_strict (TextBuilder.string . show)+bytea = primitive "bytea" False Kernel.TypeInfo.bytea Binary.bytea_strict (TextBuilder.string . show) -- | -- Encoder of @DATE@ values. {-# INLINEABLE date #-} date :: Value Day-date = primitive "date" False TypeInfo.date Binary.date (TextBuilder.string . show)+date = primitive "date" False Kernel.TypeInfo.date Binary.date (TextBuilder.string . show) -- | -- Encoder of @TIMESTAMP@ values. {-# INLINEABLE timestamp #-} timestamp :: Value LocalTime-timestamp = primitive "timestamp" False TypeInfo.timestamp Binary.timestamp_int (TextBuilder.string . show)+timestamp = primitive "timestamp" False Kernel.TypeInfo.timestamp Binary.timestamp_int (TextBuilder.string . show) -- | -- Encoder of @TIMESTAMPTZ@ values. {-# INLINEABLE timestamptz #-} timestamptz :: Value UTCTime-timestamptz = primitive "timestamptz" False TypeInfo.timestamptz Binary.timestamptz_int (TextBuilder.string . show)+timestamptz = primitive "timestamptz" False Kernel.TypeInfo.timestamptz Binary.timestamptz_int (TextBuilder.string . show) -- | -- Encoder of @TIME@ values. {-# INLINEABLE time #-} time :: Value TimeOfDay-time = primitive "time" False TypeInfo.time Binary.time_int (TextBuilder.string . show)+time = primitive "time" False Kernel.TypeInfo.time Binary.time_int (TextBuilder.string . show) -- | -- Encoder of @TIMETZ@ values. {-# INLINEABLE timetz #-} timetz :: Value (TimeOfDay, TimeZone)-timetz = primitive "timetz" False TypeInfo.timetz Binary.timetz_int (TextBuilder.string . show)+timetz = primitive "timetz" False Kernel.TypeInfo.timetz Binary.timetz_int (TextBuilder.string . show) -- | -- Encoder of @INTERVAL@ values. {-# INLINEABLE interval #-} interval :: Value DiffTime-interval = primitive "interval" False TypeInfo.interval Binary.interval_int (TextBuilder.string . show)+interval = primitive "interval" False Kernel.TypeInfo.interval Binary.interval_int (TextBuilder.string . show) -- | -- Encoder of @UUID@ values. {-# INLINEABLE uuid #-} uuid :: Value UUID-uuid = primitive "uuid" False TypeInfo.uuid Binary.uuid (TextBuilder.string . show)+uuid = primitive "uuid" False Kernel.TypeInfo.uuid Binary.uuid (TextBuilder.string . show) -- | -- Encoder of @INET@ values. {-# INLINEABLE inet #-} inet :: Value Iproute.IPRange-inet = primitive "inet" False TypeInfo.inet Binary.inet (TextBuilder.string . show)+inet = primitive "inet" False Kernel.TypeInfo.inet Binary.inet (TextBuilder.string . show) -- | -- Encoder of @MACADDR@ values.@@ -189,127 +191,127 @@ -- > toOctets >$< macaddr {-# INLINEABLE macaddr #-} macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)-macaddr = primitive "macaddr" False TypeInfo.macaddr Binary.macaddr (TextBuilder.string . show)+macaddr = primitive "macaddr" False Kernel.TypeInfo.macaddr Binary.macaddr (TextBuilder.string . show) -- | -- Encoder of @JSON@ values from JSON AST. {-# INLINEABLE json #-} json :: Value Aeson.Value-json = primitive "json" False TypeInfo.json Binary.json_ast (TextBuilder.string . show)+json = primitive "json" False Kernel.TypeInfo.json Binary.json_ast (TextBuilder.string . show) -- | -- Encoder of @JSON@ values from raw JSON. {-# INLINEABLE jsonBytes #-} jsonBytes :: Value ByteString-jsonBytes = primitive "json" False TypeInfo.json Binary.json_bytes (TextBuilder.string . show)+jsonBytes = primitive "json" False Kernel.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 TypeInfo.json Binary.json_bytes_lazy (TextBuilder.string . show)+jsonLazyBytes = primitive "json" False Kernel.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 TypeInfo.jsonb Binary.jsonb_ast (TextBuilder.string . show)+jsonb = primitive "jsonb" False Kernel.TypeInfo.jsonb Binary.jsonb_ast (TextBuilder.string . show) -- | -- Encoder of @JSONB@ values from raw JSON. {-# INLINEABLE jsonbBytes #-} jsonbBytes :: Value ByteString-jsonbBytes = primitive "jsonb" False TypeInfo.jsonb Binary.jsonb_bytes (TextBuilder.string . show)+jsonbBytes = primitive "jsonb" False Kernel.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 TypeInfo.jsonb Binary.jsonb_bytes_lazy (TextBuilder.string . show)+jsonbLazyBytes = primitive "jsonb" False Kernel.TypeInfo.jsonb Binary.jsonb_bytes_lazy (TextBuilder.string . show) -- | -- Encoder of @OID@ values. {-# INLINEABLE oid #-} oid :: Value Int32-oid = primitive "oid" False TypeInfo.oid Binary.int4_int32 (TextBuilder.string . show)+oid = primitive "oid" False Kernel.TypeInfo.oid Binary.int4_int32 (TextBuilder.string . show) -- | -- Encoder of @NAME@ values. {-# INLINEABLE name #-} name :: Value Text-name = primitive "name" False TypeInfo.name Binary.text_strict (TextBuilder.string . show)+name = primitive "name" False Kernel.TypeInfo.name Binary.text_strict (TextBuilder.string . show) -- | -- Encoder of @INT4RANGE@ values. {-# INLINEABLE int4range #-} int4range :: Value (Range.Range Int32)-int4range = primitive "int4range" False TypeInfo.int4range Binary.int4range (TextBuilder.string . show)+int4range = primitive "int4range" False Kernel.TypeInfo.int4range Binary.int4range (TextBuilder.string . show) -- | -- Encoder of @INT8RANGE@ values. {-# INLINEABLE int8range #-} int8range :: Value (Range.Range Int64)-int8range = primitive "int8range" False TypeInfo.int8range Binary.int8range (TextBuilder.string . show)+int8range = primitive "int8range" False Kernel.TypeInfo.int8range Binary.int8range (TextBuilder.string . show) -- | -- Encoder of @NUMRANGE@ values. {-# INLINEABLE numrange #-} numrange :: Value (Range.Range Scientific)-numrange = primitive "numrange" False TypeInfo.numrange Binary.numrange (TextBuilder.string . show)+numrange = primitive "numrange" False Kernel.TypeInfo.numrange Binary.numrange (TextBuilder.string . show) -- | -- Encoder of @TSRANGE@ values. {-# INLINEABLE tsrange #-} tsrange :: Value (Range.Range LocalTime)-tsrange = primitive "tsrange" False TypeInfo.tsrange Binary.tsrange_int (TextBuilder.string . show)+tsrange = primitive "tsrange" False Kernel.TypeInfo.tsrange Binary.tsrange_int (TextBuilder.string . show) -- | -- Encoder of @TSTZRANGE@ values. {-# INLINEABLE tstzrange #-} tstzrange :: Value (Range.Range UTCTime)-tstzrange = primitive "tstzrange" False TypeInfo.tstzrange Binary.tstzrange_int (TextBuilder.string . show)+tstzrange = primitive "tstzrange" False Kernel.TypeInfo.tstzrange Binary.tstzrange_int (TextBuilder.string . show) -- | -- Encoder of @DATERANGE@ values. {-# INLINEABLE daterange #-} daterange :: Value (Range.Range Day)-daterange = primitive "daterange" False TypeInfo.daterange Binary.daterange (TextBuilder.string . show)+daterange = primitive "daterange" False Kernel.TypeInfo.daterange Binary.daterange (TextBuilder.string . show) -- | -- Encoder of @INT4MULTIRANGE@ values. {-# INLINEABLE int4multirange #-} int4multirange :: Value (Range.Multirange Int32)-int4multirange = primitive "int4multirange" False TypeInfo.int4multirange Binary.int4multirange (TextBuilder.string . show)+int4multirange = primitive "int4multirange" False Kernel.TypeInfo.int4multirange Binary.int4multirange (TextBuilder.string . show) -- | -- Encoder of @INT8MULTIRANGE@ values. {-# INLINEABLE int8multirange #-} int8multirange :: Value (Range.Multirange Int64)-int8multirange = primitive "int8multirange" False TypeInfo.int8multirange Binary.int8multirange (TextBuilder.string . show)+int8multirange = primitive "int8multirange" False Kernel.TypeInfo.int8multirange Binary.int8multirange (TextBuilder.string . show) -- | -- Encoder of @NUMMULTIRANGE@ values. {-# INLINEABLE nummultirange #-} nummultirange :: Value (Range.Multirange Scientific)-nummultirange = primitive "nummultirange" False TypeInfo.nummultirange Binary.nummultirange (TextBuilder.string . show)+nummultirange = primitive "nummultirange" False Kernel.TypeInfo.nummultirange Binary.nummultirange (TextBuilder.string . show) -- | -- Encoder of @TSMULTIRANGE@ values. {-# INLINEABLE tsmultirange #-} tsmultirange :: Value (Range.Multirange LocalTime)-tsmultirange = primitive "tsmultirange" False TypeInfo.tsmultirange Binary.tsmultirange_int (TextBuilder.string . show)+tsmultirange = primitive "tsmultirange" False Kernel.TypeInfo.tsmultirange Binary.tsmultirange_int (TextBuilder.string . show) -- | -- Encoder of @TSTZMULTIRANGE@ values. {-# INLINEABLE tstzmultirange #-} tstzmultirange :: Value (Range.Multirange UTCTime)-tstzmultirange = primitive "tstzmultirange" False TypeInfo.tstzmultirange Binary.tstzmultirange_int (TextBuilder.string . show)+tstzmultirange = primitive "tstzmultirange" False Kernel.TypeInfo.tstzmultirange Binary.tstzmultirange_int (TextBuilder.string . show) -- | -- Encoder of @DATEMULTIRANGE@ values. {-# INLINEABLE datemultirange #-} datemultirange :: Value (Range.Multirange Day)-datemultirange = primitive "datemultirange" False TypeInfo.datemultirange Binary.datemultirange (TextBuilder.string . show)+datemultirange = primitive "datemultirange" False Kernel.TypeInfo.datemultirange Binary.datemultirange (TextBuilder.string . show) -- | -- Encoder of @CITEXT@ values.@@ -349,7 +351,7 @@ Nothing 0 False- (HashSet.singleton (schemaName, typeName))+ (HashSet.singleton (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName)) (const (Binary.text_strict . mapping)) (TextBuilder.text . mapping) @@ -367,7 +369,7 @@ {-# DEPRECATED unknown "Use 'custom' instead." #-} {-# INLINEABLE unknown #-} unknown :: Value ByteString-unknown = primitive "unknown" True TypeInfo.unknown Binary.bytea_strict (TextBuilder.string . show)+unknown = primitive "unknown" True Kernel.TypeInfo.unknown Binary.bytea_strict (TextBuilder.string . show) -- | -- Low level API for defining custom value encoders.@@ -380,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 (Word32, Word32) ->+ Maybe Kernel.TypeInfo.TypeInfo -> -- | Other named types whose OIDs are needed for serializing. -- -- E.g., when encoding composite types Postgres requires specifying OIDs of all of its fields.@@ -391,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) -> (Word32, Word32)) ->+ ( ((Maybe Text, Text) -> Kernel.TypeInfo.TypeInfo) -> a -> ByteString ) ->@@ -402,13 +404,13 @@ Value schemaName typeName- (fst <$> staticOids)- (snd <$> staticOids)+ (fmap Kernel.TypeInfo.toBaseOid staticOids)+ (fmap Kernel.TypeInfo.toArrayOid staticOids) 0 False- (HashSet.fromList requiredTypes)+ (HashSet.fromList (fmap Kernel.QualifiedTypeName.fromNameTuple requiredTypes)) ( \hashMap ->- ByteString.StrictBuilder.bytes . encode (fromMaybe (0, 0) . flip HashMap.lookup hashMap)+ ByteString.StrictBuilder.bytes . encode (\name -> fromMaybe (Kernel.TypeInfo.TypeInfo 0 0) (HashMap.lookup (Kernel.QualifiedTypeName.fromNameTuple name) hashMap)) ) (TextBuilder.text . render)
src/library/Hasql/Codecs/RequestingOid.hs view
@@ -13,45 +13,55 @@ 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.Platform.Prelude hiding (lift, lookup) type RequestingOid = LookingUp.LookingUp- (Maybe Text, Text)- (Word32, Word32)+ Kernel.QualifiedTypeName+ Kernel.TypeInfo.TypeInfo +{-# INLINE toUnknownTypes #-} toUnknownTypes :: RequestingOid a ->- HashSet (Maybe Text, Text)+ HashSet Kernel.QualifiedTypeName toUnknownTypes (LookingUp.LookingUp unknownTypes _) = fromList unknownTypes +{-# INLINE toBase #-} toBase :: RequestingOid a ->- HashMap (Maybe Text, Text) (Word32, Word32) ->+ HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo -> a toBase (LookingUp.LookingUp _unknownTypes decoder) oidCache = decoder \key -> HashMap.lookup key oidCache- & fromMaybe (0, 0)+ & fromMaybe (Kernel.TypeInfo.TypeInfo 0 0) +{-# INLINE requestAndHandle #-} requestAndHandle ::- [(Maybe Text, Text)] ->- (((Maybe Text, Text) -> (Word32, Word32)) -> a) ->+ [Kernel.QualifiedTypeName] ->+ ((Kernel.QualifiedTypeName -> Kernel.TypeInfo.TypeInfo) -> a) -> RequestingOid a requestAndHandle keys fn = LookingUp.LookingUp keys fn +{-# INLINE lift #-} lift :: a -> RequestingOid a lift = LookingUp.lift +{-# INLINE hoist #-} hoist :: (a -> b) -> RequestingOid a -> RequestingOid b hoist fn (LookingUp.LookingUp keys use) = LookingUp.LookingUp keys (fn . use) -lookup :: (Maybe Text, Text) -> RequestingOid (Word32, Word32)+{-# INLINE lookup #-}+lookup :: Kernel.QualifiedTypeName -> RequestingOid Kernel.TypeInfo.TypeInfo lookup = LookingUp.lookup -lookingUp :: (Maybe Text, Text) -> ((Word32, Word32) -> a) -> RequestingOid a+{-# INLINE lookingUp #-}+lookingUp :: Kernel.QualifiedTypeName -> (Kernel.TypeInfo.TypeInfo -> a) -> RequestingOid a lookingUp = LookingUp.lookingUp -hoistLookingUp :: (Maybe Text, Text) -> ((Word32, Word32) -> a -> b) -> RequestingOid a -> RequestingOid b+{-# INLINE hoistLookingUp #-}+hoistLookingUp :: Kernel.QualifiedTypeName -> (Kernel.TypeInfo.TypeInfo -> a -> b) -> RequestingOid a -> RequestingOid b hoistLookingUp = LookingUp.hoistLookingUp
src/library/Hasql/Codecs/RequestingOid/LookingUp.hs view
@@ -1,7 +1,6 @@ module Hasql.Codecs.RequestingOid.LookingUp where import Control.Applicative-import Witherable import Prelude data LookingUp k v a@@ -16,25 +15,31 @@ deriving stock instance Functor (LookingUp k v) instance Applicative (LookingUp k v) where+ {-# INLINE pure #-} pure a = LookingUp [] (\_ -> a)+ {-# INLINE (<*>) #-} LookingUp lKeys lUse <*> LookingUp rKeys rUse = LookingUp (lKeys <> rKeys) (\lookup -> lUse lookup (rUse lookup)) +{-# INLINE lookup #-} lookup :: k -> LookingUp k v v lookup key = LookingUp [key] (\lookupFn -> lookupFn key) +{-# INLINE lift #-} lift :: a -> LookingUp k v a lift fa = LookingUp [] (const fa) +{-# INLINE lookingUp #-} lookingUp :: k -> (v -> a) -> LookingUp k v a lookingUp key cont = LookingUp [key] (\lookupFn -> cont (lookupFn key)) +{-# INLINE hoistLookingUp #-} hoistLookingUp :: k -> (v -> a -> b) -> LookingUp k v a -> LookingUp k v b hoistLookingUp k tx (LookingUp keys use) = LookingUp (k : keys) (\lookupFn -> tx (lookupFn k) (use lookupFn))
− src/library/Hasql/Codecs/TypeInfo.hs
@@ -1,228 +0,0 @@-module Hasql.Codecs.TypeInfo where--import Hasql.Platform.Prelude hiding (bool)---- | A Postgresql type info-data TypeInfo = TypeInfo {toBaseOid :: Word32, toArrayOid :: Word32}--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/Comms/RowDecoder.hs view
@@ -69,6 +69,7 @@ type Decoder a = Pq.Result -> Pq.Row -> IO (Either Error a) +{-# INLINE toDecoder #-} toDecoder :: RowDecoder a -> Decoder a toDecoder (RowDecoder _ dec) result row = RowReader.toHandler dec result row
src/library/Hasql/Comms/RowReader.hs view
@@ -76,10 +76,11 @@ valueMaybe <- case valueMaybe of Nothing -> pure Nothing- Just v -> do- oid <- Pq.oidToWord32 <$> liftIO (Pq.ftype result col)+ Just v -> case {-# SCC "decode" #-} valueDec v of- Left err -> throwError (CellError colInt oid (DecodingCellError err))+ Left err -> do+ oid <- Pq.oidToWord32 <$> liftIO (Pq.ftype result col)+ throwError (CellError colInt oid (DecodingCellError err)) Right decoded -> pure (Just decoded) case processNullable valueMaybe of
src/library/Hasql/Decoders.hs view
@@ -83,9 +83,13 @@ -- * 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,7 +74,11 @@ -- * Composite Composite, field,++ -- * TypeInfo+ TypeInfo (..), ) where import Hasql.Codecs.Encoders+import Hasql.Kernel.TypeInfo (TypeInfo (..))
src/library/Hasql/Engine/Contexts/Pipeline.hs view
@@ -15,6 +15,9 @@ import Hasql.Engine.PqProcedures.SelectTypeInfo qualified as PqProcedures.SelectTypeInfo import Hasql.Engine.Structures.OidCache qualified as OidCache 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 @@ -31,42 +34,48 @@ ) run (Pipeline totalStatements unknownTypes runPipeline) usePreparedStatements connection oidCache statementCache = do let missingTypes = OidCache.selectUnknownNames unknownTypes oidCache- oidCacheUpdates <- PqProcedures.SelectTypeInfo.run connection (PqProcedures.SelectTypeInfo.SelectTypeInfo missingTypes)- case oidCacheUpdates of+ resolvedOidCache <-+ if HashSet.null missingTypes+ then pure (Right oidCache)+ else do+ oidCacheUpdates <-+ PqProcedures.SelectTypeInfo.run connection (PqProcedures.SelectTypeInfo.SelectTypeInfo missingTypes)+ pure $ case oidCacheUpdates of+ Left err -> Left err+ Right oidCacheUpdates ->+ 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))+ else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates)+ case resolvedOidCache of Left err -> pure (Left err, oidCache, statementCache)- Right oidCacheUpdates -> do- -- Validate that all requested types were found- let foundTypes = HashMap.keysSet oidCacheUpdates- notFoundTypes = HashSet.difference missingTypes foundTypes- if not (HashSet.null notFoundTypes)- then pure (Left (Errors.MissingTypesSessionError notFoundTypes), oidCache, statementCache)- else do- let newOidCache = oidCache <> OidCache.fromHashMap oidCacheUpdates- (roundtrip, newStatementCache) =- runPipeline 0 usePreparedStatements (OidCache.toHashMap newOidCache) statementCache- contextualRoundtrip = first Just roundtrip+ Right newOidCache -> do+ let (roundtrip, newStatementCache) =+ runPipeline 0 usePreparedStatements (OidCache.toHashMap newOidCache) statementCache+ contextualRoundtrip = first Just roundtrip - executionResult <- Comms.Roundtrip.toPipelineIO contextualRoundtrip Nothing connection+ executionResult <- Comms.Roundtrip.toPipelineIO contextualRoundtrip Nothing connection - let result =- first- ( \case- Comms.Roundtrip.ClientError _context details ->- Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)- Comms.Roundtrip.ServerError recvError ->- Errors.fromRecvError (fmap (fmap (\(Context index sql params prepared _) -> (totalStatements, index, sql, params, prepared))) recvError)- )- executionResult- finalStatementCache =- case executionResult of- Right _ -> newStatementCache- Left executionError ->- maybe- statementCache- (\(Context _ _ _ _ statementCache) -> statementCache)- (extract executionError)+ let result =+ first+ ( \case+ Comms.Roundtrip.ClientError _context details ->+ Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)+ Comms.Roundtrip.ServerError recvError ->+ Errors.fromRecvError (fmap (fmap (\(Context index sql params prepared _) -> (totalStatements, index, sql, params, prepared))) recvError)+ )+ executionResult+ finalStatementCache =+ case executionResult of+ Right _ -> newStatementCache+ Left executionError ->+ maybe+ statementCache+ (\(Context _ _ _ _ statementCache) -> statementCache)+ (extract executionError) - pure (result, newOidCache, finalStatementCache)+ pure (result, newOidCache, finalStatementCache) -- | -- Composable abstraction over the execution of queries in [the pipeline mode](https://www.postgresql.org/docs/current/libpq-pipeline-mode.html).@@ -138,7 +147,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 (Maybe Text, Text))+ (HashSet Kernel.QualifiedTypeName) -- | Function that runs the pipeline. -- -- The integer parameter indicates the current offset of the statement in the pipeline (0-based).@@ -155,7 +164,7 @@ -- committed cache from statement contexts carried by roundtrip errors. ( Int -> Bool ->- HashMap (Maybe Text, Text) (Word32, Word32) ->+ HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo -> StatementCache.StatementCache -> (Comms.Roundtrip.Roundtrip Context a, StatementCache.StatementCache) )
src/library/Hasql/Engine/Contexts/Session.hs view
@@ -12,6 +12,7 @@ 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 @@ -94,82 +95,87 @@ Params.toUnknownTypes paramsEncoder <> RequestingOid.toUnknownTypes requestingDecoder missingTypes = OidCache.selectUnknownNames unknownTypes oidCache- oidCacheUpdates <-- PqProcedures.SelectTypeInfo.run connection (PqProcedures.SelectTypeInfo.SelectTypeInfo missingTypes)- case oidCacheUpdates of+ resolvedOidCache <-+ if HashSet.null missingTypes+ then pure (Right oidCache)+ else do+ oidCacheUpdates <-+ PqProcedures.SelectTypeInfo.run connection (PqProcedures.SelectTypeInfo.SelectTypeInfo missingTypes)+ pure $ case oidCacheUpdates of+ Left err -> Left err+ Right oidCacheUpdates ->+ 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))+ else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates)+ case resolvedOidCache of Left err -> pure (Left err, connectionState)- Right oidCacheUpdates -> do- -- Validate that all requested types were found.- let foundTypes = HashMap.keysSet oidCacheUpdates- notFoundTypes = HashSet.difference missingTypes foundTypes- if not (HashSet.null notFoundTypes)- then pure (Left (Errors.MissingTypesSessionError notFoundTypes), connectionState)- else do- let newOidCache = oidCache <> OidCache.fromHashMap oidCacheUpdates- oidHashMap = OidCache.toHashMap newOidCache- decoder' = RequestingOid.toBase requestingDecoder oidHashMap- prepared = usePreparedStatements && preparable- -- Single-statement context for error reporting:- -- total statements 1, index 0.- context = Just (1, 0, sql, Params.renderReadable paramsEncoder params, prepared)- mapError = \case- Comms.Roundtrip.ClientError _ details ->- Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)- Comms.Roundtrip.ServerError recvError ->- Errors.fromRecvError recvError- withState (result, newStatementCache) =- ( first mapError result,- connectionState- { ConnectionState.oidCache = newOidCache,- ConnectionState.statementCache = newStatementCache- }- )- fmap withState- $ if prepared- then do- let (oidList, valueAndFormatList) =- Params.compilePreparedStatementData paramsEncoder oidHashMap params- pqOidList = fmap (Pq.Oid . fromIntegral) oidList- encodedParams =- valueAndFormatList- & fmap (fmap (\(bytes, format) -> (bytes, bool Pq.Binary Pq.Text format)))- execute remoteKey =- Comms.Roundtrip.toSerialIO- (Comms.Roundtrip.queryPrepared context remoteKey encodedParams Pq.Binary decoder')- connection- case StatementCache.lookup sql pqOidList statementCache of- Just remoteKey -> do- result <- execute remoteKey- pure (result, statementCache)- Nothing -> do- let (remoteKey, newStatementCache) = StatementCache.insert sql pqOidList statementCache- -- In non-pipeline mode PARSE and EXECUTE cannot be sent- -- back-to-back, so prepare in a dedicated roundtrip first.- prepareResult <-- Comms.Roundtrip.toSerialIO- (Comms.Roundtrip.prepare context remoteKey sql pqOidList)- connection- case prepareResult of- -- PARSE failed: the statement is not on the server, so- -- keep the old cache (no entry committed).- Left err -> pure (Left err, statementCache)- Right () -> do- -- PARSE succeeded, so the statement is on the server- -- under remoteKey regardless of whether EXECUTE then- -- fails. Commit the cache so a later use hits it instead- -- of re-issuing PARSE for an already-existing name.- result <- execute remoteKey- pure (result, newStatementCache)- else do- let encodedParams =- params- & Params.compileUnpreparedStatementData paramsEncoder oidHashMap- & fmap (fmap (\(oid, bytes, format) -> (Pq.Oid (fromIntegral oid), bytes, bool Pq.Binary Pq.Text format)))- result <-+ Right newOidCache -> do+ let oidHashMap = OidCache.toHashMap newOidCache+ decoder' = RequestingOid.toBase requestingDecoder oidHashMap+ prepared = usePreparedStatements && preparable+ -- Single-statement context for error reporting:+ -- total statements 1, index 0.+ context = Just (1, 0, sql, Params.renderReadable paramsEncoder params, prepared)+ mapError = \case+ Comms.Roundtrip.ClientError _ details ->+ Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)+ Comms.Roundtrip.ServerError recvError ->+ Errors.fromRecvError recvError+ withState (result, newStatementCache) =+ ( first mapError result,+ connectionState+ { ConnectionState.oidCache = newOidCache,+ ConnectionState.statementCache = newStatementCache+ }+ )+ fmap withState+ $ if prepared+ then do+ let (oidList, valueAndFormatList) =+ Params.compilePreparedStatementData paramsEncoder oidHashMap params+ pqOidList = fmap (Pq.Oid . fromIntegral) oidList+ encodedParams =+ valueAndFormatList+ & fmap (fmap (\(bytes, format) -> (bytes, bool Pq.Binary Pq.Text format)))+ execute remoteKey = Comms.Roundtrip.toSerialIO- (Comms.Roundtrip.queryParams context sql encodedParams Pq.Binary decoder')+ (Comms.Roundtrip.queryPrepared context remoteKey encodedParams Pq.Binary decoder') connection+ case StatementCache.lookup sql pqOidList statementCache of+ Just remoteKey -> do+ result <- execute remoteKey pure (result, statementCache)+ Nothing -> do+ let (remoteKey, newStatementCache) = StatementCache.insert sql pqOidList statementCache+ -- In non-pipeline mode PARSE and EXECUTE cannot be sent+ -- back-to-back, so prepare in a dedicated roundtrip first.+ prepareResult <-+ Comms.Roundtrip.toSerialIO+ (Comms.Roundtrip.prepare context remoteKey sql pqOidList)+ connection+ case prepareResult of+ -- PARSE failed: the statement is not on the server, so+ -- keep the old cache (no entry committed).+ Left err -> pure (Left err, statementCache)+ Right () -> do+ -- PARSE succeeded, so the statement is on the server+ -- under remoteKey regardless of whether EXECUTE then+ -- fails. Commit the cache so a later use hits it instead+ -- of re-issuing PARSE for an already-existing name.+ result <- execute remoteKey+ pure (result, newStatementCache)+ else do+ let encodedParams =+ params+ & Params.compileUnpreparedStatementData paramsEncoder oidHashMap+ & fmap (fmap (\(oid, bytes, format) -> (Pq.Oid (fromIntegral oid), bytes, bool Pq.Binary Pq.Text format)))+ result <-+ Comms.Roundtrip.toSerialIO+ (Comms.Roundtrip.queryParams context sql encodedParams Pq.Binary decoder')+ connection+ pure (result, statementCache) -- | -- Execute a pipeline.
src/library/Hasql/Engine/Decoders/Result.hs view
@@ -23,7 +23,7 @@ -- Decode no value from the result. -- -- Useful for statements like @INSERT@ or @CREATE@.-{-# INLINEABLE noResult #-}+{-# INLINE noResult #-} noResult :: Result () noResult = Result (RequestingOid.lift ResultDecoder.ok)@@ -31,7 +31,7 @@ -- | -- Get the amount of rows affected by such statements as -- @UPDATE@ or @DELETE@.-{-# INLINEABLE rowsAffected #-}+{-# INLINE rowsAffected #-} rowsAffected :: Result Int64 rowsAffected = Result (RequestingOid.lift ResultDecoder.rowsAffected)@@ -39,7 +39,7 @@ -- | -- Exactly one row. -- Will raise the 'Hasql.Errors.UnexpectedRowCountStatementError' error if it's any other.-{-# INLINEABLE singleRow #-}+{-# INLINE singleRow #-} singleRow :: Row a -> Result a singleRow decoder = Result (fmap ResultDecoder.single (Row.toDecoder decoder))@@ -52,7 +52,7 @@ -- | -- Foldl multiple rows.-{-# INLINEABLE foldlRows #-}+{-# INLINE foldlRows #-} foldlRows :: (a -> b -> a) -> a -> Row b -> Result a foldlRows step init decoder = Result@@ -60,7 +60,7 @@ -- | -- Foldr multiple rows.-{-# INLINEABLE foldrRows #-}+{-# INLINE foldrRows #-} foldrRows :: (b -> a -> a) -> a -> Row b -> Result a foldrRows step init decoder = Result@@ -70,7 +70,7 @@ -- | -- Maybe one row or none.-{-# INLINEABLE rowMaybe #-}+{-# INLINE rowMaybe #-} rowMaybe :: Row a -> Result (Maybe a) rowMaybe decoder = Result@@ -81,7 +81,7 @@ -- -- It's recommended to prefer this function to 'rowList', -- since it performs notably better.-{-# INLINEABLE rowVector #-}+{-# INLINE rowVector #-} rowVector :: Row a -> Result (Vector a) rowVector decoder = Result@@ -89,7 +89,7 @@ -- | -- Zero or more rows packed into the list.-{-# INLINEABLE rowList #-}+{-# INLINE rowList #-} rowList :: Row a -> Result [a] rowList = foldrRows strictCons []
src/library/Hasql/Engine/Decoders/Row.hs view
@@ -4,6 +4,8 @@ import Hasql.Codecs.Decoders.Value qualified as Value import Hasql.Codecs.RequestingOid qualified as RequestingOid 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 @@ -29,7 +31,7 @@ -- | -- Lift an individual value decoder to a composable row decoder.-{-# INLINEABLE column #-}+{-# INLINE column #-} column :: NullableOrNot Value a -> Row a column = \case Nullable valueDecoder ->@@ -40,7 +42,7 @@ (Value.toDecoder valueDecoder) Nothing -> do RequestingOid.hoistLookingUp- (Value.toSchema valueDecoder, Value.toTypeName valueDecoder)+ (Kernel.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder)) ( \lookupResult decoder -> Hasql.Comms.RowDecoder.nullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder) )@@ -53,11 +55,11 @@ (Value.toDecoder valueDecoder) Nothing -> do RequestingOid.hoistLookingUp- (Value.toSchema valueDecoder, Value.toTypeName valueDecoder)+ (Kernel.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 (elementOid, arrayOid) =+ chooseLookedUpOid valueDecoder typeInfo = if Value.toDimensionality valueDecoder > 0- then arrayOid- else elementOid+ then Kernel.TypeInfo.toArrayOid typeInfo+ else Kernel.TypeInfo.toBaseOid typeInfo
src/library/Hasql/Engine/PqProcedures/SelectTypeInfo.hs view
@@ -14,17 +14,20 @@ 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 newtype SelectTypeInfo = SelectTypeInfo { -- | Set of (schema name, type name) pairs to look up.- keys :: HashSet (Maybe Text, Text)+ keys :: HashSet Kernel.QualifiedTypeName } --- | Result maps (schema name, type name) pairs to (scalar OID, array OID) pairs.+-- | Result maps (schema name, type name) pairs to TypeInfo (scalar OID, array OID). type SelectTypeInfoResult =- HashMap (Maybe Text, Text) (Word32, Word32)+ HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo run :: Pq.Connection -> SelectTypeInfo -> IO (Either Errors.SessionError SelectTypeInfoResult) run connection (SelectTypeInfo keys) =@@ -87,7 +90,7 @@ paramsEncoder :: Encoders.Params SelectTypeInfo paramsEncoder =- (\(SelectTypeInfo keys) -> unzip (HashSet.toList keys))+ (\(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)))@@ -98,7 +101,7 @@ Hasql.Comms.ResultDecoder.foldl step HashMap.empty rowDecoder where step acc (schemaName, typeName, typeOid, arrayOid) =- HashMap.insert (schemaName, typeName) (typeOid, arrayOid) acc+ HashMap.insert (Kernel.QualifiedTypeName.QualifiedTypeName schemaName typeName) (Kernel.TypeInfo.TypeInfo typeOid arrayOid) acc rowDecoder :: Hasql.Comms.RowDecoder.RowDecoder (Maybe Text, Text, Word32, Word32) rowDecoder =
src/library/Hasql/Engine/Statement.hs view
@@ -7,6 +7,7 @@ ) where +import Data.Text.Encoding qualified as TextEncoding import Hasql.Decoders qualified as Decoders import Hasql.Encoders qualified as Encoders import Hasql.Engine.Decoders.Result qualified@@ -36,14 +37,14 @@ -- and produces a single result of type 'Int64'. data Statement params result = Statement- -- | SQL template.+ -- | 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.- Text+ ByteString -- | Parameters encoder. (Encoders.Params params) -- | Decoder of result.@@ -69,7 +70,7 @@ -- | Result decoder Decoders.Result result -> Statement params result-preparable sql encoder decoder = Statement sql encoder decoder True+preparable sql encoder decoder = Statement (TextEncoding.encodeUtf8 sql) encoder decoder True -- | -- Construct an unpreparable statement.@@ -86,7 +87,7 @@ -- | Result decoder Decoders.Result result -> Statement params result-unpreparable sql encoder decoder = Statement sql encoder decoder False+unpreparable sql encoder decoder = Statement (TextEncoding.encodeUtf8 sql) encoder decoder False instance Functor (Statement params) where {-# INLINE fmap #-}@@ -114,4 +115,4 @@ -- | Extract the SQL template from a statement. toSql :: Statement params result -> Text-toSql (Statement sql _ _ _) = sql+toSql (Statement sql _ _ _) = TextEncoding.decodeUtf8Lenient sql
src/library/Hasql/Engine/Structures/OidCache.hs view
@@ -16,6 +16,9 @@ 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@@ -23,8 +26,8 @@ = OidCache -- | By name of the type. --- -- > scalar name -> (scalar OID, array OID)- (HashMap (Maybe Text, Text) (Word32, Word32))+ -- > scalar name -> TypeInfo (scalar OID, array OID)+ (HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo) deriving stock (Show, Eq) instance Semigroup OidCache where@@ -40,26 +43,31 @@ OidCache HashMap.empty -- | Having a set of required type names, select those that are not present in the cache.-selectUnknownNames :: HashSet (Maybe Text, Text) -> OidCache -> HashSet (Maybe Text, Text)+{-# 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 (schema, name) (scalar, array) byName)+ OidCache (HashMap.insert (Kernel.QualifiedTypeName.QualifiedTypeName schema name) (Kernel.TypeInfo.TypeInfo scalar array) byName) -fromHashMap :: HashMap (Maybe Text, Text) (Word32, Word32) -> OidCache+{-# 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 (schema, name) byName <&> \(scalar, _) -> scalar+ 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 (schema, name) byName <&> \(_, array) -> array+ HashMap.lookup (Kernel.QualifiedTypeName.QualifiedTypeName schema name) byName <&> \info -> Kernel.TypeInfo.toArrayOid info -toHashMap :: OidCache -> HashMap (Maybe Text, Text) (Word32, Word32)+{-# INLINE toHashMap #-}+toHashMap :: OidCache -> HashMap Kernel.QualifiedTypeName Kernel.TypeInfo.TypeInfo toHashMap (OidCache byName) = byName
+ src/library/Hasql/Kernel.hs view
@@ -0,0 +1,10 @@+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 view
@@ -0,0 +1,43 @@+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 view
@@ -0,0 +1,230 @@+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 view
@@ -0,0 +1,20 @@+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
@@ -6,10 +6,9 @@ import Hasql.Engine.Contexts.Pipeline qualified as Pipeline import Hasql.Engine.Statement qualified as Statement-import Hasql.Platform.Prelude -- | -- 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 (encodeUtf8 sql) encoder decoder preparable params+ Pipeline.statement sql encoder decoder preparable params
src/library/Hasql/Session.hs view
@@ -23,7 +23,7 @@ statement :: params -> Statement.Statement params result -> Session.Session result statement params (Statement.Statement sql encoder decoder preparable) = Session.statement- (encodeUtf8 sql)+ sql encoder decoder preparable