0d5a14b · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

move buildAction to Internal module

0d5a14bAleksey Uimanov12 years ago

src/Database/PostgreSQL/Simple.hs+8−33

compare with master

unifiedsplit

@@ -140,16 +140,6 @@ import qualified Data.Text.Encoding as TE

140import Control.Monad.Trans.Reader

141import Control.Monad.Trans.State.Strict

142

143−-- | Exception thrown if a 'Query' could not be formatted correctly.

144−-- This may occur if the number of \'@?@\' characters in the query

145−-- string does not match the number of parameters provided.

146−data FormatError = FormatError {

147− fmtMessage :: String

148− , fmtQuery :: Query

149− , fmtParams :: [ByteString]

150− } deriving (Eq, Show, Typeable)

151−

152−instance Exception FormatError

153

143

154-- | Format a query string.

144-- | Format a query string.

155--

145--

@@ -289,18 +279,14 @@ parseTemplate template =

289

279

290

280

291buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder

281buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder

292−buildQuery conn q template xs = zipParams (split template) <$> mapM sub xs

282+buildQuery conn q template xs =

293− where err' msg = fmtError (utf8ToString msg) q xs

283+ zipParams (split template) <$> mapM (buildAction conn q xs) xs

294− quote = either err' (inQuotes . fromByteString)

284+ where split s =

295− utf8ToString = T.unpack . TE.decodeUtf8

285+ let (h,t) = B.break (=='?') s

296− sub (Plain b) = pure b

286+ in fromByteString h

297− sub (Escape s) = quote <$> escapeStringConn conn s

287+ : if B.null t

298− sub (EscapeByteA s) = quote <$> escapeByteaConn conn s

288+ then []

299− sub (EscapeIdentifier s) = either err' fromByteString <$>

300− escapeIdentifier conn s

301− sub (Many ys) = mconcat <$> mapM sub ys

302− split s = fromByteString h : if B.null t then [] else split (B.tail t)

289+ else split (B.tail t)

303− where (h,t) = B.break (=='?') s

304 zipParams (t:ts) (p:ps) = t <> p <> zipParams ts ps

290 zipParams (t:ts) (p:ps) = t <> p <> zipParams ts ps

305 zipParams [t] [] = t

291 zipParams [t] [] = t

306 zipParams _ _ = fmtError (show (B.count '?' template) ++

292 zipParams _ _ = fmtError (show (B.count '?' template) ++

@@ -640,17 +626,6 @@ ellipsis bs

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

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

641 | otherwise = bs

627 | otherwise = bs

642

628

643−fmtError :: String -> Query -> [Action] -> a

644−fmtError msg q xs = throw FormatError {

645− fmtMessage = msg

646− , fmtQuery = q

647− , fmtParams = map twiddle xs

648− }

649− where twiddle (Plain b) = toByteString b

650− twiddle (Escape s) = s

651− twiddle (EscapeByteA s) = s

652− twiddle (EscapeIdentifier s) = s

653− twiddle (Many ys) = B.concat (map twiddle ys)

654

629

655-- $use

630-- $use

656--

631--

src/Database/PostgreSQL/Simple/Internal.hs+51

@@ -20,24 +20,31 @@

21module Database.PostgreSQL.Simple.Internal where

23+import Blaze.ByteString.Builder

24+ ( Builder, fromByteString, toByteString )

23import Control.Applicative

25import Control.Applicative

24import Control.Exception

26import Control.Exception

25import Control.Concurrent.MVar

27import Control.Concurrent.MVar

26import Control.Monad(MonadPlus(..))

28import Control.Monad(MonadPlus(..))

27import Data.ByteString(ByteString)

29import Data.ByteString(ByteString)

30+import qualified Data.ByteString as B

28import qualified Data.ByteString.Char8 as B8

31import qualified Data.ByteString.Char8 as B8

29import Data.Char (ord)

32import Data.Char (ord)

30import Data.Int (Int64)

33import Data.Int (Int64)

31import qualified Data.IntMap as IntMap

34import qualified Data.IntMap as IntMap

32import Data.IORef

35import Data.IORef

33import Data.Maybe(fromMaybe)

36import Data.Maybe(fromMaybe)

37+import Data.Monoid

34import Data.String

38import Data.String

39+import qualified Data.Text as T

40+import qualified Data.Text.Encoding as TE

35import Data.Typeable

41import Data.Typeable

36import Data.Word

42import Data.Word

37import Database.PostgreSQL.LibPQ(Oid(..))

43import Database.PostgreSQL.LibPQ(Oid(..))

38import qualified Database.PostgreSQL.LibPQ as PQ

44import qualified Database.PostgreSQL.LibPQ as PQ

39import Database.PostgreSQL.LibPQ(ExecStatus(..))

45import Database.PostgreSQL.LibPQ(ExecStatus(..))

40import Database.PostgreSQL.Simple.Ok

46import Database.PostgreSQL.Simple.Ok

47+import Database.PostgreSQL.Simple.ToField (Action(..), inQuotes)

41import Database.PostgreSQL.Simple.Types (Query(..))

48import Database.PostgreSQL.Simple.Types (Query(..))

42import Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo)

49import Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo)

