Add a module which generates SQL strings to use sql-words.

relational-join/src/Database/Relational/Query.hs

@@ -27,5 +27,8 @@ import Database.Relational.Query.Projection
    value, valueTrue, valueFalse, valueNull, placeholder)
 import Database.Relational.Query.Relation (Relation, PrimeRelation, toSQL, fromTable)
 import Database.Relational.Query.Join
-import Database.Relational.Query.Type (Query, untypeQuery, fromRelation)
+import Database.Relational.Query.Type
+  (Query, untypeQuery, fromRelation,
+   Update, untypeUpdate, typedPrimaryUpdate,
+   Insert, untypeInsert, typedInsert)
 import Database.Relational.Query.Derives

relational-join/src/Database/Relational/Query/SQL.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.Relational.Query.SQL (
+  primaryUpdateSQL', primaryUpdateSQL,
+
+  insertSQL', insertSQL
+  ) where
+
+import Language.SQL.Keyword (Keyword(..), (.=.))
+import qualified Language.SQL.Keyword as SQL
+import Database.Relational.Query.Table (Table, name, columns)
+
+
+primaryUpdateSQL' :: String -> [String] -> String -> String
+primaryUpdateSQL' table cols pkey =
+  SQL.unwordsSQL
+  $ [UPDATE, SQL.word table, SET, assignments `SQL.sepBy` ", ",
+     WHERE, SQL.word pkey, "= ?"]
+  where assignments = map (\f -> SQL.word f .=. "?") . filter (/= pkey) $ cols
+
+primaryUpdateSQL :: Table r -> String -> String
+primaryUpdateSQL tbl = primaryUpdateSQL' (name tbl) (columns tbl)
+
+
+insertSQL' :: String -> [String] -> String
+insertSQL' table cols =
+  SQL.unwordsSQL
+  $ [INSERT, INTO, SQL.word table, cols' `SQL.parenSepBy` ", ",
+     VALUES, pfs `SQL.parenSepBy` ", "]
+  where cols' = map SQL.word cols
+        pfs      = replicate (length cols) "?"
+
+insertSQL :: Table r -> String
+insertSQL tbl = insertSQL' (name tbl) (columns tbl)

relational-join/src/Database/Relational/Query/Type.hs

@@ -2,12 +2,15 @@
 module Database.Relational.Query.Type (
   Query (untypeQuery), unsafeTypedQuery, fromRelation,
 
-  Update(untypeUpdate), unsafeTypedUpdate,
+  Update(untypeUpdate), unsafeTypedUpdate, typedPrimaryUpdate,
-  Insert(untypeInsert), unsafeTypedInsert
+  Insert(untypeInsert), unsafeTypedInsert, typedInsert
   ) where
 
 import Database.Relational.Query.Relation (PrimeRelation)
 import qualified Database.Relational.Query.Relation as Relation
+import Database.Relational.Query.Table (Table)
+import Database.Relational.Query.SQL (primaryUpdateSQL, insertSQL)
+
 
 newtype Query p a = Query { untypeQuery :: String }
 
@@ -26,7 +29,13 @@ newtype Update p a = Update { untypeUpdate :: String }
 unsafeTypedUpdate :: String -> Update p a
 unsafeTypedUpdate =  Update
 
+typedPrimaryUpdate :: Table r -> String -> Update p r
+typedPrimaryUpdate tbl =  unsafeTypedUpdate . primaryUpdateSQL tbl
+
 newtype Insert a   = Insert { untypeInsert :: String }
 
 unsafeTypedInsert :: String -> Insert a
 unsafeTypedInsert =  Insert
+
+typedInsert :: Table r -> Insert r
+typedInsert =  unsafeTypedInsert . insertSQL