git.iko.soy/typeable/postgresql-simple
on master help sign in
move buildAction to Internal module
commit0d5a14bd54cf990668d1549657524de7ce50607d authorAleksey Uimanov <s9gf4ult@gmail.com> dateThu 26 Feb 2015, 14:35 (12 years ago) parent1773773
2 files changed+59−33
compare with master
unifiedsplit
src/Database/PostgreSQL/Simple.hs+8−33 src/Database/PostgreSQL/Simple/Internal.hs+51
src/Database/PostgreSQL/Simple.hs+8−33
@@ -140,16 +140,6 @@ import qualified Data.Text.Encoding as TE
140140import Control.Monad.Trans.Reader
141141import Control.Monad.Trans.State.Strict
142142
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
153143
154144-- | Format a query string.
155145--
@@ -289,18 +279,14 @@ parseTemplate template =
289279
290280
291281buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder
292−buildQuery conn q template xs = zipParams (split template) <$> mapM sub xs
293− where err' msg = fmtError (utf8ToString msg) q xs
294− quote = either err' (inQuotes . fromByteString)
295− utf8ToString = T.unpack . TE.decodeUtf8
296− sub (Plain b) = pure b
297− sub (Escape s) = quote <$> escapeStringConn conn s
298− sub (EscapeByteA s) = quote <$> escapeByteaConn conn s
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)
303− where (h,t) = B.break (=='?') s
282+buildQuery conn q template xs =
283+ zipParams (split template) <$> mapM (buildAction conn q xs) xs
284+ where split s =
285+ let (h,t) = B.break (=='?') s
286+ in fromByteString h
287+ : if B.null t
288+ then []
289+ else split (B.tail t)
304290 zipParams (t:ts) (p:ps) = t <> p <> zipParams ts ps
305291 zipParams [t] [] = t
306292 zipParams _ _ = fmtError (show (B.count '?' template) ++
@@ -640,17 +626,6 @@ ellipsis bs
640626 | B.length bs > 15 = B.take 10 bs `B.append` "[...]"
641627 | otherwise = bs
642628
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)
654629
655630-- $use
656631--
src/Database/PostgreSQL/Simple/Internal.hs+51
@@ -20,24 +20,31 @@
2020
2121module Database.PostgreSQL.Simple.Internal where
2222
23+import Blaze.ByteString.Builder
24+ ( Builder, fromByteString, toByteString )
2325import Control.Applicative
2426import Control.Exception
2527import Control.Concurrent.MVar
2628import Control.Monad(MonadPlus(..))
2729import Data.ByteString(ByteString)
30+import qualified Data.ByteString as B
2831import qualified Data.ByteString.Char8 as B8
2932import Data.Char (ord)
3033import Data.Int (Int64)
3134import qualified Data.IntMap as IntMap
3235import Data.IORef
3336import Data.Maybe(fromMaybe)
37+import Data.Monoid
3438import Data.String
39+import qualified Data.Text as T
40+import qualified Data.Text.Encoding as TE
3541import Data.Typeable
3642import Data.Word
3743import Database.PostgreSQL.LibPQ(Oid(..))
3844import qualified Database.PostgreSQL.LibPQ as PQ
3945import Database.PostgreSQL.LibPQ(ExecStatus(..))
4046import Database.PostgreSQL.Simple.Ok
47+import Database.PostgreSQL.Simple.ToField (Action(..), inQuotes)
4148import Database.PostgreSQL.Simple.Types (Query(..))
4249import Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo)
4350import Control.Monad.Trans.State.Strict
@@ -92,6 +99,17 @@ data QueryError = QueryError {
9299
93100instance Exception QueryError
94101
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+
95113data ConnectInfo = ConnectInfo {
96114 connectHost :: String
97115 , connectPort :: Word16
@@ -502,6 +520,39 @@ throwLibPQError conn default_desc = do
502520 msg <- maybe default_desc id <$> PQ.errorMessage conn
503521 throwIO $! libPQError msg
504522
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+
505556checkError :: PQ.Connection -> Maybe a -> IO (Either ByteString a)
506557checkError _ (Just x) = return $ Right x
507558checkError c Nothing = Left . maybe "" id <$> PQ.errorMessage c