implementation module MySQL
//MySQL implementation of the Clean SQL database API
// 
import SQL
import StdEnv, StdMaybe, Pointer
import code from library "libmysql.txt"

//MySQL Does not really need a context
:: MySQLContext		:== Int
	
//A wrapper for access to MySQL's MYSQL* structs
:: MySQLConnection =
	{ conn_ptr		:: !Pointer
	}
//A wrapper to MySQL's result sets
:: MySQLCursor = 
	{ conn_ptr		:: !Pointer
	, result_ptr	:: !Pointer
	, result_size	:: !Int
	, fields_ptr	:: !Pointer
	, row_ptr		:: !Pointer
	, row_lengths	:: !Pointer
	}

//MySQL C-API Constants and Offsets
ENUM_FLAG				:== 256
CLIENT_FOUND_ROWS		:== 2

MYSQL_TYPE_TINY			:== 1
MYSQL_TYPE_SHORT		:== 2
MYSQL_TYPE_LONG			:== 3
MYSQL_TYPE_INT24		:== 9
MYSQL_TYPE_LONGLONG		:== 8
MYSQL_TYPE_DECIMAL		:== 0
MYSQL_TYPE_NEWDECIMAL	:== 246
MYSQL_TYPE_FLOAT		:== 4
MYSQL_TYPE_DOUBLE		:== 5
MYSQL_TYPE_TIMESTAMP	:== 7
MYSQL_TYPE_DATE			:== 10
MYSQL_TYPE_TIME			:== 11
MYSQL_TYPE_DATETIME		:== 12
MYSQL_TYPE_STRING		:== 254
MYSQL_TYPE_VAR_STRING	:== 253
MYSQL_TYPE_BLOB			:== 252
MYSQL_TYPE_ENUM			:== 247

SIZEOF_MYSQL_FIELD			:== 84
MYSQL_FIELD_TYPE_OFFSET 	:== 76
MYSQL_FIELD_FLAGS_OFFSET	:== 64

