git.iko.soy/typeable/postgresql-simple
on master help sign in
First draft of COPY IN/OUT support
491247fLeon P Smith
postgresql-simple.cabal+1
compare with master
unifiedsplit
@@ -23,6 +23,7 @@ Library
23 Database.PostgreSQL.Simple
23 Database.PostgreSQL.Simple
24 Database.PostgreSQL.Simple.Arrays
24 Database.PostgreSQL.Simple.Arrays
25 Database.PostgreSQL.Simple.BuiltinTypes
25 Database.PostgreSQL.Simple.BuiltinTypes
26+ Database.PostgreSQL.Simple.Copy
26 Database.PostgreSQL.Simple.FromField
27 Database.PostgreSQL.Simple.FromField
27 Database.PostgreSQL.Simple.FromRow
28 Database.PostgreSQL.Simple.FromRow
28 Database.PostgreSQL.Simple.LargeObjects
29 Database.PostgreSQL.Simple.LargeObjects
src/Database/PostgreSQL/Simple/Copy.hsnew file+155
@@ -0,0 +1,155 @@
1+{-# LANGUAGE CPP #-}
2+
3+------------------------------------------------------------------------------
4+-- |
5+-- Module: Database.PostgreSQL.Simple.Copy
6+-- Copyright: (c) 2013 Leon P Smith
7+-- License: BSD3
8+-- Maintainer: Leon P Smith <leon@melding-monads.com>
9+-- Stability: experimental
10+--
11+-- mid-level support for COPY IN and COPY OUT.
12+--
13+------------------------------------------------------------------------------
14+
15+module Database.PostgreSQL.Simple.Copy
16+ ( copy
17+ , copy_
18+ , getCopyData
19+ , putCopyData
20+ , putCopyEnd
21+ , putCopyError
22+ ) where
23+
24+import Control.Applicative
25+import Control.Concurrent ( threadWaitRead, threadWaitWrite )
26+import Control.Exception ( throwIO )
27+import qualified Data.Attoparsec.ByteString.Char8 as P
28+import Data.Int(Int64)
29+import qualified Data.ByteString.Char8 as B
30+import qualified Database.PostgreSQL.LibPQ as PQ
31+import Database.PostgreSQL.Simple hiding
32+ ( fold, fold_, forEach, forEach_ )
33+import Database.PostgreSQL.Simple.Types
34+import Database.PostgreSQL.Simple.Internal
35+
36+copy :: ( ToRow params ) => Connection -> Query -> params -> IO ()
37+copy conn template qs = do
38+ q <- formatQuery conn template qs
39+ doCopy "Database.PostgreSQL.Simple.Copy.copy" conn template q
40+
41+copy_ :: Connection -> Query -> IO ()
42+copy_ conn (Query q) = do
43+ doCopy "Database.PostgreSQL.Simple.Copy.copy_" conn (Query q) q
44+
45+doCopy :: B.ByteString -> Connection -> Query -> B.ByteString -> IO ()
46+doCopy funcName conn template q = do
47+ result <- exec conn q
48+ status <- PQ.resultStatus result
49+ let err = throwIO $ QueryError
50+ (B.unpack funcName ++ " " ++ show status)
51+ template
52+ case status of
53+ PQ.EmptyQuery -> err
54+ PQ.CommandOk -> err
55+ PQ.TuplesOk -> err
56+ PQ.CopyOut -> return ()
57+ PQ.CopyIn -> return ()
58+ PQ.BadResponse -> throwResultError funcName result status
59+ PQ.NonfatalError -> throwResultError funcName result status
60+ PQ.FatalError -> throwResultError funcName result status
61+{-# INLINE doCopy #-}
62+
63+data CopyOutResult
64+ = CopyOutRow !B.ByteString -- ^ Data representing exactly one row
65+ -- of the result.
66+ | CopyOutDone {-# UNPACK #-} !Int64 -- ^ No more rows, and a count of the
67+ -- number of rows returned.
68+
69+getCopyData :: Connection -> IO CopyOutResult
70+getCopyData conn = withConnection conn loop
71+ where
72+ funcName = "Database.PostgreSQL.Simple.Copy.getCopyData"
73+ errCmdStatus = B.unpack funcName ++ ": failed to fetch command status"
74+ errCmdStatusFmt = B.unpack funcName ++ ": failed to parse command status"
75+ loop pqconn = do
76+#if defined(mingw32_HOST_OS)
77+ row <- PQ.getCopyData pqconn False
78+#else
79+ row <- PQ.getCopyData pqconn True
80+#endif
81+ case row of
82+ PQ.CopyOutRow rowdata -> return (CopyOutRow rowdata)
83+ PQ.CopyOutDone -> do
84+ result <- maybe (fail errCmdStatus) return =<< PQ.getResult pqconn
85+ cmdStat <- maybe (fail errCmdStatus) return =<< PQ.cmdStatus result
86+ let rowCount = P.string "COPY " *> P.decimal
87+ case P.parseOnly rowCount cmdStat of
88+ Left _ -> fail errCmdStatusFmt
89+ Right n -> return (CopyOutDone n)
90+#if defined(mingw32_HOST_OS)
91+ PQ.CopyOutWouldBlock -> do
92+ fail (B.unpack funcName ++ ": the impossible happened")
93+#else
94+ PQ.CopyOutWouldBlock -> do
95+ mfd <- PQ.socket pqconn
96+ case mfd of
97+ Nothing -> throwIO (fdError funcName)
98+ Just fd -> do
99+ threadWaitRead fd
100+ _ <- PQ.consumeInput pqconn
101+ loop pqconn
102+#endif
103+ PQ.CopyOutError -> do
104+ mmsg <- PQ.errorMessage pqconn
105+ throwIO SqlError {
106+ sqlState = "",
107+ sqlExecStatus = FatalError,
108+ sqlErrorMsg = maybe "" id mmsg,
109+ sqlErrorDetail = "",
110+ sqlErrorHint = funcName
111+ }
112+
113+putCopyData :: Connection -> B.ByteString -> IO ()
114+putCopyData conn dat =
115+ doCopyIn "Database.PostgreSQL.Simple.Copy.putCopyData"
116+ (\c -> PQ.putCopyData c dat)
117+ conn
118+
119+putCopyEnd :: Connection -> IO ()
120+putCopyEnd conn = do
121+ doCopyIn "Database.PostgreSQL.Simple.Copy.putCopyEnd"
122+ (\c -> PQ.putCopyEnd c Nothing)
123+ conn
124+
125+putCopyError :: Connection -> B.ByteString -> IO ()
126+putCopyError conn err = do
127+ doCopyIn "Database.PostgreSQL.Simple.Copy.putCopyError"
128+ (\c -> PQ.putCopyEnd c (Just err))
129+ conn
130+
131+doCopyIn :: B.ByteString -> (PQ.Connection -> IO PQ.CopyInResult)
132+ -> Connection -> IO ()
133+doCopyIn funcName action conn = withConnection conn loop
134+ where
135+ loop pqconn = do
136+ stat <- action pqconn
137+ case stat of
138+ PQ.CopyInOk -> return ()
139+ PQ.CopyInError -> do
140+ mmsg <- PQ.errorMessage pqconn
141+ throwIO SqlError {
142+ sqlState = "",
143+ sqlExecStatus = FatalError,
144+ sqlErrorMsg = maybe "" id mmsg,
145+ sqlErrorDetail = "",
146+ sqlErrorHint = funcName
147+ }
148+ PQ.CopyInWouldBlock -> do
149+ mfd <- PQ.socket pqconn
150+ case mfd of
151+ Nothing -> throwIO (fdError funcName)
152+ Just fd -> do
153+ threadWaitWrite fd
154+ loop pqconn
155+{-# INLINE doCopyIn #-}
src/Database/PostgreSQL/Simple/Internal.hs+17−5
@@ -2,6 +2,7 @@
2{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE RecordWildCards #-}
5+
5------------------------------------------------------------------------------
6------------------------------------------------------------------------------
6-- |
7-- |
7-- Module: Database.PostgreSQL.Simple.Internal
8-- Module: Database.PostgreSQL.Simple.Internal
@@ -9,7 +10,6 @@
9-- License: BSD3
10-- License: BSD3
10-- Maintainer: Leon P Smith <leon@melding-monads.com>
11-- Maintainer: Leon P Smith <leon@melding-monads.com>
11-- Stability: experimental
12-- Stability: experimental
12−-- Portability: portable
13--
13--
14-- Internal bits. This interface is less stable and can change at any time.
14-- Internal bits. This interface is less stable and can change at any time.
15-- In particular this means that while the rest of the postgresql-simple
15-- In particular this means that while the rest of the postgresql-simple
@@ -44,6 +44,7 @@ import Database.PostgreSQL.Simple.Types (Query(..))
44import Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo)
44import Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo)
45import Control.Monad.Trans.State.Strict
45import Control.Monad.Trans.State.Strict
46import Control.Monad.Trans.Reader
46import Control.Monad.Trans.Reader
47+import GHC.IO.Exception
47
48
48-- | A Field represents metadata about a particular field
49-- | A Field represents metadata about a particular field
49--
50--
@@ -54,8 +55,8 @@ import Control.Monad.Trans.Reader
54data Field = Field {
55data Field = Field {
55 result :: !PQ.Result
56 result :: !PQ.Result
56 , column :: {-# UNPACK #-} !PQ.Column
57 , column :: {-# UNPACK #-} !PQ.Column
57− , typeOid :: {-# UNPACK #-} !PQ.Oid
58+ , typeOid :: {-# UNPACK #-} !PQ.Oid
58− -- ^ This returns the type oid associated with the column. Analogous
59+ -- ^ This returns the type oid associated with the column. Analogous
59 -- to libpq's @PQftype@.
60 -- to libpq's @PQftype@.
60 }
61 }
61
62
@@ -315,11 +316,11 @@ instance Alternative Conversion where
315 case oka of
316 case oka of
316 Ok _ -> return oka
317 Ok _ -> return oka
317 Errors _ -> (oka <|>) <$> runConversion mb conn
318 Errors _ -> (oka <|>) <$> runConversion mb conn
318−
319+
319instance Monad Conversion where
320instance Monad Conversion where
320 return a = Conversion $ \_conn -> return (return a)
321 return a = Conversion $ \_conn -> return (return a)
321 m >>= f = Conversion $ \conn -> do
322 m >>= f = Conversion $ \conn -> do
322− oka <- runConversion m conn
323+ oka <- runConversion m conn
323 case oka of
324 case oka of
324 Ok a -> runConversion (f a) conn
325 Ok a -> runConversion (f a) conn
325 Errors err -> return (Errors err)
326 Errors err -> return (Errors err)
@@ -339,3 +340,14 @@ newTempName Connection{..} = do
339 !n <- atomicModifyIORef connectionTempNameCounter
340 !n <- atomicModifyIORef connectionTempNameCounter
340 (\n -> let !n' = n+1 in (n', n'))
341 (\n -> let !n' = n+1 in (n', n'))
341 return $! Query $ B8.pack $ "temp" ++ show n
342 return $! Query $ B8.pack $ "temp" ++ show n
343+
344+-- FIXME? What error should getNotification and getCopyData throw?
345+fdError :: ByteString -> IOError
346+fdError funcName = IOError {
347+ ioe_handle = Nothing,
348+ ioe_type = ResourceVanished,
349+ ioe_location = B8.unpack funcName,
350+ ioe_description = "failed to fetch file descriptor",
351+ ioe_errno = Nothing,
352+ ioe_filename = Nothing
353+ }