Commit 030364b6 authored by Bas Lijnse's avatar Bas Lijnse
Browse files

Added mysql cache to iworld (should be more generic connection cache), Small...

Added mysql cache to iworld (should be more generic connection cache), Small layout fixes, small changes in googlemaps

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2632 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 9ecf8dc1
......@@ -65,7 +65,17 @@ sideStep :: !(Task a) ![TaskStep a b] -> Task a | iTask a & iTask b
sideStep ta steps = parallel Void [(Embedded,const ta),(Embedded,stepper)] @ (map snd) @? firstRes
where
firstRes (Value [v:_] _) = v
stepper l = forever (watch (taskListState l) @? firstRes >>* steps) @? const NoValue
stepper l = forever (watch (taskListState l) >>* steps`) @? const NoValue
where
steps` = [OnAction action (taskfun` taskfun) \\ (OnAction action taskfun) <- steps]
where
//Only enable when there are two tasks in the parallel set, hence no other sideSteps are active
taskfun` taskfun (Value [v,_] _) = case taskfun v of
Just t = Just (appendTask Embedded (removeWhenStable t) l)
Nothing = Nothing
taskfun` _ _ = Nothing
removeWhenStable t l = t >>* [OnValue (ifStable (\_ -> get (taskListSelfId l) >>- \id -> removeTask id l @? const NoValue))]
//Helper functions for projections
projectJust :: (Maybe a) r -> Maybe (Maybe a)
......
......@@ -183,13 +183,13 @@ decorateControl last (control,attributes)
| hasMargin = control
= if noMargins
(setMargins 0 0 0 0 control)
(if last (setMargins 0 5 5 5 control) (setMargins 0 5 0 5 control))
(if last (setMargins 5 5 5 5 control) (setMargins 5 5 0 5 control))
_ //Add decoration
# control = row (labelCtrl mbLabel ++ prefixCtrl mbPrefix ++ [control] ++ postfixCtrl mbPostfix ++ iconCtrl control mbHint mbValid mbWarning mbError)
= if noMargins
(setMargins 0 0 0 0 control)
(if last (setMargins 0 5 5 5 control) (setMargins 0 5 0 5 control))
(if last (setMargins 5 5 5 5 control) (setMargins 5 5 0 5 control))
where
row ctrls = (setSize FlexSize WrapSize o setDirection Horizontal) (defaultContainer ctrls)
......
......@@ -173,12 +173,13 @@ instance toString FileException, ParseException, CallException, SharedException,
, scrollwheel :: Bool // Scrollwheel zooming on the map
, draggable :: Bool // Map can be dragged
}
:: GoogleMapPosition =
:: GoogleMapPosition =
{ lat :: !Real //Lattitude
, lng :: !Real //Longitude
}
:: GoogleMapMarker =
{ position :: !GoogleMapPosition // Position of the marker
{ markerId :: !String // Unique identifier of the marker (to identify it a marker is dragged or selected)
, position :: !GoogleMapPosition // Position of the marker
, title :: !Maybe String // Title of the marker
, icon :: !Maybe GoogleMapIcon // Name of an icon to use
, infoWindow :: !Maybe HtmlTag // Information which is shown on click
......
......@@ -592,8 +592,8 @@ where
{ UIGoogleMapOpts
| center = (map.perspective.GoogleMapPerspective.center.lat,map.perspective.GoogleMapPerspective.center.lng)
, mapType = mapType map.perspective.GoogleMapPerspective.type
, markers = [{UIGoogleMapMarker|position=(lat,lng),title=title,icon=icon,infoWindow=fmap toString infoWindow,draggable=draggable,selected=selected}
\\ {GoogleMapMarker|position={lat,lng},title,icon,infoWindow,draggable,selected} <- map.GoogleMap.markers]
, markers = [{UIGoogleMapMarker|markerId=markerId,position=(lat,lng),title=title,icon=icon,infoWindow=fmap toString infoWindow,draggable=draggable,selected=selected}
\\ {GoogleMapMarker|markerId,position={lat,lng},title,icon,infoWindow,draggable,selected} <- map.GoogleMap.markers]
, options =
{ UIGoogleMapOptions
| mapTypeControl = map.settings.GoogleMapSettings.mapTypeControl
......
......@@ -3,6 +3,7 @@ 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
derive class iTask SQLValue, SQLDate, SQLTime
......@@ -11,39 +12,39 @@ sqlShare :: SQLDatabase String (A.*cur: *cur -> *(MaybeErrorString r,*cur) | SQL
(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
read iworld
# (mbOpen,iworld) = openMySQLDb db iworld
= case mbOpen of
Error e = (Error e, {IWorld|iworld & world = world})
Error e = (Error e, iworld)
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
# iworld = closeMySQLDb cur con cxt iworld
= (res,iworld)
write w iworld
# (mbOpen,iworld) = openMySQLDb db iworld
= case mbOpen of
Error e = (Error e, {IWorld|iworld & world = world})
Error e = (Error e, iworld)
Ok (cur,con,cxt)
# (res,cur) = writeFun w cur
# world = closeMySQLDb cur con cxt world
= (res,{IWorld|iworld & world = world})
# 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=:{IWorld|world}
# (mbOpen,world) = openMySQLDb db world
exec _ iworld
# (mbOpen,iworld) = openMySQLDb db iworld
= case mbOpen of
Error e = (Error (dynamic e,toString e), {IWorld|iworld & world = world})
Error e = (Error (dynamic e,toString e), iworld)
Ok (cur,con,cxt)
# (res,cur) = queryFun cur
# world = closeMySQLDb cur con cxt world
# iworld = closeMySQLDb cur con cxt iworld
= case res of
Error e = (Error (dynamic e,toString e), {IWorld|iworld & world = world})
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|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
......@@ -74,33 +75,43 @@ 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=:{IWorld|world}
# (mbOpen,world) = openMySQLDb db world
read iworld
# (mbOpen,iworld) = openMySQLDb db iworld
= case mbOpen of
Error e = (Error e, {IWorld|iworld & world = world})
Error e = (Error e, iworld)
Ok (cur,con,cxt)
# (err,cur) = execute query values cur
| isJust err = (Error (toString (fromJust err)),{IWorld|iworld & world = world})
| isJust err = (Error (toString (fromJust err)),iworld)
# (err,rows,cur) = fetchAll cur
| isJust err = (Error (toString (fromJust err)),{IWorld|iworld & world = world})
# world = closeMySQLDb cur con cxt world
= (Ok rows,{IWorld|iworld & world = world})
| isJust err = (Error (toString (fromJust err)),iworld)
# iworld = closeMySQLDb cur con cxt iworld
= (Ok rows,iworld)
write Void iworld = (Ok Void,iworld)
openMySQLDb :: !SQLDatabase !*World -> (MaybeErrorString (!*MySQLCursor, !*MySQLConnection, !*MySQLContext), !*World)
openMySQLDb db world
# (err,mbContext,world) = openContext world
| isJust err = (Error (toString (fromJust err)),world)
# (err,mbConn,context) = openConnection db (fromJust mbContext)
| isJust err = (Error (toString (fromJust err)),world)
# (err,mbCursor,connection) = openCursor (fromJust mbConn)
| isJust err = (Error (toString (fromJust err)),world)
= (Ok (fromJust mbCursor,connection, context), world)
openMySQLDb :: !SQLDatabase !*IWorld -> (MaybeErrorString (!*MySQLCursor, !*MySQLConnection, !*MySQLContext), !*IWorld)
openMySQLDb db iworld=:{IWorld|mysqlConnection=Just con}
= (Ok con, {IWorld|iworld & mysqlConnection=Nothing})
openMySQLDb db iworld=:{IWorld|mysqlConnection=Nothing}
# iworld=:{IWorld|world} = {IWorld|iworld & mysqlConnection = Nothing}
# world = trace_n "Opening MySQLDB" world
# (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 !*World -> *World
closeMySQLDb cursor connection context world
closeMySQLDb :: !*MySQLCursor !*MySQLConnection !*MySQLContext !*IWorld -> *IWorld
closeMySQLDb cursor connection context iworld=:{IWorld|mysqlConnection=Nothing}
= {IWorld|iworld & mysqlConnection=Just (cursor,connection,context)}
closeMySQLDb cursor connection context iworld=:{IWorld|world}
# world = trace_n "Closing MySQLDB" world
# (err,connection) = closeCursor cursor connection
# (err,context) = closeConnection connection context
# (err,world) = closeContext context world
= world
= {IWorld|iworld & world = world}
import StdDebug
......@@ -195,6 +195,7 @@ initIWorld sdkPath world
,uiMessages = newMap
,shutdown = False
,world = world
,mysqlConnection = Nothing
}
where
defaultConfig :: Config
......
......@@ -13,6 +13,7 @@ from Text.JSON import :: JSONNode
from StdFile import class FileSystem
from Data.SharedDataSource import class registerSDSDependency, class registerSDSChangeDetection, class reportSDSChange, :: CheckRes(..), :: BasicShareId, :: Hash
from iTasks.Framework.TaskServer import class HttpServerEnv
import Database.SQL.MySQL
:: *IWorld = { application :: !String // The name of the application
, build :: !String // The date/time identifier of the application's build
......@@ -41,6 +42,9 @@ from iTasks.Framework.TaskServer import class HttpServerEnv
, shutdown :: !Bool // Flag that signals the server function to shut down
, world :: !*World // The outside world
//Experimental database connection cache
, mysqlConnection :: !*(Maybe *(!*MySQLCursor, !*MySQLConnection, !*MySQLContext))
}
updateCurrentDateTime :: !*IWorld -> *IWorld
......
......@@ -13,6 +13,7 @@ from iTasks.Framework.TaskState import :: TaskListEntry
from iTasks.API.Core.SystemTypes import :: DateTime, :: User, :: Config, :: TaskId, :: TaskNo, :: InstanceNo, :: TaskListItem, :: TaskTime, :: SessionId
from iTasks import serialize, deserialize, defaultStoreFormat, functionFree
from System.Time import :: Timestamp(..), instance < Timestamp, instance toInt Timestamp
import Database.SQL.MySQL
:: StoreItem =
{ format :: !StoreFormat
......
......@@ -38,7 +38,7 @@ createSessionTaskInstance :: !(Task a) !Event !*IWorld -> (!MaybeErrorString (!T
* @return The task id of the stored instance
* @return The IWorld state
*/
createDetachedTaskInstance :: !(Task a) !(Maybe InstanceNo) !ManagementMeta !User !TaskId !(Maybe [TaskId]) !*IWorld -> (!TaskId, !*IWorld) | iTask a
createDetachedTaskInstance :: !(Task a) !(Maybe InstanceNo) !(Maybe String) !ManagementMeta !User !TaskId !(Maybe [TaskId]) !*IWorld -> (!TaskId, !*IWorld) | iTask a
/**
* Evaluate a session task instance
......
......@@ -22,7 +22,7 @@ createSessionTaskInstance task event iworld=:{currentDateTime,taskTime}
//Create the initial instance data in the store
# mmeta = defaultValue
# pmeta = {issuedAt=currentDateTime,issuedBy=worker,stable=False,firstEvent=Nothing,latestEvent=Nothing}
# meta = createMeta instanceNo (SessionInstance {SessionInfo|sessionId=sessionId,lastEvent=0}) (TaskId 0 0) mmeta pmeta
# meta = createMeta instanceNo (SessionInstance {SessionInfo|sessionId=sessionId,lastEvent=0}) (TaskId 0 0) Nothing mmeta pmeta
# (_,iworld) = 'Data.SharedDataSource'.write meta (sessionInstanceMeta instanceNo) iworld
# (_,iworld) = 'Data.SharedDataSource'.write (createReduct instanceNo task taskTime) (taskInstanceReduct instanceNo) iworld
# (_,iworld) = 'Data.SharedDataSource'.write (createResult instanceNo taskTime) (taskInstanceResult instanceNo) iworld
......@@ -38,22 +38,22 @@ where
registerSession sessionId instanceNo iworld=:{IWorld|sessions}
= {IWorld|iworld & sessions = 'Data.Map'.put sessionId instanceNo sessions}
createDetachedTaskInstance :: !(Task a) !(Maybe InstanceNo) !ManagementMeta !User !TaskId !(Maybe [TaskId]) !*IWorld -> (!TaskId, !*IWorld) | iTask a
createDetachedTaskInstance task mbInstanceNo mmeta issuer listId mbAttachment iworld=:{currentDateTime,taskTime}
createDetachedTaskInstance :: !(Task a) !(Maybe InstanceNo) !(Maybe String) !ManagementMeta !User !TaskId !(Maybe [TaskId]) !*IWorld -> (!TaskId, !*IWorld) | iTask a
createDetachedTaskInstance task mbInstanceNo name mmeta issuer listId mbAttachment iworld=:{currentDateTime,taskTime}
# (instanceNo,iworld) = case mbInstanceNo of
Nothing = newInstanceNo iworld
Just instanceNo = (instanceNo,iworld)
# pmeta = {issuedAt=currentDateTime,issuedBy=issuer,stable=False,firstEvent=Nothing,latestEvent=Nothing}
# meta = createMeta instanceNo (maybe DetachedInstance (\attachment -> TmpAttachedInstance [listId:attachment] issuer) mbAttachment) listId mmeta pmeta
# meta = createMeta instanceNo (maybe DetachedInstance (\attachment -> TmpAttachedInstance [listId:attachment] issuer) mbAttachment) listId name mmeta pmeta
# (_,iworld) = 'Data.SharedDataSource'.write meta (detachedInstanceMeta instanceNo) iworld
# (_,iworld) = 'Data.SharedDataSource'.write (createReduct instanceNo task taskTime) (taskInstanceReduct instanceNo) iworld
# (_,iworld) = 'Data.SharedDataSource'.write (createResult instanceNo taskTime) (taskInstanceResult instanceNo) iworld
# iworld = if (isJust mbAttachment) (queueUrgentEvaluate instanceNo iworld) iworld
= (TaskId instanceNo 0, iworld)
createMeta :: !InstanceNo !TIType !TaskId !ManagementMeta !ProgressMeta -> TIMeta
createMeta instanceNo instanceType listId mmeta pmeta
= {TIMeta|instanceNo=instanceNo,instanceType=instanceType,listId=listId,management=mmeta,progress=pmeta}
createMeta :: !InstanceNo !TIType !TaskId !(Maybe String) !ManagementMeta !ProgressMeta -> TIMeta
createMeta instanceNo instanceType listId name mmeta pmeta
= {TIMeta|instanceNo=instanceNo,instanceType=instanceType,listId=listId,name=name,management=mmeta,progress=pmeta}
createReduct :: !InstanceNo !(Task a) !TaskTime -> TIReduct | iTask a
createReduct instanceNo task taskTime
......@@ -296,8 +296,8 @@ topListShare = mapReadWrite (readPrj,writePrj) (detachedInstances >+| currentIns
where
readPrj (instances, currentInstance) = {TaskList|listId = TopLevelTaskList, items = [toTaskListItem m \\ (_,m) <- ('Data.Map'.toList instances)], selfId = TaskId currentInstance 0}
toTaskListItem {TIMeta|instanceNo,listId,progress,management}
= {taskId = TaskId instanceNo 0, listId = listId, name = Nothing, value = NoValue, progressMeta = Just progress, managementMeta = Just management}
toTaskListItem {TIMeta|instanceNo,listId,name,progress,management}
= {taskId = TaskId instanceNo 0, listId = listId, name = name, value = NoValue, progressMeta = Just progress, managementMeta = Just management}
writePrj [] instances = Nothing
writePrj updates (instances,_) = Just (foldl applyUpdate instances updates)
......
......@@ -14,6 +14,7 @@ derive JSONDecode TIMeta, SessionInfo, TIReduct, TaskTree
{ instanceNo :: !InstanceNo //Unique global identification
, instanceType :: !TIType
, listId :: !TaskId //Reference to parent tasklist
, name :: !Maybe String //Identifier
, progress :: !ProgressMeta
, management :: !ManagementMeta
}
......
......@@ -222,7 +222,8 @@ from iTasks.API.Core.SystemTypes import :: Document, :: DocumentId, :: Date, ::
}
:: UIGoogleMapMarker =
{ position :: !(!Real,!Real)
{ markerId :: !String
, position :: !(!Real,!Real)
, title :: !Maybe String
, icon :: !Maybe GoogleMapIcon
, infoWindow :: !Maybe String
......
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