mysql-simple 0.1.0.1 → 0.2.0.0

raw patch · 8 files changed

+457/−156 lines, 8 filesdep +pcre-lightdep −deepseqdep ~bytestringdep ~mysqldep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: pcre-light

Dependencies removed: deepseq

Dependency ranges changed: bytestring, mysql, time

API changes (from Hackage documentation)

Files

• Database/MySQL/Simple.hs +170/−23
• Database/MySQL/Simple/Orphans.hs +0/−40
• Database/MySQL/Simple/Param.hs +47/−4
• Database/MySQL/Simple/QueryParams.hs +14/−0
• Database/MySQL/Simple/QueryResults.hs +114/−63
• Database/MySQL/Simple/Result.hs +43/−12
• Database/MySQL/Simple/Types.hs +66/−8
• mysql-simple.cabal +3/−6

@@ -1,32 +1,73 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings #-} +-- |+-- Module:      Database.MySQL.Simple+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     BSD3+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- A mid-level client library for the MySQL database, aimed at ease of+-- use and high performance.+ module Database.MySQL.Simple     (-      FormatError(fmtMessage, fmtQuery, fmtParams)+    -- * Types+      Base.ConnectInfo(..)+    , Connection+    , Query+    , In(..)     , Only(..)-    , execute+    -- ** Exceptions+    , FormatError(fmtMessage, fmtQuery, fmtParams)+    , QueryError(qeMessage, qeQuery)+    , ResultError(errSQLType, errHaskellType, errMessage)+    -- * Connection management+    , Base.connect+    , Base.defaultConnectInfo+    , Base.close+    -- * Queries that return results     , query     , query_+    -- * Statements that do not return results+    , execute+    , execute_+    , executeMany+    , Base.insertID+    -- * Transaction handling+    , withTransaction+    , Base.autocommit+    , 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.DeepSeq (NFData(..))-import Control.Exception (Exception, throw)+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.Types (Only(..), Query(..))+import Database.MySQL.Simple.Result (ResultError(..))+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 +-- | Exception thrown if a 'Query' could not be formatted correctly.+-- This may occur if the number of \'@?@\' characters in the query+-- string does not match the number of parameters provided. data FormatError = FormatError {       fmtMessage :: String     , fmtQuery :: Query@@ -35,13 +76,57 @@  instance Exception FormatError +-- | Exception thrown if 'query' is used to perform an @INSERT@-like+-- operation, or 'execute' is used to perform a @SELECT@-like operation.+data QueryError = QueryError {+      qeMessage :: String+    , qeQuery :: Query+    } deriving (Eq, Show, Typeable)++instance Exception QueryError++-- | Format a query string.+--+-- String parameters are escaped according to the character set in use+-- on the 'Connection'.+--+-- 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@@ -50,39 +135,100 @@                                   " '?' characters, but " ++                                   show (length xs) ++ " parameters") q xs +-- | Execute an @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. execute :: (QueryParams q) => Connection -> Query -> q -> IO Int64 execute conn template qs = do   Base.query conn =<< formatQuery conn template qs+  finishExecute template conn++-- | A version of 'execute' that does not perform query substitution.+execute_ :: Connection -> Query -> IO Int64+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)   if ncols /= 0-    then error "execute: executed a select!"+    then throw $ QueryError ("execute resulted in " ++ show ncols +++                             "-column result") q     else Base.affectedRows conn-  -query :: (QueryParams q, QueryResults r) => Connection -> Query -> q -> IO [r]++-- | Perform a @SELECT@ or other SQL query that is expected to return+-- results.+--+-- All results are retrieved and converted before this function+-- returns.+--+-- Exceptions that may be thrown:+--+-- * 'FormatError': the query string could not be formatted correctly.+--+-- * 'QueryError': the result contains no columns (i.e. you should be+--   using 'execute' instead of 'query').+--+-- * 'ResultError': result conversion failed.+query :: (QueryParams q, QueryResults r)+         => Connection -> Query -> q -> IO [r] query conn template qs = do   Base.query conn =<< formatQuery conn template qs-  finishQuery conn-  +  finishQuery template conn++-- | A version of 'query' that does not perform query substitution. query_ :: (QueryResults r) => Connection -> Query -> IO [r]-query_ conn (Query q) = do-  Base.query conn q-  finishQuery conn+query_ conn q@(Query que) = do+  Base.query conn que+  finishQuery q conn -finishQuery :: (QueryResults r) => Connection -> IO [r]-finishQuery conn = do+finishQuery :: (QueryResults r) => Query -> Connection -> IO [r]+finishQuery q conn = do   r <- Base.storeResult conn   ncols <- Base.fieldCount (Right r)   if ncols == 0-    then return []+    then throw $ QueryError "query resulted in zero-column result" q     else do       fs <- Base.fetchFields r       flip fix [] $ \loop acc -> do         row <- Base.fetchRow r         case row of           [] -> return (reverse acc)-          _  -> let c = convertResults fs row-                in rnf c `seq` loop (c:acc)+          _  -> let !c = convertResults fs row+                in loop (c:acc) +-- | Execute an action inside a SQL transaction.+--+-- You are assumed to have started the transaction yourself.+--+-- If your action succeeds, the transaction will be 'Base.commit'ted+-- before this function returns.+--+-- If your action throws any exception (not just a SQL exception), the+-- transaction will be rolled back 'Base.rollback' before the+-- exception is propagated.+withTransaction :: Connection -> IO a -> IO a+withTransaction conn act = do+  r <- act `onException` Base.rollback conn+  Base.commit conn+  return r+ fmtError :: String -> Query -> [Action] -> a fmtError msg q xs = throw FormatError {                       fmtMessage = msg@@ -91,3 +237,4 @@                     }   where twiddle (Plain b)  = toByteString b         twiddle (Escape s) = s+        twiddle (Many ys)  = B.concat (map twiddle ys)

