Commit 17bc3798 authored by Bas Lijnse's avatar Bas Lijnse

Improved SQL database support

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2396 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent b6b681c9
......@@ -5,16 +5,42 @@ definition module SQLDatabase
*
* It provides only mimimal functionality and currently only works with MySQL...
*/
import iTasks, SQL
import iTasks, SQL, Error
derive class iTask SQLValue, SQLTime, SQLDate
/**
* Generic SQL Datbase share
* You need to supply the read/write operations as functions using an SQL cursor
*
* @param The database connection details
* @param A unique identifier for the share
* @param The read access function
* @param The write access function
*
* @return The shared data source
*/
sqlShare :: SQLDatabase String (A.*cur: *cur -> *(MaybeErrorString r,*cur) | SQLCursor cur)
(A.*cur: w *cur -> *(MaybeErrorString Void, *cur) | SQLCursor cur) -> ReadWriteShared r w
/**
* Perform one or multiple queries on an SQL database
*/
sqlExecute :: SQLDatabase (A.*cur: *cur -> *(MaybeErrorString a,*cur) | SQLCursor cur) -> Task a | iTask a
//Common helper functions for sqlExecute
execSelect :: SQLStatement [SQLValue] *cur -> *(MaybeErrorString [SQLRow],*cur) | SQLCursor cur
execInsert :: SQLStatement [SQLValue] *cur -> *(MaybeErrorString Int,*cur) | SQLCursor cur
/**
* Run a single query and fetch all results
*/
sqlExecute :: SQLDatabase SQLStatement ![SQLValue] -> Task [SQLRow]
sqlExecuteSelect :: SQLDatabase SQLStatement ![SQLValue] -> Task [SQLRow]
/**
* Read only query that is run each time the share is read.
*
* Note: Although it is possible to do other queries than just selects,
* this is a bad idea. You never know how many times the query will be executed
*/
sqlShare :: SQLDatabase SQLStatement ![SQLValue] -> ReadOnlyShared [SQLRow]
sqlSelectShare :: SQLDatabase SQLStatement ![SQLValue] -> ReadOnlyShared [SQLRow]
......@@ -4,23 +4,63 @@ import iTasks, SQL, MySQL, Error, IWorld, Shared
derive class iTask SQLValue, SQLDate, SQLTime
sqlExecute :: SQLDatabase SQLStatement ![SQLValue] -> Task [SQLRow]
sqlExecute db query values = mkInstantTask exec
sqlShare :: SQLDatabase String (A.*cur: *cur -> *(MaybeErrorString r,*cur) | SQLCursor cur)
(A.*cur: w *cur -> *(MaybeErrorString Void, *cur) | SQLCursor cur) -> ReadWriteShared r w
sqlShare db name readFun writeFun = createChangeOnWriteSDS "SQLShares" name read write
where
read iworld=:{IWorld|world}
# (mbOpen,world) = openMySQLDb db world
= case mbOpen of
Error e = (Error e, {IWorld|iworld & world = world})
Ok (cur,con,cxt)
# (res,cur) = readFun cur
# world = closeMySQLDb cur con cxt world
= (res,{IWorld|iworld & world = world})
write w iworld=:{IWorld|world}
# (mbOpen,world) = openMySQLDb db world
= case mbOpen of
Error e = (Error e, {IWorld|iworld & world = world})
Ok (cur,con,cxt)
# (res,cur) = writeFun w cur
# world = closeMySQLDb cur con cxt world
= (res,{IWorld|iworld & world = world})
sqlExecute :: SQLDatabase (A.*cur: *cur -> *(MaybeErrorString a,*cur) | SQLCursor cur) -> Task a | iTask a
sqlExecute db queryFun = mkInstantTask exec
where
exec _ iworld=:{IWorld|world}
# (mbOpen,world) = openMySQLDb db world
= case mbOpen of
Error e = (Error (dynamic e,toString e), {IWorld|iworld & world = world})
Ok (cur,con,cxt)
# (err,cur) = execute query values cur
| isJust err = (Error (dynamic (fromJust err),toString (fromJust err)),{IWorld|iworld & world = world})
# (err,rows,cur) = fetchAll cur
| isJust err = (Error (dynamic (fromJust err),toString (fromJust err)),{IWorld|iworld & world = world})
# world = closeMySQLDb cur con cxt world
= (Ok rows,{IWorld|iworld & world = world})
# (res,cur) = queryFun cur
# world = closeMySQLDb cur con cxt world
= case res of
Error e = (Error (dynamic e,toString e), {IWorld|iworld & world = world})
Ok v = (Ok v,{IWorld|iworld & world = world})
execSelect :: SQLStatement [SQLValue] *cur -> *(MaybeErrorString [SQLRow],*cur) | SQLCursor cur
execSelect query values cur
# (err,cur) = execute query values cur
| isJust err = (Error (toString (fromJust err)),cur)
# (err,rows,cur) = fetchAll cur
| isJust err = (Error (toString (fromJust err)),cur)
= (Ok rows,cur)
execInsert :: SQLStatement [SQLValue] *cur -> *(MaybeErrorString Int,*cur) | SQLCursor cur
execInsert query values cur
# (err,cur) = execute query values cur
| isJust err = (Error (toString (fromJust err)),cur)
# (err,id,cur) = insertId cur
| isJust err = (Error (toString (fromJust err)),cur)
= (Ok id,cur)
sqlExecuteSelect :: SQLDatabase SQLStatement ![SQLValue] -> Task [SQLRow]
sqlExecuteSelect db query values = sqlExecute db (execSelect query values)
sqlShare :: SQLDatabase SQLStatement ![SQLValue] -> ReadOnlyShared [SQLRow]
sqlShare db query values = createReadOnlySDSError read
sqlSelectShare :: SQLDatabase SQLStatement ![SQLValue] -> ReadOnlyShared [SQLRow]
sqlSelectShare db query values = createReadOnlySDSError read
where
read iworld=:{IWorld|world}
# (mbOpen,world) = openMySQLDb db world
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment