Add Values constructor

Closes #61 and #91.  See #61 in particular for a discussion of the design

Author: lpsmith

src/Database/PostgreSQL/Simple/ToField.hs

@@ -33,6 +33,7 @@ import Data.Monoid (mappend)
 import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime)
 import Data.Typeable (Typeable)
 import Data.Word (Word, Word8, Word16, Word32, Word64)
+import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow
 import Database.PostgreSQL.Simple.Types
 import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8
 import qualified Data.ByteString as SB
@@ -279,3 +280,59 @@ toJSONField = toField . JSON.toJSON
 inQuotes :: Builder -> Builder
 inQuotes b = quote `mappend` b `mappend` quote
   where quote = Utf8.fromChar '\''
+
+interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]
+interleaveFoldr f b bs as = foldr (\a bs -> b : f a bs) bs as
+{-# INLINE interleaveFoldr #-}
+
+instance ToRow a => ToField (Values a) where
+    toField (Values types rows) =
+        case rows of
+          []    -> case types of
+                     []    -> error err
+                     (_:_) -> values $ typedRow (repeat (lit "null"))
+                                                types
+                                                [lit " LIMIT 0)"]
+          (_:_) -> case types of
+                     []    -> values $ untypedRows rows [litC ')']
+                     (_:_) -> values $ typedRows rows types [litC ')']
+      where
+        err  = "Database.PostgreSQL.Simple.toField :: Values -> Action  either values or types must be non-empty"
+        lit  = Plain . fromByteString
+        litC = Plain . fromChar
+        values x = Many (lit "(VALUES ": x)
+
+        typedField :: (Action, QualifiedIdentifier) -> [Action] -> [Action]
+        typedField (val,typ) rest = val : lit "::" : toField typ : rest
+
+        typedRow :: [Action] -> [QualifiedIdentifier] -> [Action] -> [Action]
+        typedRow (val:vals) (typ:typs) rest =
+            litC '(' :
+              typedField (val,typ) ( interleaveFoldr
+                                        typedField
+                                        (litC ',')
+                                        (litC ')' : rest)
+                                        (zip vals typs)   )
+
+        untypedRow :: [Action] -> [Action] -> [Action]
+        untypedRow (val:vals) rest =
+            litC '(' : val :
+            interleaveFoldr
+                 (:)
+                 (litC ',')
+                 (litC ')' : rest)
+                 vals
+
+        typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]
+        typedRows (val:vals) types rest =
+            typedRow (toRow val) types (litC ',' : untypedRows vals rest)
+
+        untypedRows :: ToRow a => [a] -> [Action] -> [Action]
+        untypedRows [] rest = rest
+        untypedRows (val:vals) rest =
+            untypedRow (toRow val) $
+              interleaveFoldr
+                  (untypedRow . toRow)
+                  (litC ',')
+                  rest
+                  vals

src/Database/PostgreSQL/Simple/ToField.hs-boot

@@ -1,6 +1,29 @@
 module Database.PostgreSQL.Simple.ToField where
 
 import Database.PostgreSQL.Simple.Types
+import Blaze.ByteString.Builder(Builder)
+import Data.ByteString(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.
+  | EscapeByteA ByteString
+    -- ^ Escape binary data for use as a @bytea@ literal.  Include surrounding
+    -- quotes.  This is used by the 'Binary' newtype wrapper.
+  | EscapeIdentifier ByteString
+    -- ^ Escape before substituting. Use for all sql identifiers like
+    -- table, column names, etc. This is used by the 'Identifier' newtype
+    -- wrapper.
+  | Many [Action]
+    -- ^ Concatenate a series of rendering actions.
 
 class ToField a
 

src/Database/PostgreSQL/Simple/ToRow.hs-boot

@@ -3,6 +3,7 @@ module Database.PostgreSQL.Simple.ToRow where
 import Database.PostgreSQL.Simple.Types
 import {-# SOURCE #-} Database.PostgreSQL.Simple.ToField
 
-class ToRow a
+class ToRow a where
+    toRow :: a -> [Action]
 
 instance ToField a => ToRow (Only a)

src/Database/PostgreSQL/Simple/Types.hs

@@ -27,6 +27,7 @@ module Database.PostgreSQL.Simple.Types
     , (:.)(..)
     , Savepoint(..)
     , PGArray(..)
+    , Values(..)
     ) where
 
 import Blaze.ByteString.Builder (toByteString)
@@ -173,3 +174,44 @@ infixr 3 :.
 
 newtype Savepoint = Savepoint Query
     deriving (Eq, Ord, Show, Read, Typeable)
+
+-- | Represents a @VALUES@ table literal,  usable as an alternative
+--   to @executeMany@ and @returning@.  For example:
+--
+-- > execute c "INSERT INTO table (key,val) ?"
+-- >      (Only (Values ["int4","text"]
+-- >                    [(1,"hello"),(2,"world")]))
+--
+--   Issues the following query:
+--
+-- > INSERT INTO table (key,val) (VALUES (1::"int4",'hello'::"text"),(2,'world'))
+--
+--   When the list of values is empty,  the following query will be issued:
+--
+-- > INSERT INTO table (key,val) (VALUES (null::"int4",null::"text") LIMIT 0)
+--
+--   By contrast, @executeMany@ and @returning@ don't issue the query
+--   in the empty case, and simply return @0@ and @[]@ respectively.
+--
+--   The advantage over @executeMany@ is in cases when you want to
+--   parameterize table literals in addition to other parameters,  as can
+--   occur with writable common table expressions, for example.
+--
+--   The first argument is a list of postgresql type names.  Because this
+--   is turned into a properly quoted identifier,  the type name is case
+--   sensitive and must be as it appears in the @pg_type@ table.   Thus,
+--   you must write @timestamptz@ instead of @timestamp with time zone@,
+--   @int4@ instead of @integer@, @_int8@ instead of @bigint[]@, etcetera.
+--
+--   You may omit the type names,  however,  if you do so the list
+--   of values must be non-empty,  and postgresql must be able to infer
+--   the types of the columns from the surrounding context.   If these
+--   conditions are not met,  postgresql-simple will throw an exception
+--   without issuing the query in the former case,  and in the latter
+--   the postgres server will return an error which will be turned into
+--   a @SqlError@ exception.
+--
+--   See <http://www.postgresql.org/docs/9.3/static/sql-values.html> for
+--   more information.
+data Values a = Values [QualifiedIdentifier] [a]
+    deriving (Eq, Ord, Show, Read, Typeable)