Use Vector for column table for constant element access

This commit is contained in:
2023-09-16 19:10:46 +02:00
parent 335b6188d1
commit ff615b6172
5 changed files with 44 additions and 18 deletions
+17 -7
View File
@@ -10,11 +10,13 @@
{-# LANGUAGE TypeOperators #-}
module Database.PostgreSQL.Opium
( Error (..)
( ColumnTable
, Error (..)
, ErrorPosition (..)
, FromField (..)
, FromRow (..)
, fetch_
, toListColumnTable
)
where
@@ -24,6 +26,7 @@ import Data.ByteString (ByteString)
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Data.Vector (Vector)
import Database.PostgreSQL.LibPQ
( Column
, Connection
@@ -36,6 +39,7 @@ import GHC.TypeLits (KnownSymbol, symbolVal)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Encoding
import qualified Data.Vector as Vector
import qualified Database.PostgreSQL.LibPQ as LibPQ
import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
@@ -57,20 +61,26 @@ execParams conn query = do
fetch_ :: forall a. FromRow a => Connection -> ByteString -> IO (Either Error [a])
fetch_ conn query = runExceptT $ do
result <- execParams conn query
-- TODO: Use unboxed array for columnTable
columnTable <- ExceptT $ getColumnTable @a Proxy result
nRows <- liftIO $ LibPQ.ntuples result
mapM (ExceptT . fromRow result columnTable) [0..nRows - 1]
type ColumnTable = [(Column, Oid)]
newtype ColumnTable = ColumnTable (Vector (Column, Oid))
deriving (Eq, Show)
newColumnTable :: [(Column, Oid)] -> ColumnTable
newColumnTable = ColumnTable . Vector.fromList
indexColumnTable :: ColumnTable -> Int -> (Column, Oid)
indexColumnTable = (!!)
indexColumnTable (ColumnTable v) i = v `Vector.unsafeIndex` i
toListColumnTable :: ColumnTable -> [(Column, Oid)]
toListColumnTable (ColumnTable v) = Vector.toList v
class FromRow a where
getColumnTable :: Proxy a -> Result -> IO (Either Error ColumnTable)
default getColumnTable :: (Generic a, GetColumnTable' (Rep a)) => Proxy a -> Result -> IO (Either Error ColumnTable)
getColumnTable Proxy = runExceptT . getColumnTable' @(Rep a) Proxy
getColumnTable Proxy = runExceptT . fmap newColumnTable . getColumnTable' @(Rep a) Proxy
fromRow :: Result -> ColumnTable -> Row -> IO (Either Error a)
default fromRow :: (Generic a, FromRow' (Rep a)) => Result -> ColumnTable -> Row -> IO (Either Error a)
@@ -79,7 +89,7 @@ class FromRow a where
runExceptT $ to <$> fromRow' (FromRowCtx result columnTable iRef) row
class GetColumnTable' f where
getColumnTable' :: Proxy (f p) -> Result -> ExceptT Error IO ColumnTable
getColumnTable' :: Proxy (f p) -> Result -> ExceptT Error IO [(Column, Oid)]
instance GetColumnTable' f => GetColumnTable' (M1 D c f) where
getColumnTable' Proxy = getColumnTable' @f Proxy
@@ -91,7 +101,7 @@ instance (GetColumnTable' f, GetColumnTable' g) => GetColumnTable' (f :*: g) whe
getColumnTable' Proxy result =
(++) <$> getColumnTable' @f Proxy result <*> getColumnTable' @g Proxy result
checkColumn :: forall a. FromField a => Proxy a -> String -> Result -> ExceptT Error IO ColumnTable
checkColumn :: forall a. FromField a => Proxy a -> String -> Result -> ExceptT Error IO [(Column, Oid)]
checkColumn Proxy nameStr result = do
column <- ExceptT $ maybe (Left $ ErrorMissingColumn nameText) Right <$> LibPQ.fnumber result name
oid <- liftIO $ LibPQ.ftype result column