postgresql-types 0.1.4.0 → 0.1.5.0
raw patch · 90 files changed
+915/−851 lines, 90 filesdep ~postgresql-types-algebraPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: postgresql-types-algebra
API changes (from Hackage documentation)
- PostgresqlTypes.Bit: instance GHC.TypeNats.KnownNat numBits => PostgresqlTypes.Algebra.IsScalar (PostgresqlTypes.Bit.Bit numBits)
- PostgresqlTypes.Bool: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Bool.Bool
- PostgresqlTypes.Box: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Box.Box
- PostgresqlTypes.Bpchar: instance GHC.TypeNats.KnownNat numChars => PostgresqlTypes.Algebra.IsScalar (PostgresqlTypes.Bpchar.Bpchar numChars)
- PostgresqlTypes.Bytea: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Bytea.Bytea
- PostgresqlTypes.Char: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Char.Char
- PostgresqlTypes.Cidr: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Cidr.Cidr
- PostgresqlTypes.Circle: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Circle.Circle
- PostgresqlTypes.Citext: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Citext.Citext
- PostgresqlTypes.Date: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Date.Date
- PostgresqlTypes.Float4: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Float4.Float4
- PostgresqlTypes.Float8: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Float8.Float8
- PostgresqlTypes.Geometry: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Geometry.Geometry
- PostgresqlTypes.Hstore: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Hstore.Hstore
- PostgresqlTypes.Inet: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Inet.Inet
- PostgresqlTypes.Int2: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Int2.Int2
- PostgresqlTypes.Int4: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Int4.Int4
- PostgresqlTypes.Int8: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Int8.Int8
- PostgresqlTypes.Interval: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Interval.Interval
- PostgresqlTypes.Json: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Json.Json
- PostgresqlTypes.Jsonb: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Jsonb.Jsonb
- PostgresqlTypes.Line: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Line.Line
- PostgresqlTypes.Lseg: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Lseg.Lseg
- PostgresqlTypes.Macaddr: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Macaddr.Macaddr
- PostgresqlTypes.Macaddr8: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Macaddr8.Macaddr8
- PostgresqlTypes.Money: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Money.Money
- PostgresqlTypes.Multirange: instance PostgresqlTypes.Algebra.IsMultirangeElement a => PostgresqlTypes.Algebra.IsScalar (PostgresqlTypes.Multirange.Multirange a)
- PostgresqlTypes.Numeric: instance (GHC.TypeNats.KnownNat precision, GHC.TypeNats.KnownNat scale) => PostgresqlTypes.Algebra.IsScalar (PostgresqlTypes.Numeric.Numeric precision scale)
- PostgresqlTypes.Oid: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Oid.Oid
- PostgresqlTypes.Path: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Path.Path
- PostgresqlTypes.Point: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Point.Point
- PostgresqlTypes.Polygon: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Polygon.Polygon
- PostgresqlTypes.Range: instance PostgresqlTypes.Algebra.IsRangeElement a => PostgresqlTypes.Algebra.IsScalar (PostgresqlTypes.Range.Range a)
- PostgresqlTypes.Text: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Text.Text
- PostgresqlTypes.Time: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Time.Time
- PostgresqlTypes.Timestamp: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Timestamp.Timestamp
- PostgresqlTypes.Timestamptz: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Timestamptz.Timestamptz
- PostgresqlTypes.Timetz: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Timetz.Timetz
- PostgresqlTypes.Tsvector: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Tsvector.Tsvector
- PostgresqlTypes.Uuid: instance PostgresqlTypes.Algebra.IsScalar PostgresqlTypes.Uuid.Uuid
- PostgresqlTypes.Varbit: instance GHC.TypeNats.KnownNat maxLen => PostgresqlTypes.Algebra.IsScalar (PostgresqlTypes.Varbit.Varbit maxLen)
- PostgresqlTypes.Varchar: instance GHC.TypeNats.KnownNat maxLen => PostgresqlTypes.Algebra.IsScalar (PostgresqlTypes.Varchar.Varchar maxLen)
+ PostgresqlTypes.Bit: instance GHC.TypeNats.KnownNat numBits => PostgresqlTypes.Algebra.IsBinaryPrimitive (PostgresqlTypes.Bit.Bit numBits)
+ PostgresqlTypes.Bit: instance GHC.TypeNats.KnownNat numBits => PostgresqlTypes.Algebra.IsPrimitive (PostgresqlTypes.Bit.Bit numBits)
+ PostgresqlTypes.Bool: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Bool.Bool
+ PostgresqlTypes.Bool: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Bool.Bool
+ PostgresqlTypes.Box: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Box.Box
+ PostgresqlTypes.Box: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Box.Box
+ PostgresqlTypes.Bpchar: instance GHC.TypeNats.KnownNat numChars => PostgresqlTypes.Algebra.IsBinaryPrimitive (PostgresqlTypes.Bpchar.Bpchar numChars)
+ PostgresqlTypes.Bpchar: instance GHC.TypeNats.KnownNat numChars => PostgresqlTypes.Algebra.IsPrimitive (PostgresqlTypes.Bpchar.Bpchar numChars)
+ PostgresqlTypes.Bytea: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Bytea.Bytea
+ PostgresqlTypes.Bytea: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Bytea.Bytea
+ PostgresqlTypes.Char: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Char.Char
+ PostgresqlTypes.Char: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Char.Char
+ PostgresqlTypes.Cidr: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Cidr.Cidr
+ PostgresqlTypes.Cidr: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Cidr.Cidr
+ PostgresqlTypes.Circle: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Circle.Circle
+ PostgresqlTypes.Circle: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Circle.Circle
+ PostgresqlTypes.Citext: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Citext.Citext
+ PostgresqlTypes.Citext: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Citext.Citext
+ PostgresqlTypes.Date: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Date.Date
+ PostgresqlTypes.Date: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Date.Date
+ PostgresqlTypes.Float4: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Float4.Float4
+ PostgresqlTypes.Float4: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Float4.Float4
+ PostgresqlTypes.Float8: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Float8.Float8
+ PostgresqlTypes.Float8: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Float8.Float8
+ PostgresqlTypes.Geometry: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Geometry.Geometry
+ PostgresqlTypes.Geometry: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Geometry.Geometry
+ PostgresqlTypes.Hstore: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Hstore.Hstore
+ PostgresqlTypes.Hstore: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Hstore.Hstore
+ PostgresqlTypes.Inet: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Inet.Inet
+ PostgresqlTypes.Inet: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Inet.Inet
+ PostgresqlTypes.Int2: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Int2.Int2
+ PostgresqlTypes.Int2: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Int2.Int2
+ PostgresqlTypes.Int4: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Int4.Int4
+ PostgresqlTypes.Int4: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Int4.Int4
+ PostgresqlTypes.Int8: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Int8.Int8
+ PostgresqlTypes.Int8: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Int8.Int8
+ PostgresqlTypes.Interval: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Interval.Interval
+ PostgresqlTypes.Interval: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Interval.Interval
+ PostgresqlTypes.Json: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Json.Json
+ PostgresqlTypes.Json: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Json.Json
+ PostgresqlTypes.Jsonb: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Jsonb.Jsonb
+ PostgresqlTypes.Jsonb: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Jsonb.Jsonb
+ PostgresqlTypes.Line: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Line.Line
+ PostgresqlTypes.Line: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Line.Line
+ PostgresqlTypes.Lseg: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Lseg.Lseg
+ PostgresqlTypes.Lseg: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Lseg.Lseg
+ PostgresqlTypes.Macaddr: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Macaddr.Macaddr
+ PostgresqlTypes.Macaddr: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Macaddr.Macaddr
+ PostgresqlTypes.Macaddr8: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Macaddr8.Macaddr8
+ PostgresqlTypes.Macaddr8: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Macaddr8.Macaddr8
+ PostgresqlTypes.Money: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Money.Money
+ PostgresqlTypes.Money: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Money.Money
+ PostgresqlTypes.Multirange: instance (PostgresqlTypes.Algebra.IsMultirangeElement a, PostgresqlTypes.Algebra.IsBinaryPrimitive a) => PostgresqlTypes.Algebra.IsBinaryPrimitive (PostgresqlTypes.Multirange.Multirange a)
+ PostgresqlTypes.Multirange: instance PostgresqlTypes.Algebra.IsMultirangeElement a => PostgresqlTypes.Algebra.IsPrimitive (PostgresqlTypes.Multirange.Multirange a)
+ PostgresqlTypes.Numeric: instance (GHC.TypeNats.KnownNat precision, GHC.TypeNats.KnownNat scale) => PostgresqlTypes.Algebra.IsBinaryPrimitive (PostgresqlTypes.Numeric.Numeric precision scale)
+ PostgresqlTypes.Numeric: instance (GHC.TypeNats.KnownNat precision, GHC.TypeNats.KnownNat scale) => PostgresqlTypes.Algebra.IsPrimitive (PostgresqlTypes.Numeric.Numeric precision scale)
+ PostgresqlTypes.Oid: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Oid.Oid
+ PostgresqlTypes.Oid: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Oid.Oid
+ PostgresqlTypes.Path: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Path.Path
+ PostgresqlTypes.Path: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Path.Path
+ PostgresqlTypes.Point: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Point.Point
+ PostgresqlTypes.Point: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Point.Point
+ PostgresqlTypes.Polygon: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Polygon.Polygon
+ PostgresqlTypes.Polygon: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Polygon.Polygon
+ PostgresqlTypes.Range: instance (PostgresqlTypes.Algebra.IsRangeElement a, PostgresqlTypes.Algebra.IsBinaryPrimitive a) => PostgresqlTypes.Algebra.IsBinaryPrimitive (PostgresqlTypes.Range.Range a)
+ PostgresqlTypes.Range: instance PostgresqlTypes.Algebra.IsRangeElement a => PostgresqlTypes.Algebra.IsPrimitive (PostgresqlTypes.Range.Range a)
+ PostgresqlTypes.Text: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Text.Text
+ PostgresqlTypes.Text: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Text.Text
+ PostgresqlTypes.Time: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Time.Time
+ PostgresqlTypes.Time: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Time.Time
+ PostgresqlTypes.Timestamp: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Timestamp.Timestamp
+ PostgresqlTypes.Timestamp: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Timestamp.Timestamp
+ PostgresqlTypes.Timestamptz: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Timestamptz.Timestamptz
+ PostgresqlTypes.Timestamptz: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Timestamptz.Timestamptz
+ PostgresqlTypes.Timetz: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Timetz.Timetz
+ PostgresqlTypes.Timetz: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Timetz.Timetz
+ PostgresqlTypes.Tsvector: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Tsvector.Tsvector
+ PostgresqlTypes.Tsvector: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Tsvector.Tsvector
+ PostgresqlTypes.Uuid: instance PostgresqlTypes.Algebra.IsBinaryPrimitive PostgresqlTypes.Uuid.Uuid
+ PostgresqlTypes.Uuid: instance PostgresqlTypes.Algebra.IsPrimitive PostgresqlTypes.Uuid.Uuid
+ PostgresqlTypes.Varbit: instance GHC.TypeNats.KnownNat maxLen => PostgresqlTypes.Algebra.IsBinaryPrimitive (PostgresqlTypes.Varbit.Varbit maxLen)
+ PostgresqlTypes.Varbit: instance GHC.TypeNats.KnownNat maxLen => PostgresqlTypes.Algebra.IsPrimitive (PostgresqlTypes.Varbit.Varbit maxLen)
+ PostgresqlTypes.Varchar: instance GHC.TypeNats.KnownNat maxLen => PostgresqlTypes.Algebra.IsBinaryPrimitive (PostgresqlTypes.Varchar.Varchar maxLen)
+ PostgresqlTypes.Varchar: instance GHC.TypeNats.KnownNat maxLen => PostgresqlTypes.Algebra.IsPrimitive (PostgresqlTypes.Varchar.Varchar maxLen)
Files
- postgresql-types.cabal +5/−5
- src/integration-tests/IntegrationTests/Scripts.hs +2/−2
- src/library/PostgresqlTypes/Bit.hs +28/−26
- src/library/PostgresqlTypes/Bool.hs +9/−7
- src/library/PostgresqlTypes/Box.hs +21/−19
- src/library/PostgresqlTypes/Bpchar.hs +12/−22
- src/library/PostgresqlTypes/Bytea.hs +8/−6
- src/library/PostgresqlTypes/Char.hs +10/−7
- src/library/PostgresqlTypes/Cidr.hs +60/−59
- src/library/PostgresqlTypes/Circle.hs +15/−13
- src/library/PostgresqlTypes/Citext.hs +6/−4
- src/library/PostgresqlTypes/Date.hs +8/−6
- src/library/PostgresqlTypes/Float4.hs +6/−4
- src/library/PostgresqlTypes/Float8.hs +6/−4
- src/library/PostgresqlTypes/Geometry.hs +23/−22
- src/library/PostgresqlTypes/Hstore.hs +46/−45
- src/library/PostgresqlTypes/Inet.hs +60/−59
- src/library/PostgresqlTypes/Int2.hs +6/−4
- src/library/PostgresqlTypes/Int4.hs +6/−4
- src/library/PostgresqlTypes/Int8.hs +6/−4
- src/library/PostgresqlTypes/Interval.hs +11/−9
- src/library/PostgresqlTypes/Json.hs +11/−9
- src/library/PostgresqlTypes/Jsonb.hs +11/−9
- src/library/PostgresqlTypes/Line.hs +15/−13
- src/library/PostgresqlTypes/Lseg.hs +17/−15
- src/library/PostgresqlTypes/Macaddr.hs +25/−23
- src/library/PostgresqlTypes/Macaddr8.hs +29/−27
- src/library/PostgresqlTypes/Money.hs +6/−4
- src/library/PostgresqlTypes/Multirange.hs +19/−18
- src/library/PostgresqlTypes/Numeric.hs +36/−35
- src/library/PostgresqlTypes/Oid.hs +6/−4
- src/library/PostgresqlTypes/Path.hs +29/−27
- src/library/PostgresqlTypes/Point.hs +13/−11
- src/library/PostgresqlTypes/Polygon.hs +22/−20
- src/library/PostgresqlTypes/Range.hs +38/−37
- src/library/PostgresqlTypes/Text.hs +6/−4
- src/library/PostgresqlTypes/Time.hs +6/−4
- src/library/PostgresqlTypes/Timestamp.hs +8/−6
- src/library/PostgresqlTypes/Timestamptz.hs +8/−6
- src/library/PostgresqlTypes/Timetz.hs +15/−14
- src/library/PostgresqlTypes/Tsvector.hs +76/−75
- src/library/PostgresqlTypes/Uuid.hs +10/−8
- src/library/PostgresqlTypes/Varbit.hs +25/−23
- src/library/PostgresqlTypes/Varchar.hs +12/−10
- src/library/PostgresqlTypes/Via.hs +2/−2
- src/library/PostgresqlTypes/Via/IsPrimitive.hs +26/−0
- src/library/PostgresqlTypes/Via/IsScalar.hs +0/−26
- src/unit-tests/PostgresqlTypes/BitSpec.hs +4/−4
- src/unit-tests/PostgresqlTypes/BoolSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/BoxSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/BpcharSpec.hs +3/−3
- src/unit-tests/PostgresqlTypes/ByteaSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/CharSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/CidrSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/CircleSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/CitextSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/DateSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/Float4Spec.hs +2/−2
- src/unit-tests/PostgresqlTypes/Float8Spec.hs +2/−2
- src/unit-tests/PostgresqlTypes/GeometrySpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/HstoreSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/InetSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/Int2Spec.hs +2/−2
- src/unit-tests/PostgresqlTypes/Int4Spec.hs +2/−2
- src/unit-tests/PostgresqlTypes/Int8Spec.hs +2/−2
- src/unit-tests/PostgresqlTypes/IntervalSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/JsonSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/JsonbSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/LineSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/LsegSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/Macaddr8Spec.hs +2/−2
- src/unit-tests/PostgresqlTypes/MacaddrSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/MoneySpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/MultirangeSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/NumericSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/OidSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/PathSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/PointSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/PolygonSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/RangeSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/TextSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/TimeSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/TimestampSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/TimestamptzSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/TimetzSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/TsvectorSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/UuidSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/VarbitSpec.hs +2/−2
- src/unit-tests/PostgresqlTypes/VarcharSpec.hs +2/−2
- src/unit-tests/UnitTests/Scripts.hs +3/−3
postgresql-types.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: postgresql-types-version: 0.1.4.0+version: 0.1.5.0 category: PostgreSQL, Codecs synopsis: Precise PostgreSQL types representation and driver-agnostic codecs description:@@ -154,7 +154,7 @@ PostgresqlTypes.Timetz.Offset PostgresqlTypes.Timetz.Time PostgresqlTypes.Via- PostgresqlTypes.Via.IsScalar+ PostgresqlTypes.Via.IsPrimitive build-depends: aeson >=2.2 && <3,@@ -165,7 +165,7 @@ hashable >=1.3 && <2, jsonifier ^>=0.2.1.3, mtl >=2.2 && <3,- postgresql-types-algebra ^>=0.1,+ postgresql-types-algebra ^>=0.2, postgresql-types:jsonifier-aeson, postgresql-types:time-extras, ptr-peeker ^>=0.2,@@ -267,7 +267,7 @@ hashable >=1.3 && <2, hspec >=2.11 && <3, postgresql-types,- postgresql-types-algebra ^>=0.1,+ postgresql-types-algebra ^>=0.2, ptr-peeker ^>=0.2, ptr-poker ^>=0.1.2.16, QuickCheck >=2.14 && <3,@@ -304,7 +304,7 @@ hspec >=2.11 && <3, postgresql-libpq >=0.10 && <0.12, postgresql-types,- postgresql-types-algebra ^>=0.1,+ postgresql-types-algebra ^>=0.2, ptr-peeker ^>=0.2, ptr-poker ^>=0.1.2.16, QuickCheck >=2.14 && <3,
src/integration-tests/IntegrationTests/Scripts.hs view
@@ -21,7 +21,7 @@ mappingSpec :: forall a.- (HasCallStack, QuickCheck.Arbitrary a, Show a, Eq a, PostgresqlTypes.Algebra.IsScalar a) =>+ (HasCallStack, QuickCheck.Arbitrary a, Show a, Eq a, PostgresqlTypes.Algebra.IsPrimitive a, PostgresqlTypes.Algebra.IsBinaryPrimitive a) => Proxy a -> SpecWith Pq.Connection mappingSpec _ =@@ -50,7 +50,7 @@ Just oid -> pure oid Nothing -> fail $ "Array OID not found for type: " <> Text.unpack typeName pure (baseOid, arrayOid)- in describe "IsScalar" do+ in describe "IsPrimitive" do describe (Text.unpack typeName) do describe "Encoding via textualEncoder" do describe "And decoding via textualDecoder" do
src/library/PostgresqlTypes/Bit.hs view
@@ -38,7 +38,7 @@ -- | Bit data (packed into bytes) ByteString deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar (Bit numBits))+ deriving (Show, Read, IsString) via (ViaIsPrimitive (Bit numBits)) deriving newtype (Hashable) instance (TypeLits.KnownNat numBits) => Arbitrary (Bit numBits) where@@ -49,7 +49,7 @@ Nothing -> error "Arbitrary Bit: Generated bit string has incorrect length" Just bit -> pure bit -instance (TypeLits.KnownNat numBits) => IsScalar (Bit numBits) where+instance (TypeLits.KnownNat numBits) => IsPrimitive (Bit numBits) where schemaName = Tagged Nothing typeName = Tagged "bit" baseOid = Tagged (Just 1560)@@ -58,30 +58,6 @@ Tagged [ Text.pack (show (TypeLits.natVal (Proxy @numBits))) ]- binaryEncoder (Bit bytes) =- let len = fromIntegral (TypeLits.natVal (Proxy @numBits))- in mconcat- [ Write.bInt32 len,- Write.byteString bytes- ]- binaryDecoder = do- len <- PtrPeeker.fixed PtrPeeker.beSignedInt4- bytes <- PtrPeeker.remainderAsByteString- let expectedLen = fromIntegral (TypeLits.natVal (Proxy @numBits))- if len == expectedLen- then pure (Right (Bit bytes))- else- pure- ( Left- ( DecodingError- { location = ["Bit"],- reason =- UnsupportedValueDecodingErrorReason- ("Expected bit string of length " <> Text.pack (show expectedLen) <> " but got " <> Text.pack (show len))- (TextBuilder.toText (TextBuilder.decimal len))- }- )- ) textualEncoder (Bit bytes) = let len = fromIntegral (TypeLits.natVal (Proxy @numBits)) bits = concatMap byteToBits (ByteString.unpack bytes)@@ -109,6 +85,32 @@ chunksOf :: Int -> [a] -> [[a]] chunksOf _ [] = [] chunksOf n xs = take n xs : chunksOf n (drop n xs)++instance (TypeLits.KnownNat numBits) => IsBinaryPrimitive (Bit numBits) where+ binaryEncoder (Bit bytes) =+ let len = fromIntegral (TypeLits.natVal (Proxy @numBits))+ in mconcat+ [ Write.bInt32 len,+ Write.byteString bytes+ ]+ binaryDecoder = do+ len <- PtrPeeker.fixed PtrPeeker.beSignedInt4+ bytes <- PtrPeeker.remainderAsByteString+ let expectedLen = fromIntegral (TypeLits.natVal (Proxy @numBits))+ if len == expectedLen+ then pure (Right (Bit bytes))+ else+ pure+ ( Left+ ( DecodingError+ { location = ["Bit"],+ reason =+ UnsupportedValueDecodingErrorReason+ ("Expected bit string of length " <> Text.pack (show expectedLen) <> " but got " <> Text.pack (show len))+ (TextBuilder.toText (TextBuilder.decimal len))+ }+ )+ ) -- * Accessors
src/library/PostgresqlTypes/Bool.hs view
@@ -22,25 +22,27 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-boolean.html). newtype Bool = Bool Data.Bool.Bool deriving newtype (Eq, Ord, Hashable, Arbitrary)- deriving (Show, Read, IsString) via (ViaIsScalar Bool)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Bool) -instance IsScalar Bool where+instance IsPrimitive Bool where schemaName = Tagged Nothing typeName = Tagged "bool" baseOid = Tagged (Just 16) arrayOid = Tagged (Just 1000) typeParams = Tagged []- binaryEncoder (Bool b) = Write.word8 (if b then 1 else 0)- binaryDecoder =- PtrPeeker.fixed do- b <- PtrPeeker.unsignedInt1- pure (Right (Bool (b /= 0))) textualEncoder (Bool b) = if b then "t" else "f" textualDecoder = (Bool True <$ Attoparsec.char 't') <|> (Bool False <$ Attoparsec.char 'f') <|> (Bool True <$ Attoparsec.string "true") <|> (Bool False <$ Attoparsec.string "false")++instance IsBinaryPrimitive Bool where+ binaryEncoder (Bool b) = Write.word8 (if b then 1 else 0)+ binaryDecoder =+ PtrPeeker.fixed do+ b <- PtrPeeker.unsignedInt1+ pure (Right (Bool (b /= 0))) -- * Accessors
src/library/PostgresqlTypes/Box.hs view
@@ -40,7 +40,7 @@ -- | Upper-right y coordinate Double deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Box)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Box) instance Arbitrary Box where arbitrary = do@@ -63,25 +63,12 @@ `hashWithSalt` castDoubleToWord64 x2 `hashWithSalt` castDoubleToWord64 y2 -instance IsScalar Box where+instance IsPrimitive Box where schemaName = Tagged Nothing typeName = Tagged "box" baseOid = Tagged (Just 603) arrayOid = Tagged (Just 1020) typeParams = Tagged []- binaryEncoder (Box x1 y1 x2 y2) =- mconcat- [ Write.bWord64 (castDoubleToWord64 x2),- Write.bWord64 (castDoubleToWord64 y2),- Write.bWord64 (castDoubleToWord64 x1),- Write.bWord64 (castDoubleToWord64 y1)- ]- binaryDecoder = do- x2 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- y2 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- x1 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- y1 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- pure (Right (Box x1 y1 x2 y2)) textualEncoder (Box x1 y1 x2 y2) = -- PostgreSQL returns coordinates as (upper-right),(lower-left) -- So we output (x2,y2),(x1,y1)@@ -98,18 +85,33 @@ ] textualDecoder = do _ <- Attoparsec.char '('- x1 <- Attoparsec.double+ x2 <- Attoparsec.double _ <- Attoparsec.char ','- y1 <- Attoparsec.double+ y2 <- Attoparsec.double _ <- Attoparsec.char ')' _ <- Attoparsec.char ',' _ <- Attoparsec.char '('- x2 <- Attoparsec.double+ x1 <- Attoparsec.double _ <- Attoparsec.char ','- y2 <- Attoparsec.double+ y1 <- Attoparsec.double _ <- Attoparsec.char ')' -- PostgreSQL may return coordinates in any order, normalize to ensure x1 <= x2 and y1 <= y2 pure (normalizeFromCorners x1 y1 x2 y2)++instance IsBinaryPrimitive Box where+ binaryEncoder (Box x1 y1 x2 y2) =+ mconcat+ [ Write.bWord64 (castDoubleToWord64 x2),+ Write.bWord64 (castDoubleToWord64 y2),+ Write.bWord64 (castDoubleToWord64 x1),+ Write.bWord64 (castDoubleToWord64 y1)+ ]+ binaryDecoder = do+ x2 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ y2 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ x1 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ y1 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ pure (Right (Box x1 y1 x2 y2)) -- * Accessors
src/library/PostgresqlTypes/Bpchar.hs view
@@ -44,7 +44,7 @@ -- 'PostgresqlTypes.Char.Char' in Haskell. These are completely different types in PostgreSQL. newtype Bpchar (numChars :: TypeLits.Nat) = Bpchar Text deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar (Bpchar numChars))+ deriving (Show, Read, IsString) via (ViaIsPrimitive (Bpchar numChars)) deriving newtype (Hashable) instance (TypeLits.KnownNat numChars) => Arbitrary (Bpchar numChars) where@@ -56,7 +56,7 @@ Nothing -> error "Arbitrary Bpchar: Generated string has incorrect length" Just char -> pure char -instance (TypeLits.KnownNat numChars) => IsScalar (Bpchar numChars) where+instance (TypeLits.KnownNat numChars) => IsPrimitive (Bpchar numChars) where schemaName = Tagged Nothing typeName = Tagged "bpchar" baseOid = Tagged (Just 1042)@@ -69,6 +69,16 @@ then [] -- PostgreSQL often displays bpchar(1) / char(1) as just "char" (no length modifier) else [Text.pack (show len)] -- bpchar(n) )+ textualEncoder (Bpchar txt) = TextBuilder.text txt+ textualDecoder = do+ txt <- Attoparsec.takeText+ let len = Text.length txt+ expectedLen = fromIntegral (TypeLits.natVal (Proxy @numChars))+ if len <= expectedLen+ then pure (Bpchar txt)+ else fail ("Bpchar string length " <> show len <> " exceeds maximum " <> show expectedLen)++instance (TypeLits.KnownNat numChars) => IsBinaryPrimitive (Bpchar numChars) where binaryEncoder (Bpchar txt) = -- PostgreSQL bpchar(n) is stored blank-padded to exactly n characters let expectedLen = fromIntegral (TypeLits.natVal (Proxy @numChars))@@ -101,26 +111,6 @@ then Text.take expectedLen txt else txt <> Text.replicate (expectedLen - len) " " in Right (Bpchar paddedTxt)- textualEncoder (Bpchar txt) =- -- PostgreSQL bpchar(n) is stored blank-padded to exactly n characters- let expectedLen = fromIntegral (TypeLits.natVal (Proxy @numChars))- len = Text.length txt- paddedTxt =- if len >= expectedLen- then Text.take expectedLen txt- else txt <> Text.replicate (expectedLen - len) " "- in TextBuilder.text paddedTxt- textualDecoder = do- txt <- Attoparsec.takeText- let len = Text.length txt- expectedLen = fromIntegral (TypeLits.natVal (Proxy @numChars))- -- PostgreSQL bpchar(n) may return values with trailing spaces trimmed.- -- We need to pad them back to the expected length.- paddedTxt =- if len >= expectedLen- then Text.take expectedLen txt- else txt <> Text.replicate (expectedLen - len) " "- pure (Bpchar paddedTxt) -- * Accessors
src/library/PostgresqlTypes/Bytea.hs view
@@ -24,22 +24,18 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-binary.html). newtype Bytea = Bytea ByteString deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Bytea)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Bytea) instance Arbitrary Bytea where arbitrary = Bytea . ByteString.pack <$> arbitrary shrink (Bytea bytes) = Bytea . ByteString.pack <$> shrink (ByteString.unpack bytes) -instance IsScalar Bytea where+instance IsPrimitive Bytea where schemaName = Tagged Nothing typeName = Tagged "bytea" baseOid = Tagged (Just 17) arrayOid = Tagged (Just 1001) typeParams = Tagged []- binaryEncoder (Bytea bs) =- Write.byteString bs- binaryDecoder =- Right . Bytea <$> PtrPeeker.remainderAsByteString textualEncoder (Bytea bs) = "\\x" <> foldMap TextBuilder.hexadecimal (ByteString.unpack bs) textualDecoder = do@@ -68,6 +64,12 @@ | c >= 'a' && c <= 'f' = Right (fromIntegral (ord c - ord 'a' + 10)) | c >= 'A' && c <= 'F' = Right (fromIntegral (ord c - ord 'A' + 10)) | otherwise = Left ("Invalid hex digit: " ++ [c])++instance IsBinaryPrimitive Bytea where+ binaryEncoder (Bytea bs) =+ Write.byteString bs+ binaryDecoder =+ Right . Bytea <$> PtrPeeker.remainderAsByteString -- * Accessors
src/library/PostgresqlTypes/Char.hs view
@@ -42,22 +42,19 @@ -- these are entirely different types in PostgreSQL. newtype Char = Char Word8 deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Char)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Char) instance Arbitrary Char where arbitrary = Char <$> QuickCheck.choose (0, 127) -instance IsScalar Char where+instance IsPrimitive Char where schemaName = Tagged Nothing typeName = Tagged "char"+ typeSignature = Tagged "\"char\"" baseOid = Tagged (Just 18) arrayOid = Tagged (Just 1002)- typeSignature = Tagged "\"char\""- binaryEncoder (Char base) =- Write.word8 base- binaryDecoder =- Right . Char <$> PtrPeeker.fixed PtrPeeker.unsignedInt1+ typeParams = Tagged [] textualEncoder (Char base) = TextBuilder.unicodeCodepoint (fromIntegral base) textualDecoder = do@@ -70,6 +67,12 @@ if charOrd > 127 then fail "Invalid char: value > 127" else pure (Char (fromIntegral charOrd))++instance IsBinaryPrimitive Char where+ binaryEncoder (Char base) =+ Write.word8 base+ binaryDecoder =+ Right . Char <$> PtrPeeker.fixed PtrPeeker.unsignedInt1 -- * Accessors
src/library/PostgresqlTypes/Cidr.hs view
@@ -50,7 +50,7 @@ -- | Network mask length (0-128). Word8 deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Cidr)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Cidr) instance Arbitrary Cidr where arbitrary = do@@ -87,70 +87,13 @@ V4Cidr addr netmask -> salt `hashWithSalt` (0 :: Int) `hashWithSalt` addr `hashWithSalt` netmask V6Cidr w1 w2 w3 w4 netmask -> salt `hashWithSalt` (1 :: Int) `hashWithSalt` w1 `hashWithSalt` w2 `hashWithSalt` w3 `hashWithSalt` w4 `hashWithSalt` netmask -instance IsScalar Cidr where+instance IsPrimitive Cidr where schemaName = Tagged Nothing typeName = Tagged "cidr" baseOid = Tagged (Just 650) arrayOid = Tagged (Just 651) typeParams = Tagged [] - binaryEncoder = \case- V4Cidr addr netmask ->- mconcat- [ Write.word8 2, -- IPv4 address family- Write.word8 netmask,- Write.word8 1, -- is_cidr flag (1 for cidr)- Write.word8 4, -- address length (4 bytes for IPv4)- Write.bWord32 addr -- IPv4 network address- ]- V6Cidr w1 w2 w3 w4 netmask ->- mconcat- [ Write.word8 3, -- IPv6 address family for CIDR- Write.word8 netmask,- Write.word8 1, -- is_cidr flag (1 for cidr)- Write.word8 16, -- address length (16 bytes for IPv6)- Write.bWord32 w1,- Write.bWord32 w2,- Write.bWord32 w3,- Write.bWord32 w4- ]-- binaryDecoder = do- (family, netmask, isCidrFlag, addrLen) <-- PtrPeeker.fixed do- (,,,)- <$> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1-- runExceptT do- when (isCidrFlag /= 1) do- throwError (DecodingError ["is-cidr"] (UnexpectedValueDecodingErrorReason "1" (TextBuilder.toText (TextBuilder.decimal isCidrFlag))))-- case family of- 2 -> do- -- IPv4- when (addrLen /= 4) do- throwError (DecodingError ["address-length"] (UnexpectedValueDecodingErrorReason "4" (TextBuilder.toText (TextBuilder.decimal addrLen))))- addr <- lift do- PtrPeeker.fixed PtrPeeker.beUnsignedInt4- pure (V4Cidr addr (fromIntegral netmask))- 3 -> do- -- IPv6- when (addrLen /= 16) do- throwError (DecodingError ["address-length"] (UnexpectedValueDecodingErrorReason "16" (TextBuilder.toText (TextBuilder.decimal addrLen))))- lift do- PtrPeeker.fixed do- V6Cidr- <$> PtrPeeker.beUnsignedInt4- <*> PtrPeeker.beUnsignedInt4- <*> PtrPeeker.beUnsignedInt4- <*> PtrPeeker.beUnsignedInt4- <*> pure (fromIntegral netmask)- _ -> do- throwError (DecodingError ["address-family"] (UnexpectedValueDecodingErrorReason "2 or 3" (TextBuilder.toText (TextBuilder.decimal family))))- textualEncoder = \case V4Cidr addr netmask -> let a = ((addr `shiftR` 24) .&. 0xFF)@@ -252,6 +195,64 @@ _ -> fail "Expected 8 groups after expansion" parseHexGroup = Attoparsec.hexadecimal @Word16++instance IsBinaryPrimitive Cidr where+ binaryEncoder = \case+ V4Cidr addr netmask ->+ mconcat+ [ Write.word8 2, -- IPv4 address family+ Write.word8 netmask,+ Write.word8 1, -- is_cidr flag (1 for cidr)+ Write.word8 4, -- address length (4 bytes for IPv4)+ Write.bWord32 addr -- IPv4 network address+ ]+ V6Cidr w1 w2 w3 w4 netmask ->+ mconcat+ [ Write.word8 3, -- IPv6 address family for CIDR+ Write.word8 netmask,+ Write.word8 1, -- is_cidr flag (1 for cidr)+ Write.word8 16, -- address length (16 bytes for IPv6)+ Write.bWord32 w1,+ Write.bWord32 w2,+ Write.bWord32 w3,+ Write.bWord32 w4+ ]++ binaryDecoder = do+ (family, netmask, isCidrFlag, addrLen) <-+ PtrPeeker.fixed do+ (,,,)+ <$> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1++ runExceptT do+ when (isCidrFlag /= 1) do+ throwError (DecodingError ["is-cidr"] (UnexpectedValueDecodingErrorReason "1" (TextBuilder.toText (TextBuilder.decimal isCidrFlag))))++ case family of+ 2 -> do+ -- IPv4+ when (addrLen /= 4) do+ throwError (DecodingError ["address-length"] (UnexpectedValueDecodingErrorReason "4" (TextBuilder.toText (TextBuilder.decimal addrLen))))+ addr <- lift do+ PtrPeeker.fixed PtrPeeker.beUnsignedInt4+ pure (V4Cidr addr (fromIntegral netmask))+ 3 -> do+ -- IPv6+ when (addrLen /= 16) do+ throwError (DecodingError ["address-length"] (UnexpectedValueDecodingErrorReason "16" (TextBuilder.toText (TextBuilder.decimal addrLen))))+ lift do+ PtrPeeker.fixed do+ V6Cidr+ <$> PtrPeeker.beUnsignedInt4+ <*> PtrPeeker.beUnsignedInt4+ <*> PtrPeeker.beUnsignedInt4+ <*> PtrPeeker.beUnsignedInt4+ <*> pure (fromIntegral netmask)+ _ -> do+ throwError (DecodingError ["address-family"] (UnexpectedValueDecodingErrorReason "2 or 3" (TextBuilder.toText (TextBuilder.decimal family)))) -- * Accessors
src/library/PostgresqlTypes/Circle.hs view
@@ -37,7 +37,7 @@ -- | Circle radius (must be non-negative) Double deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Circle)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Circle) instance Arbitrary Circle where arbitrary = do@@ -58,23 +58,12 @@ `hashWithSalt` castDoubleToWord64 y `hashWithSalt` castDoubleToWord64 r -instance IsScalar Circle where+instance IsPrimitive Circle where schemaName = Tagged Nothing typeName = Tagged "circle" baseOid = Tagged (Just 718) arrayOid = Tagged (Just 719) typeParams = Tagged []- binaryEncoder (Circle x y r) =- mconcat- [ Write.bWord64 (castDoubleToWord64 x),- Write.bWord64 (castDoubleToWord64 y),- Write.bWord64 (castDoubleToWord64 r)- ]- binaryDecoder = PtrPeeker.fixed do- x <- castWord64ToDouble <$> PtrPeeker.beUnsignedInt8- y <- castWord64ToDouble <$> PtrPeeker.beUnsignedInt8- r <- castWord64ToDouble <$> PtrPeeker.beUnsignedInt8- pure (Right (Circle x y r)) textualEncoder (Circle x y r) = mconcat [ "<(",@@ -96,6 +85,19 @@ r <- Attoparsec.double _ <- Attoparsec.char '>' pure (Circle x y r)++instance IsBinaryPrimitive Circle where+ binaryEncoder (Circle x y r) =+ mconcat+ [ Write.bWord64 (castDoubleToWord64 x),+ Write.bWord64 (castDoubleToWord64 y),+ Write.bWord64 (castDoubleToWord64 r)+ ]+ binaryDecoder = PtrPeeker.fixed do+ x <- castWord64ToDouble <$> PtrPeeker.beUnsignedInt8+ y <- castWord64ToDouble <$> PtrPeeker.beUnsignedInt8+ r <- castWord64ToDouble <$> PtrPeeker.beUnsignedInt8+ pure (Right (Circle x y r)) -- * Accessors
src/library/PostgresqlTypes/Citext.hs view
@@ -31,7 +31,7 @@ -- is a property of comparisons, not of storage. NUL characters are not allowed. newtype Citext = Citext Text.Text deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Citext)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Citext) instance Arbitrary Citext where arbitrary =@@ -42,12 +42,16 @@ shrink (Citext base) = Citext . Text.pack <$> shrink (Text.unpack base) -instance IsScalar Citext where+instance IsPrimitive Citext where schemaName = Tagged Nothing typeName = Tagged "citext" baseOid = Tagged Nothing arrayOid = Tagged Nothing typeParams = Tagged []+ textualEncoder (Citext base) = TextBuilder.text base+ textualDecoder = Citext <$> Attoparsec.takeText++instance IsBinaryPrimitive Citext where binaryEncoder (Citext base) = Write.textUtf8 base binaryDecoder = do bytes <- PtrPeeker.remainderAsByteString@@ -65,8 +69,6 @@ ) ) Right base -> pure (Right (Citext base))- textualEncoder (Citext base) = TextBuilder.text base- textualDecoder = Citext <$> Attoparsec.takeText -- * Accessors
src/library/PostgresqlTypes/Date.hs view
@@ -29,7 +29,7 @@ = -- | Days since PostgreSQL epoch (2000-01-01). Date Int32 deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Date)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Date) -- | PostgreSQL date range: 4713 BC to 5874897 AD. --@@ -59,16 +59,12 @@ ) ] -instance IsScalar Date where+instance IsPrimitive Date where schemaName = Tagged Nothing typeName = Tagged "date" baseOid = Tagged (Just 1082) arrayOid = Tagged (Just 1182) typeParams = Tagged []- binaryEncoder (Date days) = Write.bInt32 days- binaryDecoder = do- days <- PtrPeeker.fixed PtrPeeker.beSignedInt4- pure (Right (Date days)) textualEncoder date = let day = toDay date (y, m, d) = Time.toGregorian day@@ -128,6 +124,12 @@ b <- Attoparsec.digit pure (digitToInt a * 10 + digitToInt b) isLeapYear y = (y `mod` 4 == 0 && y `mod` 100 /= 0) || (y `mod` 400 == 0)++instance IsBinaryPrimitive Date where+ binaryEncoder (Date days) = Write.bInt32 days+ binaryDecoder = do+ days <- PtrPeeker.fixed PtrPeeker.beSignedInt4+ pure (Right (Date days)) -- | Mapping to @daterange@ type. instance IsRangeElement Date where
src/library/PostgresqlTypes/Float4.hs view
@@ -23,22 +23,24 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-numeric.html#DATATYPE-FLOAT). newtype Float4 = Float4 Float deriving newtype (Eq, Ord, Hashable, Arbitrary)- deriving (Show, Read, IsString) via (ViaIsScalar Float4)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Float4) -instance IsScalar Float4 where+instance IsPrimitive Float4 where schemaName = Tagged Nothing typeName = Tagged "float4" baseOid = Tagged (Just 700) arrayOid = Tagged (Just 1021) typeParams = Tagged []- binaryEncoder (Float4 x) = Write.bWord32 (castFloatToWord32 x)- binaryDecoder = PtrPeeker.fixed (Right . Float4 . castWord32ToFloat <$> PtrPeeker.beUnsignedInt4) textualEncoder (Float4 x) = TextBuilder.string (printf "%g" x) textualDecoder = (Float4 (0 / 0) <$ Attoparsec.string "NaN") <|> (Float4 (1 / 0) <$ Attoparsec.string "Infinity") <|> (Float4 (-1 / 0) <$ Attoparsec.string "-Infinity") <|> (Float4 . realToFrac <$> Attoparsec.double)++instance IsBinaryPrimitive Float4 where+ binaryEncoder (Float4 x) = Write.bWord32 (castFloatToWord32 x)+ binaryDecoder = PtrPeeker.fixed (Right . Float4 . castWord32ToFloat <$> PtrPeeker.beUnsignedInt4) -- * Accessors
src/library/PostgresqlTypes/Float8.hs view
@@ -23,22 +23,24 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-numeric.html#DATATYPE-FLOAT). newtype Float8 = Float8 Double deriving newtype (Eq, Ord, Hashable, Arbitrary)- deriving (Show, Read, IsString) via (ViaIsScalar Float8)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Float8) -instance IsScalar Float8 where+instance IsPrimitive Float8 where schemaName = Tagged Nothing typeName = Tagged "float8" baseOid = Tagged (Just 701) arrayOid = Tagged (Just 1022) typeParams = Tagged []- binaryEncoder (Float8 x) = Write.bWord64 (castDoubleToWord64 x)- binaryDecoder = PtrPeeker.fixed (Right . Float8 . castWord64ToDouble <$> PtrPeeker.beUnsignedInt8) textualEncoder (Float8 x) = TextBuilder.string (printf "%g" x) textualDecoder = (Float8 (0 / 0) <$ Attoparsec.string "NaN") <|> (Float8 (1 / 0) <$ Attoparsec.string "Infinity") <|> (Float8 (-1 / 0) <$ Attoparsec.string "-Infinity") <|> (Float8 <$> Attoparsec.double)++instance IsBinaryPrimitive Float8 where+ binaryEncoder (Float8 x) = Write.bWord64 (castDoubleToWord64 x)+ binaryDecoder = PtrPeeker.fixed (Right . Float8 . castWord64ToDouble <$> PtrPeeker.beUnsignedInt8) -- * Accessors
src/library/PostgresqlTypes/Geometry.hs view
@@ -62,7 +62,7 @@ -- | Shape. Shape deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Geometry)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Geometry) -- | One of the sixteen OGC\/ISO geometry kinds that a 'Geometry' can hold — PostGIS's complete @LWTYPE@ -- vocabulary, from the seven basic OGC shapes through the ISO\/SQL-MM curve, surface and TIN extensions.@@ -281,33 +281,13 @@ mapMaybe (refineFromShapeAndSrid shape) (shrinkSrid srid) ] -instance IsScalar Geometry where+instance IsPrimitive Geometry where schemaName = Tagged Nothing typeName = Tagged "geometry" baseOid = Tagged Nothing arrayOid = Tagged Nothing typeParams = Tagged [] - binaryEncoder (Geometry srid shape) =- -- 'Geometry' is only constructible via 'refineFromShapeAndSrid' and- -- 'binaryDecoder', both of which reject shape trees whose coordinates- -- disagree on dimensionality, so 'shapeDim' cannot fail here.- writeGeometry srid (fromMaybe XyDim (shapeDim shape)) shape-- binaryDecoder = runExceptT do- (srid, shape) <- readGeometry- case refineFromShapeAndSrid shape srid of- Just geometry -> pure geometry- Nothing ->- throwError- ( DecodingError- ["geometry"]- ( UnsupportedValueDecodingErrorReason- "All coordinates of a geometry must share the same dimensionality"- (shapeName shape)- )- )- textualEncoder geometry = foldMap TextBuilder.hexadecimal (ByteString.unpack (Write.toByteString (binaryEncoder geometry))) @@ -342,6 +322,27 @@ | c >= 'a' && c <= 'f' = Right (fromIntegral (ord c - ord 'a' + 10)) | c >= 'A' && c <= 'F' = Right (fromIntegral (ord c - ord 'A' + 10)) | otherwise = Left ("Invalid hexadecimal digit: " <> [c])++instance IsBinaryPrimitive Geometry where+ binaryEncoder (Geometry srid shape) =+ -- 'Geometry' is only constructible via 'refineFromShapeAndSrid' and+ -- 'binaryDecoder', both of which reject shape trees whose coordinates+ -- disagree on dimensionality, so 'shapeDim' cannot fail here.+ writeGeometry srid (fromMaybe XyDim (shapeDim shape)) shape++ binaryDecoder = runExceptT do+ (srid, shape) <- readGeometry+ case refineFromShapeAndSrid shape srid of+ Just geometry -> pure geometry+ Nothing ->+ throwError+ ( DecodingError+ ["geometry"]+ ( UnsupportedValueDecodingErrorReason+ "All coordinates of a geometry must share the same dimensionality"+ (shapeName shape)+ )+ ) -- * Accessors
src/library/PostgresqlTypes/Hstore.hs view
@@ -32,7 +32,7 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/hstore.html). newtype Hstore = Hstore (Map.Map Text (Maybe Text)) deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Hstore)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Hstore) instance Arbitrary Hstore where arbitrary = do@@ -77,12 +77,56 @@ ) ) -instance IsScalar Hstore where+instance IsPrimitive Hstore where schemaName = Tagged Nothing typeName = Tagged "hstore" baseOid = Tagged Nothing arrayOid = Tagged Nothing typeParams = Tagged []+ textualEncoder (Hstore m) =+ if Map.null m+ then mempty+ else mconcat $ intersperse (TextBuilder.text ", ") $ map encodePair (Map.toList m)+ where+ encodePair (key, maybeValue) =+ TextBuilder.char '"'+ <> TextBuilder.text (escapeText key)+ <> TextBuilder.text "\"=>"+ <> case maybeValue of+ Nothing -> TextBuilder.text "NULL"+ Just value ->+ TextBuilder.char '"'+ <> TextBuilder.text (escapeText value)+ <> TextBuilder.char '"'+ escapeText = Text.concatMap escapeChar+ escapeChar c = case c of+ '\\' -> "\\\\"+ '"' -> "\\\""+ _ -> Text.singleton c++ textualDecoder = do+ pairs <- Attoparsec.sepBy pairParser (Attoparsec.string ", " <|> Attoparsec.string ",")+ pure (Hstore (Map.fromList pairs))+ where+ pairParser = do+ key <- quotedString+ _ <- Attoparsec.string "=>"+ value <- nullValue <|> (Just <$> quotedString)+ pure (key, value)+ quotedString = do+ _ <- Attoparsec.char '"'+ chars <- many (escapedChar <|> normalChar)+ _ <- Attoparsec.char '"'+ pure (Text.pack chars)+ escapedChar = do+ _ <- Attoparsec.char '\\'+ Attoparsec.anyChar+ normalChar = Attoparsec.satisfy (\c -> c /= '"' && c /= '\\')+ nullValue = do+ _ <- Attoparsec.string "NULL"+ pure Nothing++instance IsBinaryPrimitive Hstore where binaryEncoder (Hstore m) = do -- Binary format: -- 4 bytes: number of key-value pairs (int32)@@ -141,49 +185,6 @@ } ) Right value -> pure (key, Just value)-- textualEncoder (Hstore m) =- if Map.null m- then mempty- else mconcat $ intersperse (TextBuilder.text ", ") $ map encodePair (Map.toList m)- where- encodePair (key, maybeValue) =- TextBuilder.char '"'- <> TextBuilder.text (escapeText key)- <> TextBuilder.text "\"=>"- <> case maybeValue of- Nothing -> TextBuilder.text "NULL"- Just value ->- TextBuilder.char '"'- <> TextBuilder.text (escapeText value)- <> TextBuilder.char '"'- escapeText = Text.concatMap escapeChar- escapeChar c = case c of- '\\' -> "\\\\"- '"' -> "\\\""- _ -> Text.singleton c-- textualDecoder = do- pairs <- Attoparsec.sepBy pairParser (Attoparsec.string ", " <|> Attoparsec.string ",")- pure (Hstore (Map.fromList pairs))- where- pairParser = do- key <- quotedString- _ <- Attoparsec.string "=>"- value <- nullValue <|> (Just <$> quotedString)- pure (key, value)- quotedString = do- _ <- Attoparsec.char '"'- chars <- many (escapedChar <|> normalChar)- _ <- Attoparsec.char '"'- pure (Text.pack chars)- escapedChar = do- _ <- Attoparsec.char '\\'- Attoparsec.anyChar- normalChar = Attoparsec.satisfy (\c -> c /= '"' && c /= '\\')- nullValue = do- _ <- Attoparsec.string "NULL"- pure Nothing -- * Accessors
src/library/PostgresqlTypes/Inet.hs view
@@ -49,7 +49,7 @@ -- | Network mask length (0-128). Word8 deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Inet)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Inet) instance Arbitrary Inet where arbitrary = do@@ -86,70 +86,13 @@ V4Inet addr netmask -> salt `hashWithSalt` (0 :: Int) `hashWithSalt` addr `hashWithSalt` netmask V6Inet w1 w2 w3 w4 netmask -> salt `hashWithSalt` (1 :: Int) `hashWithSalt` w1 `hashWithSalt` w2 `hashWithSalt` w3 `hashWithSalt` w4 `hashWithSalt` netmask -instance IsScalar Inet where+instance IsPrimitive Inet where schemaName = Tagged Nothing typeName = Tagged "inet" baseOid = Tagged (Just 869) arrayOid = Tagged (Just 1041) typeParams = Tagged [] - binaryEncoder = \case- V4Inet addr netmask ->- mconcat- [ Write.word8 2, -- IPv4 address family- Write.word8 netmask,- Write.word8 0, -- is_cidr flag (0 for inet)- Write.word8 4, -- address length (4 bytes for IPv4)- Write.bWord32 addr -- IPv4 address- ]- V6Inet w1 w2 w3 w4 netmask ->- mconcat- [ Write.word8 3, -- IPv6 address family for INET (different from CIDR)- Write.word8 netmask,- Write.word8 0, -- is_cidr flag (0 for inet)- Write.word8 16, -- address length (16 bytes for IPv6)- Write.bWord32 w1,- Write.bWord32 w2,- Write.bWord32 w3,- Write.bWord32 w4- ]-- binaryDecoder = do- (family, netmask, isCidrFlag, addrLen) <-- PtrPeeker.fixed do- (,,,)- <$> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1-- runExceptT do- when (isCidrFlag /= 0) do- throwError (DecodingError ["is-cidr"] (UnexpectedValueDecodingErrorReason "0" (TextBuilder.toText (TextBuilder.decimal isCidrFlag))))-- case family of- 2 -> do- -- IPv4- when (addrLen /= 4) do- throwError (DecodingError ["address-length"] (UnexpectedValueDecodingErrorReason "4" (TextBuilder.toText (TextBuilder.decimal addrLen))))- addr <- lift do- PtrPeeker.fixed PtrPeeker.beUnsignedInt4- pure (V4Inet addr (fromIntegral netmask))- 3 -> do- -- IPv6- when (addrLen /= 16) do- throwError (DecodingError ["address-length"] (UnexpectedValueDecodingErrorReason "16" (TextBuilder.toText (TextBuilder.decimal addrLen))))- lift do- PtrPeeker.fixed do- V6Inet- <$> PtrPeeker.beUnsignedInt4- <*> PtrPeeker.beUnsignedInt4- <*> PtrPeeker.beUnsignedInt4- <*> PtrPeeker.beUnsignedInt4- <*> pure (fromIntegral netmask)- _ -> do- throwError (DecodingError ["address-family"] (UnexpectedValueDecodingErrorReason "2 or 3" (TextBuilder.toText (TextBuilder.decimal family))))- textualEncoder = \case V4Inet addr netmask -> let a = ((addr `shiftR` 24) .&. 0xFF)@@ -249,6 +192,64 @@ _ -> fail "Expected 8 groups after expansion" parseHexGroup = Attoparsec.hexadecimal @Word16++instance IsBinaryPrimitive Inet where+ binaryEncoder = \case+ V4Inet addr netmask ->+ mconcat+ [ Write.word8 2, -- IPv4 address family+ Write.word8 netmask,+ Write.word8 0, -- is_cidr flag (0 for inet)+ Write.word8 4, -- address length (4 bytes for IPv4)+ Write.bWord32 addr -- IPv4 address+ ]+ V6Inet w1 w2 w3 w4 netmask ->+ mconcat+ [ Write.word8 3, -- IPv6 address family for INET (different from CIDR)+ Write.word8 netmask,+ Write.word8 0, -- is_cidr flag (0 for inet)+ Write.word8 16, -- address length (16 bytes for IPv6)+ Write.bWord32 w1,+ Write.bWord32 w2,+ Write.bWord32 w3,+ Write.bWord32 w4+ ]++ binaryDecoder = do+ (family, netmask, isCidrFlag, addrLen) <-+ PtrPeeker.fixed do+ (,,,)+ <$> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1++ runExceptT do+ when (isCidrFlag /= 0) do+ throwError (DecodingError ["is-cidr"] (UnexpectedValueDecodingErrorReason "0" (TextBuilder.toText (TextBuilder.decimal isCidrFlag))))++ case family of+ 2 -> do+ -- IPv4+ when (addrLen /= 4) do+ throwError (DecodingError ["address-length"] (UnexpectedValueDecodingErrorReason "4" (TextBuilder.toText (TextBuilder.decimal addrLen))))+ addr <- lift do+ PtrPeeker.fixed PtrPeeker.beUnsignedInt4+ pure (V4Inet addr (fromIntegral netmask))+ 3 -> do+ -- IPv6+ when (addrLen /= 16) do+ throwError (DecodingError ["address-length"] (UnexpectedValueDecodingErrorReason "16" (TextBuilder.toText (TextBuilder.decimal addrLen))))+ lift do+ PtrPeeker.fixed do+ V6Inet+ <$> PtrPeeker.beUnsignedInt4+ <*> PtrPeeker.beUnsignedInt4+ <*> PtrPeeker.beUnsignedInt4+ <*> PtrPeeker.beUnsignedInt4+ <*> pure (fromIntegral netmask)+ _ -> do+ throwError (DecodingError ["address-family"] (UnexpectedValueDecodingErrorReason "2 or 3" (TextBuilder.toText (TextBuilder.decimal family)))) -- * Accessors
src/library/PostgresqlTypes/Int2.hs view
@@ -24,18 +24,20 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-numeric.html#DATATYPE-INT). newtype Int2 = Int2 Int16 deriving newtype (Eq, Ord, Hashable, Arbitrary)- deriving (Show, Read, IsString) via (ViaIsScalar Int2)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Int2) -instance IsScalar Int2 where+instance IsPrimitive Int2 where schemaName = Tagged Nothing typeName = Tagged "int2" baseOid = Tagged (Just 21) arrayOid = Tagged (Just 1005) typeParams = Tagged []- binaryEncoder (Int2 x) = Write.bInt16 x- binaryDecoder = PtrPeeker.fixed (Right . Int2 <$> PtrPeeker.beSignedInt2) textualEncoder (Int2 x) = TextBuilder.decimal x textualDecoder = Int2 <$> Attoparsec.signed Attoparsec.decimal++instance IsBinaryPrimitive Int2 where+ binaryEncoder (Int2 x) = Write.bInt16 x+ binaryDecoder = PtrPeeker.fixed (Right . Int2 <$> PtrPeeker.beSignedInt2) -- * Accessors
src/library/PostgresqlTypes/Int4.hs view
@@ -24,18 +24,20 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-numeric.html#DATATYPE-INT). newtype Int4 = Int4 Int32 deriving newtype (Eq, Ord, Hashable, Arbitrary, Enum, Bounded)- deriving (Show, Read, IsString) via (ViaIsScalar Int4)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Int4) -instance IsScalar Int4 where+instance IsPrimitive Int4 where schemaName = Tagged Nothing typeName = Tagged "int4" baseOid = Tagged (Just 23) arrayOid = Tagged (Just 1007) typeParams = Tagged []- binaryEncoder (Int4 x) = Write.bInt32 x- binaryDecoder = PtrPeeker.fixed (Right . Int4 <$> PtrPeeker.beSignedInt4) textualEncoder (Int4 x) = TextBuilder.decimal x textualDecoder = Int4 <$> Attoparsec.signed Attoparsec.decimal++instance IsBinaryPrimitive Int4 where+ binaryEncoder (Int4 x) = Write.bInt32 x+ binaryDecoder = PtrPeeker.fixed (Right . Int4 <$> PtrPeeker.beSignedInt4) -- | Mapping to @int4range@ type. instance IsRangeElement Int4 where
src/library/PostgresqlTypes/Int8.hs view
@@ -24,18 +24,20 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-numeric.html#DATATYPE-INT). newtype Int8 = Int8 Int64 deriving newtype (Eq, Ord, Hashable, Arbitrary)- deriving (Show, Read, IsString) via (ViaIsScalar Int8)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Int8) -instance IsScalar Int8 where+instance IsPrimitive Int8 where schemaName = Tagged Nothing typeName = Tagged "int8" baseOid = Tagged (Just 20) arrayOid = Tagged (Just 1016) typeParams = Tagged []- binaryEncoder (Int8 x) = Write.bInt64 x- binaryDecoder = PtrPeeker.fixed (Right . Int8 <$> PtrPeeker.beSignedInt8) textualEncoder (Int8 x) = TextBuilder.decimal x textualDecoder = Int8 <$> Attoparsec.signed Attoparsec.decimal++instance IsBinaryPrimitive Int8 where+ binaryEncoder (Int8 x) = Write.bInt64 x+ binaryDecoder = PtrPeeker.fixed (Right . Int8 <$> PtrPeeker.beSignedInt8) -- | Mapping to @int8range@ type. instance IsRangeElement Int8 where
src/library/PostgresqlTypes/Interval.hs view
@@ -47,7 +47,7 @@ -- | Microseconds. Int64 deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Interval)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Interval) instance Bounded Interval where minBound = Interval (-178000000 * 12) 0 0@@ -64,19 +64,12 @@ hashWithSalt salt (Interval months days micros) = salt `hashWithSalt` months `hashWithSalt` days `hashWithSalt` micros -instance IsScalar Interval where+instance IsPrimitive Interval where schemaName = Tagged Nothing typeName = Tagged "interval" baseOid = Tagged (Just 1186) arrayOid = Tagged (Just 1187) typeParams = Tagged []- binaryEncoder (Interval months days micros) =- mconcat [Write.bInt64 micros, Write.bInt32 days, Write.bInt32 months]- binaryDecoder = PtrPeeker.fixed do- micros <- PtrPeeker.beSignedInt8- days <- PtrPeeker.beSignedInt4- months <- PtrPeeker.beSignedInt4- pure (Right (Interval months days micros)) -- Renders in "format with designators" of ISO-8601 as per [the Postgres documentation](https://www.postgresql.org/docs/current/datatype-datetime.html#DATATYPE-INTERVAL-INPUT). --@@ -281,6 +274,15 @@ 'S' -> parseTimePart hours mins (secs + (sign * n)) micros _ -> fail "Unexpected time designator" _ -> pure (hours, mins, secs, micros)++instance IsBinaryPrimitive Interval where+ binaryEncoder (Interval months days micros) =+ mconcat [Write.bInt64 micros, Write.bInt32 days, Write.bInt32 months]+ binaryDecoder = PtrPeeker.fixed do+ micros <- PtrPeeker.beSignedInt8+ days <- PtrPeeker.beSignedInt4+ months <- PtrPeeker.beSignedInt4+ pure (Right (Interval months days micros)) -- * Accessors
src/library/PostgresqlTypes/Json.hs view
@@ -35,18 +35,27 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-json.html). newtype Json = Json Aeson.Value deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Json)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Json) instance Arbitrary Json where arbitrary = normalizeFromAesonValue <$> arbitrary shrink = fmap Json . shrink . toAesonValue -instance IsScalar Json where+instance IsPrimitive Json where schemaName = Tagged Nothing typeName = Tagged "json" baseOid = Tagged (Just 114) arrayOid = Tagged (Just 199) typeParams = Tagged []+ textualEncoder =+ TextBuilder.lazyText . Aeson.Text.encodeToLazyText . toAesonValue+ textualDecoder = do+ jsonText <- Attoparsec.takeText+ case Aeson.eitherDecodeStrict (Text.Encoding.encodeUtf8 jsonText) of+ Left err -> fail err+ Right value -> pure (Json value)++instance IsBinaryPrimitive Json where binaryEncoder = -- JSON type stores as UTF-8 text without version byte prefix Jsonifier.toWrite . JsonifierAeson.aesonValue . toAesonValue@@ -66,13 +75,6 @@ Json (Aeson.eitherDecodeStrict jsonBytes) )- textualEncoder =- TextBuilder.lazyText . Aeson.Text.encodeToLazyText . toAesonValue- textualDecoder = do- jsonText <- Attoparsec.takeText- case Aeson.eitherDecodeStrict (Text.Encoding.encodeUtf8 jsonText) of- Left err -> fail err- Right value -> pure (Json value) -- * Accessors
src/library/PostgresqlTypes/Jsonb.hs view
@@ -33,18 +33,27 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-json.html). newtype Jsonb = Jsonb Aeson.Value deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Jsonb)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Jsonb) instance Arbitrary Jsonb where arbitrary = normalizeFromAesonValue <$> arbitrary shrink = fmap Jsonb . shrink . toAesonValue -instance IsScalar Jsonb where+instance IsPrimitive Jsonb where schemaName = Tagged Nothing typeName = Tagged "jsonb" baseOid = Tagged (Just 3802) arrayOid = Tagged (Just 3807) typeParams = Tagged []+ textualEncoder =+ TextBuilder.lazyText . Aeson.Text.encodeToLazyText . toAesonValue+ textualDecoder = do+ jsonText <- Attoparsec.takeText+ case Aeson.eitherDecodeStrict (Text.Encoding.encodeUtf8 jsonText) of+ Left err -> fail err+ Right value -> pure (Jsonb value)++instance IsBinaryPrimitive Jsonb where binaryEncoder = mappend (Write.word8 1) . Jsonifier.toWrite . JsonifierAeson.aesonValue . toAesonValue binaryDecoder = do@@ -78,13 +87,6 @@ } ) )- textualEncoder =- TextBuilder.lazyText . Aeson.Text.encodeToLazyText . toAesonValue- textualDecoder = do- jsonText <- Attoparsec.takeText- case Aeson.eitherDecodeStrict (Text.Encoding.encodeUtf8 jsonText) of- Left err -> fail err- Right value -> pure (Jsonb value) -- * Accessors
src/library/PostgresqlTypes/Line.hs view
@@ -37,7 +37,7 @@ -- | C coefficient Double deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Line)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Line) instance Arbitrary Line where arbitrary = do@@ -61,23 +61,12 @@ `hashWithSalt` castDoubleToWord64 b `hashWithSalt` castDoubleToWord64 c -instance IsScalar Line where+instance IsPrimitive Line where schemaName = Tagged Nothing typeName = Tagged "line" baseOid = Tagged (Just 628) arrayOid = Tagged (Just 629) typeParams = Tagged []- binaryEncoder (Line a b c) =- mconcat- [ Write.bWord64 (castDoubleToWord64 a),- Write.bWord64 (castDoubleToWord64 b),- Write.bWord64 (castDoubleToWord64 c)- ]- binaryDecoder = do- a <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- b <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- c <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- pure (Right (Line a b c)) textualEncoder (Line a b c) = "{" <> TextBuilder.string (printf "%g" a)@@ -95,6 +84,19 @@ c <- Attoparsec.double _ <- Attoparsec.char '}' pure (Line a b c)++instance IsBinaryPrimitive Line where+ binaryEncoder (Line a b c) =+ mconcat+ [ Write.bWord64 (castDoubleToWord64 a),+ Write.bWord64 (castDoubleToWord64 b),+ Write.bWord64 (castDoubleToWord64 c)+ ]+ binaryDecoder = do+ a <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ b <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ c <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ pure (Right (Line a b c)) -- * Accessors
src/library/PostgresqlTypes/Lseg.hs view
@@ -38,7 +38,7 @@ -- | Y coordinate of second endpoint Double deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Lseg)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Lseg) instance Arbitrary Lseg where arbitrary = Lseg <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary@@ -53,25 +53,12 @@ `hashWithSalt` castDoubleToWord64 x2 `hashWithSalt` castDoubleToWord64 y2 -instance IsScalar Lseg where+instance IsPrimitive Lseg where schemaName = Tagged Nothing typeName = Tagged "lseg" baseOid = Tagged (Just 601) arrayOid = Tagged (Just 1018) typeParams = Tagged []- binaryEncoder (Lseg x1 y1 x2 y2) =- mconcat- [ Write.bWord64 (castDoubleToWord64 x1),- Write.bWord64 (castDoubleToWord64 y1),- Write.bWord64 (castDoubleToWord64 x2),- Write.bWord64 (castDoubleToWord64 y2)- ]- binaryDecoder = do- x1 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- y1 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- x2 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- y2 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- pure (Right (Lseg x1 y1 x2 y2)) textualEncoder (Lseg x1 y1 x2 y2) = "[(" <> TextBuilder.string (printf "%g" x1)@@ -98,6 +85,21 @@ _ <- Attoparsec.char ')' _ <- Attoparsec.char ']' pure (Lseg x1 y1 x2 y2)++instance IsBinaryPrimitive Lseg where+ binaryEncoder (Lseg x1 y1 x2 y2) =+ mconcat+ [ Write.bWord64 (castDoubleToWord64 x1),+ Write.bWord64 (castDoubleToWord64 y1),+ Write.bWord64 (castDoubleToWord64 x2),+ Write.bWord64 (castDoubleToWord64 y2)+ ]+ binaryDecoder = do+ x1 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ y1 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ x2 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ y2 <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ pure (Right (Lseg x1 y1 x2 y2)) -- * Accessors
src/library/PostgresqlTypes/Macaddr.hs view
@@ -38,7 +38,7 @@ Word8 Word8 deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Macaddr)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Macaddr) instance Arbitrary Macaddr where arbitrary = do@@ -63,33 +63,12 @@ hashWithSalt salt (Macaddr a b c d e f) = salt `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c `hashWithSalt` d `hashWithSalt` e `hashWithSalt` f -instance IsScalar Macaddr where+instance IsPrimitive Macaddr where schemaName = Tagged Nothing typeName = Tagged "macaddr" baseOid = Tagged (Just 829) arrayOid = Tagged (Just 1040) typeParams = Tagged []- binaryEncoder (Macaddr a b c d e f) =- mconcat- [ Write.word8 a,- Write.word8 b,- Write.word8 c,- Write.word8 d,- Write.word8 e,- Write.word8 f- ]- binaryDecoder =- PtrPeeker.fixed- ( Right- <$> ( Macaddr- <$> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- )- ) textualEncoder (Macaddr a b c d e f) = (TextBuilder.intercalate ":") [ TextBuilder.hexadecimal a,@@ -124,6 +103,29 @@ <$> Attoparsec.satisfy (\c -> c >= 'a' && c <= 'f') <|> (\c -> fromIntegral (ord c - ord 'A' + 10)) <$> Attoparsec.satisfy (\c -> c >= 'A' && c <= 'F')++instance IsBinaryPrimitive Macaddr where+ binaryEncoder (Macaddr a b c d e f) =+ mconcat+ [ Write.word8 a,+ Write.word8 b,+ Write.word8 c,+ Write.word8 d,+ Write.word8 e,+ Write.word8 f+ ]+ binaryDecoder =+ PtrPeeker.fixed+ ( Right+ <$> ( Macaddr+ <$> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ )+ ) -- * Accessors
src/library/PostgresqlTypes/Macaddr8.hs view
@@ -49,7 +49,7 @@ -- | Eighth byte Word8 deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Macaddr8)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Macaddr8) instance Arbitrary Macaddr8 where arbitrary = do@@ -78,37 +78,12 @@ `hashWithSalt` g `hashWithSalt` h -instance IsScalar Macaddr8 where+instance IsPrimitive Macaddr8 where schemaName = Tagged Nothing typeName = Tagged "macaddr8" baseOid = Tagged (Just 774) arrayOid = Tagged (Just 775) typeParams = Tagged []- binaryEncoder (Macaddr8 a b c d e f g h) =- mconcat- [ Write.word8 a,- Write.word8 b,- Write.word8 c,- Write.word8 d,- Write.word8 e,- Write.word8 f,- Write.word8 g,- Write.word8 h- ]- binaryDecoder =- PtrPeeker.fixed- ( Right- <$> ( Macaddr8- <$> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- <*> PtrPeeker.unsignedInt1- )- ) textualEncoder (Macaddr8 a b c d e f g h) = TextBuilder.intercalate ":" $ [ formatByte a,@@ -152,6 +127,33 @@ <$> Attoparsec.satisfy (\c -> c >= 'a' && c <= 'f') <|> (\c -> fromIntegral (ord c - ord 'A' + 10)) <$> Attoparsec.satisfy (\c -> c >= 'A' && c <= 'F')++instance IsBinaryPrimitive Macaddr8 where+ binaryEncoder (Macaddr8 a b c d e f g h) =+ mconcat+ [ Write.word8 a,+ Write.word8 b,+ Write.word8 c,+ Write.word8 d,+ Write.word8 e,+ Write.word8 f,+ Write.word8 g,+ Write.word8 h+ ]+ binaryDecoder =+ PtrPeeker.fixed+ ( Right+ <$> ( Macaddr8+ <$> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ <*> PtrPeeker.unsignedInt1+ )+ ) -- * Accessors
src/library/PostgresqlTypes/Money.hs view
@@ -31,16 +31,14 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-money.html). newtype Money = Money Int64 deriving newtype (Eq, Ord, Hashable, Arbitrary)- deriving (Show, Read, IsString) via (ViaIsScalar Money)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Money) -instance IsScalar Money where+instance IsPrimitive Money where schemaName = Tagged Nothing typeName = Tagged "money" baseOid = Tagged (Just 790) arrayOid = Tagged (Just 791) typeParams = Tagged []- binaryEncoder (Money x) = Write.bInt64 x- binaryDecoder = PtrPeeker.fixed (Right . Money <$> PtrPeeker.beSignedInt8) textualEncoder (Money x) = -- Format as currency with 2 decimal places and $ symbol -- PostgreSQL's money type typically displays with currency symbol@@ -72,6 +70,10 @@ let cents = fromIntegral (digitToInt centsDigit1 * 10 + digitToInt centsDigit2) :: Int64 value = dollars * 100 + cents pure (Money (if isNegative then negate value else value))++instance IsBinaryPrimitive Money where+ binaryEncoder (Money x) = Write.bInt64 x+ binaryDecoder = PtrPeeker.fixed (Right . Money <$> PtrPeeker.beSignedInt8) -- * Accessors
src/library/PostgresqlTypes/Multirange.hs view
@@ -46,14 +46,31 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/rangetypes.html#RANGETYPES-MULTIRANGE). newtype Multirange a = Multirange (Vector (Range a)) deriving stock (Eq, Functor)- deriving (Show, Read, IsString) via (ViaIsScalar (Multirange a))+ deriving (Show, Read, IsString) via (ViaIsPrimitive (Multirange a)) -instance (IsMultirangeElement a) => IsScalar (Multirange a) where+instance (IsMultirangeElement a) => IsPrimitive (Multirange a) where schemaName = Tagged Nothing typeName = retag (multirangeTypeName @a) baseOid = retag (multirangeBaseOid @a) arrayOid = retag (multirangeArrayOid @a) typeParams = retag (typeParams @(Range a))+ textualEncoder = \case+ Multirange ranges ->+ mconcat+ [ "{",+ TextBuilder.intercalate "," (Vector.toList (Vector.map (textualEncoder @(Range a)) ranges)),+ "}"+ ]+ textualDecoder = do+ _ <- Attoparsec.char '{'+ Attoparsec.skipSpace+ ranges <- (textualDecoder @(Range a)) `Attoparsec.sepBy` (Attoparsec.skipSpace >> Attoparsec.char ',' >> Attoparsec.skipSpace)+ Attoparsec.skipSpace+ _ <- Attoparsec.char '}'+ Attoparsec.skipSpace+ pure (Multirange (Vector.fromList ranges))++instance (IsMultirangeElement a, IsBinaryPrimitive a) => IsBinaryPrimitive (Multirange a) where binaryEncoder = \case Multirange ranges -> mconcat@@ -76,22 +93,6 @@ ExceptT do PtrPeeker.forceSize (fromIntegral size) do binaryDecoder @(Range a)- pure (Multirange (Vector.fromList ranges))-- textualEncoder = \case- Multirange ranges ->- mconcat- [ "{",- TextBuilder.intercalate "," (Vector.toList (Vector.map (textualEncoder @(Range a)) ranges)),- "}"- ]- textualDecoder = do- _ <- Attoparsec.char '{'- Attoparsec.skipSpace- ranges <- (textualDecoder @(Range a)) `Attoparsec.sepBy` (Attoparsec.skipSpace >> Attoparsec.char ',' >> Attoparsec.skipSpace)- Attoparsec.skipSpace- _ <- Attoparsec.char '}'- Attoparsec.skipSpace pure (Multirange (Vector.fromList ranges)) instance (IsRangeElement a, Arbitrary a, Ord a) => Arbitrary (Multirange a) where
src/library/PostgresqlTypes/Numeric.hs view
@@ -53,7 +53,7 @@ | PosInfinityNumeric | NanNumeric deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar (Numeric precision scale))+ deriving (Show, Read, IsString) via (ViaIsPrimitive (Numeric precision scale)) instance (TypeLits.KnownNat precision, TypeLits.KnownNat scale) => Arbitrary (Numeric precision scale) where arbitrary =@@ -111,7 +111,7 @@ PosInfinityNumeric -> salt `hashWithSalt` (2 :: Int) NanNumeric -> salt `hashWithSalt` (3 :: Int) -instance (TypeLits.KnownNat precision, TypeLits.KnownNat scale) => IsScalar (Numeric precision scale) where+instance (TypeLits.KnownNat precision, TypeLits.KnownNat scale) => IsPrimitive (Numeric precision scale) where schemaName = Tagged Nothing typeName = Tagged "numeric" baseOid = Tagged (Just 1700)@@ -126,6 +126,40 @@ (p, s) -> [Text.pack (show p), Text.pack (show s)] -- numeric(precision, scale) ) + textualEncoder =+ let prec = fromIntegral (TypeLits.natVal (Proxy @precision)) :: Int+ sc = fromIntegral (TypeLits.natVal (Proxy @scale)) :: Int+ in \case+ ScientificNumeric scientific ->+ if sc == 0 && prec /= 0+ then TextBuilder.string (Scientific.formatScientific Scientific.Fixed (Just 0) scientific)+ else TextBuilder.string (Scientific.formatScientific Scientific.Fixed Nothing scientific)+ NanNumeric ->+ "NaN"+ NegInfinityNumeric ->+ "-Infinity"+ PosInfinityNumeric ->+ "Infinity"++ textualDecoder =+ let prec = fromIntegral (TypeLits.natVal (Proxy @precision)) :: Int+ sc = fromIntegral (TypeLits.natVal (Proxy @scale)) :: Int+ in asum+ [ if prec == 0 && sc == 0+ then ScientificNumeric <$> Attoparsec.scientific+ else do+ scientific <- Attoparsec.scientific+ if Scientific.validateNumericPrecisionScale prec sc scientific+ then pure (ScientificNumeric scientific)+ else fail ("Value does not satisfy the \"precision=" <> show prec <> ", scale=" <> show sc <> "\" constraints: " <> show scientific),+ NanNumeric <$ Attoparsec.string "NaN",+ NegInfinityNumeric <$ Attoparsec.string "-Infinity",+ NegInfinityNumeric <$ Attoparsec.string "-inf",+ PosInfinityNumeric <$ Attoparsec.string "Infinity",+ PosInfinityNumeric <$ Attoparsec.string "inf"+ ]++instance (TypeLits.KnownNat precision, TypeLits.KnownNat scale) => IsBinaryPrimitive (Numeric precision scale) where binaryEncoder = \case ScientificNumeric x -> mconcat@@ -228,39 +262,6 @@ "0x0000, 0x4000, 0xC000, 0xD000, or 0xF000" (Text.toUpper (TextBuilder.toText (TextBuilder.prefixedHexadecimal flag))) }-- textualEncoder =- let prec = fromIntegral (TypeLits.natVal (Proxy @precision)) :: Int- sc = fromIntegral (TypeLits.natVal (Proxy @scale)) :: Int- in \case- ScientificNumeric scientific ->- if sc == 0 && prec /= 0- then TextBuilder.string (Scientific.formatScientific Scientific.Fixed (Just 0) scientific)- else TextBuilder.string (Scientific.formatScientific Scientific.Fixed Nothing scientific)- NanNumeric ->- "NaN"- NegInfinityNumeric ->- "-Infinity"- PosInfinityNumeric ->- "Infinity"-- textualDecoder =- let prec = fromIntegral (TypeLits.natVal (Proxy @precision)) :: Int- sc = fromIntegral (TypeLits.natVal (Proxy @scale)) :: Int- in asum- [ if prec == 0 && sc == 0- then ScientificNumeric <$> Attoparsec.scientific- else do- scientific <- Attoparsec.scientific- if Scientific.validateNumericPrecisionScale prec sc scientific- then pure (ScientificNumeric scientific)- else fail ("Value does not satisfy the \"precision=" <> show prec <> ", scale=" <> show sc <> "\" constraints: " <> show scientific),- NanNumeric <$ Attoparsec.string "NaN",- NegInfinityNumeric <$ Attoparsec.string "-Infinity",- NegInfinityNumeric <$ Attoparsec.string "-inf",- PosInfinityNumeric <$ Attoparsec.string "Infinity",- PosInfinityNumeric <$ Attoparsec.string "inf"- ] -- | Mapping to @numrange@ type. instance (TypeLits.KnownNat precision, TypeLits.KnownNat scale) => IsRangeElement (Numeric precision scale) where
src/library/PostgresqlTypes/Oid.hs view
@@ -24,18 +24,20 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-oid.html). newtype Oid = Oid Word32 deriving newtype (Eq, Ord, Hashable, Arbitrary)- deriving (Show, Read, IsString) via (ViaIsScalar Oid)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Oid) -instance IsScalar Oid where+instance IsPrimitive Oid where schemaName = Tagged Nothing typeName = Tagged "oid" baseOid = Tagged (Just 26) arrayOid = Tagged (Just 1028) typeParams = Tagged []- binaryEncoder (Oid x) = Write.bWord32 x- binaryDecoder = PtrPeeker.fixed (Right . Oid <$> PtrPeeker.beUnsignedInt4) textualEncoder (Oid x) = TextBuilder.decimal x textualDecoder = Oid <$> Attoparsec.decimal++instance IsBinaryPrimitive Oid where+ binaryEncoder (Oid x) = Write.bWord32 x+ binaryDecoder = PtrPeeker.fixed (Right . Oid <$> PtrPeeker.beUnsignedInt4) -- * Accessors
src/library/PostgresqlTypes/Path.hs view
@@ -35,7 +35,7 @@ -- | Points in the path (UnboxedVector.Vector (Double, Double)) deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Path)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Path) instance Arbitrary Path where arbitrary = do@@ -56,12 +56,39 @@ hashWithSalt salt (Path closed points) = salt `hashWithSalt` closed `hashWithSalt` UnboxedVector.toList points -instance IsScalar Path where+instance IsPrimitive Path where schemaName = Tagged Nothing typeName = Tagged "path" baseOid = Tagged (Just 602) arrayOid = Tagged (Just 1019) typeParams = Tagged []+ textualEncoder (Path closed points) =+ let openChar = if closed then "(" else "["+ closeChar = if closed then ")" else "]"+ pointsStr = TextBuilder.intercalateMap "," encodePoint (UnboxedVector.toList points)+ in openChar <> pointsStr <> closeChar+ where+ encodePoint (x, y) =+ "(" <> TextBuilder.string (printf "%g" x) <> "," <> TextBuilder.string (printf "%g" y) <> ")"+ textualDecoder = do+ closed <-+ True+ <$ Attoparsec.char '('+ <|> False+ <$ Attoparsec.char '['+ points <- parsePoint `Attoparsec.sepBy1` Attoparsec.char ','+ _ <- Attoparsec.char (if closed then ')' else ']')+ pure (Path closed (UnboxedVector.fromList points))+ where+ parsePoint = do+ _ <- Attoparsec.char '('+ x <- Attoparsec.double+ _ <- Attoparsec.char ','+ y <- Attoparsec.double+ _ <- Attoparsec.char ')'+ pure (x, y)++instance IsBinaryPrimitive Path where binaryEncoder (Path closed points) = let closedByte = if closed then 1 else 0 :: Word8 numPoints = fromIntegral (UnboxedVector.length points) :: Int32@@ -87,31 +114,6 @@ decodePoint = PtrPeeker.fixed do x <- castWord64ToDouble <$> PtrPeeker.beUnsignedInt8 y <- castWord64ToDouble <$> PtrPeeker.beUnsignedInt8- pure (x, y)- textualEncoder (Path closed points) =- let openChar = if closed then "(" else "["- closeChar = if closed then ")" else "]"- pointsStr = TextBuilder.intercalateMap "," encodePoint (UnboxedVector.toList points)- in openChar <> pointsStr <> closeChar- where- encodePoint (x, y) =- "(" <> TextBuilder.string (printf "%g" x) <> "," <> TextBuilder.string (printf "%g" y) <> ")"- textualDecoder = do- closed <-- True- <$ Attoparsec.char '('- <|> False- <$ Attoparsec.char '['- points <- parsePoint `Attoparsec.sepBy1` Attoparsec.char ','- _ <- Attoparsec.char (if closed then ')' else ']')- pure (Path closed (UnboxedVector.fromList points))- where- parsePoint = do- _ <- Attoparsec.char '('- x <- Attoparsec.double- _ <- Attoparsec.char ','- y <- Attoparsec.double- _ <- Attoparsec.char ')' pure (x, y) -- * Accessors
src/library/PostgresqlTypes/Point.hs view
@@ -32,7 +32,7 @@ -- | Y coordinate Double deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Point)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Point) instance Arbitrary Point where arbitrary = Point <$> arbitrary <*> arbitrary@@ -42,21 +42,12 @@ hashWithSalt salt (Point x y) = salt `hashWithSalt` castDoubleToWord64 x `hashWithSalt` castDoubleToWord64 y -instance IsScalar Point where+instance IsPrimitive Point where schemaName = Tagged Nothing typeName = Tagged "point" baseOid = Tagged (Just 600) arrayOid = Tagged (Just 1017) typeParams = Tagged []- binaryEncoder (Point x y) =- mconcat- [ Write.bWord64 (castDoubleToWord64 x),- Write.bWord64 (castDoubleToWord64 y)- ]- binaryDecoder = do- x <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- y <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)- pure (Right (Point x y)) textualEncoder (Point x y) = "(" <> TextBuilder.string (printf "%g" x) <> "," <> TextBuilder.string (printf "%g" y) <> ")" textualDecoder = do@@ -66,6 +57,17 @@ y <- Attoparsec.double _ <- Attoparsec.char ')' pure (Point x y)++instance IsBinaryPrimitive Point where+ binaryEncoder (Point x y) =+ mconcat+ [ Write.bWord64 (castDoubleToWord64 x),+ Write.bWord64 (castDoubleToWord64 y)+ ]+ binaryDecoder = do+ x <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ y <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)+ pure (Right (Point x y)) -- * Accessors
src/library/PostgresqlTypes/Polygon.hs view
@@ -32,7 +32,7 @@ newtype Polygon = Polygon (UnboxedVector.Vector (Double, Double)) deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Polygon)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Polygon) instance Arbitrary Polygon where arbitrary = do@@ -53,12 +53,32 @@ hashWithSalt salt (Polygon points) = salt `hashWithSalt` UnboxedVector.toList points -instance IsScalar Polygon where+instance IsPrimitive Polygon where schemaName = Tagged Nothing typeName = Tagged "polygon" baseOid = Tagged (Just 604) arrayOid = Tagged (Just 1027) typeParams = Tagged []+ textualEncoder (Polygon points) =+ "(" <> TextBuilder.intercalateMap "," encodePoint (UnboxedVector.toList points) <> ")"+ where+ encodePoint (x, y) =+ "(" <> TextBuilder.string (printf "%g" x) <> "," <> TextBuilder.string (printf "%g" y) <> ")"+ textualDecoder = do+ _ <- Attoparsec.char '('+ points <- parsePoint `Attoparsec.sepBy1` Attoparsec.char ','+ _ <- Attoparsec.char ')'+ pure (Polygon (UnboxedVector.fromList points))+ where+ parsePoint = do+ _ <- Attoparsec.char '('+ x <- Attoparsec.double+ _ <- Attoparsec.char ','+ y <- Attoparsec.double+ _ <- Attoparsec.char ')'+ pure (x, y)++instance IsBinaryPrimitive Polygon where binaryEncoder (Polygon points) = let numPoints = fromIntegral (UnboxedVector.length points) :: Int32 pointsEncoded = UnboxedVector.foldMap encodePoint points@@ -80,24 +100,6 @@ decodePoint = PtrPeeker.fixed do x <- castWord64ToDouble <$> PtrPeeker.beUnsignedInt8 y <- castWord64ToDouble <$> PtrPeeker.beUnsignedInt8- pure (x, y)- textualEncoder (Polygon points) =- "(" <> TextBuilder.intercalateMap "," encodePoint (UnboxedVector.toList points) <> ")"- where- encodePoint (x, y) =- "(" <> TextBuilder.string (printf "%g" x) <> "," <> TextBuilder.string (printf "%g" y) <> ")"- textualDecoder = do- _ <- Attoparsec.char '('- points <- parsePoint `Attoparsec.sepBy1` Attoparsec.char ','- _ <- Attoparsec.char ')'- pure (Polygon (UnboxedVector.fromList points))- where- parsePoint = do- _ <- Attoparsec.char '('- x <- Attoparsec.double- _ <- Attoparsec.char ','- y <- Attoparsec.double- _ <- Attoparsec.char ')' pure (x, y) -- * Accessors
src/library/PostgresqlTypes/Range.hs view
@@ -48,14 +48,50 @@ = EmptyRange | BoundedRange (Maybe a) (Maybe a) deriving stock (Eq, Functor)- deriving (Show, Read, IsString) via (ViaIsScalar (Range a))+ deriving (Show, Read, IsString) via (ViaIsPrimitive (Range a)) -instance (IsRangeElement a) => IsScalar (Range a) where+instance (IsRangeElement a) => IsPrimitive (Range a) where schemaName = Tagged Nothing typeName = retag (rangeTypeName @a) baseOid = retag (rangeBaseOid @a) arrayOid = retag (rangeArrayOid @a) typeParams = retag (typeParams @a)+ textualEncoder = \case+ EmptyRange -> "empty"+ BoundedRange lowerValue upperValue ->+ mconcat+ [ case lowerValue of+ Nothing -> "("+ Just lowerValue -> "[" <> textualEncoder lowerValue,+ ",",+ case upperValue of+ Nothing -> ")"+ Just upperValue -> textualEncoder upperValue <> ")"+ ]+ textualDecoder =+ parseEmpty <|> parseBounded+ where+ parseEmpty = EmptyRange <$ Attoparsec.string "empty"+ parseBounded = do+ lowerBracket <- Attoparsec.satisfy (\c -> c == '[' || c == '(')+ Attoparsec.skipSpace+ lowerValue <-+ if lowerBracket == '['+ then Just <$> parseElement+ else pure Nothing+ Attoparsec.skipSpace+ _ <- Attoparsec.char ','+ upperValue <- optional parseElement+ _ <- Attoparsec.char ')'+ pure (BoundedRange lowerValue upperValue)++ -- Parse element that might be quoted by PostgreSQL (for extreme dates)+ parseElement =+ quotedElement <|> textualDecoder @a+ where+ quotedElement = Attoparsec.char '"' *> textualDecoder @a <* Attoparsec.char '"'++instance (IsRangeElement a, IsBinaryPrimitive a) => IsBinaryPrimitive (Range a) where binaryEncoder = \case EmptyRange -> Write.word8 0b00000001@@ -113,41 +149,6 @@ ExceptT do PtrPeeker.forceSize (fromIntegral size) do binaryDecoder @a-- textualEncoder = \case- EmptyRange -> "empty"- BoundedRange lowerValue upperValue ->- mconcat- [ case lowerValue of- Nothing -> "("- Just lowerValue -> "[" <> textualEncoder lowerValue,- ",",- case upperValue of- Nothing -> ")"- Just upperValue -> textualEncoder upperValue <> ")"- ]- textualDecoder =- parseEmpty <|> parseBounded- where- parseEmpty = EmptyRange <$ Attoparsec.string "empty"- parseBounded = do- lowerBracket <- Attoparsec.satisfy (\c -> c == '[' || c == '(')- Attoparsec.skipSpace- lowerValue <-- if lowerBracket == '['- then Just <$> parseElement- else pure Nothing- Attoparsec.skipSpace- _ <- Attoparsec.char ','- upperValue <- optional parseElement- _ <- Attoparsec.char ')'- pure (BoundedRange lowerValue upperValue)-- -- Parse element that might be quoted by PostgreSQL (for extreme dates)- parseElement =- quotedElement <|> textualDecoder @a- where- quotedElement = Attoparsec.char '"' *> textualDecoder @a <* Attoparsec.char '"' instance (Arbitrary a, Ord a) => Arbitrary (Range a) where arbitrary =
src/library/PostgresqlTypes/Text.hs view
@@ -27,7 +27,7 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-character.html). newtype Text = Text Text.Text deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Text)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Text) instance Arbitrary Text where arbitrary =@@ -38,12 +38,16 @@ shrink (Text base) = Text . Text.pack <$> shrink (Text.unpack base) -instance IsScalar Text where+instance IsPrimitive Text where schemaName = Tagged Nothing typeName = Tagged "text" baseOid = Tagged (Just 25) arrayOid = Tagged (Just 1009) typeParams = Tagged []+ textualEncoder (Text base) = TextBuilder.text base+ textualDecoder = Text <$> Attoparsec.takeText++instance IsBinaryPrimitive Text where binaryEncoder (Text base) = Write.textUtf8 base binaryDecoder = do bytes <- PtrPeeker.remainderAsByteString@@ -61,8 +65,6 @@ ) ) Right base -> pure (Right (Text base))- textualEncoder (Text base) = TextBuilder.text base- textualDecoder = Text <$> Attoparsec.takeText -- * Accessors
src/library/PostgresqlTypes/Time.hs view
@@ -32,19 +32,17 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-datetime.html#DATATYPE-TIME). newtype Time = Time Int64 deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Time)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Time) instance Arbitrary Time where arbitrary = Time <$> QuickCheck.choose (toMicroseconds minBound, toMicroseconds maxBound) -instance IsScalar Time where+instance IsPrimitive Time where schemaName = Tagged Nothing typeName = Tagged "time" baseOid = Tagged (Just 1083) arrayOid = Tagged (Just 1183) typeParams = Tagged []- binaryEncoder (Time microseconds) = Write.bInt64 microseconds- binaryDecoder = PtrPeeker.fixed (Right . Time <$> PtrPeeker.beSignedInt8) textualEncoder (Time microseconds) = let diffTime = fromIntegral microseconds / 1_000_000 timeOfDay = Time.timeToTimeOfDay diffTime@@ -75,6 +73,10 @@ let paddedDigits = take 6 (Text.unpack digits ++ repeat '0') micros = foldl' (\acc c -> acc * 10 + fromIntegral (digitToInt c)) 0 paddedDigits pure micros++instance IsBinaryPrimitive Time where+ binaryEncoder (Time microseconds) = Write.bInt64 microseconds+ binaryDecoder = PtrPeeker.fixed (Right . Time <$> PtrPeeker.beSignedInt8) instance Bounded Time where minBound = Time 0
src/library/PostgresqlTypes/Timestamp.hs view
@@ -31,21 +31,17 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-datetime.html#DATATYPE-DATETIME). newtype Timestamp = Timestamp Int64 deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Timestamp)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Timestamp) instance Arbitrary Timestamp where arbitrary = Timestamp <$> QuickCheck.choose (minMicroseconds, maxMicroseconds) -instance IsScalar Timestamp where+instance IsPrimitive Timestamp where schemaName = Tagged Nothing typeName = Tagged "timestamp" baseOid = Tagged (Just 1114) arrayOid = Tagged (Just 1115) typeParams = Tagged []- binaryEncoder (Timestamp micros) = Write.bInt64 micros- binaryDecoder = do- microseconds <- PtrPeeker.fixed PtrPeeker.beSignedInt8- pure (Right (Timestamp microseconds)) textualEncoder (toLocalTime -> localTime) = formatTimestampForPostgreSQL localTime textualDecoder = do@@ -109,6 +105,12 @@ micros = foldl' (\acc c -> acc * 10 + digitToInt c) 0 paddedDigits pure micros isLeapYear yr = (yr `mod` 4 == 0 && yr `mod` 100 /= 0) || (yr `mod` 400 == 0)++instance IsBinaryPrimitive Timestamp where+ binaryEncoder (Timestamp micros) = Write.bInt64 micros+ binaryDecoder = do+ microseconds <- PtrPeeker.fixed PtrPeeker.beSignedInt8+ pure (Right (Timestamp microseconds)) -- | Mapping to @tsrange@ type. instance IsRangeElement Timestamp where
src/library/PostgresqlTypes/Timestamptz.hs view
@@ -31,21 +31,17 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-datetime.html#DATATYPE-TIMEZONES). newtype Timestamptz = Timestamptz Int64 deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Timestamptz)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Timestamptz) instance Arbitrary Timestamptz where arbitrary = Timestamptz <$> QuickCheck.choose (minMicroseconds, maxMicroseconds) -instance IsScalar Timestamptz where+instance IsPrimitive Timestamptz where schemaName = Tagged Nothing typeName = Tagged "timestamptz" baseOid = Tagged (Just 1184) arrayOid = Tagged (Just 1185) typeParams = Tagged []- binaryEncoder (Timestamptz micros) = Write.bInt64 micros- binaryDecoder = do- microseconds <- PtrPeeker.fixed PtrPeeker.beSignedInt8- pure (Right (Timestamptz microseconds)) textualEncoder (toUtcTime -> utcTime) = formatTimestamptzForPostgreSQL utcTime textualDecoder = do@@ -120,6 +116,12 @@ mi <- Attoparsec.option 0 (Attoparsec.option ':' (Attoparsec.char ':') *> twoDigits) pure (sign * (h * 60 + mi)) isLeapYear yr = (yr `mod` 4 == 0 && yr `mod` 100 /= 0) || (yr `mod` 400 == 0)++instance IsBinaryPrimitive Timestamptz where+ binaryEncoder (Timestamptz micros) = Write.bInt64 micros+ binaryDecoder = do+ microseconds <- PtrPeeker.fixed PtrPeeker.beSignedInt8+ pure (Right (Timestamptz microseconds)) -- | Mapping to @tstzrange@ type. instance IsRangeElement Timestamptz where
src/library/PostgresqlTypes/Timetz.hs view
@@ -40,7 +40,7 @@ -- | Timezone offset in seconds (positive is east of UTC, negative is west of UTC) Offset.TimetzOffset deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Timetz)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Timetz) instance Arbitrary Timetz where arbitrary = do@@ -52,25 +52,13 @@ hashWithSalt salt (Timetz time offset) = salt `hashWithSalt` Time.toMicroseconds time `hashWithSalt` Offset.toSeconds offset -instance IsScalar Timetz where+instance IsPrimitive Timetz where schemaName = Tagged Nothing typeName = Tagged "timetz" baseOid = Tagged (Just 1266) arrayOid = Tagged (Just 1270) typeParams = Tagged [] - binaryEncoder (Timetz time offset) =- mconcat- [ Time.binaryEncoder time,- Offset.binaryEncoder offset- ]-- binaryDecoder =- PtrPeeker.fixed do- time <- Time.binaryDecoder- offset <- Offset.binaryDecoder- pure (Timetz <$> time <*> offset)- -- Format: -- 23:59:59-15:59:59 -- 24:00:00-15:59:59@@ -109,6 +97,19 @@ let paddedDigits = take 6 (Text.unpack digits ++ repeat '0') micros = foldl' (\acc c -> acc * 10 + fromIntegral (digitToInt c)) 0 paddedDigits pure micros++instance IsBinaryPrimitive Timetz where+ binaryEncoder (Timetz time offset) =+ mconcat+ [ Time.binaryEncoder time,+ Offset.binaryEncoder offset+ ]++ binaryDecoder =+ PtrPeeker.fixed do+ time <- Time.binaryDecoder+ offset <- Offset.binaryDecoder+ pure (Timetz <$> time <*> offset) -- * Accessors
src/library/PostgresqlTypes/Tsvector.hs view
@@ -46,7 +46,7 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-textsearch.html). data Tsvector = Tsvector (Vector (Text, Vector (Word16, Weight))) deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar Tsvector)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Tsvector) instance Hashable Tsvector where hashWithSalt salt (Tsvector lexemes) =@@ -100,13 +100,87 @@ . List.groupBy (\a b -> fst a == fst b) . List.sortOn fst -instance IsScalar Tsvector where+instance IsPrimitive Tsvector where schemaName = Tagged Nothing typeName = Tagged "tsvector" baseOid = Tagged (Just 3614) arrayOid = Tagged (Just 3643) typeParams = Tagged [] + -- Text format: 'lexeme1':1A,2B 'lexeme2':3C+ -- Single quotes are escaped as '', backslashes as \\+ textualEncoder (Tsvector lexemes) =+ TextBuilder.intercalateMap " " encodeLexeme (Vector.toList lexemes)+ where+ encodeLexeme (token, positions) =+ TextBuilder.char '\''+ <> TextBuilder.text (escapeToken token)+ <> TextBuilder.char '\''+ <> if Vector.null positions+ then mempty+ else TextBuilder.char ':' <> TextBuilder.intercalateMap "," encodePosition (Vector.toList positions)+ encodePosition (pos, weight) =+ TextBuilder.string (show pos)+ <> case weight of+ AWeight -> TextBuilder.char 'A'+ BWeight -> TextBuilder.char 'B'+ CWeight -> TextBuilder.char 'C'+ DWeight -> mempty -- D is default, omitted by PostgreSQL+ escapeToken = Text.concatMap escapeChar+ escapeChar c = case c of+ '\'' -> "''"+ '\\' -> "\\\\"+ _ -> Text.singleton c++ textualDecoder = do+ -- Allow and ignore leading whitespace before the first lexeme+ Attoparsec.skipSpace+ lexemes <- lexemeParser `Attoparsec.sepBy` space1+ -- Allow and ignore trailing whitespace after the last lexeme+ Attoparsec.skipSpace+ -- Sort and deduplicate to match PostgreSQL's canonical form+ let Tsvector normalized = normalizeLexemes (map (\(t, ps) -> (t, Vector.fromList ps)) lexemes)+ pure (Tsvector normalized)+ where+ -- Consume one or more space / tab / newline characters between lexemes+ space1 = do+ _ <- Attoparsec.takeWhile1 (\c -> c == ' ' || c == '\t' || c == '\n')+ pure ()+ lexemeParser = do+ _ <- Attoparsec.char '\''+ token <- parseToken+ _ <- Attoparsec.char '\''+ positions <- parsePositions <|> pure []+ pure (token, positions)+ parseToken = do+ chars <- many (escapedQuote <|> escapedBackslash <|> normalChar)+ pure (Text.pack chars)+ escapedQuote = do+ _ <- Attoparsec.string "''"+ pure '\''+ escapedBackslash = do+ _ <- Attoparsec.string "\\\\"+ pure '\\'+ normalChar = Attoparsec.satisfy (\c -> c /= '\'' && c /= '\\')+ parsePositions = do+ _ <- Attoparsec.char ':'+ parsePosition `Attoparsec.sepBy1` Attoparsec.char ','+ parsePosition = do+ pos <- Attoparsec.decimal @Integer+ when (pos < 1 || pos > 16383) do+ fail ("tsvector position out of range 1..16383: " <> show pos)+ let pos' = fromIntegral pos :: Word16+ weight <-+ asum+ [ Attoparsec.char 'A' $> AWeight,+ Attoparsec.char 'B' $> BWeight,+ Attoparsec.char 'C' $> CWeight,+ Attoparsec.char 'D' $> DWeight,+ pure DWeight+ ]+ pure (pos', weight)++instance IsBinaryPrimitive Tsvector where -- Binary format: -- 4 bytes: number of lexemes (int32) -- Per lexeme:@@ -186,79 +260,6 @@ let pos = posWord .&. 0x3FFF pure (pos, weight) pure (token, positions)-- -- Text format: 'lexeme1':1A,2B 'lexeme2':3C- -- Single quotes are escaped as '', backslashes as \\- textualEncoder (Tsvector lexemes) =- TextBuilder.intercalateMap " " encodeLexeme (Vector.toList lexemes)- where- encodeLexeme (token, positions) =- TextBuilder.char '\''- <> TextBuilder.text (escapeToken token)- <> TextBuilder.char '\''- <> if Vector.null positions- then mempty- else TextBuilder.char ':' <> TextBuilder.intercalateMap "," encodePosition (Vector.toList positions)- encodePosition (pos, weight) =- TextBuilder.string (show pos)- <> case weight of- AWeight -> TextBuilder.char 'A'- BWeight -> TextBuilder.char 'B'- CWeight -> TextBuilder.char 'C'- DWeight -> mempty -- D is default, omitted by PostgreSQL- escapeToken = Text.concatMap escapeChar- escapeChar c = case c of- '\'' -> "''"- '\\' -> "\\\\"- _ -> Text.singleton c-- textualDecoder = do- -- Allow and ignore leading whitespace before the first lexeme- Attoparsec.skipSpace- lexemes <- lexemeParser `Attoparsec.sepBy` space1- -- Allow and ignore trailing whitespace after the last lexeme- Attoparsec.skipSpace- -- Sort and deduplicate to match PostgreSQL's canonical form- let Tsvector normalized = normalizeLexemes (map (\(t, ps) -> (t, Vector.fromList ps)) lexemes)- pure (Tsvector normalized)- where- -- Consume one or more space / tab / newline characters between lexemes- space1 = do- _ <- Attoparsec.takeWhile1 (\c -> c == ' ' || c == '\t' || c == '\n')- pure ()- lexemeParser = do- _ <- Attoparsec.char '\''- token <- parseToken- _ <- Attoparsec.char '\''- positions <- parsePositions <|> pure []- pure (token, positions)- parseToken = do- chars <- many (escapedQuote <|> escapedBackslash <|> normalChar)- pure (Text.pack chars)- escapedQuote = do- _ <- Attoparsec.string "''"- pure '\''- escapedBackslash = do- _ <- Attoparsec.string "\\\\"- pure '\\'- normalChar = Attoparsec.satisfy (\c -> c /= '\'' && c /= '\\')- parsePositions = do- _ <- Attoparsec.char ':'- parsePosition `Attoparsec.sepBy1` Attoparsec.char ','- parsePosition = do- pos <- Attoparsec.decimal @Integer- when (pos < 1 || pos > 16383) do- fail ("tsvector position out of range 1..16383: " <> show pos)- let pos' = fromIntegral pos :: Word16- weight <-- asum- [ Attoparsec.char 'A' $> AWeight,- Attoparsec.char 'B' $> BWeight,- Attoparsec.char 'C' $> CWeight,- Attoparsec.char 'D' $> DWeight,- pure DWeight- ]- pure (pos', weight) -- * Accessors
src/library/PostgresqlTypes/Uuid.hs view
@@ -25,7 +25,7 @@ -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-uuid.html). newtype Uuid = Uuid Data.UUID.UUID deriving newtype (Eq, Ord, Hashable)- deriving (Show, Read, IsString) via (ViaIsScalar Uuid)+ deriving (Show, Read, IsString) via (ViaIsPrimitive Uuid) instance Arbitrary Uuid where arbitrary = Uuid <$> (Data.UUID.fromWords64 <$> arbitrary <*> arbitrary)@@ -35,12 +35,20 @@ (w1, w2) <- shrink (w1, w2) ] -instance IsScalar Uuid where+instance IsPrimitive Uuid where schemaName = Tagged Nothing typeName = Tagged "uuid" baseOid = Tagged (Just 2950) arrayOid = Tagged (Just 2951) typeParams = Tagged []+ textualEncoder = TextBuilder.text . Data.UUID.toText . coerce+ textualDecoder = do+ uuidText <- Attoparsec.takeText+ case Data.UUID.fromText uuidText of+ Nothing -> fail "Invalid UUID format"+ Just uuid -> pure (Uuid uuid)++instance IsBinaryPrimitive Uuid where binaryEncoder (Uuid uuid) = case Data.UUID.toWords uuid of (w1, w2, w3, w4) ->@@ -58,12 +66,6 @@ <*> PtrPeeker.beUnsignedInt4 <*> PtrPeeker.beUnsignedInt4 )- textualEncoder = TextBuilder.text . Data.UUID.toText . coerce- textualDecoder = do- uuidText <- Attoparsec.takeText- case Data.UUID.fromText uuidText of- Nothing -> fail "Invalid UUID format"- Just uuid -> pure (Uuid uuid) -- * Accessors
src/library/PostgresqlTypes/Varbit.hs view
@@ -42,7 +42,7 @@ -- | Bit data (packed into bytes) ByteString deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar (Varbit maxLen))+ deriving (Show, Read, IsString) via (ViaIsPrimitive (Varbit maxLen)) instance (TypeLits.KnownNat maxLen) => Arbitrary (Varbit maxLen) where arbitrary = do@@ -61,34 +61,13 @@ instance Hashable (Varbit maxLen) where hashWithSalt salt (Varbit len bytes) = salt `hashWithSalt` len `hashWithSalt` bytes -instance (TypeLits.KnownNat maxLen) => IsScalar (Varbit maxLen) where+instance (TypeLits.KnownNat maxLen) => IsPrimitive (Varbit maxLen) where schemaName = Tagged Nothing typeName = Tagged "varbit" baseOid = Tagged (Just 1562) arrayOid = Tagged (Just 1563) typeParams = Tagged [Text.pack (show (TypeLits.natVal (Proxy @maxLen)))]- binaryEncoder (Varbit len bytes) =- Write.bInt32 len <> Write.byteString bytes- binaryDecoder =- let maxLen = fromIntegral (TypeLits.natVal (Proxy @maxLen))- in do- len <- PtrPeeker.fixed PtrPeeker.beSignedInt4- bytes <- PtrPeeker.remainderAsByteString-- pure- if len <= maxLen- then Right (Varbit len bytes)- else- Left- ( DecodingError- { location = ["Varbit"],- reason =- UnsupportedValueDecodingErrorReason- ("Varbit length " <> Text.pack (show len) <> " exceeds maximum " <> Text.pack (show maxLen))- (TextBuilder.toText (TextBuilder.decimal len))- }- ) textualEncoder (Varbit len bytes) = let bits = concatMap byteToBits (ByteString.unpack bytes) trimmedBits = take (fromIntegral len) bits@@ -115,6 +94,29 @@ chunksOf :: Int -> [a] -> [[a]] chunksOf _ [] = [] chunksOf n xs = take n xs : chunksOf n (drop n xs)++instance (TypeLits.KnownNat maxLen) => IsBinaryPrimitive (Varbit maxLen) where+ binaryEncoder (Varbit len bytes) =+ Write.bInt32 len <> Write.byteString bytes+ binaryDecoder =+ let maxLen = fromIntegral (TypeLits.natVal (Proxy @maxLen))+ in do+ len <- PtrPeeker.fixed PtrPeeker.beSignedInt4+ bytes <- PtrPeeker.remainderAsByteString++ pure+ if len <= maxLen+ then Right (Varbit len bytes)+ else+ Left+ ( DecodingError+ { location = ["Varbit"],+ reason =+ UnsupportedValueDecodingErrorReason+ ("Varbit length " <> Text.pack (show len) <> " exceeds maximum " <> Text.pack (show maxLen))+ (TextBuilder.toText (TextBuilder.decimal len))+ }+ ) -- * Accessors
src/library/PostgresqlTypes/Varchar.hs view
@@ -30,7 +30,7 @@ -- Character strings up to this length can be represented by this type. newtype Varchar (maxLen :: TypeLits.Nat) = Varchar Text.Text deriving stock (Eq, Ord)- deriving (Show, Read, IsString) via (ViaIsScalar (Varchar maxLen))+ deriving (Show, Read, IsString) via (ViaIsPrimitive (Varchar maxLen)) deriving newtype (Hashable) instance (TypeLits.KnownNat maxLen) => Arbitrary (Varchar maxLen) where@@ -45,13 +45,23 @@ shrunk = Text.pack <$> shrink (Text.unpack base) in [Varchar txt | txt <- shrunk, Text.length txt <= maxLen] -instance (TypeLits.KnownNat maxLen) => IsScalar (Varchar maxLen) where+instance (TypeLits.KnownNat maxLen) => IsPrimitive (Varchar maxLen) where schemaName = Tagged Nothing typeName = Tagged "varchar" baseOid = Tagged (Just 1043) arrayOid = Tagged (Just 1015) typeParams = Tagged [Text.pack (show (TypeLits.natVal (Proxy @maxLen)))]+ textualEncoder (Varchar base) = TextBuilder.text base+ textualDecoder = do+ text <- Attoparsec.takeText+ let len = Text.length text+ maxLen = fromIntegral (TypeLits.natVal (Proxy @maxLen))+ if len <= maxLen+ then pure (Varchar text)+ else fail ("Varchar string length " <> show len <> " exceeds maximum " <> show maxLen)++instance (TypeLits.KnownNat maxLen) => IsBinaryPrimitive (Varchar maxLen) where binaryEncoder (Varchar base) = Write.textUtf8 base binaryDecoder = do bytes <- PtrPeeker.remainderAsByteString@@ -84,14 +94,6 @@ ) } )- textualEncoder (Varchar base) = TextBuilder.text base- textualDecoder = do- text <- Attoparsec.takeText- let len = Text.length text- maxLen = fromIntegral (TypeLits.natVal (Proxy @maxLen))- if len <= maxLen- then pure (Varchar text)- else fail ("Varchar string length " <> show len <> " exceeds maximum " <> show maxLen) -- * Accessors
src/library/PostgresqlTypes/Via.hs view
@@ -1,6 +1,6 @@ module PostgresqlTypes.Via- ( module PostgresqlTypes.Via.IsScalar,+ ( module PostgresqlTypes.Via.IsPrimitive, ) where -import PostgresqlTypes.Via.IsScalar+import PostgresqlTypes.Via.IsPrimitive
+ src/library/PostgresqlTypes/Via/IsPrimitive.hs view
@@ -0,0 +1,26 @@+module PostgresqlTypes.Via.IsPrimitive where++import qualified Data.Attoparsec.Text as Attoparsec+import qualified Data.Text as Text+import PostgresqlTypes.Algebra+import PostgresqlTypes.Prelude++newtype ViaIsPrimitive a = ViaIsPrimitive a+ deriving newtype (Eq, Ord, Arbitrary, IsPrimitive)++instance (IsPrimitive a) => Show (ViaIsPrimitive a) where+ showsPrec d (ViaIsPrimitive a) = showsPrec d (textualEncoder a)++instance (IsPrimitive a) => Read (ViaIsPrimitive a) where+ readsPrec d str =+ [ (ViaIsPrimitive a, rest)+ | (txt, rest) <- readsPrec d str,+ let parsed = Attoparsec.parseOnly (textualDecoder @a <* Attoparsec.endOfInput) txt,+ Right a <- [parsed]+ ]++instance (IsPrimitive a) => IsString (ViaIsPrimitive a) where+ fromString string =+ case Attoparsec.parseOnly (textualDecoder @a <* Attoparsec.endOfInput) (Text.pack string) of+ Left err -> error ("ViaIsPrimitive fromString: failed to parse: " <> err)+ Right a -> ViaIsPrimitive a
− src/library/PostgresqlTypes/Via/IsScalar.hs
@@ -1,26 +0,0 @@-module PostgresqlTypes.Via.IsScalar where--import qualified Data.Attoparsec.Text as Attoparsec-import qualified Data.Text as Text-import PostgresqlTypes.Algebra-import PostgresqlTypes.Prelude--newtype ViaIsScalar a = ViaIsScalar a- deriving newtype (Eq, Ord, Arbitrary, IsScalar)--instance (IsScalar a) => Show (ViaIsScalar a) where- showsPrec d (ViaIsScalar a) = showsPrec d (textualEncoder a)--instance (IsScalar a) => Read (ViaIsScalar a) where- readsPrec d str =- [ (ViaIsScalar a, rest)- | (txt, rest) <- readsPrec d str,- let parsed = Attoparsec.parseOnly (textualDecoder @a <* Attoparsec.endOfInput) txt,- Right a <- [parsed]- ]--instance (IsScalar a) => IsString (ViaIsScalar a) where- fromString string =- case Attoparsec.parseOnly (textualDecoder @a <* Attoparsec.endOfInput) (Text.pack string) of- Left err -> error ("ViaIsScalar fromString: failed to parse: " <> err)- Right a -> ViaIsScalar a
src/unit-tests/PostgresqlTypes/BitSpec.hs view
@@ -16,10 +16,10 @@ Scripts.testShowRead (Proxy @(Bit.Bit 1)) Scripts.testShowRead (Proxy @(Bit.Bit 8)) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @(Bit.Bit 0))- Scripts.testIsScalar (Proxy @(Bit.Bit 1))- Scripts.testIsScalar (Proxy @(Bit.Bit 64))+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @(Bit.Bit 0))+ Scripts.testIsPrimitive (Proxy @(Bit.Bit 1))+ Scripts.testIsPrimitive (Proxy @(Bit.Bit 64)) describe "Bit 8" do describe "Constructors" do
src/unit-tests/PostgresqlTypes/BoolSpec.hs view
@@ -13,8 +13,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Bool.Bool) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Bool.Bool)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Bool.Bool) describe "Constructors" do describe "fromBool" do
src/unit-tests/PostgresqlTypes/BoxSpec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Box.Box) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Box.Box)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Box.Box) describe "Constructors" do describe "normalizeFromCorners" do
src/unit-tests/PostgresqlTypes/BpcharSpec.hs view
@@ -15,9 +15,9 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @(Bpchar.Bpchar 1)) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @(Bpchar.Bpchar 1))- Scripts.testIsScalar (Proxy @(Bpchar.Bpchar 42))+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @(Bpchar.Bpchar 1))+ Scripts.testIsPrimitive (Proxy @(Bpchar.Bpchar 42)) describe "Bpchar 10" do describe "Constructors" do
src/unit-tests/PostgresqlTypes/ByteaSpec.hs view
@@ -13,8 +13,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Bytea.Bytea) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Bytea.Bytea)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Bytea.Bytea) describe "Constructors" do describe "fromByteString" do
src/unit-tests/PostgresqlTypes/CharSpec.hs view
@@ -14,8 +14,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @PgChar.Char) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @PgChar.Char)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @PgChar.Char) describe "Constructors" do describe "normalizeFromWord8" do
src/unit-tests/PostgresqlTypes/CidrSpec.hs view
@@ -15,8 +15,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Cidr.Cidr) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Cidr.Cidr)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Cidr.Cidr) describe "IPv4 Constructors" do describe "normalizeFromV4" do
src/unit-tests/PostgresqlTypes/CircleSpec.hs view
@@ -13,8 +13,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Circle.Circle) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Circle.Circle)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Circle.Circle) describe "Constructors" do describe "normalizeFromCenterAndRadius" do
src/unit-tests/PostgresqlTypes/CitextSpec.hs view
@@ -15,8 +15,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Citext.Citext) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Citext.Citext)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Citext.Citext) describe "Constructors" do describe "normalizeFromText" do
src/unit-tests/PostgresqlTypes/DateSpec.hs view
@@ -15,8 +15,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Date.Date) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Date.Date)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Date.Date) describe "Constructors" do describe "normalizeFromDay" do
src/unit-tests/PostgresqlTypes/Float4Spec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Float4.Float4) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Float4.Float4)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Float4.Float4) describe "Constructors" do describe "fromFloat" do
src/unit-tests/PostgresqlTypes/Float8Spec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Float8.Float8) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Float8.Float8)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Float8.Float8) describe "Constructors" do describe "fromDouble" do
src/unit-tests/PostgresqlTypes/GeometrySpec.hs view
@@ -21,8 +21,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Geometry) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Geometry)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Geometry) describe "Constructors" do describe "refineFromShape" do
src/unit-tests/PostgresqlTypes/HstoreSpec.hs view
@@ -13,8 +13,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Hstore.Hstore) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Hstore.Hstore)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Hstore.Hstore) describe "Constructors" do describe "normalizeFromMap" do
src/unit-tests/PostgresqlTypes/InetSpec.hs view
@@ -15,8 +15,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Inet.Inet) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Inet.Inet)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Inet.Inet) describe "IPv4 Constructors" do describe "normalizeFromV4" do
src/unit-tests/PostgresqlTypes/Int2Spec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Int2.Int2) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Int2.Int2)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Int2.Int2) describe "Constructors" do describe "fromInt16" do
src/unit-tests/PostgresqlTypes/Int4Spec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Int4.Int4) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Int4.Int4)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Int4.Int4) describe "Constructors" do describe "fromInt32" do
src/unit-tests/PostgresqlTypes/Int8Spec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Int8.Int8) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Int8.Int8)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Int8.Int8) describe "Constructors" do describe "fromInt64" do
src/unit-tests/PostgresqlTypes/IntervalSpec.hs view
@@ -16,8 +16,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Interval.Interval) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Interval.Interval)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Interval.Interval) describe "Constructors" do describe "normalizeFromMonthsDaysAndMicroseconds" do
src/unit-tests/PostgresqlTypes/JsonSpec.hs view
@@ -14,8 +14,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Json.Json) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Json.Json)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Json.Json) describe "Constructors" do describe "fromValue" do
src/unit-tests/PostgresqlTypes/JsonbSpec.hs view
@@ -14,8 +14,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Jsonb.Jsonb) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Jsonb.Jsonb)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Jsonb.Jsonb) describe "Constructors" do describe "normalizeFromValue" do
src/unit-tests/PostgresqlTypes/LineSpec.hs view
@@ -13,8 +13,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Line.Line) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Line.Line)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Line.Line) describe "Constructors" do describe "normalizeFromEquation" do
src/unit-tests/PostgresqlTypes/LsegSpec.hs view
@@ -11,8 +11,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Lseg.Lseg) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Lseg.Lseg)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Lseg.Lseg) describe "Constructors" do describe "fromEndpoints" do
src/unit-tests/PostgresqlTypes/Macaddr8Spec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Macaddr8.Macaddr8) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Macaddr8.Macaddr8)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Macaddr8.Macaddr8) describe "Constructors" do describe "fromBytes" do
src/unit-tests/PostgresqlTypes/MacaddrSpec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Macaddr.Macaddr) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Macaddr.Macaddr)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Macaddr.Macaddr) describe "Constructors" do describe "fromBytes" do
src/unit-tests/PostgresqlTypes/MoneySpec.hs view
@@ -16,8 +16,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Money.Money) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Money.Money)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Money.Money) describe "Constructors" do describe "fromInt64" do
src/unit-tests/PostgresqlTypes/MultirangeSpec.hs view
@@ -13,8 +13,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @(Multirange.Multirange Int4.Int4)) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @(Multirange.Multirange Int4.Int4))+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @(Multirange.Multirange Int4.Int4)) describe "Multirange Int4" do it "has Eq instance" do
src/unit-tests/PostgresqlTypes/NumericSpec.hs view
@@ -18,8 +18,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @(Numeric.Numeric 0 0)) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @(Numeric.Numeric 0 0))+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @(Numeric.Numeric 0 0)) describe "By precision and scale" do byPrecisionAndScale (Proxy @0) (Proxy @0)
src/unit-tests/PostgresqlTypes/OidSpec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Oid.Oid) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Oid.Oid)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Oid.Oid) describe "Constructors" do describe "fromWord32" do
src/unit-tests/PostgresqlTypes/PathSpec.hs view
@@ -13,8 +13,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Path.Path) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Path.Path)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Path.Path) describe "Constructors" do describe "refineFromPointList (open path)" do
src/unit-tests/PostgresqlTypes/PointSpec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Point.Point) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Point.Point)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Point.Point) describe "Constructors" do describe "fromCoordinates" do
src/unit-tests/PostgresqlTypes/PolygonSpec.hs view
@@ -13,8 +13,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Polygon.Polygon) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Polygon.Polygon)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Polygon.Polygon) describe "Constructors" do describe "refineFromPointList" do
src/unit-tests/PostgresqlTypes/RangeSpec.hs view
@@ -13,8 +13,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @(Range.Range Int4.Int4)) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @(Range.Range Int4.Int4))+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @(Range.Range Int4.Int4)) describe "Range Int4" do it "has Eq instance" do
src/unit-tests/PostgresqlTypes/TextSpec.hs view
@@ -15,8 +15,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @PgText.Text) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @PgText.Text)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @PgText.Text) describe "Constructors" do describe "normalizeFromText" do
src/unit-tests/PostgresqlTypes/TimeSpec.hs view
@@ -18,8 +18,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @PgTime.Time) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @PgTime.Time)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @PgTime.Time) describe "Constructors" do describe "normalizeFromMicroseconds" do
src/unit-tests/PostgresqlTypes/TimestampSpec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Timestamp.Timestamp) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Timestamp.Timestamp)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Timestamp.Timestamp) describe "Constructors" do describe "normalizeFromLocalTime" do
src/unit-tests/PostgresqlTypes/TimestamptzSpec.hs view
@@ -12,8 +12,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Timestamptz.Timestamptz) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Timestamptz.Timestamptz)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Timestamptz.Timestamptz) describe "Constructors" do describe "normalizeFromUtcTime" do
src/unit-tests/PostgresqlTypes/TimetzSpec.hs view
@@ -16,8 +16,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Timetz.Timetz) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Timetz.Timetz)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Timetz.Timetz) describe "Constructors" do describe "normalizeFromTimeInMicrosecondsAndOffsetInSeconds" do
src/unit-tests/PostgresqlTypes/TsvectorSpec.hs view
@@ -13,8 +13,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Tsvector.Tsvector) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Tsvector.Tsvector)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Tsvector.Tsvector) describe "Constructors" do describe "refineFromLexemeList" do
src/unit-tests/PostgresqlTypes/UuidSpec.hs view
@@ -13,8 +13,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @Uuid.Uuid) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @Uuid.Uuid)+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @Uuid.Uuid) describe "Constructors" do describe "fromUUID" do
src/unit-tests/PostgresqlTypes/VarbitSpec.hs view
@@ -14,8 +14,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @(Varbit.Varbit 16)) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @(Varbit.Varbit 16))+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @(Varbit.Varbit 16)) describe "Varbit 16" do describe "Constructors" do
src/unit-tests/PostgresqlTypes/VarcharSpec.hs view
@@ -15,8 +15,8 @@ describe "Show/Read laws" do Scripts.testShowRead (Proxy @(Varchar.Varchar 10)) - describe "IsScalar laws" do- Scripts.testIsScalar (Proxy @(Varchar.Varchar 10))+ describe "IsPrimitive laws" do+ Scripts.testIsPrimitive (Proxy @(Varchar.Varchar 10)) describe "Varchar 10" do describe "Constructors" do
src/unit-tests/UnitTests/Scripts.hs view
@@ -15,17 +15,17 @@ import Prelude -- | Test textual encoder/decoder roundtrip-testIsScalar ::+testIsPrimitive :: forall a. ( Arbitrary a, Show a, Read a, Eq a,- PostgresqlTypes.Algebra.IsScalar a+ PostgresqlTypes.Algebra.IsBinaryPrimitive a ) => Proxy a -> Spec-testIsScalar _ =+testIsPrimitive _ = let name = Text.unpack (untag (PostgresqlTypes.Algebra.typeSignature @a)) binEnc = PostgresqlTypes.Algebra.binaryEncoder @a binDec = PostgresqlTypes.Algebra.binaryDecoder @a