postgresql-types 0.1.2 → 0.1.3

raw patch · 9 files changed

+228/−10 lines, 9 files

Files

• postgresql-types.cabal +5/−3
• src/library/PostgresqlTypes.hs +2/−0
• src/library/PostgresqlTypes/Citext.hs +92/−0
• src/library/PostgresqlTypes/Inet.hs +1/−1
• src/library/PostgresqlTypes/Money.hs +4/−2
• src/library/PostgresqlTypes/Time.hs +3/−4
• src/unit-tests/PostgresqlTypes/CitextSpec.hs +75/−0
• src/unit-tests/PostgresqlTypes/MoneySpec.hs +17/−0
• src/unit-tests/PostgresqlTypes/TimeSpec.hs +29/−0

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: postgresql-types-version: 0.1.2+version: 0.1.3 category: PostgreSQL, Codecs synopsis: Precise PostgreSQL types representation and driver-agnostic codecs description:@@ -110,6 +110,7 @@     PostgresqlTypes.Char     PostgresqlTypes.Cidr     PostgresqlTypes.Circle+    PostgresqlTypes.Citext     PostgresqlTypes.Date     PostgresqlTypes.Float4     PostgresqlTypes.Float8@@ -134,11 +135,11 @@     PostgresqlTypes.Polygon     PostgresqlTypes.Range     PostgresqlTypes.Text-    PostgresqlTypes.Tsvector     PostgresqlTypes.Time     PostgresqlTypes.Timestamp     PostgresqlTypes.Timestamptz     PostgresqlTypes.Timetz+    PostgresqlTypes.Tsvector     PostgresqlTypes.Uuid     PostgresqlTypes.Varbit     PostgresqlTypes.Varchar@@ -216,6 +217,7 @@     PostgresqlTypes.CharSpec     PostgresqlTypes.CidrSpec     PostgresqlTypes.CircleSpec+    PostgresqlTypes.CitextSpec     PostgresqlTypes.DateSpec     PostgresqlTypes.Float4Spec     PostgresqlTypes.Float8Spec@@ -241,10 +243,10 @@     PostgresqlTypes.RangeSpec     PostgresqlTypes.TextSpec     PostgresqlTypes.TimeSpec-    PostgresqlTypes.TsvectorSpec     PostgresqlTypes.TimestampSpec     PostgresqlTypes.TimestamptzSpec     PostgresqlTypes.TimetzSpec+    PostgresqlTypes.TsvectorSpec     PostgresqlTypes.UuidSpec     PostgresqlTypes.VarbitSpec     PostgresqlTypes.VarcharSpec

@@ -16,6 +16,7 @@     Varchar,     Char,     Bpchar,+    Citext,      -- * Boolean Type     Bool,@@ -77,6 +78,7 @@ import PostgresqlTypes.Char import PostgresqlTypes.Cidr import PostgresqlTypes.Circle+import PostgresqlTypes.Citext import PostgresqlTypes.Date import PostgresqlTypes.Float4 import PostgresqlTypes.Float8

