hasql 2.0.0.3 → 2.0.1.0
raw patch · 32 files changed
+658/−569 lines, 32 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Hasql.Errors: toSqlState :: IsError a => a -> Maybe Text
Files
- CHANGELOG.md +14/−0
- README.md +3/−10
- hasql.cabal +11/−11
- src/codec-vocab/CodecVocab.hs +0/−12
- src/codec-vocab/CodecVocab/QualifiedTypeName.hs +0/−43
- src/codec-vocab/CodecVocab/TypeInfo.hs +0/−235
- src/codec-vocab/CodecVocab/TypeRef.hs +0/−20
- src/codec-vocab/CodecVocab/TypeShape.hs +0/−13
- src/codecs-vocab/Hasql/CodecsVocab.hs +12/−0
- src/codecs-vocab/Hasql/CodecsVocab/QualifiedTypeName.hs +43/−0
- src/codecs-vocab/Hasql/CodecsVocab/TypeInfo.hs +235/−0
- src/codecs-vocab/Hasql/CodecsVocab/TypeRef.hs +20/−0
- src/codecs-vocab/Hasql/CodecsVocab/TypeShape.hs +13/−0
- src/connection-state-tests/Hasql/ConnectionState/OidCacheSpec.hs +34/−34
- src/connection-state/Hasql/ConnectionState/OidCache.hs +8/−8
- src/library-tests/Pure/ErrorsSpec.hs +48/−0
- src/library/Hasql/Codecs/Decoders.hs +4/−4
- src/library/Hasql/Codecs/Decoders/Array.hs +4/−4
- src/library/Hasql/Codecs/Decoders/Composite.hs +9/−9
- src/library/Hasql/Codecs/Decoders/Value.hs +45/−45
- src/library/Hasql/Codecs/Encoders.hs +4/−4
- src/library/Hasql/Codecs/Encoders/Array.hs +3/−3
- src/library/Hasql/Codecs/Encoders/Composite.hs +7/−7
- src/library/Hasql/Codecs/Encoders/Params.hs +13/−13
- src/library/Hasql/Codecs/Encoders/Value.hs +53/−53
- src/library/Hasql/Engine/Contexts/Pipeline.hs +4/−4
- src/library/Hasql/Engine/Contexts/Session.hs +2/−2
- src/library/Hasql/Engine/Decoders/Result.hs +6/−6
- src/library/Hasql/Engine/Decoders/Row.hs +9/−9
- src/library/Hasql/Engine/PqProcedures/SelectTypeInfo.hs +7/−7
- src/library/Hasql/Engine/Statement.hs +13/−13
- src/library/Hasql/Errors.hs +34/−0
CHANGELOG.md view
@@ -1,3 +1,17 @@+# v2.0.1.0++## New Features++- `IsError` gained a `toSqlState` method, exposing the SQLSTATE the server reported for an error, or `Nothing` where the error carries no server code. It saves consumers from pattern-matching their way down to the nested `ServerError` — a dig that has to be rewritten every time the error types gain a constructor.++ ```haskell+ case Errors.toSqlState err of+ Just "23505" -> handleUniqueViolation+ _ -> rethrow err+ ```++ The method has a default implementation returning `Nothing`, so existing instances keep compiling. Instances for error types that *wrap* another error type must override it and delegate to the wrapped value, otherwise they silently report `Nothing` for codes they do carry.+ # v2.0.0.3 ## Fixes
README.md view
@@ -97,18 +97,11 @@ - **Horizontal scalability of the ecosystem.** Instead of posting feature- or pull-requests, the users are encouraged to release their own small extension-libraries, with themselves becoming the copyright owners and taking on the maintenance responsibilities. Compare this model to the classical one, where some core-team is responsible for everything. One is scalable, the other is not. -# Tutorials--## Videos--There's several videos on Hasql done as part of a nice intro-level series of live Haskell+Bazel coding by the "Ants Are Everywhere" YouTube channel:--- [Coding Day 20: Switching from postgresql-simple to Hasql](https://youtu.be/ce7bGKETtoA?si=RmY_yDG24EX6i38I)-- [Coding Day 21: Refactoring the Hasql code](https://youtu.be/a9mPNXbT-qw?si=RTtXe6BXnZSQZzh-)+# Documentation -## Articles+- [**Data-Access Architecture**](https://github.com/nikita-volkov/hasql-docs/blob/main/data-access-architecture.md) — a normative reference for organising database integration code built on Hasql. It specifies how to layer types, statements, transactions and sessions, where the application domain enters the picture, how the three error channels differ, and what to test at each level. Every rule carries its rationale and derives from the capability differences between Hasql's four constructs. -- [Organization of Hasql code in a dedicated library <sup>(outdated)</sup>](https://github.com/nikita-volkov/hasql-tutorial1)+The reference is written to be consumed directly by coding agents as well as by people. Point an agent at [the raw file](https://raw.githubusercontent.com/nikita-volkov/hasql-docs/main/data-access-architecture.md) and it has the whole system in context, with the rules numbered so they can be cited back in review. # Short Example
hasql.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-version: 2.0.0.3+version: 2.0.1.0 category: Hasql, Database, PostgreSQL synopsis: Fast PostgreSQL driver with a flexible mapping API description:@@ -156,7 +156,7 @@ aeson >=2 && <3, bytestring >=0.10 && <0.13, bytestring-strict-builder >=0.4.5.4 && <0.5,- hasql:codec-vocab,+ hasql:codecs-vocab, hasql:comms, hasql:connection-state, hasql:platform,@@ -207,15 +207,15 @@ build-depends: base >=4.14 && <5 -library codec-vocab+library codecs-vocab import: base- hs-source-dirs: src/codec-vocab+ hs-source-dirs: src/codecs-vocab exposed-modules:- CodecVocab- CodecVocab.QualifiedTypeName- CodecVocab.TypeInfo- CodecVocab.TypeRef- CodecVocab.TypeShape+ Hasql.CodecsVocab+ Hasql.CodecsVocab.QualifiedTypeName+ Hasql.CodecsVocab.TypeInfo+ Hasql.CodecsVocab.TypeRef+ Hasql.CodecsVocab.TypeShape build-depends: hasql:platform@@ -229,7 +229,7 @@ Hasql.ConnectionState.StatementCache build-depends:- hasql:codec-vocab,+ hasql:codecs-vocab, hasql:platform, pqi >=1.0 && <1.2, unordered-containers >=0.2 && <0.3,@@ -316,7 +316,7 @@ build-depends: base >=4.14 && <5,- hasql:codec-vocab,+ hasql:codecs-vocab, hasql:connection-state, hspec ^>=2.11.12, unordered-containers >=0.2 && <0.3,
− src/codec-vocab/CodecVocab.hs
@@ -1,12 +0,0 @@-module CodecVocab- ( QualifiedTypeName (QualifiedTypeName),- TypeInfo (TypeInfo),- TypeRef (..),- TypeShape (TypeShape),- )-where--import CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo-import CodecVocab.TypeRef-import CodecVocab.TypeShape
− src/codec-vocab/CodecVocab/QualifiedTypeName.hs
@@ -1,43 +0,0 @@-module CodecVocab.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/codec-vocab/CodecVocab/TypeInfo.hs
@@ -1,235 +0,0 @@-module CodecVocab.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---- | Postgres's actual @unknown@ type, assigned to untyped literals. Not to be confused with 'invalid'.-unknown :: TypeInfo-unknown = TypeInfo 705 705---- | Sentinel for a type name that failed to resolve to a real OID. Not to be confused with 'unknown', which is a real Postgres type.-invalid :: TypeInfo-invalid = TypeInfo 0 0--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/codec-vocab/CodecVocab/TypeRef.hs
@@ -1,20 +0,0 @@-module CodecVocab.TypeRef- ( TypeRef (..),- )-where--import CodecVocab.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/codec-vocab/CodecVocab/TypeShape.hs
@@ -1,13 +0,0 @@-module CodecVocab.TypeShape- ( TypeShape (..),- )-where--import CodecVocab.TypeRef (TypeRef)-import Hasql.Platform.Prelude---- | A value's type shape: type reference, array dimensionality, text-format flag.-data TypeShape = TypeShape TypeRef Word Bool- deriving stock (Eq, Ord, Show, Generic)--instance Hashable TypeShape
+ src/codecs-vocab/Hasql/CodecsVocab.hs view
@@ -0,0 +1,12 @@+module Hasql.CodecsVocab+ ( QualifiedTypeName (QualifiedTypeName),+ TypeInfo (TypeInfo),+ TypeRef (..),+ TypeShape (TypeShape),+ )+where++import Hasql.CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo+import Hasql.CodecsVocab.TypeRef+import Hasql.CodecsVocab.TypeShape
+ src/codecs-vocab/Hasql/CodecsVocab/QualifiedTypeName.hs view
@@ -0,0 +1,43 @@+module Hasql.CodecsVocab.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/codecs-vocab/Hasql/CodecsVocab/TypeInfo.hs view
@@ -0,0 +1,235 @@+module Hasql.CodecsVocab.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++-- | Postgres's actual @unknown@ type, assigned to untyped literals. Not to be confused with 'invalid'.+unknown :: TypeInfo+unknown = TypeInfo 705 705++-- | Sentinel for a type name that failed to resolve to a real OID. Not to be confused with 'unknown', which is a real Postgres type.+invalid :: TypeInfo+invalid = TypeInfo 0 0++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/codecs-vocab/Hasql/CodecsVocab/TypeRef.hs view
@@ -0,0 +1,20 @@+module Hasql.CodecsVocab.TypeRef+ ( TypeRef (..),+ )+where++import Hasql.CodecsVocab.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/codecs-vocab/Hasql/CodecsVocab/TypeShape.hs view
@@ -0,0 +1,13 @@+module Hasql.CodecsVocab.TypeShape+ ( TypeShape (..),+ )+where++import Hasql.CodecsVocab.TypeRef (TypeRef)+import Hasql.Platform.Prelude++-- | A value's type shape: type reference, array dimensionality, text-format flag.+data TypeShape = TypeShape TypeRef Word Bool+ deriving stock (Eq, Ord, Show, Generic)++instance Hashable TypeShape
src/connection-state-tests/Hasql/ConnectionState/OidCacheSpec.hs view
@@ -1,18 +1,18 @@ module Hasql.ConnectionState.OidCacheSpec (spec) where -import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.ConnectionState.OidCache qualified as OidCache import Prelude import Test.Hspec -int4Key :: CodecVocab.QualifiedTypeName.QualifiedTypeName-int4Key = CodecVocab.QualifiedTypeName.QualifiedTypeName Nothing "int4"+int4Key :: CodecsVocab.QualifiedTypeName.QualifiedTypeName+int4Key = CodecsVocab.QualifiedTypeName.QualifiedTypeName Nothing "int4" -int8Key :: CodecVocab.QualifiedTypeName.QualifiedTypeName-int8Key = CodecVocab.QualifiedTypeName.QualifiedTypeName Nothing "int8"+int8Key :: CodecsVocab.QualifiedTypeName.QualifiedTypeName+int8Key = CodecsVocab.QualifiedTypeName.QualifiedTypeName Nothing "int8" spec :: Spec spec = do@@ -23,31 +23,31 @@ describe "fromHashMap and lookupTypeInfo" do it "can look up an inserted type" do- let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+ let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecsVocab.TypeInfo.TypeInfo 23 1007)) OidCache.lookupTypeInfo int4Key cache- `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 23 1007)+ `shouldBe` Just (CodecsVocab.TypeInfo.TypeInfo 23 1007) it "returns Nothing for a non-inserted type" do- let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+ let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecsVocab.TypeInfo.TypeInfo 23 1007)) OidCache.lookupTypeInfo int8Key cache `shouldBe` Nothing it "handles schema-qualified names" do- let key = CodecVocab.QualifiedTypeName.QualifiedTypeName (Just "public") "my_type"- cache = OidCache.fromHashMap (HashMap.singleton key (CodecVocab.TypeInfo.TypeInfo 100 200))+ let key = CodecsVocab.QualifiedTypeName.QualifiedTypeName (Just "public") "my_type"+ cache = OidCache.fromHashMap (HashMap.singleton key (CodecsVocab.TypeInfo.TypeInfo 100 200)) OidCache.lookupTypeInfo key cache- `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 100 200)- OidCache.lookupTypeInfo (CodecVocab.QualifiedTypeName.QualifiedTypeName Nothing "my_type") cache+ `shouldBe` Just (CodecsVocab.TypeInfo.TypeInfo 100 200)+ OidCache.lookupTypeInfo (CodecsVocab.QualifiedTypeName.QualifiedTypeName Nothing "my_type") cache `shouldBe` Nothing it "distinguishes same type name in different schemas" do- let keyA = CodecVocab.QualifiedTypeName.QualifiedTypeName (Just "schema_a") "my_type"- keyB = CodecVocab.QualifiedTypeName.QualifiedTypeName (Just "schema_b") "my_type"- cache = OidCache.fromHashMap (HashMap.fromList [(keyA, CodecVocab.TypeInfo.TypeInfo 100 200), (keyB, CodecVocab.TypeInfo.TypeInfo 300 400)])+ let keyA = CodecsVocab.QualifiedTypeName.QualifiedTypeName (Just "schema_a") "my_type"+ keyB = CodecsVocab.QualifiedTypeName.QualifiedTypeName (Just "schema_b") "my_type"+ cache = OidCache.fromHashMap (HashMap.fromList [(keyA, CodecsVocab.TypeInfo.TypeInfo 100 200), (keyB, CodecsVocab.TypeInfo.TypeInfo 300 400)]) OidCache.lookupTypeInfo keyA cache- `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 100 200)+ `shouldBe` Just (CodecsVocab.TypeInfo.TypeInfo 100 200) OidCache.lookupTypeInfo keyB cache- `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 300 400)+ `shouldBe` Just (CodecsVocab.TypeInfo.TypeInfo 300 400) describe "selectUnknownNames" do it "returns all names when cache is empty" do@@ -56,54 +56,54 @@ `shouldBe` names it "returns empty when all names are known" do- let cache = OidCache.fromHashMap (HashMap.fromList [(int4Key, CodecVocab.TypeInfo.TypeInfo 23 1007), (int8Key, CodecVocab.TypeInfo.TypeInfo 20 1016)])+ let cache = OidCache.fromHashMap (HashMap.fromList [(int4Key, CodecsVocab.TypeInfo.TypeInfo 23 1007), (int8Key, CodecsVocab.TypeInfo.TypeInfo 20 1016)]) names = HashSet.fromList [int4Key, int8Key] OidCache.selectUnknownNames names cache `shouldBe` HashSet.empty it "returns only unknown names" do- let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+ let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecsVocab.TypeInfo.TypeInfo 23 1007)) names = HashSet.fromList [int4Key, int8Key] OidCache.selectUnknownNames names cache `shouldBe` HashSet.fromList [int8Key] describe "toResolver" do it "resolves a known type" do- let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+ let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecsVocab.TypeInfo.TypeInfo 23 1007)) OidCache.toResolver cache int4Key- `shouldBe` CodecVocab.TypeInfo.TypeInfo 23 1007+ `shouldBe` CodecsVocab.TypeInfo.TypeInfo 23 1007 it "falls back to invalid for an unknown type" do OidCache.toResolver OidCache.empty int4Key- `shouldBe` CodecVocab.TypeInfo.invalid+ `shouldBe` CodecsVocab.TypeInfo.invalid describe "Semigroup" do it "right operand takes precedence for duplicate keys" do- let cacheA = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))- cacheB = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 99 999))+ let cacheA = OidCache.fromHashMap (HashMap.singleton int4Key (CodecsVocab.TypeInfo.TypeInfo 23 1007))+ cacheB = OidCache.fromHashMap (HashMap.singleton int4Key (CodecsVocab.TypeInfo.TypeInfo 99 999)) merged = cacheA <> cacheB OidCache.lookupTypeInfo int4Key merged- `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 99 999)+ `shouldBe` Just (CodecsVocab.TypeInfo.TypeInfo 99 999) it "preserves entries from both sides when no conflict" do- let cacheA = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))- cacheB = OidCache.fromHashMap (HashMap.singleton int8Key (CodecVocab.TypeInfo.TypeInfo 20 1016))+ let cacheA = OidCache.fromHashMap (HashMap.singleton int4Key (CodecsVocab.TypeInfo.TypeInfo 23 1007))+ cacheB = OidCache.fromHashMap (HashMap.singleton int8Key (CodecsVocab.TypeInfo.TypeInfo 20 1016)) merged = cacheA <> cacheB OidCache.lookupTypeInfo int4Key merged- `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 23 1007)+ `shouldBe` Just (CodecsVocab.TypeInfo.TypeInfo 23 1007) OidCache.lookupTypeInfo int8Key merged- `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 20 1016)+ `shouldBe` Just (CodecsVocab.TypeInfo.TypeInfo 20 1016) it "is associative" do- let a = OidCache.fromHashMap (HashMap.singleton "t1" (CodecVocab.TypeInfo.TypeInfo 1 2))- b = OidCache.fromHashMap (HashMap.fromList [("t1", CodecVocab.TypeInfo.TypeInfo 3 4), ("t2", CodecVocab.TypeInfo.TypeInfo 5 6)])- c = OidCache.fromHashMap (HashMap.fromList [("t2", CodecVocab.TypeInfo.TypeInfo 7 8), ("t3", CodecVocab.TypeInfo.TypeInfo 9 10)])+ let a = OidCache.fromHashMap (HashMap.singleton "t1" (CodecsVocab.TypeInfo.TypeInfo 1 2))+ b = OidCache.fromHashMap (HashMap.fromList [("t1", CodecsVocab.TypeInfo.TypeInfo 3 4), ("t2", CodecsVocab.TypeInfo.TypeInfo 5 6)])+ c = OidCache.fromHashMap (HashMap.fromList [("t2", CodecsVocab.TypeInfo.TypeInfo 7 8), ("t3", CodecsVocab.TypeInfo.TypeInfo 9 10)]) (a <> b) <> c `shouldBe` a <> (b <> c) describe "Monoid" do it "mempty is identity for Semigroup" do- let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+ let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecsVocab.TypeInfo.TypeInfo 23 1007)) cache <> mempty `shouldBe` cache mempty <> cache
src/connection-state/Hasql/ConnectionState/OidCache.hs view
@@ -12,10 +12,10 @@ ) where -import CodecVocab qualified as CodecVocab-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet+import Hasql.CodecsVocab qualified as CodecsVocab+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Platform.Prelude hiding (empty, insert, lookup, reset) -- | Pure registry state containing the hash map and counter@@ -24,7 +24,7 @@ -- | By name of the type. -- -- > scalar name -> TypeInfo (scalar OID, array OID)- (HashMap CodecVocab.QualifiedTypeName CodecVocab.TypeInfo)+ (HashMap CodecsVocab.QualifiedTypeName CodecsVocab.TypeInfo) deriving stock (Show, Eq) instance Semigroup OidCache where@@ -41,23 +41,23 @@ -- | Having a set of required type names, select those that are not present in the cache. {-# INLINE selectUnknownNames #-}-selectUnknownNames :: HashSet CodecVocab.QualifiedTypeName -> OidCache -> HashSet CodecVocab.QualifiedTypeName+selectUnknownNames :: HashSet CodecsVocab.QualifiedTypeName -> OidCache -> HashSet CodecsVocab.QualifiedTypeName selectUnknownNames keys (OidCache byName) = HashSet.filter (\key -> not (HashMap.member key byName)) keys {-# INLINE fromHashMap #-}-fromHashMap :: HashMap CodecVocab.QualifiedTypeName CodecVocab.TypeInfo -> OidCache+fromHashMap :: HashMap CodecsVocab.QualifiedTypeName CodecsVocab.TypeInfo -> OidCache fromHashMap byName = OidCache byName -- * Accessors {-# INLINE lookupTypeInfo #-}-lookupTypeInfo :: CodecVocab.QualifiedTypeName -> OidCache -> Maybe CodecVocab.TypeInfo+lookupTypeInfo :: CodecsVocab.QualifiedTypeName -> OidCache -> Maybe CodecsVocab.TypeInfo lookupTypeInfo name (OidCache byName) = HashMap.lookup name byName -- | Resolution function for a name against the cache, falling back to 'TypeInfo.invalid' on a miss. {-# INLINE toResolver #-}-toResolver :: OidCache -> CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo+toResolver :: OidCache -> CodecsVocab.QualifiedTypeName -> CodecsVocab.TypeInfo toResolver oidCache name =- lookupTypeInfo name oidCache & fromMaybe CodecVocab.TypeInfo.invalid+ lookupTypeInfo name oidCache & fromMaybe CodecsVocab.TypeInfo.invalid
src/library-tests/Pure/ErrorsSpec.hs view
@@ -31,6 +31,11 @@ (Errors.isTransient (Errors.AuthenticationConnectionError "invalid password")) `shouldBe` False + describe "toSqlState" do+ it "is Nothing, since connection errors carry no server code" do+ (Errors.toSqlState (Errors.NetworkingConnectionError "timeout"))+ `shouldBe` Nothing+ describe "toDetailedText" do it "renders NetworkingConnectionError with details" do (Errors.toDetailedText (Errors.NetworkingConnectionError "connection refused"))@@ -59,6 +64,11 @@ ("message", "syntax error") ] + describe "toSqlState" do+ it "is the code the server reported" do+ (Errors.toSqlState (Errors.ServerError "23505" "duplicate key value violates unique constraint" Nothing Nothing Nothing))+ `shouldBe` Just "23505"+ describe "toDetailedText" do it "renders ServerError with all details" do (Errors.toDetailedText (Errors.ServerError "42P01" "relation \"users\" does not exist" (Just "The relation users does not exist.") (Just "Check your table name.") (Just 15)))@@ -140,6 +150,19 @@ (Errors.toDetails (Errors.UnexpectedColumnTypeStatementError 2 23 1043)) `shouldBe` [("columnIndex", "2"), ("expectedOid", "23"), ("actualOid", "1043")] + describe "toSqlState" do+ it "digs the code out of ServerStatementError" do+ (Errors.toSqlState (Errors.ServerStatementError (Errors.ServerError "23505" "duplicate key" Nothing Nothing Nothing)))+ `shouldBe` Just "23505"++ it "is Nothing for a decoding failure" do+ (Errors.toSqlState (Errors.RowStatementError 3 (Errors.CellRowError 1 23 Errors.UnexpectedNullCellError)))+ `shouldBe` Nothing++ it "is Nothing for a row count mismatch" do+ (Errors.toSqlState (Errors.UnexpectedRowCountStatementError 1 1 0))+ `shouldBe` Nothing+ describe "toDetailedText" do it "renders UnexpectedRowCountStatementError with details" do (Errors.toDetailedText (Errors.UnexpectedRowCountStatementError 1 1 0))@@ -195,6 +218,31 @@ it "StatementSessionError is not transient" do (Errors.isTransient (Errors.StatementSessionError 1 0 "SELECT 1" [] True (Errors.UnexpectedRowCountStatementError 1 1 0))) `shouldBe` False++ describe "toSqlState" do+ it "digs the code out of StatementSessionError" do+ (Errors.toSqlState (Errors.StatementSessionError 1 0 "INSERT INTO users (email) VALUES ($1)" ["a@b.c"] True (Errors.ServerStatementError (Errors.ServerError "23505" "duplicate key" Nothing Nothing Nothing))))+ `shouldBe` Just "23505"++ it "digs the code out of ScriptSessionError" do+ (Errors.toSqlState (Errors.ScriptSessionError "DROP TABLE users" (Errors.ServerError "42P01" "relation does not exist" Nothing Nothing Nothing)))+ `shouldBe` Just "42P01"++ it "is Nothing for StatementSessionError wrapping a non-server error" do+ (Errors.toSqlState (Errors.StatementSessionError 1 0 "SELECT 1" [] True (Errors.UnexpectedRowCountStatementError 1 1 0)))+ `shouldBe` Nothing++ it "is Nothing for ConnectionSessionError" do+ (Errors.toSqlState (Errors.ConnectionSessionError "connection lost"))+ `shouldBe` Nothing++ it "is Nothing for MissingTypesSessionError" do+ (Errors.toSqlState (Errors.MissingTypesSessionError (HashSet.fromList [(Just "public", "custom_type")])))+ `shouldBe` Nothing++ it "is Nothing for DriverSessionError" do+ (Errors.toSqlState (Errors.DriverSessionError "unexpected response"))+ `shouldBe` Nothing describe "toDetailedText" do it "renders StatementSessionError with all context" do
src/library/Hasql/Codecs/Decoders.hs view
@@ -65,12 +65,12 @@ ) where -import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Data.Vector.Generic qualified as GenericVector import Hasql.Codecs.Decoders.Array qualified as Array 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.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Platform.Prelude -- * Value@@ -139,9 +139,9 @@ Value.Value Nothing "record"- (Just (CodecVocab.TypeInfo.toBaseOid typeInfo))- (Just (CodecVocab.TypeInfo.toArrayOid typeInfo))+ (Just (CodecsVocab.TypeInfo.toBaseOid typeInfo))+ (Just (CodecsVocab.TypeInfo.toArrayOid typeInfo)) 0 (Composite.toValueDecoder composite) where- typeInfo = CodecVocab.TypeInfo.record+ typeInfo = CodecsVocab.TypeInfo.record
src/library/Hasql/Codecs/Decoders/Array.hs view
@@ -12,10 +12,10 @@ ) where -import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot import Hasql.Codecs.Decoders.Value qualified as Value+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Platform.Prelude import Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Decoding qualified as Binary@@ -43,11 +43,11 @@ -- | Number of dimensions. Word -- | Decoding function- (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Array a))+ (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (Binary.Array a)) deriving (Functor) {-# INLINE toValueDecoder #-}-toValueDecoder :: Array a -> ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Value a)+toValueDecoder :: Array a -> ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (Binary.Value a) toValueDecoder (Array _ _ _ _ _ decoder) = fmap Binary.array decoder
src/library/Hasql/Codecs/Decoders/Composite.hs view
@@ -1,9 +1,9 @@ module Hasql.Codecs.Decoders.Composite where -import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot import Hasql.Codecs.Decoders.Value qualified as Value+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Platform.Prelude import Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Decoding qualified as Binary@@ -11,12 +11,12 @@ -- | -- Composable decoder of composite values (rows, records). newtype Composite a- = Composite (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Composite a))+ = Composite (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (Binary.Composite a)) deriving (Functor, Applicative)- via (Compose (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo) Binary.Composite)+ via (Compose (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo) Binary.Composite) -toValueDecoder :: Composite a -> ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Value a)+toValueDecoder :: Composite a -> ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (Binary.Value a) toValueDecoder (Composite imp) = fmap Binary.composite imp @@ -32,8 +32,8 @@ Composite (fmap (Binary.typedValueComposite oid) (Value.toDecoder imp)) Nothing -> Composite- ( (\typeInfo decoder -> Binary.typedValueComposite (if dimensionality == 0 then CodecVocab.TypeInfo.toBaseOid typeInfo else CodecVocab.TypeInfo.toArrayOid typeInfo) decoder)- <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))+ ( (\typeInfo decoder -> Binary.typedValueComposite (if dimensionality == 0 then CodecsVocab.TypeInfo.toBaseOid typeInfo else CodecsVocab.TypeInfo.toArrayOid typeInfo) decoder)+ <$> ToBeResolved.lookup (CodecsVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp)) <*> Value.toDecoder imp ) NullableOrNot.Nullable imp ->@@ -44,7 +44,7 @@ Composite (fmap (Binary.typedNullableValueComposite oid) (Value.toDecoder imp)) Nothing -> Composite- ( (\typeInfo decoder -> Binary.typedNullableValueComposite (if dimensionality == 0 then CodecVocab.TypeInfo.toBaseOid typeInfo else CodecVocab.TypeInfo.toArrayOid typeInfo) decoder)- <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))+ ( (\typeInfo decoder -> Binary.typedNullableValueComposite (if dimensionality == 0 then CodecsVocab.TypeInfo.toBaseOid typeInfo else CodecsVocab.TypeInfo.toArrayOid typeInfo) decoder)+ <$> ToBeResolved.lookup (CodecsVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp)) <*> Value.toDecoder imp )
src/library/Hasql/Codecs/Decoders/Value.hs view
@@ -53,10 +53,10 @@ ) where -import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Data.Aeson qualified as Aeson import Data.IP qualified as Iproute+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Platform.Prelude hiding (bool) import Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Decoding qualified as Binary@@ -77,7 +77,7 @@ -- | Dimensionality. If 0 then it is a scalar value, otherwise it is an array with that many dimensions. Word -- | Decoding function on a registry of OIDs by type name.- (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Value a))+ (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (Binary.Value a)) deriving (Functor) type role Value representational@@ -90,9 +90,9 @@ -- | -- Create a decoder from TypeInfo metadata and a decoding function. {-# INLINE primitive #-}-primitive :: Text -> CodecVocab.TypeInfo.TypeInfo -> Binary.Value a -> Value a+primitive :: Text -> CodecsVocab.TypeInfo.TypeInfo -> Binary.Value a -> Value a primitive typeName pti decoder =- Value Nothing typeName (Just (CodecVocab.TypeInfo.toBaseOid pti)) (Just (CodecVocab.TypeInfo.toArrayOid pti)) 0 (pure decoder)+ Value Nothing typeName (Just (CodecsVocab.TypeInfo.toBaseOid pti)) (Just (CodecsVocab.TypeInfo.toArrayOid pti)) 0 (pure decoder) -- * Static types @@ -100,19 +100,19 @@ -- Decoder of the @BOOL@ values. {-# INLINEABLE bool #-} bool :: Value Bool-bool = primitive "bool" CodecVocab.TypeInfo.bool Binary.bool+bool = primitive "bool" CodecsVocab.TypeInfo.bool Binary.bool -- | -- Decoder of the @INT2@ values. {-# INLINEABLE int2 #-} int2 :: Value Int16-int2 = primitive "int2" CodecVocab.TypeInfo.int2 Binary.int+int2 = primitive "int2" CodecsVocab.TypeInfo.int2 Binary.int -- | -- Decoder of the @INT4@ values. {-# INLINEABLE int4 #-} int4 :: Value Int32-int4 = primitive "int4" CodecVocab.TypeInfo.int4 Binary.int+int4 = primitive "int4" CodecsVocab.TypeInfo.int4 Binary.int -- | -- Decoder of the @INT8@ values.@@ -120,68 +120,68 @@ int8 :: Value Int64 int8 = {-# SCC "int8" #-}- primitive "int8" CodecVocab.TypeInfo.int8 ({-# SCC "int8.int" #-} Binary.int)+ primitive "int8" CodecsVocab.TypeInfo.int8 ({-# SCC "int8.int" #-} Binary.int) -- | -- Decoder of the @FLOAT4@ values. {-# INLINEABLE float4 #-} float4 :: Value Float-float4 = primitive "float4" CodecVocab.TypeInfo.float4 Binary.float4+float4 = primitive "float4" CodecsVocab.TypeInfo.float4 Binary.float4 -- | -- Decoder of the @FLOAT8@ values. {-# INLINEABLE float8 #-} float8 :: Value Double-float8 = primitive "float8" CodecVocab.TypeInfo.float8 Binary.float8+float8 = primitive "float8" CodecsVocab.TypeInfo.float8 Binary.float8 -- | -- Decoder of the @NUMERIC@ values. {-# INLINEABLE numeric #-} numeric :: Value Scientific-numeric = primitive "numeric" CodecVocab.TypeInfo.numeric Binary.numeric+numeric = primitive "numeric" CodecsVocab.TypeInfo.numeric Binary.numeric -- | -- Decoder of the @CHAR@ values. -- Note that it supports Unicode values. {-# INLINEABLE char #-} char :: Value Char-char = primitive "char" CodecVocab.TypeInfo.char Binary.char+char = primitive "char" CodecsVocab.TypeInfo.char Binary.char -- | -- Decoder of the @TEXT@ values. {-# INLINEABLE text #-} text :: Value Text-text = primitive "text" CodecVocab.TypeInfo.text Binary.text_strict+text = primitive "text" CodecsVocab.TypeInfo.text Binary.text_strict -- | -- Decoder of the @VARCHAR@ values. {-# INLINEABLE varchar #-} varchar :: Value Text-varchar = primitive "varchar" CodecVocab.TypeInfo.varchar Binary.text_strict+varchar = primitive "varchar" CodecsVocab.TypeInfo.varchar Binary.text_strict -- | -- Decoder of @BPCHAR@ or @CHAR(n)@, @CHARACTER(n)@ values. {-# INLINEABLE bpchar #-} bpchar :: Value Text-bpchar = primitive "bpchar" CodecVocab.TypeInfo.bpchar Binary.text_strict+bpchar = primitive "bpchar" CodecsVocab.TypeInfo.bpchar Binary.text_strict -- | -- Decoder of the @BYTEA@ values. {-# INLINEABLE bytea #-} bytea :: Value ByteString-bytea = primitive "bytea" CodecVocab.TypeInfo.bytea Binary.bytea_strict+bytea = primitive "bytea" CodecsVocab.TypeInfo.bytea Binary.bytea_strict -- | -- Decoder of the @DATE@ values. {-# INLINEABLE date #-} date :: Value Day-date = primitive "date" CodecVocab.TypeInfo.date Binary.date+date = primitive "date" CodecsVocab.TypeInfo.date Binary.date -- | -- Decoder of the @TIMESTAMP@ values. {-# INLINEABLE timestamp #-} timestamp :: Value LocalTime-timestamp = primitive "timestamp" CodecVocab.TypeInfo.timestamp Binary.timestamp_int+timestamp = primitive "timestamp" CodecsVocab.TypeInfo.timestamp Binary.timestamp_int -- | -- Decoder of the @TIMESTAMPTZ@ values.@@ -195,13 +195,13 @@ -- and communicates with Postgres using the UTC values directly. {-# INLINEABLE timestamptz #-} timestamptz :: Value UTCTime-timestamptz = primitive "timestamptz" CodecVocab.TypeInfo.timestamptz Binary.timestamptz_int+timestamptz = primitive "timestamptz" CodecsVocab.TypeInfo.timestamptz Binary.timestamptz_int -- | -- Decoder of the @TIME@ values. {-# INLINEABLE time #-} time :: Value TimeOfDay-time = primitive "time" CodecVocab.TypeInfo.time Binary.time_int+time = primitive "time" CodecsVocab.TypeInfo.time Binary.time_int -- | -- Decoder of the @TIMETZ@ values.@@ -213,25 +213,25 @@ -- to represent a value on the Haskell's side. {-# INLINEABLE timetz #-} timetz :: Value (TimeOfDay, TimeZone)-timetz = primitive "timetz" CodecVocab.TypeInfo.timetz Binary.timetz_int+timetz = primitive "timetz" CodecsVocab.TypeInfo.timetz Binary.timetz_int -- | -- Decoder of the @INTERVAL@ values. {-# INLINEABLE interval #-} interval :: Value DiffTime-interval = primitive "interval" CodecVocab.TypeInfo.interval Binary.interval_int+interval = primitive "interval" CodecsVocab.TypeInfo.interval Binary.interval_int -- | -- Decoder of the @UUID@ values. {-# INLINEABLE uuid #-} uuid :: Value UUID-uuid = primitive "uuid" CodecVocab.TypeInfo.uuid Binary.uuid+uuid = primitive "uuid" CodecsVocab.TypeInfo.uuid Binary.uuid -- | -- Decoder of the @INET@ values. {-# INLINEABLE inet #-} inet :: Value Iproute.IPRange-inet = primitive "inet" CodecVocab.TypeInfo.inet Binary.inet+inet = primitive "inet" CodecsVocab.TypeInfo.inet Binary.inet -- | -- Decoder of the @MACADDR@ values.@@ -242,103 +242,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" CodecVocab.TypeInfo.macaddr Binary.macaddr+macaddr = primitive "macaddr" CodecsVocab.TypeInfo.macaddr Binary.macaddr -- | -- Decoder of the @JSON@ values into a JSON AST. {-# INLINEABLE json #-} json :: Value Aeson.Value-json = primitive "json" CodecVocab.TypeInfo.json Binary.json_ast+json = primitive "json" CodecsVocab.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" CodecVocab.TypeInfo.json (Binary.json_bytes fn)+jsonBytes fn = primitive "json" CodecsVocab.TypeInfo.json (Binary.json_bytes fn) -- | -- Decoder of the @JSONB@ values into a JSON AST. {-# INLINEABLE jsonb #-} jsonb :: Value Aeson.Value-jsonb = primitive "jsonb" CodecVocab.TypeInfo.jsonb Binary.jsonb_ast+jsonb = primitive "jsonb" CodecsVocab.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" CodecVocab.TypeInfo.jsonb (Binary.jsonb_bytes fn)+jsonbBytes fn = primitive "jsonb" CodecsVocab.TypeInfo.jsonb (Binary.jsonb_bytes fn) -- | -- Decoder of the @INT4RANGE@ values. {-# INLINEABLE int4range #-} int4range :: Value (R.Range Int32)-int4range = primitive "int4range" CodecVocab.TypeInfo.int4range Binary.int4range+int4range = primitive "int4range" CodecsVocab.TypeInfo.int4range Binary.int4range -- | -- Decoder of the @INT8RANGE@ values. {-# INLINEABLE int8range #-} int8range :: Value (R.Range Int64)-int8range = primitive "int8range" CodecVocab.TypeInfo.int8range Binary.int8range+int8range = primitive "int8range" CodecsVocab.TypeInfo.int8range Binary.int8range -- | -- Decoder of the @NUMRANGE@ values. {-# INLINEABLE numrange #-} numrange :: Value (R.Range Scientific)-numrange = primitive "numrange" CodecVocab.TypeInfo.numrange Binary.numrange+numrange = primitive "numrange" CodecsVocab.TypeInfo.numrange Binary.numrange -- | -- Decoder of the @TSRANGE@ values. {-# INLINEABLE tsrange #-} tsrange :: Value (R.Range LocalTime)-tsrange = primitive "tsrange" CodecVocab.TypeInfo.tsrange Binary.tsrange_int+tsrange = primitive "tsrange" CodecsVocab.TypeInfo.tsrange Binary.tsrange_int -- | -- Decoder of the @TSTZRANGE@ values. {-# INLINEABLE tstzrange #-} tstzrange :: Value (R.Range UTCTime)-tstzrange = primitive "tstzrange" CodecVocab.TypeInfo.tstzrange Binary.tstzrange_int+tstzrange = primitive "tstzrange" CodecsVocab.TypeInfo.tstzrange Binary.tstzrange_int -- | -- Decoder of the @DATERANGE@ values. {-# INLINEABLE daterange #-} daterange :: Value (R.Range Day)-daterange = primitive "daterange" CodecVocab.TypeInfo.daterange Binary.daterange+daterange = primitive "daterange" CodecsVocab.TypeInfo.daterange Binary.daterange -- | -- Decoder of the @INT4MULTIRANGE@ values. {-# INLINEABLE int4multirange #-} int4multirange :: Value (R.Multirange Int32)-int4multirange = primitive "int4multirange" CodecVocab.TypeInfo.int4multirange Binary.int4multirange+int4multirange = primitive "int4multirange" CodecsVocab.TypeInfo.int4multirange Binary.int4multirange -- | -- Decoder of the @INT8MULTIRANGE@ values. {-# INLINEABLE int8multirange #-} int8multirange :: Value (R.Multirange Int64)-int8multirange = primitive "int8multirange" CodecVocab.TypeInfo.int8multirange Binary.int8multirange+int8multirange = primitive "int8multirange" CodecsVocab.TypeInfo.int8multirange Binary.int8multirange -- | -- Decoder of the @NUMMULTIRANGE@ values. {-# INLINEABLE nummultirange #-} nummultirange :: Value (R.Multirange Scientific)-nummultirange = primitive "nummultirange" CodecVocab.TypeInfo.nummultirange Binary.nummultirange+nummultirange = primitive "nummultirange" CodecsVocab.TypeInfo.nummultirange Binary.nummultirange -- | -- Decoder of the @TSMULTIRANGE@ values. {-# INLINEABLE tsmultirange #-} tsmultirange :: Value (R.Multirange LocalTime)-tsmultirange = primitive "tsmultirange" CodecVocab.TypeInfo.tsmultirange Binary.tsmultirange_int+tsmultirange = primitive "tsmultirange" CodecsVocab.TypeInfo.tsmultirange Binary.tsmultirange_int -- | -- Decoder of the @TSTZMULTIRANGE@ values. {-# INLINEABLE tstzmultirange #-} tstzmultirange :: Value (R.Multirange UTCTime)-tstzmultirange = primitive "tstzmultirange" CodecVocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int+tstzmultirange = primitive "tstzmultirange" CodecsVocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int -- | -- Decoder of the @DATEMULTIRANGE@ values. {-# INLINEABLE datemultirange #-} datemultirange :: Value (R.Multirange Day)-datemultirange = primitive "datemultirange" CodecVocab.TypeInfo.datemultirange Binary.datemultirange+datemultirange = primitive "datemultirange" CodecsVocab.TypeInfo.datemultirange Binary.datemultirange -- | -- Decoder of the @CITEXT@ values.@@ -382,9 +382,9 @@ (fmap fst staticOids) (fmap snd staticOids) 0- (ToBeResolved.ToBeResolved (fmap CodecVocab.QualifiedTypeName.fromNameTuple requestedTypes) (\lookup -> Binary.fn (fn (toTuple . lookup . CodecVocab.QualifiedTypeName.fromNameTuple))))+ (ToBeResolved.ToBeResolved (fmap CodecsVocab.QualifiedTypeName.fromNameTuple requestedTypes) (\lookup -> Binary.fn (fn (toTuple . lookup . CodecsVocab.QualifiedTypeName.fromNameTuple)))) where- toTuple typeInfo = (CodecVocab.TypeInfo.toBaseOid typeInfo, CodecVocab.TypeInfo.toArrayOid typeInfo)+ toTuple typeInfo = (CodecsVocab.TypeInfo.toBaseOid typeInfo, CodecsVocab.TypeInfo.toArrayOid typeInfo) -- | -- Refine a value decoder, lifting the possible error to the session level.@@ -443,7 +443,7 @@ toArrayOid :: Value a -> Maybe Word32 toArrayOid (Value _ _ _ oid _ _) = oid -toDecoder :: Value a -> ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Value a)+toDecoder :: Value a -> ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (Binary.Value a) toDecoder (Value _ _ _ _ _ decoder) = decoder isArray :: Value a -> Bool
src/library/Hasql/Codecs/Encoders.hs view
@@ -77,13 +77,13 @@ ) where -import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Hasql.Codecs.Encoders.Array qualified as Array import Hasql.Codecs.Encoders.Composite qualified as Composite 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.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Platform.Prelude hiding (bool) import Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Encoding qualified as Binary@@ -121,8 +121,8 @@ encoder = case scalarOidIfKnown of Just oid -> fmap (toEncoder oid) arrayEncoder Nothing ->- (\typeInfo -> toEncoder (CodecVocab.TypeInfo.toBaseOid typeInfo))- <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName baseTypeSchema baseTypeName)+ (\typeInfo -> toEncoder (CodecsVocab.TypeInfo.toBaseOid typeInfo))+ <$> ToBeResolved.lookup (CodecsVocab.QualifiedTypeName.QualifiedTypeName baseTypeSchema baseTypeName) <*> arrayEncoder in Value.Value baseTypeSchema baseTypeName scalarOidIfKnown arrayOidIfKnown dimensionality False encoder renderer
src/library/Hasql/Codecs/Encoders/Array.hs view
@@ -1,9 +1,9 @@ module Hasql.Codecs.Encoders.Array where -import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot import Hasql.Codecs.Encoders.Value qualified as Value+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Platform.Prelude import Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Encoding qualified as Binary@@ -36,7 +36,7 @@ -- | OID of the array type. (Maybe Word32) -- | Serialization function, deferring the names of types that must be looked up at runtime.- (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (a -> Binary.Array))+ (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (a -> Binary.Array)) -- | Render function for error messages. (a -> TextBuilder.TextBuilder)
src/library/Hasql/Codecs/Encoders/Composite.hs view
@@ -1,9 +1,9 @@ module Hasql.Codecs.Encoders.Composite where -import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot import Hasql.Codecs.Encoders.Value qualified as Value+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Platform.Prelude hiding (bool) import Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Encoding qualified as Binary@@ -14,7 +14,7 @@ data Composite a = Composite -- | Serialization function, deferring the names of types that must be looked up at runtime.- (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (a -> Binary.Composite))+ (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (a -> Binary.Composite)) -- | Render function for error messages. (a -> [TextBuilder.TextBuilder]) @@ -53,8 +53,8 @@ Composite (fmap (toField oid) serialize) (\val -> [print val]) Nothing -> Composite- ( (\typeInfo -> toField (if dimensionality == 0 then CodecVocab.TypeInfo.toBaseOid typeInfo else CodecVocab.TypeInfo.toArrayOid typeInfo))- <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)+ ( (\typeInfo -> toField (if dimensionality == 0 then CodecsVocab.TypeInfo.toBaseOid typeInfo else CodecsVocab.TypeInfo.toArrayOid typeInfo))+ <$> ToBeResolved.lookup (CodecsVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) <*> serialize ) (\val -> [print val])@@ -66,8 +66,8 @@ Composite (fmap (toField oid) serialize) (maybe ["NULL"] (\val -> [print val])) Nothing -> Composite- ( (\typeInfo -> toField (if dimensionality == 0 then CodecVocab.TypeInfo.toBaseOid typeInfo else CodecVocab.TypeInfo.toArrayOid typeInfo))- <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)+ ( (\typeInfo -> toField (if dimensionality == 0 then CodecsVocab.TypeInfo.toBaseOid typeInfo else CodecsVocab.TypeInfo.toArrayOid typeInfo))+ <$> ToBeResolved.lookup (CodecsVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) <*> serialize ) (maybe ["NULL"] (\val -> [print val]))
src/library/Hasql/Codecs/Encoders/Params.hs view
@@ -9,13 +9,13 @@ ) where -import CodecVocab qualified as CodecVocab-import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeRef qualified as CodecVocab.TypeRef-import CodecVocab.TypeShape (TypeShape (..)) import Data.Vector qualified as Vector import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot import Hasql.Codecs.Encoders.Value qualified as Value+import Hasql.CodecsVocab qualified as CodecsVocab+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeRef qualified as CodecsVocab.TypeRef+import Hasql.CodecsVocab.TypeShape (TypeShape (..)) import Hasql.Platform.Prelude import Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Encoding qualified as Binary@@ -28,12 +28,12 @@ freezeColumnsMetadata = Vector.fromList . toList -toUnknownTypes :: Params a -> HashSet CodecVocab.QualifiedTypeName+toUnknownTypes :: Params a -> HashSet CodecsVocab.QualifiedTypeName toUnknownTypes (Params _ (ToBeResolved.ToBeResolved unknownTypes _) _ _) = fromList unknownTypes -- | Serialise params to encoded wire values given a resolver of type names to their OIDs.-toSerializer :: Params a -> (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) -> a -> [Maybe ByteString]+toSerializer :: Params a -> (CodecsVocab.QualifiedTypeName -> CodecsVocab.TypeInfo) -> a -> [Maybe ByteString] toSerializer (Params _ (ToBeResolved.ToBeResolved _ serializer) _ _) resolve = serializer resolve -- | Render params in human-readable form (for error reporting).@@ -87,7 +87,7 @@ data Params a = Params { size :: Int, -- | Serialization function, deferring the names of types that must be looked up at runtime.- request :: ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName CodecVocab.TypeInfo (a -> [Maybe ByteString]),+ request :: ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName CodecsVocab.TypeInfo (a -> [Maybe ByteString]), -- | Type shape for each parameter. columnsMetadata :: DList TypeShape, printer :: a -> DList Text@@ -146,15 +146,15 @@ Params { size, request = toRequest serialize,- columnsMetadata = pure (TypeShape (CodecVocab.TypeRef.KnownOid oid) dimensionality textFormat),+ columnsMetadata = pure (TypeShape (CodecsVocab.TypeRef.KnownOid oid) dimensionality textFormat), printer } Nothing ->- let key = CodecVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName+ let key = CodecsVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName in Params { size, request = toRequest (ToBeResolved.lookup key *> serialize),- columnsMetadata = pure (TypeShape (CodecVocab.TypeRef.NamedType key) dimensionality textFormat),+ columnsMetadata = pure (TypeShape (CodecsVocab.TypeRef.NamedType key) dimensionality textFormat), printer } @@ -169,15 +169,15 @@ Params { size, request = toRequest serialize,- columnsMetadata = pure (TypeShape (CodecVocab.TypeRef.KnownOid oid) dimensionality textFormat),+ columnsMetadata = pure (TypeShape (CodecsVocab.TypeRef.KnownOid oid) dimensionality textFormat), printer } Nothing ->- let key = CodecVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName+ let key = CodecsVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName in Params { size, request = toRequest (ToBeResolved.lookup key *> serialize),- columnsMetadata = pure (TypeShape (CodecVocab.TypeRef.NamedType key) dimensionality textFormat),+ columnsMetadata = pure (TypeShape (CodecsVocab.TypeRef.NamedType key) dimensionality textFormat), printer }
src/library/Hasql/Codecs/Encoders/Value.hs view
@@ -1,12 +1,12 @@ module Hasql.Codecs.Encoders.Value where import ByteString.StrictBuilder qualified-import CodecVocab qualified as CodecVocab-import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as LazyByteString import Data.IP qualified as Iproute+import Hasql.CodecsVocab qualified as CodecsVocab+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Platform.Prelude import Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Encoding qualified as Binary@@ -33,7 +33,7 @@ -- | Text format? Bool -- | Serialization function, deferring the names of types that must be looked up at runtime.- (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName CodecVocab.TypeInfo (a -> Binary.Encoding))+ (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName CodecsVocab.TypeInfo (a -> Binary.Encoding)) -- | Render function for error messages. (a -> TextBuilder.TextBuilder) @@ -43,13 +43,13 @@ Value schemaName typeName valueOid arrayOid dimensionality textFormat (fmap (\encode -> encode . f) serialize) (render . f) {-# INLINE primitive #-}-primitive :: Text -> Bool -> CodecVocab.TypeInfo -> (a -> Binary.Encoding) -> (a -> TextBuilder.TextBuilder) -> Value a+primitive :: Text -> Bool -> CodecsVocab.TypeInfo -> (a -> Binary.Encoding) -> (a -> TextBuilder.TextBuilder) -> Value a primitive typeName isText typeInfo encode render = Value Nothing typeName- (Just (CodecVocab.TypeInfo.toBaseOid typeInfo))- (Just (CodecVocab.TypeInfo.toArrayOid typeInfo))+ (Just (CodecsVocab.TypeInfo.toBaseOid typeInfo))+ (Just (CodecsVocab.TypeInfo.toArrayOid typeInfo)) 0 isText (pure encode)@@ -59,43 +59,43 @@ -- Encoder of @BOOL@ values. {-# INLINEABLE bool #-} bool :: Value Bool-bool = primitive "bool" False CodecVocab.TypeInfo.bool Binary.bool (TextBuilder.string . show)+bool = primitive "bool" False CodecsVocab.TypeInfo.bool Binary.bool (TextBuilder.string . show) -- | -- Encoder of @INT2@ values. {-# INLINEABLE int2 #-} int2 :: Value Int16-int2 = primitive "int2" False CodecVocab.TypeInfo.int2 Binary.int2_int16 (TextBuilder.string . show)+int2 = primitive "int2" False CodecsVocab.TypeInfo.int2 Binary.int2_int16 (TextBuilder.string . show) -- | -- Encoder of @INT4@ values. {-# INLINEABLE int4 #-} int4 :: Value Int32-int4 = primitive "int4" False CodecVocab.TypeInfo.int4 Binary.int4_int32 (TextBuilder.string . show)+int4 = primitive "int4" False CodecsVocab.TypeInfo.int4 Binary.int4_int32 (TextBuilder.string . show) -- | -- Encoder of @INT8@ values. {-# INLINEABLE int8 #-} int8 :: Value Int64-int8 = primitive "int8" False CodecVocab.TypeInfo.int8 Binary.int8_int64 (TextBuilder.string . show)+int8 = primitive "int8" False CodecsVocab.TypeInfo.int8 Binary.int8_int64 (TextBuilder.string . show) -- | -- Encoder of @FLOAT4@ values. {-# INLINEABLE float4 #-} float4 :: Value Float-float4 = primitive "float4" False CodecVocab.TypeInfo.float4 Binary.float4 (TextBuilder.string . show)+float4 = primitive "float4" False CodecsVocab.TypeInfo.float4 Binary.float4 (TextBuilder.string . show) -- | -- Encoder of @FLOAT8@ values. {-# INLINEABLE float8 #-} float8 :: Value Double-float8 = primitive "float8" False CodecVocab.TypeInfo.float8 Binary.float8 (TextBuilder.string . show)+float8 = primitive "float8" False CodecsVocab.TypeInfo.float8 Binary.float8 (TextBuilder.string . show) -- | -- Encoder of @NUMERIC@ values. {-# INLINEABLE numeric #-} numeric :: Value Scientific-numeric = primitive "numeric" False CodecVocab.TypeInfo.numeric Binary.numeric (TextBuilder.string . show)+numeric = primitive "numeric" False CodecsVocab.TypeInfo.numeric Binary.numeric (TextBuilder.string . show) -- | -- Encoder of @CHAR@ values.@@ -104,79 +104,79 @@ -- identifies itself under the @TEXT@ OID because of that. {-# INLINEABLE char #-} char :: Value Char-char = primitive "char" False CodecVocab.TypeInfo.text Binary.char_utf8 (TextBuilder.string . show)+char = primitive "char" False CodecsVocab.TypeInfo.text Binary.char_utf8 (TextBuilder.string . show) -- | -- Encoder of @TEXT@ values. {-# INLINEABLE text #-} text :: Value Text-text = primitive "text" False CodecVocab.TypeInfo.text Binary.text_strict (TextBuilder.string . show)+text = primitive "text" False CodecsVocab.TypeInfo.text Binary.text_strict (TextBuilder.string . show) -- | -- Encoder of @VARCHAR@ values. {-# INLINEABLE varchar #-} varchar :: Value Text-varchar = primitive "varchar" False CodecVocab.TypeInfo.varchar Binary.text_strict (TextBuilder.string . show)+varchar = primitive "varchar" False CodecsVocab.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 CodecVocab.TypeInfo.bpchar Binary.text_strict (TextBuilder.string . show)+bpchar = primitive "bpchar" False CodecsVocab.TypeInfo.bpchar Binary.text_strict (TextBuilder.string . show) -- | -- Encoder of @BYTEA@ values. {-# INLINEABLE bytea #-} bytea :: Value ByteString-bytea = primitive "bytea" False CodecVocab.TypeInfo.bytea Binary.bytea_strict (TextBuilder.string . show)+bytea = primitive "bytea" False CodecsVocab.TypeInfo.bytea Binary.bytea_strict (TextBuilder.string . show) -- | -- Encoder of @DATE@ values. {-# INLINEABLE date #-} date :: Value Day-date = primitive "date" False CodecVocab.TypeInfo.date Binary.date (TextBuilder.string . show)+date = primitive "date" False CodecsVocab.TypeInfo.date Binary.date (TextBuilder.string . show) -- | -- Encoder of @TIMESTAMP@ values. {-# INLINEABLE timestamp #-} timestamp :: Value LocalTime-timestamp = primitive "timestamp" False CodecVocab.TypeInfo.timestamp Binary.timestamp_int (TextBuilder.string . show)+timestamp = primitive "timestamp" False CodecsVocab.TypeInfo.timestamp Binary.timestamp_int (TextBuilder.string . show) -- | -- Encoder of @TIMESTAMPTZ@ values. {-# INLINEABLE timestamptz #-} timestamptz :: Value UTCTime-timestamptz = primitive "timestamptz" False CodecVocab.TypeInfo.timestamptz Binary.timestamptz_int (TextBuilder.string . show)+timestamptz = primitive "timestamptz" False CodecsVocab.TypeInfo.timestamptz Binary.timestamptz_int (TextBuilder.string . show) -- | -- Encoder of @TIME@ values. {-# INLINEABLE time #-} time :: Value TimeOfDay-time = primitive "time" False CodecVocab.TypeInfo.time Binary.time_int (TextBuilder.string . show)+time = primitive "time" False CodecsVocab.TypeInfo.time Binary.time_int (TextBuilder.string . show) -- | -- Encoder of @TIMETZ@ values. {-# INLINEABLE timetz #-} timetz :: Value (TimeOfDay, TimeZone)-timetz = primitive "timetz" False CodecVocab.TypeInfo.timetz Binary.timetz_int (TextBuilder.string . show)+timetz = primitive "timetz" False CodecsVocab.TypeInfo.timetz Binary.timetz_int (TextBuilder.string . show) -- | -- Encoder of @INTERVAL@ values. {-# INLINEABLE interval #-} interval :: Value DiffTime-interval = primitive "interval" False CodecVocab.TypeInfo.interval Binary.interval_int (TextBuilder.string . show)+interval = primitive "interval" False CodecsVocab.TypeInfo.interval Binary.interval_int (TextBuilder.string . show) -- | -- Encoder of @UUID@ values. {-# INLINEABLE uuid #-} uuid :: Value UUID-uuid = primitive "uuid" False CodecVocab.TypeInfo.uuid Binary.uuid (TextBuilder.string . show)+uuid = primitive "uuid" False CodecsVocab.TypeInfo.uuid Binary.uuid (TextBuilder.string . show) -- | -- Encoder of @INET@ values. {-# INLINEABLE inet #-} inet :: Value Iproute.IPRange-inet = primitive "inet" False CodecVocab.TypeInfo.inet Binary.inet (TextBuilder.string . show)+inet = primitive "inet" False CodecsVocab.TypeInfo.inet Binary.inet (TextBuilder.string . show) -- | -- Encoder of @MACADDR@ values.@@ -187,127 +187,127 @@ -- > toOctets >$< macaddr {-# INLINEABLE macaddr #-} macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)-macaddr = primitive "macaddr" False CodecVocab.TypeInfo.macaddr Binary.macaddr (TextBuilder.string . show)+macaddr = primitive "macaddr" False CodecsVocab.TypeInfo.macaddr Binary.macaddr (TextBuilder.string . show) -- | -- Encoder of @JSON@ values from JSON AST. {-# INLINEABLE json #-} json :: Value Aeson.Value-json = primitive "json" False CodecVocab.TypeInfo.json Binary.json_ast (TextBuilder.string . show)+json = primitive "json" False CodecsVocab.TypeInfo.json Binary.json_ast (TextBuilder.string . show) -- | -- Encoder of @JSON@ values from raw JSON. {-# INLINEABLE jsonBytes #-} jsonBytes :: Value ByteString-jsonBytes = primitive "json" False CodecVocab.TypeInfo.json Binary.json_bytes (TextBuilder.string . show)+jsonBytes = primitive "json" False CodecsVocab.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 CodecVocab.TypeInfo.json Binary.json_bytes_lazy (TextBuilder.string . show)+jsonLazyBytes = primitive "json" False CodecsVocab.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 CodecVocab.TypeInfo.jsonb Binary.jsonb_ast (TextBuilder.string . show)+jsonb = primitive "jsonb" False CodecsVocab.TypeInfo.jsonb Binary.jsonb_ast (TextBuilder.string . show) -- | -- Encoder of @JSONB@ values from raw JSON. {-# INLINEABLE jsonbBytes #-} jsonbBytes :: Value ByteString-jsonbBytes = primitive "jsonb" False CodecVocab.TypeInfo.jsonb Binary.jsonb_bytes (TextBuilder.string . show)+jsonbBytes = primitive "jsonb" False CodecsVocab.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 CodecVocab.TypeInfo.jsonb Binary.jsonb_bytes_lazy (TextBuilder.string . show)+jsonbLazyBytes = primitive "jsonb" False CodecsVocab.TypeInfo.jsonb Binary.jsonb_bytes_lazy (TextBuilder.string . show) -- | -- Encoder of @OID@ values. {-# INLINEABLE oid #-} oid :: Value Int32-oid = primitive "oid" False CodecVocab.TypeInfo.oid Binary.int4_int32 (TextBuilder.string . show)+oid = primitive "oid" False CodecsVocab.TypeInfo.oid Binary.int4_int32 (TextBuilder.string . show) -- | -- Encoder of @NAME@ values. {-# INLINEABLE name #-} name :: Value Text-name = primitive "name" False CodecVocab.TypeInfo.name Binary.text_strict (TextBuilder.string . show)+name = primitive "name" False CodecsVocab.TypeInfo.name Binary.text_strict (TextBuilder.string . show) -- | -- Encoder of @INT4RANGE@ values. {-# INLINEABLE int4range #-} int4range :: Value (Range.Range Int32)-int4range = primitive "int4range" False CodecVocab.TypeInfo.int4range Binary.int4range (TextBuilder.string . show)+int4range = primitive "int4range" False CodecsVocab.TypeInfo.int4range Binary.int4range (TextBuilder.string . show) -- | -- Encoder of @INT8RANGE@ values. {-# INLINEABLE int8range #-} int8range :: Value (Range.Range Int64)-int8range = primitive "int8range" False CodecVocab.TypeInfo.int8range Binary.int8range (TextBuilder.string . show)+int8range = primitive "int8range" False CodecsVocab.TypeInfo.int8range Binary.int8range (TextBuilder.string . show) -- | -- Encoder of @NUMRANGE@ values. {-# INLINEABLE numrange #-} numrange :: Value (Range.Range Scientific)-numrange = primitive "numrange" False CodecVocab.TypeInfo.numrange Binary.numrange (TextBuilder.string . show)+numrange = primitive "numrange" False CodecsVocab.TypeInfo.numrange Binary.numrange (TextBuilder.string . show) -- | -- Encoder of @TSRANGE@ values. {-# INLINEABLE tsrange #-} tsrange :: Value (Range.Range LocalTime)-tsrange = primitive "tsrange" False CodecVocab.TypeInfo.tsrange Binary.tsrange_int (TextBuilder.string . show)+tsrange = primitive "tsrange" False CodecsVocab.TypeInfo.tsrange Binary.tsrange_int (TextBuilder.string . show) -- | -- Encoder of @TSTZRANGE@ values. {-# INLINEABLE tstzrange #-} tstzrange :: Value (Range.Range UTCTime)-tstzrange = primitive "tstzrange" False CodecVocab.TypeInfo.tstzrange Binary.tstzrange_int (TextBuilder.string . show)+tstzrange = primitive "tstzrange" False CodecsVocab.TypeInfo.tstzrange Binary.tstzrange_int (TextBuilder.string . show) -- | -- Encoder of @DATERANGE@ values. {-# INLINEABLE daterange #-} daterange :: Value (Range.Range Day)-daterange = primitive "daterange" False CodecVocab.TypeInfo.daterange Binary.daterange (TextBuilder.string . show)+daterange = primitive "daterange" False CodecsVocab.TypeInfo.daterange Binary.daterange (TextBuilder.string . show) -- | -- Encoder of @INT4MULTIRANGE@ values. {-# INLINEABLE int4multirange #-} int4multirange :: Value (Range.Multirange Int32)-int4multirange = primitive "int4multirange" False CodecVocab.TypeInfo.int4multirange Binary.int4multirange (TextBuilder.string . show)+int4multirange = primitive "int4multirange" False CodecsVocab.TypeInfo.int4multirange Binary.int4multirange (TextBuilder.string . show) -- | -- Encoder of @INT8MULTIRANGE@ values. {-# INLINEABLE int8multirange #-} int8multirange :: Value (Range.Multirange Int64)-int8multirange = primitive "int8multirange" False CodecVocab.TypeInfo.int8multirange Binary.int8multirange (TextBuilder.string . show)+int8multirange = primitive "int8multirange" False CodecsVocab.TypeInfo.int8multirange Binary.int8multirange (TextBuilder.string . show) -- | -- Encoder of @NUMMULTIRANGE@ values. {-# INLINEABLE nummultirange #-} nummultirange :: Value (Range.Multirange Scientific)-nummultirange = primitive "nummultirange" False CodecVocab.TypeInfo.nummultirange Binary.nummultirange (TextBuilder.string . show)+nummultirange = primitive "nummultirange" False CodecsVocab.TypeInfo.nummultirange Binary.nummultirange (TextBuilder.string . show) -- | -- Encoder of @TSMULTIRANGE@ values. {-# INLINEABLE tsmultirange #-} tsmultirange :: Value (Range.Multirange LocalTime)-tsmultirange = primitive "tsmultirange" False CodecVocab.TypeInfo.tsmultirange Binary.tsmultirange_int (TextBuilder.string . show)+tsmultirange = primitive "tsmultirange" False CodecsVocab.TypeInfo.tsmultirange Binary.tsmultirange_int (TextBuilder.string . show) -- | -- Encoder of @TSTZMULTIRANGE@ values. {-# INLINEABLE tstzmultirange #-} tstzmultirange :: Value (Range.Multirange UTCTime)-tstzmultirange = primitive "tstzmultirange" False CodecVocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int (TextBuilder.string . show)+tstzmultirange = primitive "tstzmultirange" False CodecsVocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int (TextBuilder.string . show) -- | -- Encoder of @DATEMULTIRANGE@ values. {-# INLINEABLE datemultirange #-} datemultirange :: Value (Range.Multirange Day)-datemultirange = primitive "datemultirange" False CodecVocab.TypeInfo.datemultirange Binary.datemultirange (TextBuilder.string . show)+datemultirange = primitive "datemultirange" False CodecsVocab.TypeInfo.datemultirange Binary.datemultirange (TextBuilder.string . show) -- | -- Encoder of @CITEXT@ values.@@ -346,7 +346,7 @@ Nothing 0 False- (fmap (\_typeInfo -> Binary.text_strict . mapping) (ToBeResolved.lookup (CodecVocab.QualifiedTypeName schemaName typeName)))+ (fmap (\_typeInfo -> Binary.text_strict . mapping) (ToBeResolved.lookup (CodecsVocab.QualifiedTypeName schemaName typeName))) (TextBuilder.text . mapping) -- |@@ -363,7 +363,7 @@ {-# DEPRECATED unknown "Use 'custom' instead." #-} {-# INLINEABLE unknown #-} unknown :: Value ByteString-unknown = primitive "unknown" True CodecVocab.TypeInfo.unknown Binary.bytea_strict (TextBuilder.string . show)+unknown = primitive "unknown" True CodecsVocab.TypeInfo.unknown Binary.bytea_strict (TextBuilder.string . show) -- | -- Low level API for defining custom value encoders.@@ -403,13 +403,13 @@ 0 False ( ToBeResolved.ToBeResolved- (fmap CodecVocab.QualifiedTypeName.fromNameTuple requiredTypes)+ (fmap CodecsVocab.QualifiedTypeName.fromNameTuple requiredTypes) ( \resolve -> ByteString.StrictBuilder.bytes . encode ( \name ->- let typeInfo = resolve (CodecVocab.QualifiedTypeName.fromNameTuple name)- in (CodecVocab.TypeInfo.toBaseOid typeInfo, CodecVocab.TypeInfo.toArrayOid typeInfo)+ let typeInfo = resolve (CodecsVocab.QualifiedTypeName.fromNameTuple name)+ in (CodecsVocab.TypeInfo.toBaseOid typeInfo, CodecsVocab.TypeInfo.toArrayOid typeInfo) ) ) )
src/library/Hasql/Engine/Contexts/Pipeline.hs view
@@ -5,10 +5,10 @@ ) where -import CodecVocab qualified as CodecVocab-import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet+import Hasql.CodecsVocab qualified as CodecsVocab+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip import Hasql.ConnectionState.OidCache qualified as OidCache import Hasql.ConnectionState.StatementCache qualified as StatementCache@@ -43,7 +43,7 @@ let foundTypes = HashMap.keysSet oidCacheUpdates notFoundTypes = HashSet.difference missingTypes foundTypes in if not (HashSet.null notFoundTypes)- then Left (Errors.MissingTypesSessionError (HashSet.map CodecVocab.QualifiedTypeName.toNameTuple notFoundTypes))+ then Left (Errors.MissingTypesSessionError (HashSet.map CodecsVocab.QualifiedTypeName.toNameTuple notFoundTypes)) else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates) case resolvedOidCache of Left err -> pure (Left err, oidCache, statementCache)@@ -144,7 +144,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 OID 0 for unknown types as a fallback in case of bugs.- (HashSet CodecVocab.QualifiedTypeName)+ (HashSet CodecsVocab.QualifiedTypeName) -- | Function that runs the pipeline. -- -- The integer parameter indicates the current offset of the statement in the pipeline (0-based).
src/library/Hasql/Engine/Contexts/Session.hs view
@@ -1,8 +1,8 @@ module Hasql.Engine.Contexts.Session where -import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip import Hasql.ConnectionState qualified as ConnectionState import Hasql.ConnectionState.OidCache qualified as OidCache@@ -99,7 +99,7 @@ let foundTypes = HashMap.keysSet oidCacheUpdates notFoundTypes = HashSet.difference missingTypes foundTypes in if not (HashSet.null notFoundTypes)- then Left (Errors.MissingTypesSessionError (HashSet.map CodecVocab.QualifiedTypeName.toNameTuple notFoundTypes))+ then Left (Errors.MissingTypesSessionError (HashSet.map CodecsVocab.QualifiedTypeName.toNameTuple notFoundTypes)) else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates) case resolvedOidCache of Left err -> pure (Left err, connectionState)
src/library/Hasql/Engine/Decoders/Result.hs view
@@ -1,7 +1,7 @@ module Hasql.Engine.Decoders.Result where -import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Comms.ResultDecoder qualified as ResultDecoder import Hasql.Engine.Decoders.Row (Row (..)) import Hasql.Engine.Decoders.Row qualified as Row@@ -11,17 +11,17 @@ -- | -- Decoder of a query result. newtype Result a- = Result (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (ResultDecoder.ResultDecoder a))+ = Result (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (ResultDecoder.ResultDecoder a)) deriving (Functor, Applicative, Filterable)- via (Compose (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo) ResultDecoder.ResultDecoder)+ via (Compose (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo) ResultDecoder.ResultDecoder) -- | Names of types that must be looked up at runtime before the decoder can run.-toUnknownTypes :: Result a -> HashSet CodecVocab.QualifiedTypeName.QualifiedTypeName+toUnknownTypes :: Result a -> HashSet CodecsVocab.QualifiedTypeName.QualifiedTypeName toUnknownTypes (Result (ToBeResolved.ToBeResolved unknownTypes _)) = fromList unknownTypes -- | Resolve the decoder given a resolver of type names to their OIDs.-toBase :: Result a -> (CodecVocab.QualifiedTypeName.QualifiedTypeName -> CodecVocab.TypeInfo.TypeInfo) -> ResultDecoder.ResultDecoder a+toBase :: Result a -> (CodecsVocab.QualifiedTypeName.QualifiedTypeName -> CodecsVocab.TypeInfo.TypeInfo) -> ResultDecoder.ResultDecoder a toBase (Result (ToBeResolved.ToBeResolved _ decoder)) = decoder -- * Construction
src/library/Hasql/Engine/Decoders/Row.hs view
@@ -1,9 +1,9 @@ module Hasql.Engine.Decoders.Row where -import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Hasql.Codecs.Decoders import Hasql.Codecs.Decoders.Value qualified as Value+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Comms.RowDecoder qualified import Hasql.Platform.Prelude import Hasql.ToBeResolved qualified as ToBeResolved@@ -19,14 +19,14 @@ -- x = (,,) '<$>' ('column' . 'nullable') 'int8' '<*>' ('column' . 'nonNullable') 'text' '<*>' ('column' . 'nonNullable') 'time' -- @ newtype Row a- = Row (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Hasql.Comms.RowDecoder.RowDecoder a))+ = Row (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (Hasql.Comms.RowDecoder.RowDecoder a)) deriving (Functor, Applicative, Filterable)- via (Compose (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo) Hasql.Comms.RowDecoder.RowDecoder)+ via (Compose (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo) Hasql.Comms.RowDecoder.RowDecoder) toDecoder :: Row a ->- ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Hasql.Comms.RowDecoder.RowDecoder a)+ ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (Hasql.Comms.RowDecoder.RowDecoder a) toDecoder (Row f) = f -- |@@ -44,7 +44,7 @@ ( \lookupResult decoder -> Hasql.Comms.RowDecoder.nullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder) )- <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))+ <$> ToBeResolved.lookup (CodecsVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder)) <*> Value.toDecoder valueDecoder NonNullable valueDecoder -> Row case Value.toOid valueDecoder of@@ -54,10 +54,10 @@ (Value.toDecoder valueDecoder) Nothing -> (\lookupResult decoder -> Hasql.Comms.RowDecoder.nonNullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder))- <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))+ <$> ToBeResolved.lookup (CodecsVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder)) <*> Value.toDecoder valueDecoder where chooseLookedUpOid valueDecoder typeInfo = if Value.toDimensionality valueDecoder > 0- then CodecVocab.TypeInfo.toArrayOid typeInfo- else CodecVocab.TypeInfo.toBaseOid typeInfo+ then CodecsVocab.TypeInfo.toArrayOid typeInfo+ else CodecsVocab.TypeInfo.toBaseOid typeInfo
src/library/Hasql/Engine/PqProcedures/SelectTypeInfo.hs view
@@ -5,11 +5,11 @@ ) where -import CodecVocab qualified as CodecVocab-import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet+import Hasql.CodecsVocab qualified as CodecsVocab+import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo import Hasql.Comms.ResultDecoder qualified import Hasql.Comms.Roundtrip qualified import Hasql.Comms.RowDecoder qualified@@ -21,12 +21,12 @@ newtype SelectTypeInfo = SelectTypeInfo { -- | Set of (schema name, type name) pairs to look up.- keys :: HashSet CodecVocab.QualifiedTypeName+ keys :: HashSet CodecsVocab.QualifiedTypeName } -- | Result maps (schema name, type name) pairs to TypeInfo (scalar OID, array OID). type SelectTypeInfoResult =- HashMap CodecVocab.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo+ HashMap CodecsVocab.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo run :: Pq.Connection -> SelectTypeInfo -> IO (Either Errors.SessionError SelectTypeInfoResult) run connection (SelectTypeInfo keys) =@@ -78,7 +78,7 @@ -- Text OID is 25; text-array OID is 1009. encodeParams :: SelectTypeInfo -> [Maybe (Word32, ByteString, Pq.Format)] encodeParams (SelectTypeInfo keys) =- let (schemaNames, typeNames) = unzip (fmap CodecVocab.QualifiedTypeName.toNameTuple (HashSet.toList keys))+ let (schemaNames, typeNames) = unzip (fmap CodecsVocab.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 (1009, schemaArray, Pq.Binary),@@ -97,7 +97,7 @@ Hasql.Comms.ResultDecoder.foldl step HashMap.empty rowDecoder where step acc (schemaName, typeName, typeOid, arrayOid) =- HashMap.insert (CodecVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) (CodecVocab.TypeInfo.TypeInfo typeOid arrayOid) acc+ HashMap.insert (CodecsVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) (CodecsVocab.TypeInfo.TypeInfo typeOid arrayOid) acc -- | These four columns have permanently fixed, well-known Postgres OIDs -- (text = 25, int4 = 23), so they're decoded directly against
src/library/Hasql/Engine/Statement.hs view
@@ -9,14 +9,14 @@ ) where -import CodecVocab qualified as CodecVocab-import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo-import CodecVocab.TypeRef qualified as CodecVocab.TypeRef-import CodecVocab.TypeShape (TypeShape (..)) import Data.Text.Encoding qualified as TextEncoding import Data.Vector qualified as Vector import Hasql.Codecs.Encoders qualified as Encoders import Hasql.Codecs.Encoders.Params qualified as Params+import Hasql.CodecsVocab qualified as CodecsVocab+import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo+import Hasql.CodecsVocab.TypeRef qualified as CodecsVocab.TypeRef+import Hasql.CodecsVocab.TypeShape (TypeShape (..)) import Hasql.Comms.ResultDecoder qualified as ResultDecoder import Hasql.Engine.Decoders.Result qualified as Decoders import Hasql.Engine.Decoders.Result qualified as Decoders.Result@@ -52,13 +52,13 @@ -- Produced once at construction from the Params DList and reused across executions. columnsMetadata :: Vector TypeShape, -- | Serialise params to encoded wire values given a resolver of type names to their OIDs.- serializer :: (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) -> params -> [Maybe ByteString],+ serializer :: (CodecsVocab.QualifiedTypeName -> CodecsVocab.TypeInfo) -> 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 CodecVocab.QualifiedTypeName,+ unknownTypes :: HashSet CodecsVocab.QualifiedTypeName, -- | Result decoder, given a resolver of type names to their OIDs.- decoder :: (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) -> ResultDecoder.ResultDecoder result,+ decoder :: (CodecsVocab.QualifiedTypeName -> CodecsVocab.TypeInfo) -> ResultDecoder.ResultDecoder result, -- | Whether this statement may be prepared on the server. isPrepared :: Bool }@@ -148,7 +148,7 @@ -- | Compile prepared-statement data: resolve OIDs and pair encoded values with their format flags. compilePreparedStatementData :: Statement params result ->- (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) ->+ (CodecsVocab.QualifiedTypeName -> CodecsVocab.TypeInfo) -> params -> ([Word32], [Maybe (ByteString, Bool)]) compilePreparedStatementData stmt resolve params =@@ -161,7 +161,7 @@ -- | Compile unprepared-statement data: resolve OIDs inline with encoded values. compileUnpreparedStatementData :: Statement params result ->- (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) ->+ (CodecsVocab.QualifiedTypeName -> CodecsVocab.TypeInfo) -> params -> [Maybe (Word32, ByteString, Bool)] compileUnpreparedStatementData stmt resolve params =@@ -171,7 +171,7 @@ (serializer stmt resolve params) -- | Resolve a param's wire OID given the dictionary of resolved type names.-resolveOid :: (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) -> CodecVocab.TypeRef.TypeRef -> Word -> Word32-resolveOid resolve (CodecVocab.TypeRef.NamedType name) dim =- (if dim == 0 then CodecVocab.TypeInfo.toBaseOid else CodecVocab.TypeInfo.toArrayOid) (resolve name)-resolveOid _ (CodecVocab.TypeRef.KnownOid oid) _ = oid+resolveOid :: (CodecsVocab.QualifiedTypeName -> CodecsVocab.TypeInfo) -> CodecsVocab.TypeRef.TypeRef -> Word -> Word32+resolveOid resolve (CodecsVocab.TypeRef.NamedType name) dim =+ (if dim == 0 then CodecsVocab.TypeInfo.toBaseOid else CodecsVocab.TypeInfo.toArrayOid) (resolve name)+resolveOid _ (CodecsVocab.TypeRef.KnownOid oid) _ = oid
src/library/Hasql/Errors.hs view
@@ -44,6 +44,23 @@ -- | Whether the error is transient and the operation causing it can be retried. isTransient :: a -> Bool + -- | The SQLSTATE the server reported, if this error carries one at all.+ --+ -- Lets you branch on a PostgreSQL error code without knowing which+ -- constructors of which error type the server error is nested under. For the+ -- code vocabulary see+ -- <https://www.postgresql.org/docs/current/errcodes-appendix.html>.+ --+ -- 'Nothing' means the error carries no server code: a connection failure, a+ -- decoding failure, a driver bug. It never means "the operation succeeded".+ --+ -- The default implementation returns 'Nothing', which is correct only for+ -- error types that can never carry a server error. A type that wraps another+ -- error type MUST override it and delegate to the wrapped value, otherwise it+ -- silently reports 'Nothing' for codes it does in fact carry.+ toSqlState :: a -> Maybe Text+ toSqlState _ = Nothing+ -- | Convert the error to a multiline detailed human-readable text representation containing all details. toDetailedText :: (IsError e) => e -> Text toDetailedText = TextBuilder.toText . toDetailedTextBuilder@@ -110,6 +127,8 @@ isTransient = const False + toSqlState (ServerError code _ _ _ _) = Just code+ instance IsError CellError where toMessage = \case UnexpectedNullCellError ->@@ -164,6 +183,14 @@ isTransient = const False + toSqlState = \case+ ServerStatementError executionError -> toSqlState executionError+ UnexpectedRowCountStatementError {} -> Nothing+ UnexpectedColumnCountStatementError {} -> Nothing+ UnexpectedColumnTypeStatementError {} -> Nothing+ RowStatementError _ rowError -> toSqlState rowError+ UnexpectedResultStatementError {} -> Nothing+ instance IsError RowError where toMessage = \case CellRowError _ _ cellErr ->@@ -224,3 +251,10 @@ ScriptSessionError {} -> False DriverSessionError {} -> False MissingTypesSessionError {} -> False++ toSqlState = \case+ StatementSessionError _ _ _ _ _ statementError -> toSqlState statementError+ ScriptSessionError _ serverError -> toSqlState serverError+ ConnectionSessionError {} -> Nothing+ DriverSessionError {} -> Nothing+ MissingTypesSessionError {} -> Nothing