diff --git a/src/Database/PostgreSQL/Simple/FromField.hs b/src/Database/PostgreSQL/Simple/FromField.hs index 983b53a5..e77b5237 100644 --- a/src/Database/PostgreSQL/Simple/FromField.hs +++ b/src/Database/PostgreSQL/Simple/FromField.hs @@ -218,18 +218,17 @@ typename :: Field -> Conversion ByteString typename field = typname <$> typeInfo field typeInfo :: Field -> Conversion TypeInfo -typeInfo Field{..} = Conversion $ \conn -> do - Ok <$> (getTypeInfo conn typeOid) +typeInfo f = Conversion $ \conn -> Ok <$> getTypeInfo conn (typeOid f) typeInfoByOid :: PQ.Oid -> Conversion TypeInfo -typeInfoByOid oid = Conversion $ \conn -> do - Ok <$> (getTypeInfo conn oid) +typeInfoByOid oid = Conversion $ \conn -> Ok <$> getTypeInfo conn oid -- | Returns the name of the column. This is often determined by a table -- definition, but it can be set using an @as@ clause. name :: Field -> Maybe ByteString name Field{..} = unsafeDupablePerformIO (PQ.fname result column) +name UnpackedField{..} = unpackedFieldColumnName -- | Returns the name of the object id of the @table@ associated with the -- column, if any. Returns 'Nothing' when there is no such table; @@ -237,7 +236,9 @@ name Field{..} = unsafeDupablePerformIO (PQ.fname result column) -- Analogous to libpq's @PQftable@. tableOid :: Field -> Maybe PQ.Oid -tableOid Field{..} = toMaybeOid (unsafeDupablePerformIO (PQ.ftable result column)) +tableOid field = case field of + Field{..} -> toMaybeOid (unsafeDupablePerformIO (PQ.ftable result column)) + UnpackedField{..} -> toMaybeOid unpackedFieldTableOid where toMaybeOid x = if x == PQ.invalidOid @@ -249,7 +250,9 @@ tableOid Field{..} = toMaybeOid (unsafeDupablePerformIO (PQ.ftable result column -- to libpq's @PQftablecol@. tableColumn :: Field -> Int -tableColumn Field{..} = fromCol (unsafeDupablePerformIO (PQ.ftablecol result column)) +tableColumn field = case field of + Field{..} -> fromCol (unsafeDupablePerformIO (PQ.ftablecol result column)) + UnpackedField{..} -> unpackedFieldColumnNumber where fromCol (PQ.Col x) = fromIntegral x @@ -258,6 +261,7 @@ tableColumn Field{..} = fromCol (unsafeDupablePerformIO (PQ.ftablecol result col format :: Field -> PQ.Format format Field{..} = unsafeDupablePerformIO (PQ.fformat result column) +format UnpackedField{..} = unpackedFieldFormat -- | void instance FromField () where @@ -523,7 +527,7 @@ fromArray :: FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a]) fromArray fieldParser typeInfo f = sequence . (parseIt <$>) <$> array delim where delim = typdelim (typelem typeInfo) - fElem = f{ typeOid = typoid (typelem typeInfo) } + fElem = setTypeOid f $ typoid (typelem typeInfo) parseIt item = fieldParser f' $ if item == Arrays.Plain "NULL" then Nothing else Just item' diff --git a/src/Database/PostgreSQL/Simple/FromRow.hs b/src/Database/PostgreSQL/Simple/FromRow.hs index e2ba1af9..920141ea 100644 --- a/src/Database/PostgreSQL/Simple/FromRow.hs +++ b/src/Database/PostgreSQL/Simple/FromRow.hs @@ -88,6 +88,10 @@ getTypeInfoByCol Row{..} col = Conversion $ \conn -> do oid <- PQ.ftype rowresult col Ok <$> getTypeInfo conn oid +getTypeInfoByCol UnpackedRow{..} col = typeInfo $ fst f + where PQ.Col c = col + f = unpackedRowValues !! fromIntegral c + getTypenameByCol :: Row -> PQ.Column -> Conversion ByteString getTypenameByCol row col = typname <$> getTypeInfoByCol row col @@ -95,27 +99,32 @@ getTypenameByCol row col = typname <$> getTypeInfoByCol row col fieldWith :: FieldParser a -> RowParser a fieldWith fieldP = RP $ do let unCol (PQ.Col x) = fromIntegral x :: Int - r@Row{..} <- ask - column <- lift get - lift (put (column + 1)) - let ncols = nfields rowresult - if (column >= ncols) - then lift $ lift $ do - vals <- mapM (getTypenameByCol r) [0..ncols-1] - let err = ConversionFailed - (show (unCol ncols) ++ " values: " ++ show (map ellipsis vals)) - Nothing - "" - ("at least " ++ show (unCol column + 1) - ++ " slots in target type") - "mismatch between number of columns to \ - \convert and number in target type" - conversionError err - else do - let !result = rowresult - !typeOid = unsafeDupablePerformIO (PQ.ftype result column) - !field = Field{..} - lift (lift (fieldP field (getvalue result row column))) + ask >>= \r -> case r of + UnpackedRow{..} -> do + column <- lift get + lift (put (column + 1)) + lift $ lift $ uncurry fieldP $ unpackedRowValues !! unCol column + Row{..} -> do + column <- lift get + lift (put (column + 1)) + let ncols = nfields rowresult + if (column >= ncols) + then lift $ lift $ do + vals <- mapM (getTypenameByCol r) [0..ncols-1] + let err = ConversionFailed + (show (unCol ncols) ++ " values: " ++ show (map ellipsis vals)) + Nothing + "" + ("at least " ++ show (unCol column + 1) + ++ " slots in target type") + "mismatch between number of columns to \ + \convert and number in target type" + conversionError err + else do + let !result = rowresult + !fieldTypeOid = unsafeDupablePerformIO (PQ.ftype result column) + !field = Field{..} + lift (lift (fieldP field (getvalue result row column))) field :: FromField a => RowParser a field = fieldWith fromField diff --git a/src/Database/PostgreSQL/Simple/Internal.hs b/src/Database/PostgreSQL/Simple/Internal.hs index 330ef08d..80ae01dc 100644 --- a/src/Database/PostgreSQL/Simple/Internal.hs +++ b/src/Database/PostgreSQL/Simple/Internal.hs @@ -66,10 +66,26 @@ import Control.Concurrent(threadWaitRead, threadWaitWrite) data Field = Field { result :: !PQ.Result , column :: {-# UNPACK #-} !PQ.Column - , typeOid :: {-# UNPACK #-} !PQ.Oid + , fieldTypeOid :: {-# UNPACK #-} !PQ.Oid -- ^ This returns the type oid associated with the column. Analogous -- to libpq's @PQftype@. } + | UnpackedField + { unpackedFieldTypeOid :: PQ.Oid + , unpackedFieldColumnName :: Maybe ByteString + , unpackedFieldTableOid :: PQ.Oid + , unpackedFieldColumnNumber :: Int + , unpackedFieldFormat :: PQ.Format + } + +typeOid :: Field -> PQ.Oid +typeOid Field{..} = fieldTypeOid +typeOid UnpackedField{..} = unpackedFieldTypeOid + +setTypeOid :: Field -> PQ.Oid -> Field +setTypeOid f oid = case f of + Field {} -> f { fieldTypeOid = oid } + UnpackedField {} -> f { unpackedFieldTypeOid = oid } type TypeInfoCache = IntMap.IntMap TypeInfo @@ -452,6 +468,9 @@ data Row = Row { row :: {-# UNPACK #-} !PQ.Row , rowresult :: !PQ.Result } + | UnpackedRow + { unpackedRowValues :: [(Field, Maybe ByteString)] + } newtype RowParser a = RP { unRP :: ReaderT Row (StateT PQ.Column Conversion) a } deriving ( Functor, Applicative, Alternative, Monad ) diff --git a/src/Database/PostgreSQL/Simple/Range.hs b/src/Database/PostgreSQL/Simple/Range.hs index 07397585..d3f5cade 100644 --- a/src/Database/PostgreSQL/Simple/Range.hs +++ b/src/Database/PostgreSQL/Simple/Range.hs @@ -49,6 +49,7 @@ import Data.Word (Word, Word16, Word32, import Database.PostgreSQL.Simple.Compat (scientificBuilder, (<>), toByteString) import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.Internal (setTypeOid) import Database.PostgreSQL.Simple.Time hiding (PosInfinity, NegInfinity) -- import qualified Database.PostgreSQL.Simple.Time as Time @@ -197,7 +198,7 @@ fromFieldRange fromField' f mdat = do info <- typeInfo f case info of Range{} -> - let f' = f { typeOid = typoid (rngsubtype info) } + let f' = setTypeOid f $ typoid (rngsubtype info) in case mdat of Nothing -> returnError UnexpectedNull f "" Just "empty" -> pure $ empty