//MySQL C-API foreign functions
// libmysql.dll access
mysql_affected_rows :: !Pointer -> Int
mysql_affected_rows a0 = code {
	ccall mysql_affected_rows@4 "PI:I"
}
mysql_close :: !Pointer -> Int
mysql_close a0 = code {
	ccall mysql_close@4 "PI:I"
}
mysql_errno :: !Pointer -> Int
mysql_errno a0 = code {
	ccall mysql_errno@4 "PI:I"
}
mysql_error :: !Pointer -> Pointer
mysql_error a0 = code {
	ccall mysql_error@4 "PI:I"
}
mysql_fetch_fields :: !Pointer -> Pointer
mysql_fetch_fields a0 = code {
	ccall mysql_fetch_fields@4 "PI:I"
}
mysql_fetch_lengths :: !Pointer -> Pointer
mysql_fetch_lengths a0 = code {
	ccall mysql_fetch_lengths@4 "PI:I"
}
mysql_fetch_row :: !Pointer -> Pointer
mysql_fetch_row a0 = code {
	ccall mysql_fetch_row@4 "PI:I"
}
mysql_free_result :: !Pointer -> Int
mysql_free_result a0 = code {
	ccall mysql_free_result@4 "PI:I"
}
mysql_init :: !Int -> Int
mysql_init a0 = code {
	ccall mysql_init@4 "PI:I"
}
mysql_insert_id :: !Pointer -> Int
mysql_insert_id a0 = code {
	ccall mysql_insert_id@4 "PI:I"
}
mysql_num_fields :: !Pointer -> Int
mysql_num_fields a0 = code {
	ccall mysql_num_fields@4 "PI:I"
}
mysql_num_rows :: !Pointer -> Int
mysql_num_rows a0 = code {
	ccall mysql_num_rows@4 "PI:I"
}
mysql_real_connect :: !Pointer !{#Char} !{#Char} !{#Char} !{#Char} !Int !Int !Int -> Pointer
mysql_real_connect a0 a1 a2 a3 a4 a5 a6 a7 = code {
	ccall mysql_real_connect@32 "PIssssIII:I"
}
mysql_real_escape_string :: !Pointer !{#Char} !{#Char} !Int -> Int
mysql_real_escape_string a0 a1 a2 a3 = code {
	ccall mysql_real_escape_string@16 "PIssI:I"
}
mysql_real_query :: !Pointer !{#Char} !Int -> Int
mysql_real_query a0 a1 a2 = code {
	ccall mysql_real_query@12 "PIsI:I"
}
mysql_store_result :: !Pointer -> Pointer
mysql_store_result a0 = code {
	ccall mysql_store_result@4 "PI:I"
}

instance SQLEnvironment World MySQLContext
where
	//Dummy environment
	openContext :: !*World -> (!(Maybe SQLError),!(Maybe *MySQLContext),!*World)
	openContext world = (Nothing, Just 42, world)

	closeContext :: !*MySQLContext !*World -> (!(Maybe SQLError), !*World)
	closeContext context world = (Nothing, world)

instance SQLContext MySQLContext MySQLConnection
where
	openConnection	:: !String !String !String !String !*MySQLContext	-> (!(Maybe SQLError),!(Maybe *MySQLConnection),!*MySQLContext)
	openConnection host username password database context
		//Initialize a handle
		# conn_ptr	= mysql_init 0
		| conn_ptr == 0		= (Just (SQLInterfaceError 1 "Could not initialize a connection"), Nothing, context)
		//Connect
		# ok_ptr	= mysql_real_connect conn_ptr (packString host) (packString username) (packString password) (packString database) 0 0 CLIENT_FOUND_ROWS
		| ok_ptr == 0
			# errno 	= mysql_errno conn_ptr
			# errmsg	= derefString (mysql_error conn_ptr)
			| errno <> errno || errmsg <> errmsg	= undef //Force execution
			= (Just (SQLDatabaseError errno errmsg), Nothing, context) 
		//Success
		= (Nothing, Just {MySQLConnection|conn_ptr = conn_ptr}, context)
		
	closeConnection	:: !*MySQLConnection !*MySQLContext -> (!(Maybe SQLError), !*MySQLContext)
	closeConnection connection=:{MySQLConnection|conn_ptr} context 
		# dummy = mysql_close conn_ptr
		| dummy <> dummy = undef	// Force execution of void function
		= (Nothing, context)

instance SQLConnection MySQLConnection MySQLCursor
where
	openCursor :: !*MySQLConnection -> (!(Maybe SQLError), !(Maybe *MySQLCursor), !*MySQLConnection)
	openCursor connection=:{MySQLConnection|conn_ptr}
		# cursor = {MySQLCursor
					| conn_ptr		= conn_ptr
					, result_ptr	= 0
					, result_size	= 0
					, fields_ptr	= 0
					, row_ptr		= 0
					, row_lengths	= 0
					}
		= (Nothing, Just cursor, connection)
	
	closeCursor	:: !*MySQLCursor !*MySQLConnection -> (!(Maybe SQLError), !*MySQLConnection)
	closeCursor cursor=:{MySQLCursor|result_ptr} connection
		| result_ptr == 0
			= (Nothing, connection)
		# dummy = mysql_free_result result_ptr
		| dummy <> dummy = undef	// Force execution of void function
		= (Nothing,connection)

instance SQLCursor MySQLCursor
where
	execute	:: !SQLStatement ![SQLValue] !*MySQLCursor -> (!(Maybe SQLError), !*MySQLCursor)
	execute statement values cursor=:{MySQLCursor|conn_ptr,result_ptr}
		# (error, stmt, cursor)		= mkStatement statement values cursor
		| isJust error				= (error, cursor)
		# dummy						= if (result_ptr <> 0) (mysql_free_result result_ptr) 0
		| dummy <> dummy			= undef // Force execution of void function
		# ok						= mysql_real_query conn_ptr stmt (size stmt)
		| ok <> 0
			# errno 	= mysql_errno conn_ptr
			# errmsg	= derefString (mysql_error conn_ptr)
			| errno <> errno || errmsg <> errmsg	= undef //Force execution
			= (Just (SQLDatabaseError errno errmsg),cursor)
		# result_ptr				= mysql_store_result conn_ptr
		| result_ptr == 0
			= (Nothing, {MySQLCursor|cursor & result_ptr = 0})
		# result_size				= mysql_num_fields result_ptr
		# fields_ptr				= mysql_fetch_fields result_ptr
		= (Nothing, {MySQLCursor|cursor & result_ptr = result_ptr, result_size = result_size, fields_ptr = fields_ptr})
	where
		mkStatement :: !SQLStatement ![SQLValue] !*MySQLCursor -> (!(Maybe SQLError), !SQLStatement, !*MySQLCursor)
		mkStatement statement [] cursor
			# index			= markerIndex statement 0
			| index <> -1	= (Just (SQLProgrammingError 1 "Too many markers in SQL statement"), "", cursor)
							= (Nothing, statement, cursor)
		mkStatement statement [x:xs] cursor
			# index			= markerIndex statement 0
			| index == -1	= (Just (SQLProgrammingError 1 "Not enough markers in SQL statement"), "", cursor)
			# premarker							= statement % (0,index - 1)
			# postmarker						= statement % (index + 1, size statement - 1)
			# (x, cursor)						= formatSQLValue x cursor
			# (xs_error,xs_statement, cursor)	= mkStatement postmarker xs cursor
			= (xs_error, premarker +++ x +++ xs_statement, cursor)

		//Find the index of the first '?' in the string (-1 if not found)
		markerIndex :: String Int -> Int
		markerIndex s i
			| i == size s		= -1
			| select s i == '?'	= i
			| otherwise			= markerIndex s (i + 1)

		//Convert an SQLValue to a string which is properly escaped for inclusion in an SQL statement
		formatSQLValue :: !SQLValue !*MySQLCursor -> (!String, !*MySQLCursor)
		formatSQLValue (SQLVChar s) cursor 
			# (s, cursor) = escapeString s cursor
			= ("'" +++ s +++ "'", cursor)
		formatSQLValue (SQLVVarchar s) cursor 
			# (s, cursor) = escapeString s cursor
			= ("'" +++ s +++ "'", cursor)
		formatSQLValue (SQLVText s) cursor 
			# (s, cursor) = escapeString s cursor
			= ("'" +++ s +++ "'", cursor)
		formatSQLValue (SQLVInteger i) cursor = (toString i, cursor)
		formatSQLValue (SQLVReal r) cursor = (toString r, cursor)
		formatSQLValue (SQLVFloat f) cursor = (toString f, cursor)
		formatSQLValue (SQLVDouble d) cursor = (toString d, cursor)
		formatSQLValue (SQLVDate d) cursor = ("'" +++ toString d +++  "'", cursor) 
		formatSQLValue (SQLVTime t) cursor = ("'" +++ toString t +++ "'", cursor)
		formatSQLValue (SQLVTimestamp t) cursor = (toString t, cursor)
		formatSQLValue (SQLVDatetime d t) cursor = ("'" +++ toString d +++ " " +++ toString t +++ "'", cursor) 
		formatSQLValue (SQLVEnum s) cursor
			# (s, cursor) = escapeString s cursor
			= ("'" +++ s +++ "'", cursor)
		formatSQLValue (SQLVNull) cursor = ("NULL", cursor)
		formatSQLValue (SQLVUnknown s) cursor 
			# (s, cursor) = escapeString s cursor
			= ("'" +++ s +++ "'", cursor)
		
		//The cursor argument is required because it allows the escape function to take
		//the character set of the database into account.
		escapeString :: !String !*MySQLCursor -> (!String, !*MySQLCursor)
		escapeString s cursor=:{MySQLCursor|conn_ptr}
			# buffer = createArray (2 * (size s) + 1 ) '\0'			//Create a buffer that is large enough to hold the escaped string
			# escaped_size = mysql_real_escape_string conn_ptr buffer s (size s)
			# escaped = buffer % (0, escaped_size - 1)				//Trim the buffer to the right size
			= (escaped, cursor)
		
	executeMany :: !SQLStatement ![[SQLValue]] !*MySQLCursor -> (!(Maybe SQLError), !*MySQLCursor)
	executeMany statement [] 	cursor = (Nothing, cursor)
	executeMany statement [x:xs] cursor
		# (error, cursor)	= execute statement x cursor
		| isJust error	= (error, cursor)
						= executeMany statement xs cursor

	insertId :: !*MySQLCursor -> (!(Maybe SQLError), !Int, !*MySQLCursor)
	insertId cursor=:{MySQLCursor|conn_ptr}
		= (Nothing, mysql_insert_id conn_ptr, cursor)
	
	numRows	:: !*MySQLCursor -> (!(Maybe SQLError), !Int, !*MySQLCursor)
	numRows	cursor=:{MySQLCursor|conn_ptr}
		= (Nothing, mysql_affected_rows conn_ptr, cursor) 
	
	numFields :: !*MySQLCursor -> (!(Maybe SQLError), !Int, !*MySQLCursor)
	numFields cursor=:{MySQLCursor|result_ptr}
		= (Nothing, mysql_num_fields result_ptr, cursor)

	fetchOne :: !*MySQLCursor -> (!(Maybe SQLError), !(Maybe SQLRow), !*MySQLCursor)
	fetchOne cursor=:{MySQLCursor|conn_ptr,result_ptr,result_size}
		| result_ptr == 0
			= (Just (SQLProgrammingError 1 "You cannot fetch a row when there is no result set") ,Nothing, cursor)
		# row_ptr	= mysql_fetch_row result_ptr
		| row_ptr == 0
			# errno = mysql_errno conn_ptr
			| errno == 0
				= (Nothing, Nothing, {MySQLCursor|cursor & row_ptr = 0})
			| otherwise
				# errmsg	= derefString (mysql_error conn_ptr)
				| errmsg <> errmsg	= undef //Force execution
				= (Just (SQLDatabaseError errno errmsg), Nothing, {MySQLCursor|cursor & row_ptr = 0})
		| otherwise
			# row_lengths		= mysql_fetch_lengths result_ptr	
			# (row, cursor)		= mapst readField [0..(result_size - 1)] {MySQLCursor|cursor & row_ptr = row_ptr, row_lengths = row_lengths}
			= (Nothing, Just row, cursor)
	where
		mapst :: (.a *st -> (.b, *st)) [.a] *st -> ([.b], *st)
		mapst f [] st = ([],st)
		mapst f [x:xs] st
			# (fx,st)	= f x st
			# (fxs,st)	= mapst f xs st
			= ([fx:fxs],st)
	
		readField :: !Int !*MySQLCursor -> (!SQLValue, !*MySQLCursor)
		readField n cursor=:{MySQLCursor|fields_ptr,row_ptr,row_lengths}
			# cell_ptr			= readInt row_ptr (4 * n)
			| cell_ptr	== 0
				= (SQLVNull, cursor)
			# cell_size			= readInt row_lengths (4 * n)
			# data				= {readChar cell_ptr i \\ i <- [0.. cell_size - 1]}
			# type				= readInt fields_ptr ((SIZEOF_MYSQL_FIELD * n) + MYSQL_FIELD_TYPE_OFFSET)
			# flags				= readInt fields_ptr ((SIZEOF_MYSQL_FIELD * n) + MYSQL_FIELD_FLAGS_OFFSET)
			| (flags bitand ENUM_FLAG) <> 0 
				= (SQLVEnum data, cursor)
			| otherwise
				= case type of
					MYSQL_TYPE_TINY			= (SQLVInteger (toInt data),cursor)
					MYSQL_TYPE_SHORT		= (SQLVInteger (toInt data),cursor)
					MYSQL_TYPE_LONG			= (SQLVInteger (toInt data),cursor)
					MYSQL_TYPE_INT24		= (SQLVInteger (toInt data),cursor)
					MYSQL_TYPE_LONGLONG		= (SQLVInteger (toInt data),cursor)
					MYSQL_TYPE_DECIMAL		= (SQLVReal (toReal data),cursor)
					MYSQL_TYPE_NEWDECIMAL	= (SQLVReal (toReal data),cursor)
					MYSQL_TYPE_FLOAT		= (SQLVFloat (toReal data),cursor)
					MYSQL_TYPE_DOUBLE		= (SQLVDouble (toReal data),cursor)
					MYSQL_TYPE_TIMESTAMP	= (SQLVTimestamp (toInt data),cursor)
					MYSQL_TYPE_DATE			= (SQLVDate {year = toInt (data % (0,3)), month = toInt (data % (5,6)), day = toInt (data % (8,9))},cursor)
					MYSQL_TYPE_TIME			= (SQLVTime {hour = toInt (data % (0,1)), minute = toInt (data % (3,4)), second = toInt (data % (6,7))},cursor)
					MYSQL_TYPE_DATETIME		= (SQLVDatetime {year = toInt (data % (0,3)), month = toInt (data % (5,6)), day = toInt (data % (8,9))}
															{hour = toInt (data % (11,12)), minute = toInt (data % (14,15)), second = toInt (data % (17,18))},cursor)
					MYSQL_TYPE_STRING		= (SQLVChar data,cursor)
					MYSQL_TYPE_VAR_STRING	= (SQLVVarchar data,cursor)
					MYSQL_TYPE_BLOB			= (SQLVText data,cursor)
					MYSQL_TYPE_ENUM			= (SQLVEnum data,cursor)
					_						= (SQLVUnknown data,cursor)
	
	fetchMany :: !Int !*MySQLCursor -> (!(Maybe SQLError), ![SQLRow], !*MySQLCursor)
	fetchMany 0 cursor = (Nothing, [], cursor)
	fetchMany n cursor 
		# (error, row, cursor) = fetchOne cursor
		= case row of	Nothing		= (Nothing, [], cursor)
						(Just x)
							# (error, xs, cursor) = fetchMany (n - 1) cursor
							= (error, [x:xs], cursor)

	fetchAll :: !*MySQLCursor -> (!(Maybe SQLError), ![SQLRow], !*MySQLCursor)
	fetchAll cursor 
		# (error, row, cursor) = fetchOne cursor
		= case row of	Nothing 	= (Nothing, [], cursor)
						(Just x)
							# (error, xs, cursor) = fetchAll cursor
							= (error, [x:xs], cursor)

	commit :: !*MySQLCursor -> (!(Maybe SQLError), !*MySQLCursor)
	commit cursor = (Just SQLNotSupportedError, cursor)

	rollback :: !*MySQLCursor -> (!(Maybe SQLError), !*MySQLCursor)
	rollback cursor = (Just SQLNotSupportedError, cursor)