d7475b8 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Add preliminary support for converting SQL arrays

d7475b8Bas van Dijk14 years ago

src/Database/PostgreSQL/Simple.hs+35−21

compare with master

unifiedsplit

@@ -4,6 +4,7 @@

4{-# LANGUAGE PatternGuards #-}

5{-# LANGUAGE RecordWildCards #-}

6{-# LANGUAGE ViewPatterns #-}

7+{-# LANGUAGE QuasiQuotes #-}

8------------------------------------------------------------------------------

9------------------------------------------------------------------------------

9-- |

10-- |

@@ -140,6 +141,7 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..))

140import Database.PostgreSQL.Simple.Types

141import Database.PostgreSQL.Simple.Types

141 ( Binary(..), In(..), Only(..), Query(..), (:.)(..) )

142 ( Binary(..), In(..), Only(..), Query(..), (:.)(..) )

142import Database.PostgreSQL.Simple.Internal as Base

143import Database.PostgreSQL.Simple.Internal as Base

144+import Database.PostgreSQL.Simple.SqlQQ (sql)

143import qualified Database.PostgreSQL.LibPQ as PQ

145import qualified Database.PostgreSQL.LibPQ as PQ

144import qualified Data.ByteString.Char8 as B

146import qualified Data.ByteString.Char8 as B

145import qualified Data.Text as T

147import qualified Data.Text as T

@@ -549,19 +551,19 @@ finishQuery conn q result = do

549 PQ.TuplesOk -> do

551 PQ.TuplesOk -> do

550 ncols <- PQ.nfields result

552 ncols <- PQ.nfields result

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

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

552− typenames <- V.generateM (unCol ncols)

554+ typeinfos <- V.generateM (unCol ncols)

553 (\(PQ.Col . fromIntegral -> col) -> do

555 (\(PQ.Col . fromIntegral -> col) -> do

554− getTypename conn =<< PQ.ftype result col)

556+ getTypeInfo conn =<< PQ.ftype result col)

555 nrows <- PQ.ntuples result

557 nrows <- PQ.ntuples result

556 ncols <- PQ.nfields result

558 ncols <- PQ.nfields result

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

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

558− let rw = Row row typenames result

560+ let rw = Row row typeinfos result

559 case runStateT (runReaderT (unRP fromRow) rw) 0 of

561 case runStateT (runReaderT (unRP fromRow) rw) 0 of

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

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

561 | otherwise -> do

563 | otherwise -> do

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

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

563 v <- PQ.getvalue result row c

565 v <- PQ.getvalue result row c

564− return ( typenames V.! unCol c

566+ return ( typeinfos V.! unCol c

565 , fmap ellipsis v )

567 , fmap ellipsis v )

566 throw (ConversionFailed

568 throw (ConversionFailed

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

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

@@ -963,24 +965,36 @@ fmtError msg q xs = throw FormatError {

963-- wrong results. In such cases, write a @newtype@ wrapper and a

965-- wrong results. In such cases, write a @newtype@ wrapper and a

964-- custom 'Result' instance to handle your encoding.

966-- custom 'Result' instance to handle your encoding.

965

967

966−getTypename :: Connection -> PQ.Oid -> IO ByteString

968+getTypeInfo :: Connection -> PQ.Oid -> IO TypeInfo

967−getTypename conn@Connection{..} oid =

969+getTypeInfo conn@Connection{..} oid =

968 case oid2typname oid of

970 case oid2typname oid of

969− Just name -> return name

971+ Just name -> return $! TypeInfo { typ = NamedOid oid name

972+ , typelem = Nothing

973+ }

970 Nothing -> modifyMVar connectionObjects $ \oidmap -> do

974 Nothing -> modifyMVar connectionObjects $ \oidmap -> do

971 case IntMap.lookup (oid2int oid) oidmap of

975 case IntMap.lookup (oid2int oid) oidmap of

972− Just name -> return (oidmap, name)

976+ Just typeinfo -> return (oidmap, typeinfo)

973 Nothing -> do

977 Nothing -> do

974− names <- query conn "SELECT typname FROM pg_type WHERE oid=?"

978+ names <- query conn

979+ [sql| SELECT p.oid, p.typname, c.oid, c.typname

980+ FROM pg_type AS p LEFT OUTER JOIN pg_type AS c

981+ ON c.oid = p.typelem

982+ WHERE p.oid = ?

975− (Only oid)

983+ |] (Only oid)

976− name <- case names of

984+ typinf <- case names of

977− [] -> return $ throw SqlError {

985+ [] -> return $ throw SqlError {

978− sqlNativeError = -1,

986+ sqlNativeError = -1,

979− sqlErrorMsg = "invalid type oid",

987+ sqlErrorMsg = "invalid type oid",

980− sqlState = ""

988+ sqlState = ""

981− }

989+ }

982− [Only x] -> return x

990+ [(pOid, pTypName, mbCOid, mbCTypName)] ->

991+ return $! TypeInfo { typ = NamedOid pOid pTypName

992+ , typelem = do

993+ cOid <- mbCOid

994+ cTypName <- mbCTypName

995+ return $ NamedOid cOid cTypName

996+ }

983− _ -> fail "typename query returned more than one result"

997+ _ -> fail "typename query returned more than one result"

984− -- oid is a primary key, so the query should

998+ -- oid is a primary key, so the query should

985− -- never return more than one result

999+ -- never return more than one result

986− return (IntMap.insert (oid2int oid) name oidmap, name)

1000+ return (IntMap.insert (oid2int oid) typinf oidmap, typinf)

src/Database/PostgreSQL/Simple/FromField.hs+1−1

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

282 => Field -> Compat -> (ByteString -> Ok a)

283 -> Maybe ByteString -> Ok a

284doFromField f types cvt (Just bs)

285− | Just typ <- oid2builtin (typeOid f)

285+ | Just typ <- oid2builtin (typoid $ typ $ typeinfo f)

286 , mkCompat typ `compat` types = cvt bs

287 | otherwise = returnError Incompatible f "types incompatible"

288doFromField f _ _ _ = returnError UnexpectedNull f ""

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

@@ -68,13 +68,13 @@ class FromRow a where

68fieldWith :: FieldParser a -> RowParser a

69fieldWith fieldP = RP $ do

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

71− Row{..} <- ask

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

72 column <- lift get

73 lift (put (column + 1))

74 let ncols = nfields rowresult

75 if (column >= ncols)

76 then do

77− let vals = map (\c -> ( typenames ! (unCol c)

77+ let vals = map (\c -> ( typenames r ! (unCol c)

78 , fmap ellipsis (getvalue rowresult row c) ))

79 [0..ncols-1]

80 convertError = ConversionFailed

@@ -85,7 +85,7 @@ fieldWith fieldP = RP $ do

85 \convert and number in target type"

86 lift (lift (Errors [SomeException convertError]))

87 else do

88− let typename = typenames ! unCol column

88+ let typeinfo = typeinfos ! unCol column

89 result = rowresult

90 field = Field{..}

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

src/Database/PostgreSQL/Simple/Internal.hs+17−3

@@ -52,9 +52,20 @@ import System.IO.Unsafe (unsafePerformIO)

52data Field = Field {

53 result :: !PQ.Result

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

55− , typename :: !ByteString

55+ , typeinfo :: !TypeInfo

56 }

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

59+ , typname :: !ByteString

60+ } deriving Show

61+

62+data TypeInfo = TypeInfo { typ :: !NamedOid

63+ , typelem :: !(Maybe NamedOid)

64+ } deriving Show

65+

66+typename :: Field -> ByteString

67+typename = typname . typ . typeinfo

68+

58name :: Field -> Maybe ByteString

69name :: Field -> Maybe ByteString

59name Field{..} = unsafePerformIO (PQ.fname result column)

70name Field{..} = unsafePerformIO (PQ.fname result column)

@@ -76,7 +87,7 @@ typeOid Field{..} = unsafePerformIO (PQ.ftype result column)

77data Connection = Connection {

88data Connection = Connection {

78 connectionHandle :: {-# UNPACK #-} !(MVar PQ.Connection)

89 connectionHandle :: {-# UNPACK #-} !(MVar PQ.Connection)

79− , connectionObjects :: {-# UNPACK #-} !(MVar (IntMap.IntMap ByteString))

90+ , connectionObjects :: {-# UNPACK #-} !(MVar (IntMap.IntMap TypeInfo))

80 }

91 }

82data SqlType

93data SqlType

@@ -301,10 +312,13 @@ newNullConnection = do

301

312

302data Row = Row {

313data Row = Row {

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

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

304− , typenames :: !(V.Vector ByteString)

315+ , typeinfos :: !(V.Vector TypeInfo)

305 , rowresult :: !PQ.Result

316 , rowresult :: !PQ.Result

306 }

317 }

307

318

319+typenames :: Row -> V.Vector ByteString

320+typenames = V.map (typname . typ) . typeinfos

321+

308newtype RowParser a = RP { unRP :: ReaderT Row (StateT PQ.Column Ok) a }

322newtype RowParser a = RP { unRP :: ReaderT Row (StateT PQ.Column Ok) a }

309 deriving ( Functor, Applicative, Alternative, Monad )

323 deriving ( Functor, Applicative, Alternative, Monad )

310

324