5883c38 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Stop pre-calculating typeinfos

5883c38Leon P Smith14 years ago

src/Database/PostgreSQL/Simple.hs+3−7

compare with master

unifiedsplit

@@ -146,7 +146,6 @@ import qualified Database.PostgreSQL.LibPQ as PQ

146import qualified Data.ByteString.Char8 as B

147import qualified Data.Text as T

148import qualified Data.Text.Encoding as TE

149−import qualified Data.Vector as V

150import Control.Monad.Trans.Reader

149import Control.Monad.Trans.Reader

151import Control.Monad.Trans.State.Strict

150import Control.Monad.Trans.State.Strict

152

151

@@ -548,22 +547,19 @@ finishQuery conn q result = do

548 PQ.CommandOk -> do

547 PQ.CommandOk -> do

549 throwIO $ QueryError "query resulted in a command response" q

548 throwIO $ QueryError "query resulted in a command response" q

550 PQ.TuplesOk -> do

549 PQ.TuplesOk -> do

551− ncols <- PQ.nfields result

552 let unCol (PQ.Col x) = fromIntegral x :: Int

550 let unCol (PQ.Col x) = fromIntegral x :: Int

553− typeinfos <- V.generateM (unCol ncols)

554− (\(PQ.Col . fromIntegral -> col) -> do

555− getTypeInfo conn =<< PQ.ftype result col)

556 nrows <- PQ.ntuples result

551 nrows <- PQ.ntuples result

557 ncols <- PQ.nfields result

552 ncols <- PQ.nfields result

558 forM' 0 (nrows-1) $ \row -> do

553 forM' 0 (nrows-1) $ \row -> do

559− let rw = Row row typeinfos result

554+ let rw = Row row result

560 okvc <- runConversion (runStateT (runReaderT (unRP fromRow) rw) 0) conn

555 okvc <- runConversion (runStateT (runReaderT (unRP fromRow) rw) 0) conn

561 case okvc of

556 case okvc of

562 Ok (val,col) | col == ncols -> return val

557 Ok (val,col) | col == ncols -> return val

563 | otherwise -> do

558 | otherwise -> do

564 vals <- forM' 0 (ncols-1) $ \c -> do

559 vals <- forM' 0 (ncols-1) $ \c -> do

560+ tinfo <- getTypeInfo conn =<< PQ.ftype result c

565 v <- PQ.getvalue result row c

561 v <- PQ.getvalue result row c

566− return ( typeinfos V.! unCol c

562+ return ( tinfo

567 , fmap ellipsis v )

563 , fmap ellipsis v )

