Move to released algebra

nikita-volkov · nikita-volkov · commit 35ea86b77448 · 2026-01-22T19:58:15.000+03:00
diff --git a/.github/workflows/build.yaml b/.github/workflows/build.yaml
@@ -19,11 +19,11 @@ jobs:
     uses: nikita-volkov/haskell-hackage-lib-github-actions-workflows/.github/workflows/check-cabal.yaml@v4
     secrets: inherit
 
-  build-with-ghc-9-2:
+  build-with-oldest:
     uses: nikita-volkov/haskell-hackage-lib-github-actions-workflows/.github/workflows/build.yaml@v4
     secrets: inherit
     with:
-      ghc: "9.2"
+      ghc: "8.10"
       skip-doctest: true
       skip-benchmarks: true
       test-options: >
diff --git a/cabal.project b/cabal.project
@@ -4,8 +4,3 @@ allow-newer:
   *:base,
   *:ghc,
   *:template-haskell,
-
-source-repository-package
-  type: git
-  location: https://github.com/nikita-volkov/postgresql-types-algebra
-  tag: c37ff6c7b43bb9e89e58c308b5023305b931577c
diff --git a/postgresql-types.cabal b/postgresql-types.cabal
@@ -63,11 +63,9 @@ common base
     MultiParamTypeClasses
     MultiWayIf
     NamedFieldPuns
-    NoFieldSelectors
     NoImplicitPrelude
     NoMonomorphismRestriction
     NumericUnderscores
-    OverloadedRecordDot
     OverloadedStrings
     ParallelListComp
     PatternGuards
@@ -167,7 +165,7 @@ library
     postgresql-types:base-extras,
     postgresql-types:jsonifier-aeson,
     postgresql-types:time-extras,
-    postgresql-types-algebra,
+    postgresql-types-algebra ^>=0.1,
     profunctors ^>=5.6 && <6,
     ptr-peeker ^>=0.1,
     ptr-poker ^>=0.1.3,
diff --git a/src/integration-tests/Main/Scripts.hs b/src/integration-tests/Main/Scripts.hs
@@ -38,13 +38,17 @@ mappingSpec _ =
           (Just baseOid, Just arrayOid) ->
             pure (baseOid, arrayOid)
           _ -> do
-            result <- Procedures.run connection Procedures.GetTypeInfoByNameParams {name = typeName}
-            let baseOid = case maybeBaseOid of
-                  Just oid -> oid
-                  Nothing -> fromMaybe (error $ "Base OID not found for type: " <> Text.unpack typeName) result.baseOid
-                arrayOid = case maybeArrayOid of
-                  Just oid -> oid
-                  Nothing -> fromMaybe (error $ "Array OID not found for type: " <> Text.unpack typeName) result.arrayOid
+            Procedures.GetTypeInfoByNameResult {..} <- Procedures.run connection Procedures.GetTypeInfoByNameParams {name = typeName}
+            baseOid <- case maybeBaseOid of
+              Just oid -> pure oid
+              Nothing -> case baseOid of
+                Just oid -> pure oid
+                Nothing -> fail $ "Base OID not found for type: " <> Text.unpack typeName
+            arrayOid <- case maybeArrayOid of
+              Just oid -> pure oid
+              Nothing -> case arrayOid of
+                Just oid -> pure oid
+                Nothing -> fail $ "Array OID not found for type: " <> Text.unpack typeName
             pure (baseOid, arrayOid)
    in describe "IsScalar" do
         describe (Text.unpack typeName) do
@@ -206,12 +210,12 @@ mappingSpec _ =
 
           describe "Metadata" do
             it "Should match the DB catalogue" \(connection :: Pq.Connection) -> do
-              result <- Procedures.run connection Procedures.GetTypeInfoByNameParams {name = typeName}
+              Procedures.GetTypeInfoByNameResult {..} <- Procedures.run connection Procedures.GetTypeInfoByNameParams {name = typeName}
               case (maybeBaseOid, maybeArrayOid) of
                 (Just expectedBaseOid, Just expectedArrayOid) -> do
-                  shouldBe (Just expectedBaseOid) result.baseOid
-                  shouldBe (Just expectedArrayOid) result.arrayOid
+                  shouldBe baseOid (Just expectedBaseOid)
+                  shouldBe arrayOid (Just expectedArrayOid)
                 _ -> do
                   -- For types without stable OIDs, just verify the OIDs exist
