packages feed

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 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