43import Control.Monad.Trans.State.Strict

50import Control.Monad.Trans.State.Strict

@@ -92,6 +99,17 @@ data QueryError = QueryError {

93instance Exception QueryError

100instance Exception QueryError

101

102+-- | Exception thrown if a 'Query' could not be formatted correctly.

103+-- This may occur if the number of \'@?@\' characters in the query

104+-- string does not match the number of parameters provided.

105+data FormatError = FormatError {

106+ fmtMessage :: String

107+ , fmtQuery :: Query

108+ , fmtParams :: [ByteString]

109+ } deriving (Eq, Show, Typeable)

110+

111+instance Exception FormatError

112+

95data ConnectInfo = ConnectInfo {

113data ConnectInfo = ConnectInfo {

96 connectHost :: String

114 connectHost :: String

97 , connectPort :: Word16

115 , connectPort :: Word16

@@ -502,6 +520,39 @@ throwLibPQError conn default_desc = do

502 msg <- maybe default_desc id <$> PQ.errorMessage conn

520 msg <- maybe default_desc id <$> PQ.errorMessage conn

503 throwIO $! libPQError msg

521 throwIO $! libPQError msg

504

522

523+

524+fmtError :: String -> Query -> [Action] -> a

525+fmtError msg q xs = throw FormatError {

526+ fmtMessage = msg

527+ , fmtQuery = q

528+ , fmtParams = map twiddle xs

529+ }

530+ where twiddle (Plain b) = toByteString b

531+ twiddle (Escape s) = s

532+ twiddle (EscapeByteA s) = s

533+ twiddle (EscapeIdentifier s) = s

534+ twiddle (Many ys) = B.concat (map twiddle ys)

535+

536+fmtErrorBs :: Query -> [Action] -> ByteString -> a

537+fmtErrorBs q xs msg = fmtError (T.unpack $ TE.decodeUtf8 msg) q xs

538+

539+-- | Quote bytestring or throw 'FormatError'

540+quote :: Query -> [Action] -> Either ByteString ByteString -> Builder

541+quote q xs = either (fmtErrorBs q xs) (inQuotes . fromByteString)

542+

543+buildAction :: Connection -- ^ Connection for string escaping

544+ -> Query -- ^ Query for message error

545+ -> [Action] -- ^ List of parameters for message error

546+ -> Action -- ^ Action to build

547+ -> IO Builder

548+buildAction _ _ _ (Plain b) = pure b

549+buildAction conn q xs (Escape s) = quote q xs <$> escapeStringConn conn s

550+buildAction conn q xs (EscapeByteA s) = quote q xs <$> escapeByteaConn conn s

551+buildAction conn q xs (EscapeIdentifier s) =

552+ either (fmtErrorBs q xs) fromByteString <$> escapeIdentifier conn s

553+buildAction conn q xs (Many ys) =

554+ mconcat <$> mapM (buildAction conn q xs) ys

555+

505checkError :: PQ.Connection -> Maybe a -> IO (Either ByteString a)

556checkError :: PQ.Connection -> Maybe a -> IO (Either ByteString a)

506checkError _ (Just x) = return $ Right x

557checkError _ (Just x) = return $ Right x

507checkError c Nothing = Left . maybe "" id <$> PQ.errorMessage c

558checkError c Nothing = Left . maybe "" id <$> PQ.errorMessage c