From/ToSQL instances for Word16, Word32, Word64

scrive · Jan 8, 2025 · b468460 · b468460
1 parent 55dfd04
commit b468460
Show file tree

Hide file tree

Showing 6 changed files with 47 additions and 4 deletions.
diff --git a/cabal.project b/cabal.project
@@ -4,3 +4,5 @@ packages: .
 allow-newer: *:base
            , *:ghc-prim
            , *:template-haskell
+
+tests: True
diff --git a/src/Database/PostgreSQL/PQTypes/Format.hs b/src/Database/PostgreSQL/PQTypes/Format.hs
@@ -85,6 +85,15 @@ instance PQFormat Float where
 instance PQFormat Double where
   pqFormat = BS.pack "%float8"
 
+instance PQFormat Word16 where
+  pqFormat = BS.pack "%int2"
+
+instance PQFormat Word32 where
+  pqFormat = BS.pack "%int4"
+
+instance PQFormat Word64 where
+  pqFormat = BS.pack "%int8"
+
 -- CHAR
 
 instance PQFormat Char where

diff --git a/src/Database/PostgreSQL/PQTypes/FromSQL.hs b/src/Database/PostgreSQL/PQTypes/FromSQL.hs
@@ -68,6 +68,21 @@ instance FromSQL Double where
   fromSQL Nothing = unexpectedNULL
   fromSQL (Just n) = pure . realToFrac $ n
 
+instance FromSQL Word16 where
+  type PQBase Word16 = CUShort
+  fromSQL Nothing = unexpectedNULL
+  fromSQL (Just n) = pure . fromIntegral $ n
+
+instance FromSQL Word32 where
+  type PQBase Word32 = CUInt
+  fromSQL Nothing = unexpectedNULL
+  fromSQL (Just n) = pure . fromIntegral $ n
+
+instance FromSQL Word64 where
+  type PQBase Word64 = CULLong
+  fromSQL Nothing = unexpectedNULL
+  fromSQL (Just n) = pure . fromIntegral $ n
+
 -- CHAR
 
 instance FromSQL Char where

diff --git a/src/Database/PostgreSQL/PQTypes/ToSQL.hs b/src/Database/PostgreSQL/PQTypes/ToSQL.hs
@@ -84,6 +84,18 @@ instance ToSQL Double where
   type PQDest Double = CDouble
   toSQL n _ = putAsPtr (realToFrac n)
 
+instance ToSQL Word16 where
+  type PQDest Word16 = CUShort
+  toSQL n _ = putAsPtr (fromIntegral n)
+
+instance ToSQL Word32 where
+  type PQDest Word32 = CUInt
+  toSQL n _ = putAsPtr (fromIntegral n)
+
+instance ToSQL Word64 where
+  type PQDest Word64 = CULLong
+  toSQL n _ = putAsPtr (fromIntegral n)
+
 -- CHAR
 
 instance ToSQL Char where

diff --git a/test/Main.hs b/test/Main.hs
@@ -593,6 +593,9 @@ tests td =
   , nullTest td (u :: Int64)
   , nullTest td (u :: Float)
   , nullTest td (u :: Double)
+  , nullTest td (u :: Word16)
+  , nullTest td (u :: Word32)
+  , nullTest td (u :: Word64)
   , nullTest td (u :: Bool)
   , nullTest td (u :: AsciiChar)
   , nullTest td (u :: Word8)
@@ -618,6 +621,9 @@ tests td =
   , putGetTest td 100 (u :: Int64) (==)
   , putGetTest td 10000 (u :: Float) (==)
   , putGetTest td 10000 (u :: Double) (==)
+  , putGetTest td 100 (u :: Word16) (==)
+  , putGetTest td 100 (u :: Word32) (==)
+  , putGetTest td 100 (u :: Word64) (==)
   , putGetTest td 100 (u :: Bool) (==)
   , putGetTest td 100 (u :: AsciiChar) (==)
   , putGetTest td 100 (u :: Word8) (==)
@@ -681,9 +687,9 @@ tests td =
   , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple))
   , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested))
   , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested))
-  , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16))
-  , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32))
-  , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64))
+  , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Word16))
+  , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Word16, Word32))
+  , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Word16, Word32, Word64))
   , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float))
   , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double))
   , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool))

diff --git a/test/Prelude/Instances.hs b/test/Prelude/Instances.hs
@@ -505,4 +505,3 @@ deriving instance
   , Show a41, Show a42, Show a43, Show a44, Show a45, Show a46, Show a47, Show a48
   , Show a49, Show a50
   ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47, a48, a49, a50)
-
Original file line number	Diff line number	Diff line change
Expand Up		@@ -505,4 +505,3 @@ deriving instance
		, Show a41, Show a42, Show a43, Show a44, Show a45, Show a46, Show a47, Show a48
		, Show a49, Show a50
		) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47, a48, a49, a50)