Add 'Unpacked' Fields and Rows

src/Database/PostgreSQL/Simple/FromField.hs

@@ -218,26 +218,27 @@ 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;
 --   for example a computed column does not have a table associated with it.
 --   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'

src/Database/PostgreSQL/Simple/FromRow.hs

@@ -88,34 +88,43 @@ 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
 
 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

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 )

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