implementation module iTasks.API.Extensions.SQLDatabase import iTasks, Database.SQL, Database.SQL.MySQL, Data.Error, Data.Func import iTasks.Framework.IWorld, iTasks.Framework.Shared from Data.SharedDataSource import class reportSDSChange(..) import qualified Data.Map //Extend Resource type for mysql resources :: *Resource | MySQLResource *(!*MySQLCursor, !*MySQLConnection, !*MySQLContext) derive class iTask SQLValue, SQLDate, SQLTime 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 # (mbOpen,iworld) = openMySQLDb db iworld = case mbOpen of Error e = (Error e, iworld) Ok (cur,con,cxt) # (res,cur) = readFun cur # iworld = closeMySQLDb cur con cxt iworld = (res,iworld) write w iworld # (mbOpen,iworld) = openMySQLDb db iworld = case mbOpen of Error e = (Error e, iworld) Ok (cur,con,cxt) # (res,cur) = writeFun w cur # iworld = closeMySQLDb cur con cxt iworld = (res,iworld) sqlExecute :: SQLDatabase [String] (A.*cur: *cur -> *(MaybeErrorString a,*cur) | SQLCursor cur) -> Task a | iTask a sqlExecute db touchIds queryFun = mkInstantTask exec where exec _ iworld # (mbOpen,iworld) = openMySQLDb db iworld = case mbOpen of Error e = (Error (dynamic e,toString e), iworld) Ok (cur,con,cxt) # (res,cur) = queryFun cur # iworld = closeMySQLDb cur con cxt iworld = case res of Error e = (Error (dynamic e,toString e), iworld) Ok v //Trigger share change for all touched ids //# iworld = seqSt (\s w -> queueWork (TriggerSDSChange s,Nothing) w) touchIds {IWorld|iworld & world = world} # iworld = seqSt (\s w -> reportSDSChange ("SQLShares:"+++s) (\Void->True) w) touchIds iworld = (Ok v,iworld) 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) execDelete :: SQLStatement [SQLValue] *cur -> *(MaybeErrorString Void,*cur) | SQLCursor cur execDelete query values cur # (err,cur) = execute query values cur | isJust err = (Error (toString (fromJust err)),cur) = (Ok Void,cur) sqlExecuteSelect :: SQLDatabase SQLStatement ![SQLValue] -> Task [SQLRow] sqlExecuteSelect db query values = sqlExecute db [] (execSelect query values) sqlSelectShare :: SQLDatabase String SQLStatement ![SQLValue] -> ReadOnlyShared [SQLRow] sqlSelectShare db name query values = createChangeOnWriteSDS "SQLShares" name read write where read iworld # (mbOpen,iworld) = openMySQLDb db iworld = case mbOpen of Error e = (Error e, iworld) Ok (cur,con,cxt) # (err,cur) = execute query values cur | isJust err = (Error (toString (fromJust err)),iworld) # (err,rows,cur) = fetchAll cur | isJust err = (Error (toString (fromJust err)),iworld) # iworld = closeMySQLDb cur con cxt iworld = (Ok rows,iworld) write Void iworld = (Ok Void,iworld) openMySQLDb :: !SQLDatabase !*IWorld -> (MaybeErrorString (!*MySQLCursor, !*MySQLConnection, !*MySQLContext), !*IWorld) openMySQLDb db iworld=:{IWorld|resources=Just (MySQLResource con)} = (Ok con, {IWorld|iworld & resources=Nothing}) openMySQLDb db iworld=:{IWorld|resources=Nothing} # iworld=:{IWorld|world} = {IWorld|iworld & resources = Nothing} # (err,mbContext,world) = openContext world | isJust err = (Error (toString (fromJust err)),{IWorld|iworld & world = world}) # (err,mbConn,context) = openConnection db (fromJust mbContext) | isJust err = (Error (toString (fromJust err)),{IWorld|iworld & world = world}) # (err,mbCursor,connection) = openCursor (fromJust mbConn) | isJust err = (Error (toString (fromJust err)),{IWorld|iworld & world = world}) = (Ok (fromJust mbCursor,connection, context),{IWorld|iworld & world = world}) closeMySQLDb :: !*MySQLCursor !*MySQLConnection !*MySQLContext !*IWorld -> *IWorld closeMySQLDb cursor connection context iworld=:{IWorld|resources=Nothing} = {IWorld|iworld & resources=Just (MySQLResource (cursor,connection,context))} closeMySQLDb cursor connection context iworld=:{IWorld|world} # (err,connection) = closeCursor cursor connection # (err,context) = closeConnection connection context # (err,world) = closeContext context world = {IWorld|iworld & world = world}