-                  shouldSatisfy result.baseOid isJust
-                  shouldSatisfy result.arrayOid isJust
+                  shouldSatisfy baseOid isJust
+                  shouldSatisfy arrayOid isJust
diff --git a/src/library/PostgresqlTypes/Bit.hs b/src/library/PostgresqlTypes/Bit.hs
@@ -49,6 +49,7 @@ instance (TypeLits.KnownNat numBits) => Arbitrary (Bit numBits) where
       Just bit -> pure bit
 
 instance (TypeLits.KnownNat numBits) => IsScalar (Bit numBits) where
+  schemaName = Tagged Nothing
   typeName = Tagged "bit"
   baseOid = Tagged (Just 1560)
   arrayOid = Tagged (Just 1561)
diff --git a/src/library/PostgresqlTypes/Bool.hs b/src/library/PostgresqlTypes/Bool.hs
@@ -25,6 +25,7 @@ newtype Bool = Bool Data.Bool.Bool
   deriving (Show, Read, IsString) via (ViaIsScalar Bool)
 
 instance IsScalar Bool where
+  schemaName = Tagged Nothing
   typeName = Tagged "bool"
   baseOid = Tagged (Just 16)
   arrayOid = Tagged (Just 1000)
diff --git a/src/library/PostgresqlTypes/Box.hs b/src/library/PostgresqlTypes/Box.hs
@@ -56,6 +56,7 @@ instance Arbitrary Box where
     ]
 
 instance IsScalar Box where
+  schemaName = Tagged Nothing
   typeName = Tagged "box"
   baseOid = Tagged (Just 603)
   arrayOid = Tagged (Just 1020)
diff --git a/src/library/PostgresqlTypes/Bpchar.hs b/src/library/PostgresqlTypes/Bpchar.hs
@@ -56,6 +56,7 @@ instance (TypeLits.KnownNat numChars) => Arbitrary (Bpchar numChars) where
       Just char -> pure char
 
 instance (TypeLits.KnownNat numChars) => IsScalar (Bpchar numChars) where
+  schemaName = Tagged Nothing
   typeName = Tagged "bpchar"
   baseOid = Tagged (Just 1042)
   arrayOid = Tagged (Just 1014)
diff --git a/src/library/PostgresqlTypes/Bytea.hs b/src/library/PostgresqlTypes/Bytea.hs
@@ -27,6 +27,7 @@ newtype Bytea = Bytea ByteString
   deriving (Show, Read, IsString) via (ViaIsScalar Bytea)
 
 instance IsScalar Bytea where
+  schemaName = Tagged Nothing
   typeName = Tagged "bytea"
   baseOid = Tagged (Just 17)
   arrayOid = Tagged (Just 1001)
diff --git a/src/library/PostgresqlTypes/Char.hs b/src/library/PostgresqlTypes/Char.hs
@@ -49,6 +49,7 @@ instance Arbitrary Char where
     Char <$> QuickCheck.choose (0, 127)
 
 instance IsScalar Char where
+  schemaName = Tagged Nothing
   typeName = Tagged "char"
   baseOid = Tagged (Just 18)
   arrayOid = Tagged (Just 1002)
diff --git a/src/library/PostgresqlTypes/Cidr.hs b/src/library/PostgresqlTypes/Cidr.hs
@@ -83,6 +83,7 @@ instance Arbitrary Cidr where
       ]
 
 instance IsScalar Cidr where
+  schemaName = Tagged Nothing
   typeName = Tagged "cidr"
   baseOid = Tagged (Just 650)
   arrayOid = Tagged (Just 651)
diff --git a/src/library/PostgresqlTypes/Circle.hs b/src/library/PostgresqlTypes/Circle.hs
@@ -52,6 +52,7 @@ instance Arbitrary Circle where
     pure (Circle x' y' r')
 
 instance IsScalar Circle where
+  schemaName = Tagged Nothing
   typeName = Tagged "circle"
   baseOid = Tagged (Just 718)
   arrayOid = Tagged (Just 719)
diff --git a/src/library/PostgresqlTypes/Date.hs b/src/library/PostgresqlTypes/Date.hs
@@ -60,6 +60,7 @@ instance Arbitrary Date where
       ]
 
 instance IsScalar Date where
+  schemaName = Tagged Nothing
   typeName = Tagged "date"
   baseOid = Tagged (Just 1082)
   arrayOid = Tagged (Just 1182)
diff --git a/src/library/PostgresqlTypes/Float4.hs b/src/library/PostgresqlTypes/Float4.hs
@@ -26,6 +26,7 @@ newtype Float4 = Float4 Float
   deriving (Show, Read, IsString) via (ViaIsScalar Float4)
 
 instance IsScalar Float4 where
