Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Bring the API up to snuff in various ways.

* Make the top-level module exports more friendly.

* Support insert/update of multiple rows via executeMany.

* Allow us to specify "IN" parameters.

* Report result conversion errors properly.

* Identify compatible numeric types more accurately and generously.
  • Loading branch information...
commit 04d978bb3b8f5beb1412d507cba7bd61a350cb94 1 parent f1f1a6c
@bos authored
View
73 Database/MySQL/Simple.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
+{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings #-}
-- |
-- Module: Database.MySQL.Simple
@@ -14,7 +14,10 @@
module Database.MySQL.Simple
(
-- * Types
- Query
+ Base.ConnectInfo(..)
+ , Connection
+ , Query
+ , In(..)
, Only(..)
-- ** Exceptions
, FormatError(fmtMessage, fmtQuery, fmtParams)
@@ -30,6 +33,7 @@ module Database.MySQL.Simple
-- * Statements that do not return results
, execute
, execute_
+ , executeMany
, Base.insertID
-- * Transaction handling
, withTransaction
@@ -37,23 +41,27 @@ module Database.MySQL.Simple
, Base.commit
, Base.rollback
-- * Helper functions
+ , formatMany
, formatQuery
) where
-import Blaze.ByteString.Builder (fromByteString, toByteString)
+import Blaze.ByteString.Builder (Builder, fromByteString, toByteString)
+import Blaze.ByteString.Builder.Char8 (fromChar)
import Control.Applicative ((<$>), pure)
import Control.Exception (Exception, onException, throw)
import Control.Monad.Fix (fix)
import Data.ByteString (ByteString)
import Data.Int (Int64)
-import Data.Monoid (mappend)
+import Data.List (intersperse)
+import Data.Monoid (mappend, mconcat)
import Data.Typeable (Typeable)
import Database.MySQL.Base (Connection)
import Database.MySQL.Simple.Param (Action(..), inQuotes)
import Database.MySQL.Simple.QueryParams (QueryParams(..))
import Database.MySQL.Simple.QueryResults (QueryResults(..))
import Database.MySQL.Simple.Result (ResultError(..))
-import Database.MySQL.Simple.Types (Only(..), Query(..))
+import Database.MySQL.Simple.Types (In(..), Only(..), Query(..))
+import Text.Regex.PCRE.Light (compile, caseless, match)
import qualified Data.ByteString.Char8 as B
import qualified Database.MySQL.Base as Base
@@ -82,19 +90,43 @@ instance Exception QueryError
-- String parameters are escaped according to the character set in use
-- on the 'Connection'.
--
--- Exceptions that may be thrown:
---
--- * 'FormatError': the query string could not be formatted correctly.
---
--- * 'QueryError': the result contains a non-zero number of columns
--- (i.e. you should be using 'query' instead of 'execute').
+-- Throws 'FormatError' if the query string could not be formatted
+-- correctly.
formatQuery :: QueryParams q => Connection -> Query -> q -> IO ByteString
formatQuery conn q@(Query template) qs
| null xs && '?' `B.notElem` template = return template
- | otherwise = toByteString . zipParams (split template) <$> mapM sub xs
+ | otherwise = toByteString <$> buildQuery conn q template xs
where xs = renderParams qs
- sub (Plain b) = pure b
+
+-- | Format a query string with a variable number of rows.
+--
+-- The query string must contain exactly one substitution group,
+-- identified by the SQL keyword \"@VALUES@\" (case insensitive)
+-- followed by an \"@(@\" character, a series of one or more \"@?@\"
+-- characters separated by commas, and a \"@)@\" character. White
+-- space in a substitution group is permitted.
+--
+-- Throws 'FormatError' if the query string could not be formatted
+-- correctly.
+formatMany :: (QueryParams q) => Connection -> Query -> [q] -> IO ByteString
+formatMany _ q [] = fmtError "no rows supplied" q []
+formatMany conn q@(Query template) qs = do
+ case match re template [] of
+ Just [_,before,qbits,after] -> do
+ bs <- mapM (buildQuery conn q qbits . renderParams) qs
+ return . toByteString . mconcat $ fromByteString before :
+ intersperse (fromChar ',') bs ++
+ [fromByteString after]
+ _ -> error "foo"
+ where
+ re = compile "^([^?]+\\bvalues\\s*)(\\(\\s*[?](?:\\s*,\\s*[?])*\\s*\\))(.*)$"
+ [caseless]
+
+buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder
+buildQuery conn q template xs = zipParams (split template) <$> mapM sub xs
+ where sub (Plain b) = pure b
sub (Escape s) = (inQuotes . fromByteString) <$> Base.escape conn s
+ sub (Many ys) = mconcat <$> mapM sub ys
split s = fromByteString h : if B.null t then [] else split (B.tail t)
where (h,t) = B.break (=='?') s
zipParams (t:ts) (p:ps) = t `mappend` p `mappend` zipParams ts ps
@@ -108,7 +140,7 @@ formatQuery conn q@(Query template) qs
--
-- Returns the number of rows affected.
--
--- Throws 'FormatError' if the string could not be formatted correctly.
+-- Throws 'FormatError' if the query could not be formatted correctly.
execute :: (QueryParams q) => Connection -> Query -> q -> IO Int64
execute conn template qs = do
Base.query conn =<< formatQuery conn template qs
@@ -120,6 +152,18 @@ execute_ conn q@(Query stmt) = do
Base.query conn stmt
finishExecute q conn
+-- | Execute a multi-row @INSERT@, @UPDATE@, or other SQL query that is not
+-- expected to return results.
+--
+-- Returns the number of rows affected.
+--
+-- Throws 'FormatError' if the query could not be formatted correctly.
+executeMany :: (QueryParams q) => Connection -> Query -> [q] -> IO Int64
+executeMany _ _ [] = return 0
+executeMany conn q qs = do
+ Base.query conn =<< formatMany conn q qs
+ finishExecute q conn
+
finishExecute :: Query -> Connection -> IO Int64
finishExecute q conn = do
ncols <- Base.fieldCount (Left conn)
@@ -193,3 +237,4 @@ fmtError msg q xs = throw FormatError {
}
where twiddle (Plain b) = toByteString b
twiddle (Escape s) = s
+ twiddle (Many ys) = B.concat (map twiddle ys)
View
17 Database/MySQL/Simple/Param.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, OverloadedStrings #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, FlexibleInstances,
+ OverloadedStrings #-}
-- |
-- Module: Database.MySQL.Simple.Param
@@ -18,9 +19,11 @@ module Database.MySQL.Simple.Param
) where
import Blaze.ByteString.Builder (Builder, fromByteString, toByteString)
+import Blaze.ByteString.Builder.Char8 (fromChar)
import Blaze.Text (integral, double, float)
import Data.ByteString (ByteString)
import Data.Int (Int8, Int16, Int32, Int64)
+import Data.List (intersperse)
import Data.Monoid (mappend)
import Data.Time.Calendar (Day, showGregorian)
import Data.Time.Clock (UTCTime)
@@ -28,7 +31,7 @@ import Data.Time.Format (formatTime)
import Data.Time.LocalTime (TimeOfDay)
import Data.Typeable (Typeable)
import Data.Word (Word, Word8, Word16, Word32, Word64)
-import Database.MySQL.Simple.Types (Null)
+import Database.MySQL.Simple.Types (In(..), Null)
import System.Locale (defaultTimeLocale)
import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8
import qualified Data.ByteString as SB
@@ -48,11 +51,14 @@ data Action =
-- ^ Escape and enclose in quotes before substituting. Use for all
-- text-like types, and anything else that may contain unsafe
-- characters when rendered.
+ | Many [Action]
+ -- ^ Concatenate a series of rendering actions.
deriving (Typeable)
instance Show Action where
show (Plain b) = "Plain " ++ show (toByteString b)
show (Escape b) = "Escape " ++ show b
+ show (Many b) = "Many " ++ show b
-- | A type that may be used as a single parameter to a SQL query.
class Param a where
@@ -68,6 +74,13 @@ instance (Param a) => Param (Maybe a) where
render (Just a) = render a
{-# INLINE render #-}
+instance (Param a) => Param (In [a]) where
+ render (In []) = Plain $ fromByteString "(null)"
+ render (In xs) = Many $
+ Plain (fromChar '(') :
+ (intersperse (Plain (fromChar ',')) . map render $ xs) ++
+ [Plain (fromChar ')')]
+
renderNull :: Action
renderNull = Plain (fromByteString "null")
View
45 Database/MySQL/Simple/QueryResults.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
-- |
-- Module: Database.MySQL.Simpe.QueryResults
@@ -19,7 +19,8 @@ module Database.MySQL.Simple.QueryResults
import Control.Exception (throw)
import Data.ByteString (ByteString)
-import Database.MySQL.Base.Types (Field)
+import qualified Data.ByteString.Char8 as B
+import Database.MySQL.Base.Types (Field(fieldType))
import Database.MySQL.Simple.Result (ResultError(..), Result(..))
import Database.MySQL.Simple.Types (Only(..))
@@ -60,38 +61,38 @@ class QueryResults a where
instance (Result a) => QueryResults (Only a) where
convertResults [fa] [va] = Only a
where !a = convert fa va
- convertResults fs vs = convertError fs vs
+ convertResults fs vs = convertError fs vs 1
instance (Result a, Result b) => QueryResults (a,b) where
convertResults [fa,fb] [va,vb] = (a,b)
where !a = convert fa va; !b = convert fb vb
- convertResults fs vs = convertError fs vs
+ convertResults fs vs = convertError fs vs 2
instance (Result a, Result b, Result c) => QueryResults (a,b,c) where
convertResults [fa,fb,fc] [va,vb,vc] = (a,b,c)
where !a = convert fa va; !b = convert fb vb; !c = convert fc vc
- convertResults fs vs = convertError fs vs
+ convertResults fs vs = convertError fs vs 3
instance (Result a, Result b, Result c, Result d) =>
QueryResults (a,b,c,d) where
convertResults [fa,fb,fc,fd] [va,vb,vc,vd] = (a,b,c,d)
where !a = convert fa va; !b = convert fb vb; !c = convert fc vc
!d = convert fd vd
- convertResults fs vs = convertError fs vs
+ convertResults fs vs = convertError fs vs 4
instance (Result a, Result b, Result c, Result d, Result e) =>
QueryResults (a,b,c,d,e) where
convertResults [fa,fb,fc,fd,fe] [va,vb,vc,vd,ve] = (a,b,c,d,e)
where !a = convert fa va; !b = convert fb vb; !c = convert fc vc
!d = convert fd vd; !e = convert fe ve
- convertResults fs vs = convertError fs vs
+ convertResults fs vs = convertError fs vs 5
instance (Result a, Result b, Result c, Result d, Result e, Result f) =>
QueryResults (a,b,c,d,e,f) where
convertResults [fa,fb,fc,fd,fe,ff] [va,vb,vc,vd,ve,vf] = (a,b,c,d,e,f)
where !a = convert fa va; !b = convert fb vb; !c = convert fc vc
!d = convert fd vd; !e = convert fe ve; !f = convert ff vf
- convertResults fs vs = convertError fs vs
+ convertResults fs vs = convertError fs vs 6
instance (Result a, Result b, Result c, Result d, Result e, Result f,
Result g) =>
@@ -101,7 +102,7 @@ instance (Result a, Result b, Result c, Result d, Result e, Result f,
where !a = convert fa va; !b = convert fb vb; !c = convert fc vc
!d = convert fd vd; !e = convert fe ve; !f = convert ff vf
!g = convert fg vg
- convertResults fs vs = convertError fs vs
+ convertResults fs vs = convertError fs vs 7
instance (Result a, Result b, Result c, Result d, Result e, Result f,
Result g, Result h) =>
@@ -111,7 +112,7 @@ instance (Result a, Result b, Result c, Result d, Result e, Result f,
where !a = convert fa va; !b = convert fb vb; !c = convert fc vc
!d = convert fd vd; !e = convert fe ve; !f = convert ff vf
!g = convert fg vg; !h = convert fh vh
- convertResults fs vs = convertError fs vs
+ convertResults fs vs = convertError fs vs 8
instance (Result a, Result b, Result c, Result d, Result e, Result f,
Result g, Result h, Result i) =>
@@ -121,7 +122,7 @@ instance (Result a, Result b, Result c, Result d, Result e, Result f,
where !a = convert fa va; !b = convert fb vb; !c = convert fc vc
!d = convert fd vd; !e = convert fe ve; !f = convert ff vf
!g = convert fg vg; !h = convert fh vh; !i = convert fi vi
- convertResults fs vs = convertError fs vs
+ convertResults fs vs = convertError fs vs 9
instance (Result a, Result b, Result c, Result d, Result e, Result f,
Result g, Result h, Result i, Result j) =>
@@ -133,13 +134,19 @@ instance (Result a, Result b, Result c, Result d, Result e, Result f,
!d = convert fd vd; !e = convert fe ve; !f = convert ff vf
!g = convert fg vg; !h = convert fh vh; !i = convert fi vi
!j = convert fj vj
- convertResults fs vs = convertError fs vs
+ convertResults fs vs = convertError fs vs 10
-- | Throw a 'ConversionFailed' exception, indicating a mismatch
--- between the number of columns in the 'Field' and the number in the
--- row. (This should never happen.)
-convertError :: [Field] -> [Maybe ByteString] -> a
-convertError fs vs = throw $ ConversionFailed
- (show (length fs) ++ " columns left in result")
- (show (length vs) ++ " values left in row")
- "mismatch between number of columns to convert"
+-- between the number of columns in the 'Field' and row, and the
+-- number in the collection to be converted to.
+convertError :: [Field] -> [Maybe ByteString] -> Int -> a
+convertError fs vs n = throw $ ConversionFailed
+ (show (length fs) ++ " values: " ++ show (zip (map fieldType fs)
+ (map (fmap ellipsis) vs)))
+ (show n ++ " slots in target type")
+ "mismatch between number of columns to convert and number in target type"
+
+ellipsis :: ByteString -> ByteString
+ellipsis bs
+ | B.length bs > 15 = B.take 10 bs `B.append` "[...]"
+ | otherwise = bs
View
15 Database/MySQL/Simple/Result.hs
@@ -10,6 +10,13 @@
--
-- The 'Result' typeclass, for converting a single value in a row
-- returned by a SQL query into a more useful Haskell representation.
+--
+-- A Haskell numeric type is considered to be compatible with all
+-- MySQL numeric types that are less accurate than it. For instance,
+-- the Haskell 'Double' type is compatible with the MySQL 'Long' type
+-- because it can represent a 'Long' exactly. On the other hand, since
+-- a 'Double' might lose precision if representing a 'LongLong', the
+-- two are /not/ considered compatible.
module Database.MySQL.Simple.Result
(
@@ -113,15 +120,17 @@ instance Result Word64 where
instance Result Float where
convert = atto ok ((fromRational . toRational) <$> double)
- where ok = mkCompats [Float,Double,Decimal,NewDecimal]
+ where ok = mkCompats [Float,Double,Decimal,NewDecimal,Tiny,Short,Int24]
instance Result Double where
convert = atto ok double
- where ok = mkCompats [Float,Double,Decimal,NewDecimal]
+ where ok = mkCompats [Float,Double,Decimal,NewDecimal,Tiny,Short,Int24,
+ Long]
instance Result (Ratio Integer) where
convert = atto ok rational
- where ok = mkCompats [Float,Double,Decimal,NewDecimal]
+ where ok = mkCompats [Float,Double,Decimal,NewDecimal,Tiny,Short,Int24,
+ Long,LongLong]
instance Result SB.ByteString where
convert f = doConvert f okText $ id
View
25 Database/MySQL/Simple/Types.hs
@@ -14,15 +14,18 @@ module Database.MySQL.Simple.Types
(
Null(..)
, Only(..)
+ , In(..)
, Query(..)
) where
-import Blaze.ByteString.Builder
-import Control.Arrow
+import Blaze.ByteString.Builder (toByteString)
+import Control.Arrow (first)
import Data.ByteString (ByteString)
+import Data.Monoid (Monoid(..))
import Data.String (IsString(..))
import Data.Typeable (Typeable)
import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8
+import qualified Data.ByteString as B
-- | A placeholder for the SQL @NULL@ value.
data Null = Null
@@ -60,6 +63,11 @@ instance Read Query where
instance IsString Query where
fromString = Query . toByteString . Utf8.fromString
+instance Monoid Query where
+ mempty = Query B.empty
+ mappend (Query a) (Query b) = Query (B.append a b)
+ {-# INLINE mappend #-}
+
-- | A single-value collection.
--
-- This can be handy if you need to supply a single parameter to a SQL
@@ -68,5 +76,16 @@ instance IsString Query where
-- Example:
--
-- @query \"select x from scores where x > ?\" ('Only' (42::Int))@
-newtype Only a = Only a
+newtype Only a = Only {
+ fromOnly :: a
+ } deriving (Eq, Ord, Read, Show, Typeable, Functor)
+
+-- | Wrap a list of values for use in an @IN@ clause. Replaces a
+-- single \"@?@\" character with a parenthesized list of rendered
+-- values.
+--
+-- Example:
+--
+-- > query "select * from whatever where id in ?" (In [3,4,5])
+newtype In a = In a
deriving (Eq, Ord, Read, Show, Typeable, Functor)
View
1  mysql-simple.cabal
@@ -45,6 +45,7 @@ library
blaze-textual,
bytestring >= 0.9,
mysql >= 0.1.0.1,
+ pcre-light,
old-locale,
text >= 0.11.0.2,
time
Please sign in to comment.
Something went wrong with that request. Please try again.