Add Manual Storable Instances for DPIXid and VersionInfo (#26) (#42)

* Added storable instances for DPIXid and VersionInfo

* Added storable roundtrip test for VersionInfo and DPIXid type

* Fixed example from README

Author: tusharad

README.md

@@ -21,8 +21,8 @@ import GHC.Generics (Generic)
 main :: IO ()
 main = do
   let stmt = "select count(*), sysdate, 'ignore next column', 125.24, 3.14 from dual"
-  conn <- createConn (ConnectionParams "username" "password" "localhost/XEPDB1")
-  rows <- query @ReturnedRow conn stmt
+  conn <- connect (ConnectionParams "username" "password" "localhost/XEPDB1" Nothing)
+  rows <- query_ conn stmt :: IO [ReturnedRow]
   print rows
 
 -- [ ReturnedRow { count = RowCount {getRowCount = 1.0}

src/Database/Oracle/Simple/Internal.hs

@@ -33,6 +33,7 @@ module Database.Oracle.Simple.Internal
     ConnectionParams (..),
     OracleError (..),
     ErrorInfo (..),
+    VersionInfo (..),
     renderErrorInfo,
     ping,
     fetch,
@@ -538,8 +539,28 @@ data VersionInfo = VersionInfo
   , portUpdateNum :: CInt
   , fullVersionNum :: CUInt
   }
-  deriving (Show, Eq, Generic)
-  deriving anyclass (GStorable)
+  deriving (Show, Eq)
+
+instance Storable VersionInfo where
+    sizeOf _ = sizeOf (undefined :: CInt) * 6
+    alignment _ = alignment (undefined :: CInt)
+    peek p = do
+        let basePtr = castPtr p
+        versionNum <- peekByteOff basePtr 0
+        releaseNum <- peekByteOff basePtr 4
+        updateNum <- peekByteOff basePtr 8
+        portReleaseNum <- peekByteOff basePtr 12
+        portUpdateNum <- peekByteOff basePtr 16
+        fullVersionNum <- peekByteOff basePtr 20
+        return VersionInfo{..}
+    poke p VersionInfo{..} = do
+        let basePtr = castPtr p
+        pokeByteOff basePtr 0 versionNum
+        pokeByteOff basePtr 4 releaseNum
+        pokeByteOff basePtr 8 updateNum
+        pokeByteOff basePtr 12 portReleaseNum
+        pokeByteOff basePtr 16 portUpdateNum
+        pokeByteOff basePtr 20 fullVersionNum
 
 getClientVersion ::
   IO VersionInfo

src/Database/Oracle/Simple/Transaction.hs

@@ -1,13 +1,13 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Database.Oracle.Simple.Transaction
-  ( beginTransaction,
+  ( 
+    DPIXid (..),
+    beginTransaction,
     commitTransaction,
     prepareCommit,
     withTransaction,
@@ -19,12 +19,11 @@ import Control.Exception (catch, throw)
 import Control.Monad (replicateM, void, when, (<=<))
 import Data.UUID (UUID, toString)
 import Data.UUID.V4 (nextRandom)
-import Foreign (alloca, peek, poke, withForeignPtr)
+import Foreign (alloca, withForeignPtr)
 import Foreign.C.String (CString, withCStringLen)
 import Foreign.C.Types (CInt (CInt), CLong, CUInt (CUInt))
-import Foreign.Ptr (Ptr)
-import Foreign.Storable.Generic (GStorable)
-import GHC.Generics (Generic)
+import Foreign.Ptr (Ptr ,castPtr)
+import Foreign.Storable (Storable(..))
 import System.Random (getStdRandom, uniformR)
 
 import Database.Oracle.Simple.Execute (execute_)
@@ -141,8 +140,86 @@ data DPIXid = DPIXid
   , dpixBranchQualifier :: CString
   , dpixBranchQualifierLength :: CUInt
   }
-  deriving (Generic, Show)
-  deriving anyclass (GStorable)
+  deriving (Show, Eq)
+
+instance Storable DPIXid where
+    sizeOf _ =
+        let
+            -- Sizes of fields
+            sizeFormatId = sizeOf (undefined :: CLong)
+            sizeTransactionId = sizeOf (undefined :: CString)
+            sizeTransactionIdLength = sizeOf (undefined :: CUInt)
+            sizeQualifier = sizeOf (undefined :: CString)
+            sizeQualifierLength = sizeOf (undefined :: CUInt)
+
+            -- Alignments of fields
+            alignFormatId = alignment (undefined :: CLong)
+            alignTransactionId = alignment (undefined :: CString)
+            alignTransactionIdLength = alignment (undefined :: CUInt)
+            alignQualifier = alignment (undefined :: CString)
+            alignQualifierLength = alignment (undefined :: CUInt)
+
+            -- Padding for each field
+            paddingTransactionId = padding sizeFormatId alignTransactionId
+            paddingTransactionIdLength = padding (sizeTransactionId + paddingTransactionId) alignTransactionIdLength
+            paddingQualifier = padding (sizeTransactionIdLength + paddingTransactionIdLength) alignQualifier
+            paddingQualifierLength = padding (sizeQualifier + paddingQualifier) alignQualifierLength
+        in
+            sizeFormatId +
+            paddingTransactionId + sizeTransactionId +
+            paddingTransactionIdLength + sizeTransactionIdLength +
+            paddingQualifier + sizeQualifier +
+            paddingQualifierLength + sizeQualifierLength +
+            -- Final padding to align the structure itself
+            padding (sizeFormatId +
+                     paddingTransactionId + sizeTransactionId +
+                     paddingTransactionIdLength + sizeTransactionIdLength +
+                     paddingQualifier + sizeQualifier +
+                     paddingQualifierLength + sizeQualifierLength) alignFormatId
+
+    alignment _ = alignment (undefined :: CLong)
+
+    peek p = do
+        let basePtr = castPtr p
+        formatId <- peekByteOff basePtr 0
+
+        let offsetTransactionId = alignedOffset 0 (sizeOf (undefined :: CLong)) (alignment (undefined :: CString))
+        transactionId <- peekByteOff basePtr offsetTransactionId
+
+        let offsetTransactionIdLength = offsetTransactionId + sizeOf (undefined :: CString)
+        transactionIdLength <- peekByteOff basePtr offsetTransactionIdLength
+
+        let offsetQualifier = alignedOffset offsetTransactionIdLength (sizeOf (undefined :: CUInt)) (alignment (undefined :: CString))
+        qualifier <- peekByteOff basePtr offsetQualifier
+
+        let offsetQualifierLength = offsetQualifier + sizeOf (undefined :: CString)
+        qualifierLength <- peekByteOff basePtr offsetQualifierLength
+
+        return $ DPIXid formatId transactionId transactionIdLength qualifier qualifierLength
+
+    poke p (DPIXid formatId transactionId transactionIdLength qualifier qualifierLength) = do
+        let basePtr = castPtr p
+        pokeByteOff basePtr 0 formatId
+
+        let offsetTransactionId = alignedOffset 0 (sizeOf (undefined :: CLong)) (alignment (undefined :: CString))
+        pokeByteOff basePtr offsetTransactionId transactionId
+
+        let offsetTransactionIdLength = offsetTransactionId + sizeOf (undefined :: CString)
+        pokeByteOff basePtr offsetTransactionIdLength transactionIdLength
+
+        let offsetQualifier = alignedOffset offsetTransactionIdLength (sizeOf (undefined :: CUInt)) (alignment (undefined :: CString))
+        pokeByteOff basePtr offsetQualifier qualifier
+
+        let offsetQualifierLength = offsetQualifier + sizeOf (undefined :: CString)
+        pokeByteOff basePtr offsetQualifierLength qualifierLength
+
+-- Helper to calculate padding between fields
+padding :: Int -> Int -> Int
+padding size align = (align - size `mod` align) `mod` align
+
+-- Helper to calculate aligned offsets
+alignedOffset :: Int -> Int -> Int -> Int
+alignedOffset base size align = base + size + padding (base + size) align
 
 withDPIXid :: Transaction -> (Ptr DPIXid -> IO a) -> IO a
 withDPIXid Transaction {..} action =

test/Main.hs

@@ -22,6 +22,9 @@ import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 import Test.Hspec (Spec, around, describe, hspec, it, shouldBe)
 import Test.Hspec.Hedgehog (hedgehog)
+import Foreign (peek, Storable, with)
+import Foreign.C.Types (CLong(..), CUInt(..))
+import Foreign.C.String (newCString)
 
 import Database.Oracle.Simple
 
@@ -242,5 +245,32 @@ spec pool = do
         results <- query_ @(Only Int) conn "select * from transactions_test"
         void $ execute_ conn "drop table transactions_test"
         results `shouldBe` [Only 1 .. Only 8] <> [Only 10]
+    describe "Storable round trip tests" $ do
+        it "VersionInfo" $ \_ -> do
+            let versionInfo = VersionInfo {
+                versionNum = 1
+              , releaseNum = 2
+              , updateNum = 3
+              , portReleaseNum = 4
+              , portUpdateNum = 5
+              , fullVersionNum = 6
+            }
+            result <- roundTripStorable versionInfo
+            result `shouldBe` versionInfo
+        it "DPIXid" $ \_ -> do
+            someCString <- newCString "hello"
+            let dpixid = DPIXid { 
+                dpixFormatId = CLong 1
+              , dpixGlobalTransactionId = someCString
+              , dpixGlobalTransactionIdLength = CUInt 2
+              , dpixBranchQualifier = someCString
+              , dpixBranchQualifierLength = CUInt 3
+            }
+            result <- roundTripStorable dpixid
+            result `shouldBe` dpixid
   where
     handleOracleError action = Exc.try @OracleError action >>= either (\_ -> pure ()) (\_ -> pure ())
+
+-- | Round-trip a value through its `Storable` instance.
+roundTripStorable :: Storable a => a -> IO a
+roundTripStorable x = with x peek