d90815d · typeable/postgresql-simple

122 ( Builder, byteString, char8, intDec )

123import Control.Applicative ((<$>))

124import Control.Exception as E

125−import Control.Monad (foldM)

125+import Control.Monad (unless)

126import Data.ByteString (ByteString)

127import Data.Int (Int64)

128import Data.List (intersperse)

142import qualified Data.ByteString.Char8 as B

143import Control.Monad.Trans.Reader

144import Control.Monad.Trans.State.Strict

145+import Control.Monad.IO.Class (liftIO)

145

146

147

147-- | Format a query string.

148-- | Format a query string.

567 _ <- execute_ conn $ mconcat

568 _ <- execute_ conn $ mconcat

568 [ "DECLARE ", name, " NO SCROLL CURSOR FOR ", q ]

569 [ "DECLARE ", name, " NO SCROLL CURSOR FOR ", q ]

569 return name

570 return name

570− fetch (Query name) = queryWith_ parser conn $

571− Query (toByteString (byteString "FETCH FORWARD "

572− <> intDec chunkSize

573− <> byteString " FROM "

574− <> byteString name

575− ))

576 close name =

571 close name =

577 (execute_ conn ("CLOSE " <> name) >> return ()) `E.catch` \ex ->

572 (execute_ conn ("CLOSE " <> name) >> return ()) `E.catch` \ex ->

578 -- Don't throw exception if CLOSE failed because the transaction is

573 -- Don't throw exception if CLOSE failed because the transaction is

579 -- aborted. Otherwise, it will throw away the original error.

574 -- aborted. Otherwise, it will throw away the original error.

580− if isFailedTransactionError ex then return () else throwIO ex

575+ unless (isFailedTransactionError ex) $ throwIO ex

581−

576+

582− go = bracket declare close $ \name ->

577+ go = bracket declare close $ \(Query name) ->

578+ let q = toByteString (byteString "FETCH FORWARD "

579+ <> intDec chunkSize

580+ <> byteString " FROM "

581+ <> byteString name

582+ )

583− let loop a = do

583+ loop a = do

584− rs <- fetch name

584+ result <- liftIO (exec conn q)

585− if null rs then return a else foldM f a rs >>= loop

585+ status <- liftIO (PQ.resultStatus result)

586+ case status of

587+ PQ.TuplesOk -> do

588+ nrows <- liftIO (PQ.ntuples result)

589+ ncols <- liftIO (PQ.nfields result)

590+ if nrows > 0

591+ then do

592+ a' <- innerLoop 0 nrows ncols result a

593+ loop a'

594+ else return a

595+ _ -> liftIO (throwResultError "fold" result status)

596+ innerLoop row nrows ncols result a

597+ | row < nrows = do

598+ x <- getRowWith parser row ncols conn result

599+ a' <- f a x

600+ innerLoop (row+1) nrows ncols result a'

601+ | otherwise = return a

586 in loop a0

602 in loop a0

587

603

588-- FIXME: choose the Automatic chunkSize more intelligently

604-- FIXME: choose the Automatic chunkSize more intelligently

651 case status of

667 case status of

652 PQ.EmptyQuery ->

668 PQ.EmptyQuery ->

653 throwIO $ QueryError "query: Empty query" q

669 throwIO $ QueryError "query: Empty query" q

654− PQ.CommandOk -> do

670+ PQ.CommandOk ->

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

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

656 PQ.TuplesOk -> do

672 PQ.TuplesOk -> do

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

658 nrows <- PQ.ntuples result

673 nrows <- PQ.ntuples result

659 ncols <- PQ.nfields result

674 ncols <- PQ.nfields result

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

675+ forM' 0 (nrows-1) $ \row ->

661− let rw = Row row result

676+ getRowWith parser row ncols conn result

662− okvc <- runConversion (runStateT (runReaderT (unRP parser) rw) 0) conn

663− case okvc of

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

665− | otherwise -> do

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

667− tinfo <- getTypeInfo conn =<< PQ.ftype result c

668− v <- PQ.getvalue result row c

669− return ( tinfo

670− , fmap ellipsis v )

671− throw (ConversionFailed

672− (show (unCol ncols) ++ " values: " ++ show vals)

673− Nothing

674− ""

675− (show (unCol col) ++ " slots in target type")

676− "mismatch between number of columns to \

677− \convert and number in target type")

678− Errors [] -> throwIO $ ConversionFailed "" Nothing "" "" "unknown error"

679− Errors [x] -> throwIO x

680− Errors xs -> throwIO $ ManyErrors xs

681 PQ.CopyOut ->

677 PQ.CopyOut ->

682 throwIO $ QueryError "query: COPY TO is not supported" q

678 throwIO $ QueryError "query: COPY TO is not supported" q

683 PQ.CopyIn ->

679 PQ.CopyIn ->

686 PQ.NonfatalError -> throwResultError "query" result status

682 PQ.NonfatalError -> throwResultError "query" result status

687 PQ.FatalError -> throwResultError "query" result status

683 PQ.FatalError -> throwResultError "query" result status

688

684

685+getRowWith :: RowParser r -> PQ.Row -> PQ.Column -> Connection -> PQ.Result -> IO r

686+getRowWith parser row ncols conn result = do

687+ let rw = Row row result

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

689+ okvc <- runConversion (runStateT (runReaderT (unRP parser) rw) 0) conn

690+ case okvc of

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

692+ | otherwise -> do

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

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

695+ v <- PQ.getvalue result row c

696+ return ( tinfo

697+ , fmap ellipsis v )

698+ throw (ConversionFailed

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

700+ Nothing

701+ ""

702+ (show (unCol col) ++ " slots in target type")

703+ "mismatch between number of columns to \

704+ \convert and number in target type")

705+ Errors [] -> throwIO $ ConversionFailed "" Nothing "" "" "unknown error"

706+ Errors [x] -> throwIO x

707+ Errors xs -> throwIO $ ManyErrors xs

708+

689ellipsis :: ByteString -> ByteString

709ellipsis :: ByteString -> ByteString

690ellipsis bs

710ellipsis bs

691 | B.length bs > 15 = B.take 10 bs `B.append` "[...]"

711 | B.length bs > 15 = B.take 10 bs `B.append` "[...]"