From 483c6352022f7ad6279c5d9a76a9682560d456af Mon Sep 17 00:00:00 2001
From: d00bring <haskelldb-users@lists.sourceforge.net>
Date: Sun, 22 Feb 2004 03:05:47 -0800
Subject: [PATCH] added transactions support. exported nullable.

darcs-hash:20040222110547-cca28-be90d3f8b42c685fd12261dd209c253bda81dd1a.gz
---
 INSTALL                               |  4 ++++
 src/Database/HaskellDB.hs             |  4 ++--
 src/Database/HaskellDB/Database.hs    | 11 ++++++++++-
 src/Database/HaskellDB/HSQL/Common.hs |  5 +++++
 src/Database/HaskellDB/Query.hs       |  8 ++++----
 5 files changed, 25 insertions(+), 7 deletions(-)

diff --git a/INSTALL b/INSTALL
index 5dd29c9..f8f765a 100644
--- a/INSTALL
+++ b/INSTALL
@@ -59,6 +59,10 @@ Database support:
   HaskellDB only works with MySQL version >= 4.1 since earlier
   versions don't support for nested subqueries.
 
+  MySQL only supports transactions on transaction-safe table types,
+  such as InnoDB and BDB. The default table type, MyISAM does not
+  support transactions. See the MySQL manual for more information.
+
 - PostgreSQL
 
   Should work.
\ No newline at end of file
diff --git a/src/Database/HaskellDB.hs b/src/Database/HaskellDB.hs
index a18f936..8fdf0c7 100644
--- a/src/Database/HaskellDB.hs
+++ b/src/Database/HaskellDB.hs
@@ -29,7 +29,7 @@ module Database.HaskellDB
 	, (.*.) , (./.), (.%.), (.+.), (.-.), (.++.)
 	, _not, like, cat
 	, isNull, notNull
-	, constant
+	, constant, nullable
 	
 	, count, _sum, _max, _min, avg
 	, stddev, stddevP, variance, varianceP
@@ -41,7 +41,7 @@ module Database.HaskellDB
 	, (!.)
 	, query, lazyQuery, strictQuery
 	, insert, delete, update, insertQuery
-	, tables, describe
+	, tables, describe, transaction
 	
 	, showQ, showOpt, showSql
 	
diff --git a/src/Database/HaskellDB/Database.hs b/src/Database/HaskellDB/Database.hs
index e559348..4ee5363 100644
--- a/src/Database/HaskellDB/Database.hs
+++ b/src/Database/HaskellDB/Database.hs
@@ -24,7 +24,7 @@ module Database.HaskellDB.Database (
 		-- * Function declarations
 		, query, lazyQuery, strictQuery
 		, insert, delete, update, insertQuery
-		, tables, describe
+		, tables, describe, transaction
 		) where
 
 import Database.HaskellDB.HDBRec
@@ -63,6 +63,7 @@ data Database db row
   	  , dbUpdate :: db -> TableName -> [PrimExpr] -> Assoc -> IO ()
 	  , dbTables :: db -> IO [TableName]
 	  , dbDescribe :: db -> TableName -> IO [(Attribute,FieldDef)]
+	  , dbTransaction :: forall a. db -> IO a -> IO a
   	  , database :: db
   	  }
   	  
@@ -158,3 +159,11 @@ describe :: Database db row -- ^ Database
 	 -> TableName -- ^ Name of the tables whose columns are to be listed
 	 -> IO [(Attribute,FieldDef)] -- ^ Name and type info for each column
 describe db = dbInvoke dbDescribe db
+
+
+-- | Performs some database action in a transaction. If no exception is thrown,
+--   the changes are committed. 
+transaction :: Database db row -- ^ Database
+	    -> IO a -- ^ Action to run
+	    -> IO a 
+transaction db = dbInvoke dbTransaction db
diff --git a/src/Database/HaskellDB/HSQL/Common.hs b/src/Database/HaskellDB/HSQL/Common.hs
index 3ee80dc..804caac 100644
--- a/src/Database/HaskellDB/HSQL/Common.hs
+++ b/src/Database/HaskellDB/HSQL/Common.hs
@@ -73,6 +73,7 @@ newHSQL connection
 		 dbUpdate	= hsqlUpdate,
 		 dbTables       = hsqlTables,
 		 dbDescribe     = hsqlDescribe,
+		 dbTransaction  = hsqlTransaction,
 		 database	= connection
 	       }
 
@@ -126,6 +127,10 @@ hsqlDescribe conn table = liftM (map toFieldDef) (HSQL.describe conn table)
     where
     toFieldDef (name,sqlType,nullable) = (name,(toFieldType sqlType, nullable))
 
+-- | HSQL implementation of 'Database.dbTransaction'.
+hsqlTransaction :: Connection -> IO a -> IO a
+hsqlTransaction conn action = inTransaction conn (\_ -> action)
+
 toFieldType :: SqlType -> FieldType
 toFieldType (SqlDecimal _ _) = DoubleT
 toFieldType (SqlNumeric _ _) = DoubleT
diff --git a/src/Database/HaskellDB/Query.hs b/src/Database/HaskellDB/Query.hs
index 03ac4a6..c780226 100644
--- a/src/Database/HaskellDB/Query.hs
+++ b/src/Database/HaskellDB/Query.hs
@@ -29,7 +29,7 @@ module Database.HaskellDB.Query (
 	     , union, intersect, divide, minus
 	     , _not, like, cat
 	     , isNull, notNull
-	     , constant
+	     , constant, nullable
 	     , count, _sum, _max, _min, avg
 	     , stddev, stddevP, variance, varianceP
 	     , asc, desc, order
@@ -318,10 +318,10 @@ instance ShowConstant a => ShowConstant (Maybe a) where
 constant :: ShowConstant a => a -> Expr a
 constant x      = Expr (ConstExpr (showConstant x))
 
--- This function is not exported and is not used anywhere.. 
--- Either export it or delete it :)
+-- | Turn constant data into a nullable expression. 
+--   Same as @constant . Just@
 nullable        :: ShowConstant a => a -> Expr (Maybe a)
-nullable x      = Expr (ConstExpr (showConstant x))
+nullable x      = constant (Just x)
 
 
 -----------------------------------------------------------