+  schemaName = Tagged Nothing
   typeName = Tagged "float4"
   baseOid = Tagged (Just 700)
   arrayOid = Tagged (Just 1021)
diff --git a/src/library/PostgresqlTypes/Float8.hs b/src/library/PostgresqlTypes/Float8.hs
@@ -26,6 +26,7 @@ newtype Float8 = Float8 Double
   deriving (Show, Read, IsString) via (ViaIsScalar Float8)
 
 instance IsScalar Float8 where
+  schemaName = Tagged Nothing
   typeName = Tagged "float8"
   baseOid = Tagged (Just 701)
   arrayOid = Tagged (Just 1022)
diff --git a/src/library/PostgresqlTypes/Hstore.hs b/src/library/PostgresqlTypes/Hstore.hs
@@ -50,6 +50,7 @@ instance Arbitrary Hstore where
     Hstore . Map.fromList <$> shrink (Map.toList base)
 
 instance IsScalar Hstore where
+  schemaName = Tagged Nothing
   typeName = Tagged "hstore"
   baseOid = Tagged Nothing
   arrayOid = Tagged Nothing
diff --git a/src/library/PostgresqlTypes/Inet.hs b/src/library/PostgresqlTypes/Inet.hs
@@ -82,6 +82,7 @@ instance Arbitrary Inet where
       ]
 
 instance IsScalar Inet where
+  schemaName = Tagged Nothing
   typeName = Tagged "inet"
   baseOid = Tagged (Just 869)
   arrayOid = Tagged (Just 1041)
diff --git a/src/library/PostgresqlTypes/Int2.hs b/src/library/PostgresqlTypes/Int2.hs
@@ -27,6 +27,7 @@ newtype Int2 = Int2 Int16
   deriving (Show, Read, IsString) via (ViaIsScalar Int2)
 
 instance IsScalar Int2 where
+  schemaName = Tagged Nothing
   typeName = Tagged "int2"
   baseOid = Tagged (Just 21)
   arrayOid = Tagged (Just 1005)
diff --git a/src/library/PostgresqlTypes/Int4.hs b/src/library/PostgresqlTypes/Int4.hs
@@ -27,6 +27,7 @@ newtype Int4 = Int4 Int32
   deriving (Show, Read, IsString) via (ViaIsScalar Int4)
 
 instance IsScalar Int4 where
+  schemaName = Tagged Nothing
   typeName = Tagged "int4"
   baseOid = Tagged (Just 23)
   arrayOid = Tagged (Just 1007)
diff --git a/src/library/PostgresqlTypes/Int8.hs b/src/library/PostgresqlTypes/Int8.hs
@@ -27,6 +27,7 @@ newtype Int8 = Int8 Int64
   deriving (Show, Read, IsString) via (ViaIsScalar Int8)
 
 instance IsScalar Int8 where
+  schemaName = Tagged Nothing
   typeName = Tagged "int8"
   baseOid = Tagged (Just 20)
   arrayOid = Tagged (Just 1016)
diff --git a/src/library/PostgresqlTypes/Interval.hs b/src/library/PostgresqlTypes/Interval.hs
@@ -38,52 +38,46 @@ import qualified TextBuilder
 -- Range: @-178000000@ years to @178000000@ years.
 --
 -- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-datetime.html#DATATYPE-INTERVAL-INPUT).
-data Interval = Interval
-  { months :: Int32,
-    days :: Int32,
-    micros :: Int64
-  }
+data Interval
+  = Interval
+      -- | Months.
+      Int32
+      -- | Days.
+      Int32
+      -- | Microseconds.
+      Int64
   deriving stock (Eq, Ord)
   deriving (Show, Read, IsString) via (ViaIsScalar Interval)
 
 instance Bounded Interval where
-  minBound =
-    Interval
-      { months = -178000000 * 12,
-        days = 0,
-        micros = 0
-      }
-  maxBound =
-    Interval
-      { months = 178000000 * 12,
-        days = 0,
-        micros = 0
-      }
+  minBound = Interval (-178000000 * 12) 0 0
+  maxBound = Interval (178000000 * 12) 0 0
 
 instance Arbitrary Interval where
   arbitrary = do
     micros <- QuickCheck.choose (-999_999, 999_999)
     days <- QuickCheck.choose (-daysPerMonth, daysPerMonth)
-    months <- QuickCheck.choose ((minBound @Interval).months, (maxBound @Interval).months)
-    pure (max minBound (min maxBound (Interval {..})))
+    months <- QuickCheck.choose (toMonths (minBound @Interval), toMonths (maxBound @Interval))
+    pure (max minBound (min maxBound (Interval months days micros)))
 
 instance IsScalar Interval where