@@ -1,40 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Database.MySQL.Simple.Orphans () where--import Control.DeepSeq (NFData(..))-import Data.Time.Calendar (Day(..))-import Data.Time.Clock (UTCTime(..))-import Data.Time.LocalTime (TimeOfDay(..))-import qualified Data.ByteString.Internal as SB-import qualified Data.ByteString.Lazy.Internal as LB--instance NFData SB.ByteString where-    rnf (SB.PS _ _ _) = ()-    {-# INLINE rnf #-}--instance NFData LB.ByteString where-    rnf (LB.Chunk (SB.PS _ _ _) cs) = rnf cs-    rnf LB.Empty = ()--instance NFData Day where-    rnf (ModifiedJulianDay !_) = ()-    {-# INLINE rnf #-}--instance NFData TimeOfDay where-    rnf (TimeOfDay !_ !_ !_) = ()-    {-# INLINE rnf #-}--instance NFData UTCTime where-    rnf (UTCTime !_ !_) = ()-    {-# INLINE rnf #-}--instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,-          NFData g, NFData h, NFData i, NFData j) =>-    NFData (a,b,c,d,e,f,g,h,i,j)-  where-    rnf (a,b,c,d,e,f,g,h,i,j) =-      rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e `seq`-      rnf f `seq` rnf g `seq` rnf h `seq` rnf i `seq` rnf j-    {-# INLINE rnf #-}

@@ -1,5 +1,16 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, FlexibleInstances,+    OverloadedStrings #-} +-- |+-- Module:      Database.MySQL.Simple.Param+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     BSD3+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- The 'Param' typeclass, for rendering a parameter to a SQL query.+ module Database.MySQL.Simple.Param     (       Action(..)@@ -8,16 +19,19 @@     ) 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.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@@ -26,11 +40,30 @@ import qualified Data.Text.Encoding as ST import qualified Data.Text.Lazy as LT -data Action = Plain Builder-            | Escape ByteString+-- | How to render an element when substituting it into a query.+data Action =+    Plain Builder+    -- ^ Render without escaping or quoting. Use for non-text types+    -- such as numbers, when you are /certain/ that they will not+    -- introduce formatting vulnerabilities via use of characters such+    -- as spaces or \"@'@\".+  | Escape ByteString+    -- ^ 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 :: a -> Action+    -- ^ Prepare a value for substitution into a query string.  instance Param Action where     render a = a@@ -41,6 +74,13 @@     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") @@ -138,6 +178,9 @@     render = Plain . inQuotes . Utf8.fromString . show     {-# INLINE render #-} +-- | Surround a string with single-quote characters: \"@'@\"+--+-- This function /does not/ perform any other escaping. inQuotes :: Builder -> Builder inQuotes b = quote `mappend` b `mappend` quote   where quote = Utf8.fromChar '\''

@@ -1,3 +1,14 @@+-- |+-- Module:      Database.MySQL.Simple.QueryParams+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     BSD3+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- The 'QueryParams' typeclass, for rendering a collection of+-- parameters to a SQL query.+ module Database.MySQL.Simple.QueryParams     (       QueryParams(..)@@ -6,8 +17,11 @@ import Database.MySQL.Simple.Param (Action(..), Param(..)) import Database.MySQL.Simple.Types (Only(..)) +-- | A collection type that can be turned into a list of rendering+-- 'Action's. class QueryParams a where     renderParams :: a -> [Action]+    -- ^ Render a collection of values.  instance QueryParams () where     renderParams _ = []

@@ -1,101 +1,152 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}++-- |+-- Module:      Database.MySQL.Simpe.QueryResults+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     BSD3+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- The 'QueryResults' typeclass, for converting a row of results+-- returned by a SQL query into a more useful Haskell representation.+ module Database.MySQL.Simple.QueryResults     (       QueryResults(..)+    , convertError     ) where -import Control.DeepSeq (NFData(..)) 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(..)) -class (NFData a) => QueryResults a where+-- | A collection type that can be converted from a list of strings.+--+-- Instances should use the 'convert' method of the 'Result' class+-- to perform conversion of each element of the collection.+--+-- This example instance demonstrates how to convert a two-column row+-- into a Haskell pair. Each field in the metadata is paired up with+-- each value from the row, and the two are passed to 'convert'.+--+-- @+-- 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+-- @+--+-- Notice that this instance evaluates each element to WHNF before+-- constructing the pair. By doing this, we guarantee two important+-- properties:+--+-- * Keep resource usage under control by preventing the construction+--   of potentially long-lived thunks.+--+-- * Ensure that any 'ResultError' that might arise is thrown+--   immediately, rather than some place later in application code+--   that cannot handle it.+class QueryResults a where     convertResults :: [Field] -> [Maybe ByteString] -> a+    -- ^ Convert values from a row into a Haskell collection.+    --+    -- This function will throw a 'ResultError' if conversion of the+    -- collection fails. -instance (NFData a, Result a) => QueryResults (Only a) where-    convertResults [fa] [va] = Only (convert fa va)-    convertResults fs vs  = convError fs vs+instance (Result a) => QueryResults (Only a) where+    convertResults [fa] [va] = Only a+        where !a = convert fa va+    convertResults fs vs  = convertError fs vs 1 -instance (NFData a, NFData b,-          Result a, Result b) => QueryResults (a,b) where-    convertResults [fa,fb] [va,vb] = (convert fa va, convert fb vb)-    convertResults fs vs  = convError fs vs+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 2 -instance (NFData a, NFData b, NFData c,-          Result a, Result b, Result c) => QueryResults (a,b,c) where-    convertResults [fa,fb,fc] [va,vb,vc] =-        (convert fa va, convert fb vb, convert fc vc)-    convertResults fs vs  = convError fs vs+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 3 -instance (NFData a, NFData b, NFData c, NFData d,-          Result a, Result b, Result c, Result d) =>+instance (Result a, Result b, Result c, Result d) =>     QueryResults (a,b,c,d) where-    convertResults [fa,fb,fc,fd] [va,vb,vc,vd] =-        (convert fa va, convert fb vb, convert fc vc, convert fd vd)-    convertResults fs vs  = convError fs vs+    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 4 -instance (NFData a, NFData b, NFData c, NFData d, NFData e,-          Result a, Result b, Result c, Result d, Result e) =>+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] =-        (convert fa va, convert fb vb, convert fc vc, convert fd vd,-         convert fe ve)-    convertResults fs vs  = convError fs vs+    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 5 -instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,-          Result a, Result b, Result c, Result d, Result e, Result f) =>+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] =-        (convert fa va, convert fb vb, convert fc vc, convert fd vd,-         convert fe ve, convert ff vf)-    convertResults fs vs  = convError fs vs+    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 6 -instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,-          NFData g,-          Result a, Result b, Result c, Result d, Result e, Result f,+instance (Result a, Result b, Result c, Result d, Result e, Result f,           Result g) =>     QueryResults (a,b,c,d,e,f,g) where     convertResults [fa,fb,fc,fd,fe,ff,fg] [va,vb,vc,vd,ve,vf,vg] =-        (convert fa va, convert fb vb, convert fc vc, convert fd vd,-         convert fe ve, convert ff vf, convert fg vg)-    convertResults fs vs  = convError fs vs+        (a,b,c,d,e,f,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 7 -instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,-          NFData g, NFData h,-          Result a, Result b, Result c, Result d, Result e, Result f,+instance (Result a, Result b, Result c, Result d, Result e, Result f,           Result g, Result h) =>     QueryResults (a,b,c,d,e,f,g,h) where     convertResults [fa,fb,fc,fd,fe,ff,fg,fh] [va,vb,vc,vd,ve,vf,vg,vh] =-        (convert fa va, convert fb vb, convert fc vc, convert fd vd,-         convert fe ve, convert ff vf, convert fg vg, convert fh vh)-    convertResults fs vs  = convError fs vs+        (a,b,c,d,e,f,g,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 8 -instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,-          NFData g, NFData h, NFData i,-          Result a, Result b, Result c, Result d, Result e, Result f,+instance (Result a, Result b, Result c, Result d, Result e, Result f,           Result g, Result h, Result i) =>     QueryResults (a,b,c,d,e,f,g,h,i) where     convertResults [fa,fb,fc,fd,fe,ff,fg,fh,fi] [va,vb,vc,vd,ve,vf,vg,vh,vi] =-        (convert fa va, convert fb vb, convert fc vc, convert fd vd,-         convert fe ve, convert ff vf, convert fg vg, convert fh vh,-         convert fi vi)-    convertResults fs vs  = convError fs vs+        (a,b,c,d,e,f,g,h,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 9 -instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,-          NFData g, NFData h, NFData i, NFData j,-          Result a, Result b, Result c, Result d, Result e, Result f,+instance (Result a, Result b, Result c, Result d, Result e, Result f,           Result g, Result h, Result i, Result j) =>     QueryResults (a,b,c,d,e,f,g,h,i,j) where     convertResults [fa,fb,fc,fd,fe,ff,fg,fh,fi,fj]                    [va,vb,vc,vd,ve,vf,vg,vh,vi,vj] =-        (convert fa va, convert fb vb, convert fc vc, convert fd vd,-         convert fe ve, convert ff vf, convert fg vg, convert fh vh,-         convert fi vi, convert fj vj)-    convertResults fs vs  = convError fs vs+        (a,b,c,d,e,f,g,h,i,j)+        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+              !j = convert fj vj+    convertResults fs vs  = convertError fs vs 10 -convError :: [Field] -> [Maybe ByteString] -> a-convError 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"+-- | Throw a 'ConversionFailed' exception, indicating a mismatch+-- 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

@@ -1,5 +1,23 @@ {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances #-} +-- |+-- Module:      Database.MySQL.Simpe.QueryResults+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     BSD3+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- 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     (       Result(..)@@ -9,7 +27,6 @@ #include "MachDeps.h"  import Control.Applicative ((<$>), (<*>), (<*), pure)-import Control.DeepSeq (NFData) import Control.Exception (Exception, throw) import Data.Attoparsec.Char8 hiding (Result) import Data.Bits ((.&.), (.|.), shiftL)@@ -24,7 +41,6 @@ import Data.Typeable (TypeRep, Typeable, typeOf) import Data.Word (Word, Word8, Word16, Word32, Word64) import Database.MySQL.Base.Types (Field(..), Type(..))-import Database.MySQL.Simple.Orphans () import System.Locale (defaultTimeLocale) import qualified Data.ByteString as SB import qualified Data.ByteString.Char8 as B8@@ -33,21 +49,34 @@ import qualified Data.Text.Encoding as ST import qualified Data.Text.Lazy as LT -data ResultError = Incompatible { errSourceType :: String-                                , errDestType :: String+-- | Exception thrown if conversion from a SQL value to a Haskell+-- value fails.+data ResultError = Incompatible { errSQLType :: String+                                , errHaskellType :: String                                 , errMessage :: String }-                 | UnexpectedNull { errSourceType :: String-                                  , errDestType :: String+                 -- ^ The SQL and Haskell types are not compatible.+                 | UnexpectedNull { errSQLType :: String+                                  , errHaskellType :: String                                   , errMessage :: String }-                 | ConversionFailed { errSourceType :: String-                                    , errDestType :: String+                 -- ^ A SQL @NULL@ was encountered when the Haskell+                 -- type did not permit it.+                 | ConversionFailed { errSQLType :: String+                                    , errHaskellType :: String                                     , errMessage :: String }+                 -- ^ The SQL value could not be parsed, or could not+                 -- be represented as a valid Haskell value, or an+                 -- unexpected low-level error occurred (e.g. mismatch+                 -- between metadata and actual data in a row).                    deriving (Eq, Show, Typeable)  instance Exception ResultError -class (NFData a) => Result a where+-- | A type that may be converted from a SQL type.+class Result a where     convert :: Field -> Maybe ByteString -> a+    -- ^ Convert a SQL value to a Haskell value.+    --+    -- Throws a 'ResultError' if conversion fails.  instance (Result a) => Result (Maybe a) where     convert _ Nothing = Nothing@@ -91,15 +120,17 @@  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

@@ -1,24 +1,58 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-} +-- |+-- Module:      Database.MySQL.Simple.Types+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     BSD3+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Basic types.+ module Database.MySQL.Simple.Types     (       Null(..)     , Only(..)+    , In(..)     , Query(..)     ) where -import Control.Arrow-import Control.DeepSeq (NFData)-import Blaze.ByteString.Builder+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 Data.ByteString (ByteString)+import qualified Data.ByteString as B +-- | A placeholder for the SQL @NULL@ value. data Null = Null+          deriving (Read, Show, Typeable) +instance Eq Null where+    _ == _ = False+    _ /= _ = False++-- | A query string. This type is intended to make it difficult to+-- construct a SQL query by concatenating string fragments, as that is+-- an extremely common way to accidentally introduce SQL injection+-- vulnerabilities into an application.+--+-- This type is an instance of 'IsString', so the easiest way to+-- construct a query is to enable the @OverloadedStrings@ language+-- extension and then simply write the query in double quotes.+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import Database.MySQL.Simple+-- >+-- > q :: Query+-- > q = "select ?" newtype Query = Query {       fromQuery :: ByteString-    } deriving (Eq, Ord)+    } deriving (Eq, Ord, Typeable)  instance Show Query where     show = show . fromQuery@@ -29,5 +63,29 @@ instance IsString Query where     fromString = Query . toByteString . Utf8.fromString -newtype Only a = Only a-    deriving (Eq, Ord, Read, Show, NFData)+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+-- query.+--+-- Example:+--+-- @query \"select x from scores where x > ?\" ('Only' (42::Int))@+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)

@@ -1,5 +1,5 @@ name:           mysql-simple-version:        0.1.0.1+version:        0.2.0.0 homepage:       https://github.com/mailrank/mysql-simple bug-reports:    https://github.com/mailrank/mysql-simple/issues synopsis:       A mid-level MySQL client library.@@ -38,17 +38,14 @@     Database.MySQL.Simple.Result     Database.MySQL.Simple.Types -  other-modules:-    Database.MySQL.Simple.Orphans-   build-depends:     attoparsec >= 0.8.5.3,     base < 5,     blaze-builder,     blaze-textual,     bytestring >= 0.9,-    deepseq,-    mysql,+    mysql >= 0.1.0.1,+    pcre-light,     old-locale,     text >= 0.11.0.2,     time