Commits

Bryan O'Sullivan  committed 24e71c6

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.

  • Participants
  • Parent commits e3ed4df

Comments (0)

Files changed (6)

File Database/MySQL/Simple.hs

-{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
+{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings #-}
 
 -- |
 -- Module:      Database.MySQL.Simple
 module Database.MySQL.Simple
     (
     -- * Types
-      Query
+      Base.ConnectInfo(..)
+    , Connection
+    , Query
+    , In(..)
     , Only(..)
     -- ** Exceptions
     , FormatError(fmtMessage, fmtQuery, fmtParams)
     -- * Statements that do not return results
     , execute
     , execute_
+    , executeMany
     , Base.insertID
     -- * Transaction handling
     , withTransaction
     , 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
 
 -- 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
 --
 -- 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
   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)
                     }
   where twiddle (Plain b)  = toByteString b
         twiddle (Escape s) = s
+        twiddle (Many ys)  = B.concat (map twiddle ys)

File Database/MySQL/Simple/Param.hs

-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, OverloadedStrings #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, FlexibleInstances,
+    OverloadedStrings #-}
 
 -- |
 -- 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)
 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
     -- ^ 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
     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")
 

File Database/MySQL/Simple/QueryResults.hs

-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
 
 -- |
 -- Module:      Database.MySQL.Simpe.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(..))
 
 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) =>
         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) =>
         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) =>
         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) =>
               !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

File Database/MySQL/Simple/Result.hs

 --
 -- 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
     (
 
 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

File Database/MySQL/Simple/Types.hs

     (
       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
 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
 -- 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)

File mysql-simple.cabal

     blaze-textual,
     bytestring >= 0.9,
     mysql >= 0.1.0.1,
+    pcre-light,
     old-locale,
     text >= 0.11.0.2,
     time