5883c38 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

Stop pre-calculating typeinfos

commit5883c3862c23ff7b4e3d03b5b3110095c332025b authorLeon P Smith <leon@melding-monads.com> dateSun 27 Jan 2013, 22:48 (14 years ago) parent0636c4a

4 files changed+22−25

compare with master

unifiedsplit

src/Database/PostgreSQL/Simple.hs+3−7 src/Database/PostgreSQL/Simple/FromField.hs+2−7 src/Database/PostgreSQL/Simple/FromRow.hs+17−9 src/Database/PostgreSQL/Simple/Internal.hs−2

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

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

146146import qualified Data.ByteString.Char8 as B

147147import qualified Data.Text as T

148148import qualified Data.Text.Encoding as TE

149−import qualified Data.Vector as V

150149import Control.Monad.Trans.Reader

151150import Control.Monad.Trans.State.Strict

152151

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

548547 PQ.CommandOk -> do

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

550549 PQ.TuplesOk -> do

551− ncols <- PQ.nfields result

552550 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)

556551 nrows <- PQ.ntuples result

557552 ncols <- PQ.nfields result

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

559− let rw = Row row typeinfos result

554+ let rw = Row row result

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

561556 case okvc of

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

563558 | otherwise -> do

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

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

565561 v <- PQ.getvalue result row c

566− return ( typeinfos V.! unCol c

562+ return ( tinfo

567563 , fmap ellipsis v )

568564 throw (ConversionFailed

569565 (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

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

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

317317 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

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

323− | otherwise = fElem

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

324319

325320newtype Compat = Compat Word64

326321

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

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

352347 -> Maybe ByteString -> Conversion a

353348doFromField f types cvt (Just bs)

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

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

355350 , mkCompat typ `compat` types = cvt bs

356351 | otherwise = returnError Incompatible f "types incompatible"

357352doFromField f _ _ _ = returnError UnexpectedNull f ""

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

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

3232import qualified Database.PostgreSQL.LibPQ as PQ

3333import Database.PostgreSQL.Simple.Internal

3434import Database.PostgreSQL.Simple.FromField

35+import Database.PostgreSQL.Simple.Ok

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

37+import Database.PostgreSQL.Simple.TypeInfo

3638import System.IO.Unsafe (unsafePerformIO)

3739

3840import Control.Monad.Trans.State.Strict

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

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

7173nfields result = unsafePerformIO (PQ.nfields result)

7274

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+

7384fieldWith :: FieldParser a -> RowParser a

7485fieldWith fieldP = RP $ do

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

76− Row{..} <- ask

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

7788 column <- lift get

7889 lift (put (column + 1))

7990 let ncols = nfields rowresult

8091 if (column >= ncols)

81− then do

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

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

84− [0..ncols-1]

85− convertError = ConversionFailed

92+ then lift $ lift $ do

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

94+ let err = ConversionFailed

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

8796 Nothing

8897 ""

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

9099 ++ " slots in target type")

91100 "mismatch between number of columns to \

92101 \convert and number in target type"

93− lift (lift (conversionError convertError))

102+ conversionError err

94103 else do

95− let typeinfo = typeinfos ! unCol column

96− result = rowresult

104+ let result = rowresult

97105 field = Field{..}

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

99107

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

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

5252data Field = Field {

5353 result :: !PQ.Result

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

55− , typeinfo :: !TypeInfo

5655 }

5756

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

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

288287

289288data Row = Row {

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

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

292290 , rowresult :: !PQ.Result

293291 }

294292