Move Only to Database.Oracle.Simple.Internal, add ToRow instance for the same

src/Database/Oracle/Simple/FromRow.hs

@@ -1,18 +1,18 @@
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE DeriveAnyClass             #-}
-{-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE DefaultSignatures          #-}
-{-# LANGUAGE DerivingStrategies         #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RankNTypes                 #-}
-{-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE TypeApplications           #-}
-{-# LANGUAGE TypeOperators              #-}
-{-# LANGUAGE TypeSynonymInstances       #-}
-{-# LANGUAGE UndecidableInstances       #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Database.Oracle.Simple.FromRow where
 
@@ -32,6 +32,8 @@ class FromRow a where
   default fromRow :: (GFromRow (Rep a), Generic a) => RowParser a
   fromRow = to <$> gFromRow
 
+instance FromField a => FromRow (Only a)
+
 instance FromField a => FromRow (Identity a)
 
 instance (FromField a, FromField b) => FromRow (a, b)
@@ -70,10 +72,6 @@ instance
   )
   => FromRow (a, b, c, d, e, f, g, h, i, j)
 
-newtype Only a = Only { getOnly :: a }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass FromRow
-
 class GFromRow f where
   gFromRow :: RowParser (f a)
 

src/Database/Oracle/Simple/Internal.hs

@@ -22,8 +22,6 @@
 
 module Database.Oracle.Simple.Internal where
 
-import Test.QuickCheck
-import Data.Time
 import Control.Exception
 import Control.Monad
 import Control.Monad.State.Strict
@@ -32,6 +30,7 @@ import Data.IORef
 import Data.Kind
 import Data.List as L
 import Data.Text
+import Data.Time
 import Data.Typeable
 import Data.Word
 import Foreign
@@ -44,6 +43,7 @@ import Foreign.Storable.Generic
 import GHC.Generics
 import GHC.TypeLits
 import System.IO.Unsafe
+import Test.QuickCheck
 
 newtype DPIStmt = DPIStmt (Ptr DPIStmt)
   deriving (Show, Eq)
@@ -204,9 +204,9 @@ toDPIPurity :: DPIPurity -> CUInt
 toDPIPurity = fromIntegral . fromEnum
 
 data DPIModeConnClose
-  = DPI_MODE_CONN_CLOSE_DEFAULT --                0x0000
-  | DPI_MODE_CONN_CLOSE_DROP    --                0x0001
-  | DPI_MODE_CONN_CLOSE_RETAG   --                0x0002
+  = DPI_MODE_CONN_CLOSE_DEFAULT -- 0x0000
+  | DPI_MODE_CONN_CLOSE_DROP    -- 0x0001
+  | DPI_MODE_CONN_CLOSE_RETAG   -- 0x0002
   deriving (Show, Eq)
 
 toDpiModeConnClose :: DPIModeConnClose -> CUInt
@@ -458,8 +458,12 @@ getServerVersion (Connection fptr) versionInfo = do
     alloca $ \releaseStringPtr -> do
       alloca $ \versionInfoPtr -> do
         poke versionInfoPtr versionInfo
-        status <- dpiContext_getServerVersion
-          conn releaseStringPtr (fromIntegral (10 :: Int)) versionInfoPtr
+        status <-
+          dpiContext_getServerVersion
+            conn
+            releaseStringPtr
+            (fromIntegral (10 :: Int))
+            versionInfoPtr
         if status == 0
           then (peekCString <=< peek) releaseStringPtr
           else error $ show status <> " oh no!"
@@ -547,21 +551,22 @@ data DPITimestamp = DPITimestamp
 -- to the year, month, day, hour, minutes and seconds
 dpiTimeStampToUTCDPITimeStamp :: DPITimestamp -> DPITimestamp
 dpiTimeStampToUTCDPITimeStamp dpi@DPITimestamp{..} = utcDpi
-  where
-    offsetInMinutes, currentMinutes :: Int
-    offsetInMinutes = negate $ (fromIntegral tzHourOffset * 60) + fromIntegral tzMinuteOffset
-    currentMinutes = (fromIntegral hour * 60) + fromIntegral minute
-    (hours, minutes) = ((currentMinutes + offsetInMinutes) `mod` 1440) `quotRem` 60
-
-    gregorianDay = fromGregorian (fromIntegral year) (fromIntegral month) (fromIntegral day)
-    updatedDay | fromIntegral currentMinutes + fromIntegral offsetInMinutes > 1440
-               = addDays 1 gregorianDay
-               | fromIntegral currentMinutes + fromIntegral offsetInMinutes < 0
-               = addDays (-1) gregorianDay
-               | otherwise = gregorianDay
-    (year', month', day') = toGregorian updatedDay
-    utcDpi
-      = dpi
+ where
+  offsetInMinutes, currentMinutes :: Int
+  offsetInMinutes = negate $ (fromIntegral tzHourOffset * 60) + fromIntegral tzMinuteOffset
+  currentMinutes = (fromIntegral hour * 60) + fromIntegral minute
+  (hours, minutes) = ((currentMinutes + offsetInMinutes) `mod` 1440) `quotRem` 60
+
+  gregorianDay = fromGregorian (fromIntegral year) (fromIntegral month) (fromIntegral day)
+  updatedDay
+    | fromIntegral currentMinutes + fromIntegral offsetInMinutes > 1440 =
+        addDays 1 gregorianDay
+    | fromIntegral currentMinutes + fromIntegral offsetInMinutes < 0 =
+        addDays (-1) gregorianDay
+    | otherwise = gregorianDay
+  (year', month', day') = toGregorian updatedDay
+  utcDpi =
+    dpi
       { tzHourOffset = 0
       , tzMinuteOffset = 0
       , year = fromIntegral year'
@@ -573,19 +578,19 @@ dpiTimeStampToUTCDPITimeStamp dpi@DPITimestamp{..} = utcDpi
 
 instance Arbitrary DPITimestamp where
   arbitrary = do
-    year           <- choose (1000, 2023)
-    month          <- choose (1, 12)
-    day            <- choose (1, 28)
-    hour           <- choose (1, 23)
-    minute         <- choose (1, 59)
-    second         <- choose (1, 59)
-    fsecond        <- choose (0, 100000)
-    tzHourOffset   <- choose (-14, 14)
+    year <- choose (1000, 2023)
+    month <- choose (1, 12)
+    day <- choose (1, 28)
+    hour <- choose (1, 23)
+    minute <- choose (1, 59)
+    second <- choose (1, 59)
+    fsecond <- choose (0, 100000)
+    tzHourOffset <- choose (-14, 14)
     tzMinuteOffset <-
       if signum tzHourOffset < 0
         then choose (-59, 0)
         else choose (0, 59)
-    pure DPITimestamp {..}
+    pure DPITimestamp{..}
 
 instance HasDPINativeType DPITimestamp where
   dpiNativeType Proxy = DPI_NATIVE_TYPE_TIMESTAMP
@@ -974,4 +979,9 @@ isHealthy (Connection fptr) =
   withForeignPtr fptr $ \conn -> do
     alloca $ \healthPtr -> do
       throwOracleError =<< dpiConn_getIsHealthy conn healthPtr
-      (==1) <$> peek healthPtr
+      (== 1) <$> peek healthPtr
+
+-- | The 1-tuple type or single-value "collection".
+-- Structurally equivalent to 'Data.Functor.Identity.Identity'.
+newtype Only a = Only {fromOnly :: a}
+  deriving stock (Eq, Ord, Read, Show, Generic)

src/Database/Oracle/Simple/ToRow.hs

@@ -1,30 +1,30 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Database.Oracle.Simple.ToRow where
 
-import           Control.Monad
-import           Control.Monad.State.Strict
-import           Data.Functor.Identity
-import qualified Data.List                       as L
-import           Data.Proxy
-import           Data.Traversable
-import           Data.Word
-import           Database.Oracle.Simple.Internal
-import           Database.Oracle.Simple.ToField
-import           Foreign.Ptr
-import           GHC.Generics
-import           GHC.TypeLits
+import Control.Monad
+import Control.Monad.State.Strict
+import Data.Functor.Identity
+import qualified Data.List as L
+import Data.Proxy
+import Data.Traversable
+import Data.Word
+import Database.Oracle.Simple.Internal
+import Database.Oracle.Simple.ToField
+import Foreign.Ptr
+import GHC.Generics
+import GHC.TypeLits
 
 newtype RowWriter a = RowWriter {runRowWriter :: DPIStmt -> StateT Column IO a}
 
@@ -48,6 +48,8 @@ class ToRow a where
   default toRow :: (GToRow (Rep a), Generic a) => a -> RowWriter ()
   toRow = gToRow . from
 
+instance ToField a => ToRow (Only a)
+
 instance ToField a => ToRow (Identity a)
 
 instance (ToField a, ToField b) => ToRow (a, b)
@@ -62,13 +64,16 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) => T
 
 instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g) => ToRow (a, b, c, d, e, f, g)
 
-instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h)
+instance
+  (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h)
   => ToRow (a, b, c, d, e, f, g, h)
 
-instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h, ToField i)
+instance
+  (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h, ToField i)
   => ToRow (a, b, c, d, e, f, g, h, i)
 
-instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h, ToField i, ToField j)
+instance
+  (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h, ToField i, ToField j)
   => ToRow (a, b, c, d, e, f, g, h, i, j)
 
 class GToRow f where
@@ -90,7 +95,7 @@ instance (TypeError ('Text "Sum types not supported")) => GToRow (l :+: r) where
   gToRow = error "Sum types not supported"
 
 instance (ToField a) => GToRow (K1 i a) where
-  gToRow (K1 x)= void (writeField x)
+  gToRow (K1 x) = void (writeField x)
 
 instance (ToField a) => ToField (Maybe a) where
   toField (Just val) = toField val