Commit 1ffb398c authored by Bas Lijnse's avatar Bas Lijnse

System share fix

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2378 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 04381d6d
......@@ -287,7 +287,7 @@ where
//Destroy detached tasks (Just delete the instance)
destroyParTask (_,iworld) {TaskListEntry|entryId,state=DetachedState instanceNo _ _}
= (Nothing,deleteTaskInstance instanceNo iworld)
= (Nothing,deleteInstance instanceNo iworld)
toValueAndTime :: !TaskListEntry -> (!TaskTime,TaskValue a) | iTask a
toValueAndTime {TaskListEntry|result=TIValue val _,lastEvent} = (lastEvent,deserialize val)
......@@ -448,7 +448,7 @@ where
remove :: !(TaskListId a) !TaskId !*IWorld -> *IWorld
remove TopLevelTaskList (TaskId instanceNo 0) iworld
= deleteTaskInstance instanceNo iworld
= deleteInstance instanceNo iworld
remove (ParallelTaskList parId) entryId iworld
= markListEntryRemoved parId entryId iworld
remove _ _ iworld = iworld
......
......@@ -10,7 +10,7 @@ from Util import qualified currentDate, currentTime, currentDateTime, currentT
SYSTEM_DATA_NS :== "SystemData"
sharedStore :: !String !a -> Shared a | JSONEncode{|*|}, JSONDecode{|*|}, TC a
sharedStore storeId defaultV = storeAccess NS_APPLICATION_SHARES storeId defaultV
sharedStore storeId defaultV = storeAccess NS_APPLICATION_SHARES storeId (Just defaultV)
currentDateTime :: ReadOnlyShared DateTime
currentDateTime = createReadOnlySDSPredictable SYSTEM_DATA_NS "currentDateTime" read
......
......@@ -29,8 +29,14 @@ NS_APPLICATION_SHARES :== "application-data"
/**
* Create a shared data source for a piece of data in the store
*
* @param The namespace in the store
* @param The key of the value in the store
* @param Optionally a default value to be used on first read. If nothing is given an error will occur when reading before writing.
*
* @return The shared data source
*/
storeAccess :: !String !String a -> RWShared a a IWorld | JSONEncode{|*|}, JSONDecode{|*|}, TC a
storeAccess :: !StoreNamespace !StoreKey !(Maybe a) -> RWShared a a IWorld | JSONEncode{|*|}, JSONDecode{|*|}, TC a
/**
* Determine the location of the store from data directory and build
......
......@@ -17,12 +17,12 @@ from iTasks import serialize, deserialize, defaultStoreFormat, functionFree
:: StoreFormat = SFPlain | SFDynamic
storeAccess :: !String !String a -> RWShared a a IWorld | JSONEncode{|*|}, JSONDecode{|*|}, TC a
storeAccess :: !StoreNamespace !StoreKey !(Maybe a) -> RWShared a a IWorld | JSONEncode{|*|}, JSONDecode{|*|}, TC a
storeAccess namespace storeId defaultV = createChangeOnWriteSDS namespace storeId read write
where
read iworld
# (mbV,iworld) = loadValue namespace storeId iworld
= (maybe (Ok defaultV) Ok mbV, iworld)
= (maybe (maybe (Error ("Can't read " +++ storeId)) Ok defaultV) Ok mbV, iworld)
write v iworld
= (Ok Void,storeValue namespace storeId v iworld)
......
......@@ -15,7 +15,10 @@ newInstanceNo :: !*IWorld -> (!InstanceNo, !*IWorld)
maxInstanceNo :: !*IWorld -> (!InstanceNo, !*IWorld)
newDocumentId :: !*IWorld -> (!DocumentId, !*IWorld)
//Task instance state accessible as shared data sources
//Create and delete task instances
deleteInstance :: !InstanceNo !*IWorld -> *IWorld
//Task instance state is accessible as shared data sources
taskInstances :: RWShared (Map InstanceNo TIMeta) (Map InstanceNo TIMeta) IWorld //The master index of available instances
taskInstanceMeta :: !InstanceNo -> RWShared TIMeta TIMeta IWorld
......@@ -23,8 +26,6 @@ taskInstanceReduct :: !InstanceNo -> RWShared TIReduct TIReduct IWorld
taskInstanceResult :: !InstanceNo -> RWShared TIResult TIResult IWorld
taskInstanceRep :: !InstanceNo -> RWShared TIRep TIRep IWorld
deleteTaskInstance :: !InstanceNo !*IWorld -> *IWorld
//Documents
createDocument :: !String !String !String !*IWorld -> (!MaybeError FileError Document, !*IWorld)
createDocumentWith :: !String !String (*File -> *File) !*IWorld -> (!MaybeError FileError Document, !*IWorld)
......
......@@ -21,7 +21,7 @@ derive JSONDecode UIControlSequence, UIActionSet, UIControlGroup, UIAbstractCont
derive JSONDecode UIMenuButtonOpts, UIButtonOpts, UIContainerOpts, UIPanelOpts, UIFieldSetOpts, UIWindowOpts, UIViewportOpts
derive JSONDecode UISize, UIMinSize, UIDirection, UIHAlign, UIVAlign, UISideSizes, UIMenuItem
derive gDefault TIMeta//, TIReduct, TIResult, TaskListEntry, TaskTree//, TaskRep, DeferredJSON, InteractionMask
//derive gDefault TIMeta//, TIReduct, TIResult, TaskListEntry, TaskTree//, TaskRep, DeferredJSON, InteractionMask
INCREMENT :== "increment"
PERSISTENT_INDEX :== "persistent-index"
......@@ -60,84 +60,36 @@ newDocumentId iworld=:{world,timestamp}
# (Clock c,world) = clock world
= (toString (take 32 [toChar (97 + abs (i rem 26)) \\ i <- genRandInt (toInt timestamp+c)]) ,{iworld & world = world})
deleteInstance :: !InstanceNo !*IWorld -> *IWorld
deleteInstance instanceNo iworld
= case read taskInstances iworld of
(Ok instances,iworld)
# (_,iworld) = write (del instanceNo instances) taskInstances iworld
= iworld
(_,iworld)
= iworld
storeTaskInstance :: !TaskInstance !*IWorld -> *IWorld
storeTaskInstance (meta=:{TIMeta|instanceNo,sessionId},reduct,result,rep) iworld
//Store all parts
# iworld = storeValue NS_TASK_INSTANCES (meta_store instanceNo) meta iworld
# iworld = storeValue NS_TASK_INSTANCES (reduct_store instanceNo) reduct iworld
# iworld = storeValue NS_TASK_INSTANCES (result_store instanceNo) result iworld
# iworld = storeValue NS_TASK_INSTANCES (rep_store instanceNo) rep iworld
= case sessionId of
Just sessionId = updateSessionInstanceIndex (put sessionId instanceNo) iworld
Nothing = updatePersistentInstanceIndex (replace (instanceToTaskListItem meta rep)) iworld
where
replace item [] = [item]
replace item [i:is] = if (item.TaskListItem.taskId == i.TaskListItem.taskId) [item:is] [i:replace item is]
instanceToTaskListItem :: !TIMeta !TIRep -> TaskListItem a
instanceToTaskListItem {TIMeta|instanceNo,progress,management} (TaskRep def _)
= {taskId = TaskId instanceNo 0, value = NoValue, taskMeta = toList (uiDefAttributes def), progressMeta = Just progress, managementMeta = Just management}
loadTaskInstance :: !InstanceNo !*IWorld -> (!MaybeErrorString (TIMeta,TIReduct,TIResult), !*IWorld)
loadTaskInstance instanceNo iworld
# (meta,iworld) = loadValue NS_TASK_INSTANCES (meta_store instanceNo) iworld
# (reduct,iworld) = loadValue NS_TASK_INSTANCES (reduct_store instanceNo) iworld
# (result,iworld) = loadValue NS_TASK_INSTANCES (result_store instanceNo) iworld
= case (meta,reduct,result) of
(Just meta,Just reduct,Just result)
= (Ok (meta,reduct,result),iworld)
_
= (Error ("Could not load instance state of task " +++ toString instanceNo),iworld)
loadSessionInstance :: !SessionId !*IWorld -> (!MaybeErrorString (TIMeta,TIReduct,TIResult), !*IWorld)
loadSessionInstance sessionId iworld=:{sessions}
= case get sessionId sessions of
Just topno = loadTaskInstance topno iworld
_ = (Error ("Could not load session " +++ sessionId), iworld)
loadTaskMeta :: !InstanceNo !*IWorld -> (!MaybeErrorString TIMeta, !*IWorld)
loadTaskMeta instanceNo iworld
# (meta,iworld) = loadValue NS_TASK_INSTANCES (meta_store instanceNo) iworld
= (maybe (Error ("Could not load meta state of task " +++ toString instanceNo)) Ok meta, iworld)
loadTaskReduct :: !InstanceNo !*IWorld -> (!MaybeErrorString TIReduct, !*IWorld)
loadTaskReduct instanceNo iworld
# (reduct,iworld) = loadValue NS_TASK_INSTANCES (reduct_store instanceNo) iworld
= (maybe (Error ("Could not load reduct state of task " +++ toString instanceNo)) Ok reduct, iworld)
loadTaskResult :: !InstanceNo !*IWorld -> (!MaybeErrorString TIResult, !*IWorld)
loadTaskResult instanceNo iworld
# (result,iworld) = loadValue NS_TASK_INSTANCES (result_store instanceNo) iworld
= (maybe (Error ("Could not load result state of task " +++ toString instanceNo)) Ok result, iworld)
loadTaskRep :: !InstanceNo !*IWorld -> (!MaybeErrorString TIRep, !*IWorld)
loadTaskRep instanceNo iworld
# (rep,iworld) = loadValue NS_TASK_INSTANCES (rep_store instanceNo) iworld
= (maybe (Error ("Could not load ui representation state of task " +++ toString instanceNo)) Ok rep, iworld)
storeTaskMeta :: !InstanceNo !TIMeta !*IWorld -> *IWorld
storeTaskMeta instanceNo meta iworld = storeValue NS_TASK_INSTANCES (meta_store instanceNo) meta iworld
storeTaskReduct :: !InstanceNo !TIReduct !*IWorld -> *IWorld
storeTaskReduct instanceNo reduct iworld = storeValue NS_TASK_INSTANCES (reduct_store instanceNo) reduct iworld
storeTaskResult :: !InstanceNo !TIResult !*IWorld -> *IWorld
storeTaskResult instanceNo result iworld = storeValue NS_TASK_INSTANCES (result_store instanceNo) result iworld
storeTaskRep :: !InstanceNo !TIRep !*IWorld -> *IWorld
storeTaskRep instanceNo rep iworld = storeValue NS_TASK_INSTANCES (rep_store instanceNo) rep iworld
deleteTaskInstance :: !InstanceNo !*IWorld -> *IWorld
deleteTaskInstance instanceNo iworld
# iworld = deleteValue NS_TASK_INSTANCES (meta_store instanceNo) iworld
# iworld = deleteValue NS_TASK_INSTANCES (reduct_store instanceNo) iworld
# iworld = deleteValue NS_TASK_INSTANCES (result_store instanceNo) iworld
# iworld = deleteValue NS_TASK_INSTANCES (rep_store instanceNo) iworld
# iworld = updatePersistentInstanceIndex (delete instanceNo) iworld
= iworld
taskInstances :: RWShared (Map InstanceNo TIMeta) (Map InstanceNo TIMeta) IWorld
taskInstances = storeAccess NS_TASK_INSTANCES "instances" (Just newMap)
taskInstanceMeta :: !InstanceNo -> RWShared TIMeta TIMeta IWorld
taskInstanceMeta instanceNo = mapReadWriteError (readPrj,writePrj) taskInstances
where
delete id list = [ i \\ i <- list | i.TaskListItem.taskId <> TaskId id 0]
readPrj instances = case get instanceNo instances of
Just i = Ok i
_ = Error ("Task instance " +++ toString instanceNo +++ " could not be found")
writePrj i instances = Ok (Just (put instanceNo i instances))
taskInstanceReduct :: !InstanceNo -> RWShared TIReduct TIReduct IWorld
taskInstanceReduct instanceNo = storeAccess NS_TASK_INSTANCES (reduct_store instanceNo) Nothing
taskInstanceResult :: !InstanceNo -> RWShared TIResult TIResult IWorld
taskInstanceResult instanceNo = storeAccess NS_TASK_INSTANCES (result_store instanceNo) Nothing
taskInstanceRep :: !InstanceNo -> RWShared TIRep TIRep IWorld
taskInstanceRep instanceNo = storeAccess NS_TASK_INSTANCES (rep_store instanceNo) Nothing
createDocument :: !String !String !String !*IWorld -> (!MaybeError FileError Document, !*IWorld)
createDocument name mime content iworld
# (documentId, iworld) = newDocumentId iworld
......@@ -162,14 +114,6 @@ documentLocation :: !DocumentId !*IWorld -> (!FilePath,!*IWorld)
documentLocation documentId iworld=:{build,dataDirectory}
= (storePath dataDirectory build </> NS_DOCUMENT_CONTENT </> (documentId +++ "_data.bin"),iworld)
updateTaskInstanceMeta :: !InstanceNo !(TIMeta -> TIMeta) !*IWorld -> *IWorld
updateTaskInstanceMeta instanceNo f iworld
= case loadValue NS_TASK_INSTANCES (meta_store instanceNo) iworld of
(Nothing,iworld) = iworld
(Just meta,iworld)
# iworld = storeValue NS_TASK_INSTANCES (meta_store instanceNo) (f meta) iworld
= addOutdatedInstances [(instanceNo, Nothing)] iworld
addShareRegistration :: !BasicShareId !InstanceNo !*IWorld -> *IWorld
addShareRegistration shareId instanceNo iworld
# (mbRegs,iworld) = loadValue NS_TASK_INSTANCES SHARE_REGISTRATIONS iworld
......@@ -200,28 +144,7 @@ addOutdatedOnShareChange shareId filterFun iworld
addOutdatedInstances :: ![(!InstanceNo, !Maybe Timestamp)] !*IWorld -> *IWorld
addOutdatedInstances outdated iworld = seqSt queueWork [(Evaluate instanceNo,mbTs) \\ (instanceNo,mbTs) <- outdated] iworld
taskInstances :: RWShared (Map InstanceNo TIMeta) (Map InstanceNo TIMeta) IWorld
taskInstances = storeAccess NS_TASK_INSTANCES "instances" newMap
taskInstanceMeta :: !InstanceNo -> RWShared TIMeta TIMeta IWorld
taskInstanceMeta instanceNo = mapReadWriteError (readPrj,writePrj) taskInstances
where
readPrj instances = case get instanceNo instances of
Just i = Ok i
_ = Error ("Task instance " +++ toString instanceNo +++ " could not be found")
writePrj i instances = Ok (Just (put instanceNo i instances))
taskInstanceReduct :: !InstanceNo -> RWShared TIReduct TIReduct IWorld
taskInstanceReduct instanceNo = storeAccess NS_TASK_INSTANCES (reduct_store instanceNo) (abort "Read task instance reduct too early")
taskInstanceResult :: !InstanceNo -> RWShared TIResult TIResult IWorld
taskInstanceResult instanceNo = storeAccess NS_TASK_INSTANCES (result_store instanceNo) (abort "Read task instance result too early")
taskInstanceRep :: !InstanceNo -> RWShared TIRep TIRep IWorld
taskInstanceRep instanceNo = storeAccess NS_TASK_INSTANCES (rep_store instanceNo) (abort "Read task representation result too early")
storeCurUI :: !SessionId !Int !UIDef !*IWorld -> *IWorld
storeCurUI sid version def iworld=:{IWorld|uis} = {IWorld|iworld & uis = put sid (version,def) uis}
......@@ -241,14 +164,3 @@ restoreUICache iworld
= case mbUis of
Just uis = {IWorld|iworld & uis = uis}
_ = iworld
updateSessionInstanceIndex :: !((Map SessionId InstanceNo)-> (Map SessionId InstanceNo)) !*IWorld -> *IWorld
updateSessionInstanceIndex f iworld=:{sessions}
= {IWorld|iworld & sessions = f sessions}
updatePersistentInstanceIndex :: !([TaskListItem Void] -> [TaskListItem Void]) !*IWorld -> *IWorld
updatePersistentInstanceIndex f iworld
# (index,iworld) = loadValue NS_TASK_INSTANCES PERSISTENT_INDEX iworld
# iworld = storeValue NS_TASK_INSTANCES PERSISTENT_INDEX (f (fromMaybe [] index)) iworld
= iworld
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