+  schemaName = Tagged Nothing
   typeName = Tagged "interval"
   baseOid = Tagged (Just 1186)
   arrayOid = Tagged (Just 1187)
   typeParams = Tagged []
-  binaryEncoder (Interval {..}) =
+  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 {..}))
+    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).
   --
   -- >P quantity unit [ quantity unit ...] [ T [ quantity unit ...]]
-  textualEncoder (Interval {..}) =
+  textualEncoder (Interval months days micros) =
     let monthsSign = if months < 0 then "-" else ""
         daysSign = if days < 0 then "-" else ""
         microsSign = if micros < 0 then "-" else ""
@@ -288,19 +282,19 @@ instance IsScalar Interval where
 
 -- | Extract the months component.
 toMonths :: Interval -> Int32
-toMonths Interval {..} = months
+toMonths (Interval months _ _) = months
 
 -- | Extract the days component.
 toDays :: Interval -> Int32
-toDays Interval {..} = days
+toDays (Interval _ days _) = days
 
 -- | Extract the microseconds component.
 toMicroseconds :: Interval -> Int64
-toMicroseconds Interval {..} = micros
+toMicroseconds (Interval _ _ micros) = micros
 
 -- | Convert interval to total microseconds, approximating months as 30 days and days as 24 hours.
 normalizeToMicrosecondsInTotal :: Interval -> Integer
-normalizeToMicrosecondsInTotal Interval {..} =
+normalizeToMicrosecondsInTotal (Interval months days micros) =
   fromIntegral micros + microsPerDay * (fromIntegral days + daysPerMonth * fromIntegral months)
 
 -- | Convert interval to 'DiffTime', approximating months as 30 days and days as 24 hours.
@@ -312,13 +306,13 @@ normalizeToDiffTime = picosecondsToDiffTime . (1_000_000 *) . normalizeToMicrose
 -- | Construct 'Interval' from months, days, and microseconds components, clamping to valid range.
 normalizeFromMonthsDaysAndMicroseconds :: Int32 -> Int32 -> Int64 -> Interval
 normalizeFromMonthsDaysAndMicroseconds months days micros =
-  let interval = Interval {..}
+  let interval = Interval months days micros
    in max minBound (min maxBound interval)
 
 -- | Try to construct 'Interval' from months, days, and microseconds components, failing if out of range.
 refineFromMonthsDaysAndMicroseconds :: Int32 -> Int32 -> Int64 -> Maybe Interval
 refineFromMonthsDaysAndMicroseconds months days micros =
-  let interval = Interval {..}
+  let interval = Interval months days micros
    in if interval >= minBound && interval <= maxBound
         then Just interval
         else Nothing
@@ -358,7 +352,7 @@ unsafeFromMicrosecondsInTotal =
     micros <- fromIntegral <$> state (swap . flip divMod microsPerDay)
     days <- fromIntegral <$> state (swap . flip divMod daysPerMonth)
     months <- fromIntegral <$> get
-    pure Interval {..}
+    pure (Interval months days micros)
 
 microsPerDay :: (Num a) => a
 microsPerDay = 1_000_000 * 60 * 60 * 24
diff --git a/src/library/PostgresqlTypes/Json.hs b/src/library/PostgresqlTypes/Json.hs
@@ -42,6 +42,7 @@ instance Arbitrary Json where
   shrink = fmap Json . shrink . toAesonValue
 
 instance IsScalar Json where
+  schemaName = Tagged Nothing
   typeName = Tagged "json"
   baseOid = Tagged (Just 114)
   arrayOid = Tagged (Just 199)
diff --git a/src/library/PostgresqlTypes/Jsonb.hs b/src/library/PostgresqlTypes/Jsonb.hs
@@ -40,6 +40,7 @@ instance Arbitrary Jsonb where
   shrink = fmap Jsonb . shrink . toAesonValue
 
 instance IsScalar Jsonb where
+  schemaName = Tagged Nothing
   typeName = Tagged "jsonb"
   baseOid = Tagged (Just 3802)
   arrayOid = Tagged (Just 3807)
diff --git a/src/library/PostgresqlTypes/Line.hs b/src/library/PostgresqlTypes/Line.hs
@@ -55,6 +55,7 @@ instance Arbitrary Line where
     ]
 
 instance IsScalar Line where
+  schemaName = Tagged Nothing
   typeName = Tagged "line"
   baseOid = Tagged (Just 628)
   arrayOid = Tagged (Just 629)