568 throw (ConversionFailed

564 throw (ConversionFailed

569 (show (unCol ncols) ++ " values: " ++ show vals)

565 (show (unCol ncols) ++ " values: " ++ show vals)

src/Database/PostgreSQL/Simple/FromField.hs+2−7

@@ -315,12 +315,7 @@ instance (FromField a, Typeable a) => FromField (Vector a) where

315fromArray :: (FromField a) => Char -> Field -> Parser (Conversion [a])

316fromArray delim f = sequence . (parseIt <$>) <$> array delim

317 where

318− fElem = f{ typeinfo = TypeInfo tElem Nothing }

319− tInfo = typeinfo f

320− tElem = fromMaybe (typ tInfo) (typelem tInfo)

321− parseIt item = (fromField f' . Just . fmt delim) item

318+ parseIt item = (fromField f . Just . fmt delim) item

322− where f' | Array _ <- item = f

323− | otherwise = fElem

324

319

325newtype Compat = Compat Word64

320newtype Compat = Compat Word64

326

321

@@ -351,7 +346,7 @@ doFromField :: forall a . (Typeable a)

351 => Field -> Compat -> (ByteString -> Conversion a)

346 => Field -> Compat -> (ByteString -> Conversion a)

352 -> Maybe ByteString -> Conversion a

347 -> Maybe ByteString -> Conversion a

353doFromField f types cvt (Just bs)

348doFromField f types cvt (Just bs)

354− | Just typ <- oid2builtin (typoid $ typ $ typeinfo f)

349+ | Just typ <- oid2builtin (typeOid f)

355 , mkCompat typ `compat` types = cvt bs

350 , mkCompat typ `compat` types = cvt bs

356 | otherwise = returnError Incompatible f "types incompatible"

351 | otherwise = returnError Incompatible f "types incompatible"

357doFromField f _ _ _ = returnError UnexpectedNull f ""

352doFromField f _ _ _ = returnError UnexpectedNull f ""

src/Database/PostgreSQL/Simple/FromRow.hs+17−9

@@ -32,7 +32,9 @@ import Database.PostgreSQL.Simple.Types (Only(..))

32import qualified Database.PostgreSQL.LibPQ as PQ

33import Database.PostgreSQL.Simple.Internal

34import Database.PostgreSQL.Simple.FromField

35+import Database.PostgreSQL.Simple.Ok

35import Database.PostgreSQL.Simple.Types ((:.)(..))

36import Database.PostgreSQL.Simple.Types ((:.)(..))

37+import Database.PostgreSQL.Simple.TypeInfo

36import System.IO.Unsafe (unsafePerformIO)

38import System.IO.Unsafe (unsafePerformIO)

38import Control.Monad.Trans.State.Strict

40import Control.Monad.Trans.State.Strict

@@ -70,19 +72,26 @@ getvalue result row col = unsafePerformIO (PQ.getvalue result row col)

70nfields :: PQ.Result -> PQ.Column

72nfields :: PQ.Result -> PQ.Column

71nfields result = unsafePerformIO (PQ.nfields result)

73nfields result = unsafePerformIO (PQ.nfields result)

75+getTypeInfoByCol :: Row -> PQ.Column -> Conversion TypeInfo

76+getTypeInfoByCol Row{..} col =

77+ Conversion $ \conn -> do

78+ oid <- PQ.ftype rowresult col

79+ Ok <$> getTypeInfo conn oid

80+

81+getTypenameByCol :: Row -> PQ.Column -> Conversion ByteString

82+getTypenameByCol row col = typname . typ <$> getTypeInfoByCol row col

83+

73fieldWith :: FieldParser a -> RowParser a

84fieldWith :: FieldParser a -> RowParser a

74fieldWith fieldP = RP $ do

85fieldWith fieldP = RP $ do

75 let unCol (PQ.Col x) = fromIntegral x :: Int

86 let unCol (PQ.Col x) = fromIntegral x :: Int

76− Row{..} <- ask

87+ r@Row{..} <- ask

77 column <- lift get

88 column <- lift get

78 lift (put (column + 1))

89 lift (put (column + 1))

79 let ncols = nfields rowresult

90 let ncols = nfields rowresult

80 if (column >= ncols)

91 if (column >= ncols)

81− then do

92+ then lift $ lift $ do

82− let vals = map (\c -> ( typname (typ (typeinfos ! unCol c))

93+ vals <- mapM (getTypenameByCol r) [0..ncols-1]

83− , fmap ellipsis (getvalue rowresult row c) ))

84− [0..ncols-1]

85− convertError = ConversionFailed

94+ let err = ConversionFailed

86 (show (unCol ncols) ++ " values: " ++ show vals)

95 (show (unCol ncols) ++ " values: " ++ show vals)

87 Nothing

96 Nothing

88 ""

97 ""

@@ -90,10 +99,9 @@ fieldWith fieldP = RP $ do

90 ++ " slots in target type")

99 ++ " slots in target type")

91 "mismatch between number of columns to \

100 "mismatch between number of columns to \

92 \convert and number in target type"

101 \convert and number in target type"

93− lift (lift (conversionError convertError))

102+ conversionError err

94 else do

103 else do

95− let typeinfo = typeinfos ! unCol column

96− result = rowresult

104+ let result = rowresult

97 field = Field{..}

105 field = Field{..}

98 lift (lift (fieldP field (getvalue result row column)))

106 lift (lift (fieldP field (getvalue result row column)))

107

src/Database/PostgreSQL/Simple/Internal.hs−2

@@ -52,7 +52,6 @@ import qualified Data.Vector as V

52data Field = Field {

53 result :: !PQ.Result

54 , column :: {-# UNPACK #-} !PQ.Column

55− , typeinfo :: !TypeInfo

56 }

55 }

58data NamedOid = NamedOid { typoid :: !PQ.Oid

57data NamedOid = NamedOid { typoid :: !PQ.Oid

@@ -288,7 +287,6 @@ newNullConnection = do

288

287

289data Row = Row {

288data Row = Row {

290 row :: {-# UNPACK #-} !PQ.Row

289 row :: {-# UNPACK #-} !PQ.Row

291− , typeinfos :: !(V.Vector TypeInfo)

292 , rowresult :: !PQ.Result

290 , rowresult :: !PQ.Result

293 }

291 }

294

292