@@ -0,0 +1,92 @@+module PostgresqlTypes.Citext+  ( Citext,++    -- * Accessors+    toText,++    -- * Constructors+    normalizeFromText,+    refineFromText,+  )+where++import qualified Data.Attoparsec.Text as Attoparsec+import Data.String+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text.Encoding+import PostgresqlTypes.Algebra+import PostgresqlTypes.Prelude hiding (Text)+import PostgresqlTypes.Via+import qualified PtrPeeker+import qualified PtrPoker.Write as Write+import qualified Test.QuickCheck as QuickCheck+import qualified TextBuilder++-- | PostgreSQL @citext@ type. Case-insensitive variable-length character string.+-- Requires the @citext@ extension to be installed in PostgreSQL.+--+-- [PostgreSQL docs](https://www.postgresql.org/docs/18/citext.html).+--+-- The value is stored as UTF-8 text, identical to @text@. Case-insensitivity+-- 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)++instance Arbitrary Citext where+  arbitrary =+    Citext <$> do+      charList <- QuickCheck.listOf do+        QuickCheck.suchThat arbitrary (\char -> char /= '\NUL')+      pure (Text.pack charList)+  shrink (Citext base) =+    Citext . Text.pack <$> shrink (Text.unpack base)++instance IsScalar Citext where+  schemaName = Tagged Nothing+  typeName = Tagged "citext"+  baseOid = Tagged Nothing+  arrayOid = Tagged Nothing+  typeParams = Tagged []+  binaryEncoder (Citext base) = Write.textUtf8 base+  binaryDecoder = do+    bytes <- PtrPeeker.remainderAsByteString+    case Text.Encoding.decodeUtf8' bytes of+      Left e ->+        pure+          ( Left+              ( DecodingError+                  { location = [],+                    reason =+                      ParsingDecodingErrorReason+                        (fromString (show e))+                        bytes+                  }+              )+          )+      Right base -> pure (Right (Citext base))+  textualEncoder (Citext base) = TextBuilder.text base+  textualDecoder = Citext <$> Attoparsec.takeText++-- * Accessors++-- | Extract the underlying 'Data.Text.Text' value.+toText :: Citext -> Text.Text+toText (Citext t) = t++-- * Constructors++-- | Construct a PostgreSQL 'Citext' from a 'Data.Text.Text' value.+--+-- Strips null characters to ensure PostgreSQL compatibility.+normalizeFromText :: Text.Text -> Citext+normalizeFromText = Citext . Text.replace "\NUL" ""++-- | Construct a PostgreSQL 'Citext' from a 'Data.Text.Text' value.+--+-- Returns 'Nothing' if the text contains null characters (not supported by PostgreSQL).+refineFromText :: Text.Text -> Maybe Citext+refineFromText text =+  if Text.elem '\NUL' text+    then Nothing+    else Just (Citext text)

@@ -148,7 +148,7 @@                 <*> PtrPeeker.beUnsignedInt4                 <*> pure (fromIntegral netmask)         _ -> do-          throwError (DecodingError ["address-family"] (UnexpectedValueDecodingErrorReason "2 or 10" (TextBuilder.toText (TextBuilder.decimal family))))+          throwError (DecodingError ["address-family"] (UnexpectedValueDecodingErrorReason "2 or 3" (TextBuilder.toText (TextBuilder.decimal family))))    textualEncoder = \case     V4Inet addr netmask ->

@@ -44,8 +44,10 @@   textualEncoder (Money x) =     -- Format as currency with 2 decimal places and $ symbol     -- PostgreSQL's money type typically displays with currency symbol-    let isNegative = x < 0-        absValue = abs x+    -- Use Integer to avoid abs overflow on minBound @Int64+    let value = fromIntegral x :: Integer+        isNegative = value < 0+        absValue = abs value         dollars = quot absValue 100         cents = rem absValue 100         centsText =

@@ -55,10 +55,9 @@     m <- twoDigits     -- Seconds are optional     s <- Attoparsec.option 0 (Attoparsec.char ':' *> parseSeconds)-    if h < 25 && m < 60 && s < 61_000_000-      then-        let microseconds = fromIntegral h * 3600_000_000 + fromIntegral m * 60_000_000 + s-         in pure (Time microseconds)+    let microseconds = fromIntegral h * 3600_000_000 + fromIntegral m * 60_000_000 + s+    if h <= 24 && m < 60 && s < 61_000_000 && microseconds >= 0 && microseconds <= 86_400_000_000+      then pure (Time microseconds)       else fail "Invalid time"     where       twoDigits = do

@@ -0,0 +1,75 @@+module PostgresqlTypes.CitextSpec (spec) where++import Data.Data (Proxy (Proxy))+import Data.Maybe+import qualified Data.Text as Text+import qualified PostgresqlTypes.Citext as Citext+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Instances ()+import qualified UnitTests.Scripts as Scripts+import Prelude++spec :: Spec+spec = do+  describe "Show/Read laws" do+    Scripts.testShowRead (Proxy @Citext.Citext)++  describe "IsScalar laws" do+    Scripts.testIsScalar (Proxy @Citext.Citext)++  describe "Constructors" do+    describe "normalizeFromText" do+      it "strips null characters" do+        let pgText = Citext.normalizeFromText "hello\NULworld"+        Citext.toText pgText `shouldBe` "helloworld"++      it "preserves text without null characters" do+        let pgText = Citext.normalizeFromText "hello world"+        Citext.toText pgText `shouldBe` "hello world"++      it "handles multiple null characters" do+        let pgText = Citext.normalizeFromText "\NULa\NULb\NULc\NUL"+        Citext.toText pgText `shouldBe` "abc"++      it "handles empty text" do+        let pgText = Citext.normalizeFromText ""+        Citext.toText pgText `shouldBe` ""++    describe "refineFromText" do+      it "rejects text with null characters" do+        Citext.refineFromText "hello\NULworld" `shouldBe` Nothing++      it "accepts text without null characters" do+        let result = Citext.refineFromText "hello world"+        result `shouldSatisfy` isJust+        fmap Citext.toText result `shouldBe` Just "hello world"++      it "accepts empty text" do+        let result = Citext.refineFromText ""+        result `shouldSatisfy` isJust++  describe "Accessors" do+    describe "toText" do+      it "extracts text value" do+        let pgText = Citext.normalizeFromText "test"+        Citext.toText pgText `shouldBe` "test"++  describe "Property Tests" do+    it "normalizeFromText is idempotent" do+      property \(t :: Text.Text) ->+        let normalized1 = Citext.normalizeFromText t+            normalized2 = Citext.normalizeFromText (Citext.toText normalized1)+         in normalized1 === normalized2++    describe "refineFromText" do+      it "succeeds for text without nulls" do+        property \(pgText :: Citext.Citext) ->+          let t = Citext.toText pgText+              refined = Citext.refineFromText t+           in refined === Just pgText++      it "rejects text with nulls" do+        property \(NonEmpty prefix, NonEmpty suffix) ->+          let textWithNull = Text.pack prefix <> "\NUL" <> Text.pack suffix+           in Citext.refineFromText textWithNull === Nothing

@@ -1,11 +1,15 @@ module PostgresqlTypes.MoneySpec (spec) where +import qualified Data.Attoparsec.Text import Data.Data (Proxy (Proxy)) import Data.Int+import qualified PostgresqlTypes.Algebra import qualified PostgresqlTypes.Money as Money import Test.Hspec import Test.QuickCheck+import qualified TextBuilder import qualified UnitTests.Scripts as Scripts+import Prelude  spec :: Spec spec = do@@ -34,6 +38,19 @@       it "extracts Int64 value representing cents" do         let pgMoney = Money.fromInt64 9999         Money.toInt64 pgMoney `shouldBe` 9999++  describe "Edge Cases" do+    it "textual encoder handles minBound @Int64 correctly" do+      let pgMoney = Money.fromInt64 (minBound @Int64)+          encoded = TextBuilder.toText (PostgresqlTypes.Algebra.textualEncoder pgMoney)+          decoded = Data.Attoparsec.Text.parseOnly (PostgresqlTypes.Algebra.textualDecoder @Money.Money) encoded+      decoded `shouldBe` Right pgMoney++    it "textual encoder handles maxBound @Int64 correctly" do+      let pgMoney = Money.fromInt64 (maxBound @Int64)+          encoded = TextBuilder.toText (PostgresqlTypes.Algebra.textualEncoder pgMoney)+          decoded = Data.Attoparsec.Text.parseOnly (PostgresqlTypes.Algebra.textualDecoder @Money.Money) encoded+      decoded `shouldBe` Right pgMoney    describe "Property Tests" do     it "roundtrips through toInt64 and fromInt64" do

@@ -1,8 +1,11 @@ module PostgresqlTypes.TimeSpec (spec) where +import qualified Data.Attoparsec.Text import Data.Data (Proxy (Proxy))+import Data.Either (isLeft, isRight) import Data.Maybe import qualified Data.Time as Time+import qualified PostgresqlTypes.Algebra import qualified PostgresqlTypes.Time as PgTime import Test.Hspec import Test.QuickCheck@@ -62,6 +65,32 @@         let pgTime = PgTime.normalizeFromMicroseconds 43_200_000_000 -- noon             tod = PgTime.toTimeOfDay pgTime         tod `shouldBe` Time.TimeOfDay 12 0 0++  describe "Edge Cases" do+    it "textual decoder accepts 24:00:00" do+      let result = Data.Attoparsec.Text.parseOnly (PostgresqlTypes.Algebra.textualDecoder @PgTime.Time) "24:00:00"+      result `shouldSatisfy` isRight+      fmap PgTime.toMicroseconds result `shouldBe` Right 86_400_000_000++    it "textual decoder rejects 24:00:01" do+      let result = Data.Attoparsec.Text.parseOnly (PostgresqlTypes.Algebra.textualDecoder @PgTime.Time) "24:00:01"+      result `shouldSatisfy` isLeft++    it "textual decoder rejects 24:01:00" do+      let result = Data.Attoparsec.Text.parseOnly (PostgresqlTypes.Algebra.textualDecoder @PgTime.Time) "24:01:00"+      result `shouldSatisfy` isLeft++    it "textual decoder rejects 24:30:00" do+      let result = Data.Attoparsec.Text.parseOnly (PostgresqlTypes.Algebra.textualDecoder @PgTime.Time) "24:30:00"+      result `shouldSatisfy` isLeft++    it "textual decoder rejects 24:00:00.000001" do+      let result = Data.Attoparsec.Text.parseOnly (PostgresqlTypes.Algebra.textualDecoder @PgTime.Time) "24:00:00.000001"+      result `shouldSatisfy` isLeft++    it "textual decoder accepts 23:59:59.999999" do+      let result = Data.Attoparsec.Text.parseOnly (PostgresqlTypes.Algebra.textualDecoder @PgTime.Time) "23:59:59.999999"+      result `shouldSatisfy` isRight    describe "Property Tests" do     it "roundtrips through toMicroseconds and normalizeFromMicroseconds" do