Skip to content
Browse files

Stop pre-calculating typeinfos

  • Loading branch information...
1 parent 0636c4a commit 5883c3862c23ff7b4e3d03b5b3110095c332025b @lpsmith committed Jan 27, 2013
View
10 src/Database/PostgreSQL/Simple.hs
@@ -146,7 +146,6 @@ import qualified Database.PostgreSQL.LibPQ as PQ
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
-import qualified Data.Vector as V
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State.Strict
@@ -548,22 +547,19 @@ finishQuery conn q result = do
PQ.CommandOk -> do
throwIO $ QueryError "query resulted in a command response" q
PQ.TuplesOk -> do
- ncols <- PQ.nfields result
let unCol (PQ.Col x) = fromIntegral x :: Int
- typeinfos <- V.generateM (unCol ncols)
- (\(PQ.Col . fromIntegral -> col) -> do
- getTypeInfo conn =<< PQ.ftype result col)
nrows <- PQ.ntuples result
ncols <- PQ.nfields result
forM' 0 (nrows-1) $ \row -> do
- let rw = Row row typeinfos result
+ let rw = Row row result
okvc <- runConversion (runStateT (runReaderT (unRP fromRow) rw) 0) conn
case okvc of
Ok (val,col) | col == ncols -> return val
| otherwise -> do
vals <- forM' 0 (ncols-1) $ \c -> do
+ tinfo <- getTypeInfo conn =<< PQ.ftype result c
v <- PQ.getvalue result row c
- return ( typeinfos V.! unCol c
+ return ( tinfo
, fmap ellipsis v )
throw (ConversionFailed
(show (unCol ncols) ++ " values: " ++ show vals)
View
9 src/Database/PostgreSQL/Simple/FromField.hs
@@ -315,12 +315,7 @@ instance (FromField a, Typeable a) => FromField (Vector a) where
fromArray :: (FromField a) => Char -> Field -> Parser (Conversion [a])
fromArray delim f = sequence . (parseIt <$>) <$> array delim
where
- fElem = f{ typeinfo = TypeInfo tElem Nothing }
- tInfo = typeinfo f
- tElem = fromMaybe (typ tInfo) (typelem tInfo)
- parseIt item = (fromField f' . Just . fmt delim) item
- where f' | Array _ <- item = f
- | otherwise = fElem
+ parseIt item = (fromField f . Just . fmt delim) item
newtype Compat = Compat Word64
@@ -351,7 +346,7 @@ doFromField :: forall a . (Typeable a)
=> Field -> Compat -> (ByteString -> Conversion a)
-> Maybe ByteString -> Conversion a
doFromField f types cvt (Just bs)
- | Just typ <- oid2builtin (typoid $ typ $ typeinfo f)
+ | Just typ <- oid2builtin (typeOid f)
, mkCompat typ `compat` types = cvt bs
| otherwise = returnError Incompatible f "types incompatible"
doFromField f _ _ _ = returnError UnexpectedNull f ""
View
26 src/Database/PostgreSQL/Simple/FromRow.hs
@@ -32,7 +32,9 @@ import Database.PostgreSQL.Simple.Types (Only(..))
import qualified Database.PostgreSQL.LibPQ as PQ
import Database.PostgreSQL.Simple.Internal
import Database.PostgreSQL.Simple.FromField
+import Database.PostgreSQL.Simple.Ok
import Database.PostgreSQL.Simple.Types ((:.)(..))
+import Database.PostgreSQL.Simple.TypeInfo
import System.IO.Unsafe (unsafePerformIO)
import Control.Monad.Trans.State.Strict
@@ -70,30 +72,36 @@ getvalue result row col = unsafePerformIO (PQ.getvalue result row col)
nfields :: PQ.Result -> PQ.Column
nfields result = unsafePerformIO (PQ.nfields result)
+getTypeInfoByCol :: Row -> PQ.Column -> Conversion TypeInfo
+getTypeInfoByCol Row{..} col =
+ Conversion $ \conn -> do
+ oid <- PQ.ftype rowresult col
+ Ok <$> getTypeInfo conn oid
+
+getTypenameByCol :: Row -> PQ.Column -> Conversion ByteString
+getTypenameByCol row col = typname . typ <$> getTypeInfoByCol row col
+
fieldWith :: FieldParser a -> RowParser a
fieldWith fieldP = RP $ do
let unCol (PQ.Col x) = fromIntegral x :: Int
- Row{..} <- ask
+ r@Row{..} <- ask
column <- lift get
lift (put (column + 1))
let ncols = nfields rowresult
if (column >= ncols)
- then do
- let vals = map (\c -> ( typname (typ (typeinfos ! unCol c))
- , fmap ellipsis (getvalue rowresult row c) ))
- [0..ncols-1]
- convertError = ConversionFailed
+ then lift $ lift $ do
+ vals <- mapM (getTypenameByCol r) [0..ncols-1]
+ let err = ConversionFailed
(show (unCol ncols) ++ " values: " ++ show vals)
Nothing
""
("at least " ++ show (unCol column + 1)
++ " slots in target type")
"mismatch between number of columns to \
\convert and number in target type"
- lift (lift (conversionError convertError))
+ conversionError err
else do
- let typeinfo = typeinfos ! unCol column
- result = rowresult
+ let result = rowresult
field = Field{..}
lift (lift (fieldP field (getvalue result row column)))
View
2 src/Database/PostgreSQL/Simple/Internal.hs
@@ -52,7 +52,6 @@ import qualified Data.Vector as V
data Field = Field {
result :: !PQ.Result
, column :: {-# UNPACK #-} !PQ.Column
- , typeinfo :: !TypeInfo
}
data NamedOid = NamedOid { typoid :: !PQ.Oid
@@ -288,7 +287,6 @@ newNullConnection = do
data Row = Row {
row :: {-# UNPACK #-} !PQ.Row
- , typeinfos :: !(V.Vector TypeInfo)
, rowresult :: !PQ.Result
}

0 comments on commit 5883c38

Please sign in to comment.
Something went wrong with that request. Please try again.