diff --git a/CONTRIBUTORS b/CONTRIBUTORS --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -10,3 +10,4 @@ Jeff Chu Oliver Charles Simon Meier +Alexey Uimanov diff --git a/postgresql-simple.cabal b/postgresql-simple.cabal --- a/postgresql-simple.cabal +++ b/postgresql-simple.cabal @@ -1,5 +1,5 @@ Name: postgresql-simple -Version: 0.3.3.2 +Version: 0.3.4.0 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple. @@ -23,6 +23,7 @@ Database.PostgreSQL.Simple Database.PostgreSQL.Simple.Arrays Database.PostgreSQL.Simple.BuiltinTypes + Database.PostgreSQL.Simple.Copy Database.PostgreSQL.Simple.FromField Database.PostgreSQL.Simple.FromRow Database.PostgreSQL.Simple.LargeObjects @@ -75,7 +76,7 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple - tag: v0.3.3.2 + tag: v0.3.4.0 test-suite test type: exitcode-stdio-1.0 diff --git a/src/Database/PostgreSQL/Simple.hs b/src/Database/PostgreSQL/Simple.hs --- a/src/Database/PostgreSQL/Simple.hs +++ b/src/Database/PostgreSQL/Simple.hs @@ -13,7 +13,6 @@ -- License: BSD3 -- Maintainer: Leon P Smith -- Stability: experimental --- Portability: portable -- -- A mid-level client library for the PostgreSQL database, aimed at ease of -- use and high performance. @@ -483,11 +482,11 @@ where declare = do name <- newTempName conn - _ <- execute_ conn $ mconcat + _ <- execute_ conn $ mconcat [ "DECLARE ", name, " NO SCROLL CURSOR FOR ", q ] return name fetch (Query name) = query_ conn $ - Query (toByteString (fromByteString "FETCH FORWARD " + Query (toByteString (fromByteString "FETCH FORWARD " <> integral chunkSize <> fromByteString " FROM " <> fromByteString name @@ -696,7 +695,7 @@ -- -- The obvious approach would appear to be something like this: -- --- > instance (Param a) => QueryParam a where +-- > instance (ToField a) => ToRow a where -- > ... -- -- Unfortunately, this wreaks havoc with type inference, so we take a @@ -775,9 +774,10 @@ -- $returning -- --- The 'returning' function is similar to 'executeMany' but is --- intended for use with multi-tuple @INSERT@ or @UPDATE@ statements --- that make use of @RETURNING@. +-- PostgreSQL supports returning values from data manipulation statements +-- such as @INSERT@ and @UPDATE@. You can use these statements by +-- using 'query' instead of 'execute'. For multi-tuple inserts, +-- use 'returning' instead of 'executeMany'. -- -- For example, were there an auto-incrementing @id@ column and -- timestamp column @t@ that defaulted to the present time for the @@ -785,7 +785,8 @@ -- sales records and also return their new @id@s and timestamps. -- -- > let q = "insert into sales (amount, label) values (?,?) returning id, t" --- > xs :: [(Int, UTCTime)] <- returning conn q [(20,"Chips"),(300,"Wood")] +-- > xs :: [(Int, UTCTime)] <- query conn q (15,"Sawdust") +-- > ys :: [(Int, UTCTime)] <- returning conn q [(20,"Chips"),(300,"Wood")] -- $result -- diff --git a/src/Database/PostgreSQL/Simple/Arrays.hs b/src/Database/PostgreSQL/Simple/Arrays.hs --- a/src/Database/PostgreSQL/Simple/Arrays.hs +++ b/src/Database/PostgreSQL/Simple/Arrays.hs @@ -7,7 +7,6 @@ -- License: BSD3 -- Maintainer: Leon P Smith -- Stability: experimental --- Portability: portable -- -- A Postgres array parser and pretty-printer. ------------------------------------------------------------------------------ @@ -91,4 +90,3 @@ f '\\' = "\\\\" f c = B.singleton c -- TODO: Implement easy performance improvements with unfoldr. - diff --git a/src/Database/PostgreSQL/Simple/Copy.hs b/src/Database/PostgreSQL/Simple/Copy.hs new file mode 100644 --- /dev/null +++ b/src/Database/PostgreSQL/Simple/Copy.hs @@ -0,0 +1,210 @@ +{-# LANGUAGE CPP, DeriveDataTypeable #-} + +------------------------------------------------------------------------------ +-- | +-- Module: Database.PostgreSQL.Simple.Copy +-- Copyright: (c) 2013 Leon P Smith +-- License: BSD3 +-- Maintainer: Leon P Smith +-- Stability: experimental +-- +-- mid-level support for COPY IN and COPY OUT. See +-- for +-- more information. +-- +-- To use this binding, first call 'copy' with a @COPY FROM STDIN@ +-- or @COPY TO STDOUT@ query as documented in the link above. Then +-- call @getCopyData@ repeatedly until it returns 'CopyOutDone' in +-- the former case, or in the latter, call @putCopyData@ repeatedly +-- and then finish by calling either @putCopyEnd@ to proceed or +-- @putCopyError@ to abort. +-- +-- You cannot issue another query on the same connection while a copy +-- is ongoing; this will result in an exception. It is harmless to +-- concurrently call @getNotification@ on a connection while it is in +-- a copy in or copy out state, however be aware that current versions +-- of the PostgreSQL backend will not deliver notifications to a client +-- while a transaction is ongoing. +-- +------------------------------------------------------------------------------ + +module Database.PostgreSQL.Simple.Copy + ( copy + , copy_ + , CopyOutResult(..) + , getCopyData + , putCopyData + , putCopyEnd + , putCopyError + ) where + +import Control.Applicative +import Control.Concurrent +import Control.Exception ( throwIO ) +import qualified Data.Attoparsec.ByteString.Char8 as P +import Data.Typeable(Typeable) +import Data.Int(Int64) +import qualified Data.ByteString.Char8 as B +import qualified Database.PostgreSQL.LibPQ as PQ +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.Types +import Database.PostgreSQL.Simple.Internal + +-- | Issue a query that changes a connection's state to @CopyIn@ +-- (via a @COPY FROM STDIN@ query) or @CopyOut@ (via @COPY TO STDOUT@) +-- query. Performs parameter subsitution. + +copy :: ( ToRow params ) => Connection -> Query -> params -> IO () +copy conn template qs = do + q <- formatQuery conn template qs + doCopy "Database.PostgreSQL.Simple.Copy.copy" conn template q + +-- | Issue a query that changes a connection's state to @CopyIn@ +-- (via a @COPY FROM STDIN@ query) or @CopyOut@ (via @COPY TO STDOUT@) +-- query. Does not perform parameter subsitution. + +copy_ :: Connection -> Query -> IO () +copy_ conn (Query q) = do + doCopy "Database.PostgreSQL.Simple.Copy.copy_" conn (Query q) q + +doCopy :: B.ByteString -> Connection -> Query -> B.ByteString -> IO () +doCopy funcName conn template q = do + result <- exec conn q + status <- PQ.resultStatus result + let err = throwIO $ QueryError + (B.unpack funcName ++ " " ++ show status) + template + case status of + PQ.EmptyQuery -> err + PQ.CommandOk -> err + PQ.TuplesOk -> err + PQ.CopyOut -> return () + PQ.CopyIn -> return () + PQ.BadResponse -> throwResultError funcName result status + PQ.NonfatalError -> throwResultError funcName result status + PQ.FatalError -> throwResultError funcName result status + +data CopyOutResult + = CopyOutRow !B.ByteString -- ^ Data representing either exactly + -- one row of the result, or header + -- or footer data depending on format. + | CopyOutDone {-# UNPACK #-} !Int64 -- ^ No more rows, and a count of the + -- number of rows returned. + deriving (Eq, Typeable, Show) + +-- | A connection must be in the @CopyOut@ state in order to call this +-- function, via a @COPY TO STDOUT@ query. If this returns a 'CopyOutRow', +-- the connection remains in the @CopyOut@ state, if it returns 'CopyOutDone', +-- then the connection has reverted to the ready state. + +getCopyData :: Connection -> IO CopyOutResult +getCopyData conn = withConnection conn loop + where + funcName = "Database.PostgreSQL.Simple.Copy.getCopyData" + loop pqconn = do +#if defined(mingw32_HOST_OS) + row <- PQ.getCopyData pqconn False +#else + row <- PQ.getCopyData pqconn True +#endif + case row of + PQ.CopyOutRow rowdata -> return $! CopyOutRow rowdata + PQ.CopyOutDone -> CopyOutDone <$> getCopyCommandTag funcName pqconn +#if defined(mingw32_HOST_OS) + PQ.CopyOutWouldBlock -> do + fail (B.unpack funcName ++ ": the impossible happened") +#else + PQ.CopyOutWouldBlock -> do + mfd <- PQ.socket pqconn + case mfd of + Nothing -> throwIO (fdError funcName) + Just fd -> do + threadWaitRead fd + _ <- PQ.consumeInput pqconn + loop pqconn +#endif + PQ.CopyOutError -> do + mmsg <- PQ.errorMessage pqconn + throwIO SqlError { + sqlState = "", + sqlExecStatus = FatalError, + sqlErrorMsg = maybe "" id mmsg, + sqlErrorDetail = "", + sqlErrorHint = funcName + } + +-- | A connection must be in the @CopyIn@ state in order to call this +-- function, via a @COPY FROM STDIN@ query. The connection remains +-- in a @CopyIn@ state after this function is called. Note that +-- the data does not need to represent a single row, or even an +-- integral number of rows. The net result of +-- @putCopyData conn a >> putCopyData conn b@ +-- is the same as @putCopyData conn c@ whenever @c == BS.append a b@. + +putCopyData :: Connection -> B.ByteString -> IO () +putCopyData conn dat = withConnection conn $ \pqconn -> do + doCopyIn funcName (\c -> PQ.putCopyData c dat) pqconn + where + funcName = "Database.PostgreSQL.Simple.Copy.putCopyData" + + +-- | A connection must be in the @CopyIn@ state in order to call this +-- function, via a @COPY FROM STDIN@ query. Completes the COPY IN +-- operation, changing the connection's state back to normal. +-- Returns the number of rows processed. + +putCopyEnd :: Connection -> IO Int64 +putCopyEnd conn = withConnection conn $ \pqconn -> do + doCopyIn funcName (\c -> PQ.putCopyEnd c Nothing) pqconn + getCopyCommandTag funcName pqconn + where + funcName = "Database.PostgreSQL.Simple.Copy.putCopyEnd" + +-- | A connection must be in the @CopyIn@ state in order to call this +-- function, via a @COPY FROM STDIN@ query. Aborts the COPY IN +-- operation, changing the connection's state back to normal. + +putCopyError :: Connection -> B.ByteString -> IO () +putCopyError conn err = withConnection conn $ \pqconn -> do + doCopyIn funcName (\c -> PQ.putCopyEnd c (Just err)) pqconn + where + funcName = "Database.PostgreSQL.Simple.Copy.putCopyError" + + +doCopyIn :: B.ByteString -> (PQ.Connection -> IO PQ.CopyInResult) + -> PQ.Connection -> IO () +doCopyIn funcName action = loop + where + loop pqconn = do + stat <- action pqconn + case stat of + PQ.CopyInOk -> return () + PQ.CopyInError -> do + mmsg <- PQ.errorMessage pqconn + throwIO SqlError { + sqlState = "", + sqlExecStatus = FatalError, + sqlErrorMsg = maybe "" id mmsg, + sqlErrorDetail = "", + sqlErrorHint = funcName + } + PQ.CopyInWouldBlock -> do + mfd <- PQ.socket pqconn + case mfd of + Nothing -> throwIO (fdError funcName) + Just fd -> do + threadWaitWrite fd + loop pqconn +{-# INLINE doCopyIn #-} + +getCopyCommandTag :: B.ByteString -> PQ.Connection -> IO Int64 +getCopyCommandTag funcName pqconn = do + result <- maybe (fail errCmdStatus) return =<< PQ.getResult pqconn + cmdStat <- maybe (fail errCmdStatus) return =<< PQ.cmdStatus result + let rowCount = P.string "COPY " *> (P.decimal <* P.endOfInput) + case P.parseOnly rowCount cmdStat of + Left _ -> fail errCmdStatusFmt + Right n -> return $! n + where + errCmdStatus = B.unpack funcName ++ ": failed to fetch command status" + errCmdStatusFmt = B.unpack funcName ++ ": failed to parse command status" diff --git a/src/Database/PostgreSQL/Simple/FromField.hs b/src/Database/PostgreSQL/Simple/FromField.hs --- a/src/Database/PostgreSQL/Simple/FromField.hs +++ b/src/Database/PostgreSQL/Simple/FromField.hs @@ -10,7 +10,6 @@ License: BSD3 Maintainer: Leon P Smith Stability: experimental -Portability: portable The 'FromField' typeclass, for converting a single value in a row returned by a SQL query into a more useful Haskell representation. diff --git a/src/Database/PostgreSQL/Simple/FromRow.hs b/src/Database/PostgreSQL/Simple/FromRow.hs --- a/src/Database/PostgreSQL/Simple/FromRow.hs +++ b/src/Database/PostgreSQL/Simple/FromRow.hs @@ -7,7 +7,6 @@ -- License: BSD3 -- Maintainer: Leon P Smith -- Stability: experimental --- Portability: portable -- -- The 'FromRow' typeclass, for converting a row of results -- returned by a SQL query into a more useful Haskell representation. @@ -71,7 +70,7 @@ nfields result = unsafeDupablePerformIO (PQ.nfields result) getTypeInfoByCol :: Row -> PQ.Column -> Conversion TypeInfo -getTypeInfoByCol Row{..} col = +getTypeInfoByCol Row{..} col = Conversion $ \conn -> do oid <- PQ.ftype rowresult col Ok <$> getTypeInfo conn oid diff --git a/src/Database/PostgreSQL/Simple/HStore.hs b/src/Database/PostgreSQL/Simple/HStore.hs --- a/src/Database/PostgreSQL/Simple/HStore.hs +++ b/src/Database/PostgreSQL/Simple/HStore.hs @@ -5,7 +5,6 @@ -- License: BSD3 -- Maintainer: Leon P Smith -- Stability: experimental --- Portability: portable -- -- Parsers and printers for hstore, a extended type bundled with -- PostgreSQL providing finite maps from text strings to text strings. diff --git a/src/Database/PostgreSQL/Simple/HStore/Implementation.hs b/src/Database/PostgreSQL/Simple/HStore/Implementation.hs --- a/src/Database/PostgreSQL/Simple/HStore/Implementation.hs +++ b/src/Database/PostgreSQL/Simple/HStore/Implementation.hs @@ -7,7 +7,6 @@ -- License: BSD3 -- Maintainer: Leon P Smith -- Stability: experimental --- Portability: portable -- -- This code has yet to be profiled and optimized. -- diff --git a/src/Database/PostgreSQL/Simple/HStore/Internal.hs b/src/Database/PostgreSQL/Simple/HStore/Internal.hs --- a/src/Database/PostgreSQL/Simple/HStore/Internal.hs +++ b/src/Database/PostgreSQL/Simple/HStore/Internal.hs @@ -7,7 +7,6 @@ -- License: BSD3 -- Maintainer: Leon P Smith -- Stability: experimental --- Portability: portable -- ------------------------------------------------------------------------------ diff --git a/src/Database/PostgreSQL/Simple/Internal.hs b/src/Database/PostgreSQL/Simple/Internal.hs --- a/src/Database/PostgreSQL/Simple/Internal.hs +++ b/src/Database/PostgreSQL/Simple/Internal.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} + ------------------------------------------------------------------------------ -- | -- Module: Database.PostgreSQL.Simple.Internal @@ -9,7 +10,6 @@ -- License: BSD3 -- Maintainer: Leon P Smith -- Stability: experimental --- Portability: portable -- -- Internal bits. This interface is less stable and can change at any time. -- In particular this means that while the rest of the postgresql-simple @@ -44,6 +44,7 @@ import Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo) import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader +import GHC.IO.Exception -- | A Field represents metadata about a particular field -- @@ -54,8 +55,8 @@ data Field = Field { result :: !PQ.Result , column :: {-# UNPACK #-} !PQ.Column - , typeOid :: {-# UNPACK #-} !PQ.Oid - -- ^ This returns the type oid associated with the column. Analogous + , typeOid :: {-# UNPACK #-} !PQ.Oid + -- ^ This returns the type oid associated with the column. Analogous -- to libpq's @PQftype@. } @@ -315,11 +316,11 @@ case oka of Ok _ -> return oka Errors _ -> (oka <|>) <$> runConversion mb conn - + instance Monad Conversion where return a = Conversion $ \_conn -> return (return a) m >>= f = Conversion $ \conn -> do - oka <- runConversion m conn + oka <- runConversion m conn case oka of Ok a -> runConversion (f a) conn Errors err -> return (Errors err) @@ -339,3 +340,14 @@ !n <- atomicModifyIORef connectionTempNameCounter (\n -> let !n' = n+1 in (n', n')) return $! Query $ B8.pack $ "temp" ++ show n + +-- FIXME? What error should getNotification and getCopyData throw? +fdError :: ByteString -> IOError +fdError funcName = IOError { + ioe_handle = Nothing, + ioe_type = ResourceVanished, + ioe_location = B8.unpack funcName, + ioe_description = "failed to fetch file descriptor", + ioe_errno = Nothing, + ioe_filename = Nothing + } diff --git a/src/Database/PostgreSQL/Simple/Notification.hs b/src/Database/PostgreSQL/Simple/Notification.hs --- a/src/Database/PostgreSQL/Simple/Notification.hs +++ b/src/Database/PostgreSQL/Simple/Notification.hs @@ -36,6 +36,7 @@ import Control.Concurrent import Control.Monad ( when ) +import Control.Exception ( throwIO ) import qualified Data.ByteString as B import Database.PostgreSQL.Simple.Internal import qualified Database.PostgreSQL.LibPQ as PQ @@ -47,9 +48,6 @@ , notificationData :: !B.ByteString } -errfd :: String -errfd = "Database.PostgreSQL.Simple.Notification.getNotification: failed to fetch file descriptor" - convertNotice :: PQ.Notify -> Notification convertNotice PQ.Notify{..} = Notification { notificationPid = notifyBePid @@ -62,6 +60,7 @@ getNotification :: Connection -> IO Notification getNotification conn = loop False where + funcName = "Database.PostgreSQL.Simple.Notification.getNotification" loop doConsume = do res <- withConnection conn $ \c -> do when doConsume (PQ.consumeInput c >> return ()) @@ -70,7 +69,7 @@ Nothing -> do mfd <- PQ.socket c case mfd of - Nothing -> fail errfd + Nothing -> throwIO $ fdError funcName Just fd -> return (Left fd) Just msg -> return (Right msg) -- FIXME? what happens if the connection is closed/reset right here? diff --git a/src/Database/PostgreSQL/Simple/ToField.hs b/src/Database/PostgreSQL/Simple/ToField.hs --- a/src/Database/PostgreSQL/Simple/ToField.hs +++ b/src/Database/PostgreSQL/Simple/ToField.hs @@ -9,7 +9,6 @@ -- License: BSD3 -- Maintainer: Leon P Smith -- Stability: experimental --- Portability: portable -- -- The 'ToField' typeclass, for rendering a parameter to a SQL query. -- diff --git a/src/Database/PostgreSQL/Simple/ToRow.hs b/src/Database/PostgreSQL/Simple/ToRow.hs --- a/src/Database/PostgreSQL/Simple/ToRow.hs +++ b/src/Database/PostgreSQL/Simple/ToRow.hs @@ -6,7 +6,6 @@ -- License: BSD3 -- Maintainer: Leon P Smith -- Stability: experimental --- Portability: portable -- -- The 'ToRow' typeclass, for rendering a collection of -- parameters to a SQL query. diff --git a/src/Database/PostgreSQL/Simple/Types.hs b/src/Database/PostgreSQL/Simple/Types.hs --- a/src/Database/PostgreSQL/Simple/Types.hs +++ b/src/Database/PostgreSQL/Simple/Types.hs @@ -8,7 +8,6 @@ -- License: BSD3 -- Maintainer: Leon P Smith -- Stability: experimental --- Portability: portable -- -- Basic types. --