diff --git a/src/library/PostgresqlTypes/Lseg.hs b/src/library/PostgresqlTypes/Lseg.hs
@@ -46,6 +46,7 @@ instance Arbitrary Lseg where
     [Lseg x1' y1' x2' y2' | (x1', y1', x2', y2') <- shrink (x1, y1, x2, y2)]
 
 instance IsScalar Lseg where
+  schemaName = Tagged Nothing
   typeName = Tagged "lseg"
   baseOid = Tagged (Just 601)
   arrayOid = Tagged (Just 1018)
diff --git a/src/library/PostgresqlTypes/Macaddr.hs b/src/library/PostgresqlTypes/Macaddr.hs
@@ -60,6 +60,7 @@ instance Arbitrary Macaddr where
     ]
 
 instance IsScalar Macaddr where
+  schemaName = Tagged Nothing
   typeName = Tagged "macaddr"
   baseOid = Tagged (Just 829)
   arrayOid = Tagged (Just 1040)
diff --git a/src/library/PostgresqlTypes/Macaddr8.hs b/src/library/PostgresqlTypes/Macaddr8.hs
@@ -67,6 +67,7 @@ instance Arbitrary Macaddr8 where
     ]
 
 instance IsScalar Macaddr8 where
+  schemaName = Tagged Nothing
   typeName = Tagged "macaddr8"
   baseOid = Tagged (Just 774)
   arrayOid = Tagged (Just 775)
diff --git a/src/library/PostgresqlTypes/Money.hs b/src/library/PostgresqlTypes/Money.hs
@@ -34,6 +34,7 @@ newtype Money = Money Int64
   deriving (Show, Read, IsString) via (ViaIsScalar Money)
 
 instance IsScalar Money where
+  schemaName = Tagged Nothing
   typeName = Tagged "money"
   baseOid = Tagged (Just 790)
   arrayOid = Tagged (Just 791)
diff --git a/src/library/PostgresqlTypes/Multirange.hs b/src/library/PostgresqlTypes/Multirange.hs
@@ -49,6 +49,7 @@ newtype Multirange a = Multirange (Vector (Range a))
   deriving (Show, Read, IsString) via (ViaIsScalar (Multirange a))
 
 instance (IsMultirangeElement a) => IsScalar (Multirange a) where
+  schemaName = Tagged Nothing
   typeName = retag (multirangeTypeName @a)
   baseOid = retag (multirangeBaseOid @a)
   arrayOid = retag (multirangeArrayOid @a)
diff --git a/src/library/PostgresqlTypes/Numeric.hs b/src/library/PostgresqlTypes/Numeric.hs
diff --git a/src/library/PostgresqlTypes/Oid.hs b/src/library/PostgresqlTypes/Oid.hs
diff --git a/src/library/PostgresqlTypes/Path.hs b/src/library/PostgresqlTypes/Path.hs
diff --git a/src/library/PostgresqlTypes/Point.hs b/src/library/PostgresqlTypes/Point.hs
diff --git a/src/library/PostgresqlTypes/Polygon.hs b/src/library/PostgresqlTypes/Polygon.hs
diff --git a/src/library/PostgresqlTypes/Range.hs b/src/library/PostgresqlTypes/Range.hs
diff --git a/src/library/PostgresqlTypes/Text.hs b/src/library/PostgresqlTypes/Text.hs
diff --git a/src/library/PostgresqlTypes/Time.hs b/src/library/PostgresqlTypes/Time.hs
diff --git a/src/library/PostgresqlTypes/Timestamp.hs b/src/library/PostgresqlTypes/Timestamp.hs
diff --git a/src/library/PostgresqlTypes/Timestamptz.hs b/src/library/PostgresqlTypes/Timestamptz.hs
diff --git a/src/library/PostgresqlTypes/Timetz.hs b/src/library/PostgresqlTypes/Timetz.hs
diff --git a/src/library/PostgresqlTypes/Uuid.hs b/src/library/PostgresqlTypes/Uuid.hs
diff --git a/src/library/PostgresqlTypes/Varbit.hs b/src/library/PostgresqlTypes/Varbit.hs
diff --git a/src/library/PostgresqlTypes/Varchar.hs b/src/library/PostgresqlTypes/Varchar.hs

Original file line number	Diff line number	Diff line change
`@@ -56,6 +56,7 @@ instance Arbitrary Box where`
`56`	`56`	`]`
`57`	`57`
`58`	`58`	`instance IsScalar Box where`
	`59`	`+ schemaName = Tagged Nothing`
`59`	`60`	`typeName = Tagged "box"`
`60`	`61`	`baseOid = Tagged (Just 603)`
`61`	`62`	`arrayOid = Tagged (Just 1020)`